Add OrvilleM monad and RawSql modules

This commit is contained in:
2026-05-29 23:07:49 -04:00
parent 7a0777f497
commit 73864d938f
3 changed files with 92 additions and 7 deletions
+1 -7
View File
@@ -15,19 +15,13 @@ build-type: Simple
library
exposed-modules:
Orville.SQLite
Orville.SQLite.AutoMigration
Orville.SQLite.Execution
Orville.SQLite.FieldDefinition
Orville.SQLite.Monad
Orville.SQLite.RawSql
Orville.SQLite.SqlMarshaller
Orville.SQLite.SqlType
Orville.SQLite.TableDefinition
hs-source-dirs: src
build-depends:
base >=4.17 && <5
, direct-sqlite
, mtl
, text
, bytestring
default-language: Haskell2010
+41
View File
@@ -0,0 +1,41 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Orville.SQLite.Monad
( OrvilleM
, withConnection
, openConnection
, closeConnection
, runOrvilleM
, withTransaction
) where
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Reader (ReaderT, runReaderT, ask, MonadReader)
import qualified Data.Text as T
import qualified Database.SQLite3 as SQLite3
newtype OrvilleM a = OrvilleM
{ unOrvilleM :: ReaderT SQLite3.Database IO a
}
deriving (Functor, Applicative, Monad, MonadIO, MonadReader SQLite3.Database)
runOrvilleM :: SQLite3.Database -> OrvilleM a -> IO a
runOrvilleM db action = runReaderT (unOrvilleM action) db
withConnection :: SQLite3.Database -> OrvilleM a -> IO a
withConnection = runOrvilleM
openConnection :: String -> IO SQLite3.Database
openConnection path = SQLite3.open (T.pack path)
closeConnection :: SQLite3.Database -> IO ()
closeConnection = SQLite3.close
withTransaction :: OrvilleM a -> OrvilleM a
withTransaction action = do
db <- ask
liftIO $ SQLite3.exec db "BEGIN TRANSACTION"
result <- action
liftIO $ SQLite3.exec db "COMMIT"
pure result
+50
View File
@@ -0,0 +1,50 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Orville.SQLite.RawSql
( RawSql (..)
, fromString
, toRawSql
, intercalate
, fromText
, space
, comma
, leftParen
, rightParen
, equals
) where
import qualified Data.Text as T
newtype RawSql = RawSql {unRawSql :: String}
deriving (Show, Eq, Semigroup, Monoid)
fromString :: String -> RawSql
fromString = RawSql
toRawSql :: RawSql -> RawSql
toRawSql = id
fromText :: T.Text -> RawSql
fromText = RawSql . T.unpack
intercalate :: RawSql -> [RawSql] -> RawSql
intercalate sep parts = RawSql . intercalateStr (unRawSql sep) $ map unRawSql parts
where
intercalateStr _ [] = ""
intercalateStr _ [x] = x
intercalateStr s (x : xs) = x <> s <> intercalateStr s xs
space :: RawSql
space = RawSql " "
comma :: RawSql
comma = RawSql ", "
leftParen :: RawSql
leftParen = RawSql "("
rightParen :: RawSql
rightParen = RawSql ")"
equals :: RawSql
equals = RawSql " = "