{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Database.Persist.Sqlite
( withSqlitePool
, withSqlitePoolInfo
, withSqliteConn
, withSqliteConnInfo
, createSqlitePool
, createSqlitePoolFromInfo
, module Database.Persist.Sql
, SqliteConf (..)
, SqliteConnectionInfo
, mkSqliteConnectionInfo
, sqlConnectionStr
, walEnabled
, fkEnabled
, extraPragmas
, runSqlite
, runSqliteInfo
, wrapConnection
, wrapConnectionInfo
, mockMigration
, retryOnBusy
, waitForDatabase
, RawSqlite
, persistentBackend
, rawSqliteConnection
, withRawSqliteConnInfo
, createRawSqlitePoolFromInfo
, createRawSqlitePoolFromInfo_
, withRawSqlitePoolInfo
, withRawSqlitePoolInfo_
) where
import Control.Concurrent (threadDelay)
import qualified Control.Exception as E
import Control.Monad (forM_)
import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, askRunInIO, withRunInIO, withUnliftIO, unliftIO, withRunInIO)
import Control.Monad.Logger (NoLoggingT, runNoLoggingT, MonadLogger, logWarn, runLoggingT)
import Control.Monad.Trans.Reader (ReaderT, runReaderT, withReaderT)
import Control.Monad.Trans.Writer (runWriterT)
import Data.Acquire (Acquire, mkAcquire, with)
import Data.Maybe
import Data.Aeson
import Data.Aeson.Types (modifyFailure)
import Data.Conduit
import qualified Data.Conduit.List as CL
import qualified Data.HashMap.Lazy as HashMap
import Data.Int (Int64)
import Data.IORef
import qualified Data.List as List
import qualified Data.Map as Map
import Data.Monoid ((<>))
import Data.Pool (Pool)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Lens.Micro.TH (makeLenses)
import UnliftIO.Resource (ResourceT, runResourceT)
import Database.Persist.Sql
import qualified Database.Persist.Sql.Util as Util
import qualified Database.Sqlite as Sqlite
createSqlitePool :: (MonadLogger m, MonadUnliftIO m)
=> Text -> Int -> m (Pool SqlBackend)
createSqlitePool :: Text -> Int -> m (Pool SqlBackend)
createSqlitePool = SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
forall (m :: * -> *).
(MonadLogger m, MonadUnliftIO m) =>
SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo (SqliteConnectionInfo -> Int -> m (Pool SqlBackend))
-> (Text -> SqliteConnectionInfo)
-> Text
-> Int
-> m (Pool SqlBackend)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SqliteConnectionInfo
conStringToInfo
createSqlitePoolFromInfo :: (MonadLogger m, MonadUnliftIO m)
=> SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo :: SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo SqliteConnectionInfo
connInfo = (LogFunc -> IO SqlBackend) -> Int -> m (Pool SqlBackend)
forall backend (m :: * -> *).
(MonadLogger m, MonadUnliftIO m,
BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> Int -> m (Pool backend)
createSqlPool ((LogFunc -> IO SqlBackend) -> Int -> m (Pool SqlBackend))
-> (LogFunc -> IO SqlBackend) -> Int -> m (Pool SqlBackend)
forall a b. (a -> b) -> a -> b
$ (SqlBackend -> Connection -> SqlBackend)
-> SqliteConnectionInfo -> LogFunc -> IO SqlBackend
forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> SqlBackend
forall a b. a -> b -> a
const SqliteConnectionInfo
connInfo
withSqlitePool :: (MonadUnliftIO m, MonadLogger m)
=> Text
-> Int
-> (Pool SqlBackend -> m a) -> m a
withSqlitePool :: Text -> Int -> (Pool SqlBackend -> m a) -> m a
withSqlitePool Text
connInfo = (LogFunc -> IO SqlBackend)
-> Int -> (Pool SqlBackend -> m a) -> m a
forall backend (m :: * -> *) a.
(MonadLogger m, MonadUnliftIO m,
BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> Int -> (Pool backend -> m a) -> m a
withSqlPool ((LogFunc -> IO SqlBackend)
-> Int -> (Pool SqlBackend -> m a) -> m a)
-> (SqliteConnectionInfo -> LogFunc -> IO SqlBackend)
-> SqliteConnectionInfo
-> Int
-> (Pool SqlBackend -> m a)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SqlBackend -> Connection -> SqlBackend)
-> SqliteConnectionInfo -> LogFunc -> IO SqlBackend
forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> SqlBackend
forall a b. a -> b -> a
const (SqliteConnectionInfo -> Int -> (Pool SqlBackend -> m a) -> m a)
-> SqliteConnectionInfo -> Int -> (Pool SqlBackend -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ Text -> SqliteConnectionInfo
conStringToInfo Text
connInfo
withSqlitePoolInfo :: (MonadUnliftIO m, MonadLogger m)
=> SqliteConnectionInfo
-> Int
-> (Pool SqlBackend -> m a) -> m a
withSqlitePoolInfo :: SqliteConnectionInfo -> Int -> (Pool SqlBackend -> m a) -> m a
withSqlitePoolInfo SqliteConnectionInfo
connInfo = (LogFunc -> IO SqlBackend)
-> Int -> (Pool SqlBackend -> m a) -> m a
forall backend (m :: * -> *) a.
(MonadLogger m, MonadUnliftIO m,
BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> Int -> (Pool backend -> m a) -> m a
withSqlPool ((LogFunc -> IO SqlBackend)
-> Int -> (Pool SqlBackend -> m a) -> m a)
-> (LogFunc -> IO SqlBackend)
-> Int
-> (Pool SqlBackend -> m a)
-> m a
forall a b. (a -> b) -> a -> b
$ (SqlBackend -> Connection -> SqlBackend)
-> SqliteConnectionInfo -> LogFunc -> IO SqlBackend
forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> SqlBackend
forall a b. a -> b -> a
const SqliteConnectionInfo
connInfo
withSqliteConn :: (MonadUnliftIO m, MonadLogger m)
=> Text -> (SqlBackend -> m a) -> m a
withSqliteConn :: Text -> (SqlBackend -> m a) -> m a
withSqliteConn = SqliteConnectionInfo -> (SqlBackend -> m a) -> m a
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
SqliteConnectionInfo -> (SqlBackend -> m a) -> m a
withSqliteConnInfo (SqliteConnectionInfo -> (SqlBackend -> m a) -> m a)
-> (Text -> SqliteConnectionInfo)
-> Text
-> (SqlBackend -> m a)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SqliteConnectionInfo
conStringToInfo
withSqliteConnInfo :: (MonadUnliftIO m, MonadLogger m)
=> SqliteConnectionInfo -> (SqlBackend -> m a) -> m a
withSqliteConnInfo :: SqliteConnectionInfo -> (SqlBackend -> m a) -> m a
withSqliteConnInfo = (LogFunc -> IO SqlBackend) -> (SqlBackend -> m a) -> m a
forall backend (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m,
BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> (backend -> m a) -> m a
withSqlConn ((LogFunc -> IO SqlBackend) -> (SqlBackend -> m a) -> m a)
-> (SqliteConnectionInfo -> LogFunc -> IO SqlBackend)
-> SqliteConnectionInfo
-> (SqlBackend -> m a)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SqlBackend -> Connection -> SqlBackend)
-> SqliteConnectionInfo -> LogFunc -> IO SqlBackend
forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> SqlBackend
forall a b. a -> b -> a
const
openWith :: (SqlBackend -> Sqlite.Connection -> r)
-> SqliteConnectionInfo
-> LogFunc
-> IO r
openWith :: (SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> r
f SqliteConnectionInfo
connInfo LogFunc
logFunc = do
Connection
conn <- Text -> IO Connection
Sqlite.open (Text -> IO Connection) -> Text -> IO Connection
forall a b. (a -> b) -> a -> b
$ SqliteConnectionInfo -> Text
_sqlConnectionStr SqliteConnectionInfo
connInfo
SqlBackend
backend <- SqliteConnectionInfo -> Connection -> LogFunc -> IO SqlBackend
wrapConnectionInfo SqliteConnectionInfo
connInfo Connection
conn LogFunc
logFunc IO SqlBackend -> IO () -> IO SqlBackend
forall a b. IO a -> IO b -> IO a
`E.onException` Connection -> IO ()
Sqlite.close Connection
conn
r -> IO r
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> IO r) -> r -> IO r
forall a b. (a -> b) -> a -> b
$ SqlBackend -> Connection -> r
f SqlBackend
backend Connection
conn
wrapConnection :: Sqlite.Connection -> LogFunc -> IO SqlBackend
wrapConnection :: Connection -> LogFunc -> IO SqlBackend
wrapConnection = SqliteConnectionInfo -> Connection -> LogFunc -> IO SqlBackend
wrapConnectionInfo (Text -> SqliteConnectionInfo
mkSqliteConnectionInfo Text
"")
retryOnBusy :: (MonadUnliftIO m, MonadLogger m) => m a -> m a
retryOnBusy :: m a -> m a
retryOnBusy m a
action =
[Int] -> m a
start ([Int] -> m a) -> [Int] -> m a
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
20 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> [Int]
forall t. (Ord t, Num t) => t -> [t]
delays Int
1000
where
delays :: t -> [t]
delays t
x
| t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
1000000 = t -> [t]
forall a. a -> [a]
repeat t
x
| Bool
otherwise = t
x t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
delays (t
x t -> t -> t
forall a. Num a => a -> a -> a
* t
2)
start :: [Int] -> m a
start [] = do
Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logWarn Text
"Out of retry attempts"
m a
action
start (Int
x:[Int]
xs) = do
Either SqliteException a
eres <- ((forall a. m a -> IO a) -> IO (Either SqliteException a))
-> m (Either SqliteException a)
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Either SqliteException a))
-> m (Either SqliteException a))
-> ((forall a. m a -> IO a) -> IO (Either SqliteException a))
-> m (Either SqliteException a)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> IO a -> IO (Either SqliteException a)
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO a -> IO (Either SqliteException a))
-> IO a -> IO (Either SqliteException a)
forall a b. (a -> b) -> a -> b
$ m a -> IO a
forall a. m a -> IO a
run m a
action
case Either SqliteException a
eres of
Left (Sqlite.SqliteException { seError :: SqliteException -> Error
Sqlite.seError = Error
Sqlite.ErrorBusy }) -> do
Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logWarn Text
"Encountered an SQLITE_BUSY, going to retry..."
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
x
[Int] -> m a
start [Int]
xs
Left SqliteException
e -> IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ SqliteException -> IO a
forall e a. Exception e => e -> IO a
E.throwIO SqliteException
e
Right a
y -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y
waitForDatabase
:: (MonadUnliftIO m, MonadLogger m, BackendCompatible SqlBackend backend)
=> ReaderT backend m ()
waitForDatabase :: ReaderT backend m ()
waitForDatabase = ReaderT backend m () -> ReaderT backend m ()
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
m a -> m a
retryOnBusy (ReaderT backend m () -> ReaderT backend m ())
-> ReaderT backend m () -> ReaderT backend m ()
forall a b. (a -> b) -> a -> b
$ Text -> [PersistValue] -> ReaderT backend m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
rawExecute Text
"SELECT 42" []
wrapConnectionInfo
:: SqliteConnectionInfo
-> Sqlite.Connection
-> LogFunc
-> IO SqlBackend
wrapConnectionInfo :: SqliteConnectionInfo -> Connection -> LogFunc -> IO SqlBackend
wrapConnectionInfo SqliteConnectionInfo
connInfo Connection
conn LogFunc
logFunc = do
let
walPragma :: [(Text, Bool)] -> [(Text, Bool)]
walPragma
| SqliteConnectionInfo -> Bool
_walEnabled SqliteConnectionInfo
connInfo = ((Text
"PRAGMA journal_mode=WAL;", Bool
True)(Text, Bool) -> [(Text, Bool)] -> [(Text, Bool)]
forall a. a -> [a] -> [a]
:)
| Bool
otherwise = [(Text, Bool)] -> [(Text, Bool)]
forall a. a -> a
id
fkPragma :: [(Text, Bool)] -> [(Text, Bool)]
fkPragma
| SqliteConnectionInfo -> Bool
_fkEnabled SqliteConnectionInfo
connInfo = ((Text
"PRAGMA foreign_keys = on;", Bool
False)(Text, Bool) -> [(Text, Bool)] -> [(Text, Bool)]
forall a. a -> [a] -> [a]
:)
| Bool
otherwise = [(Text, Bool)] -> [(Text, Bool)]
forall a. a -> a
id
pragmas :: [(Text, Bool)]
pragmas = [(Text, Bool)] -> [(Text, Bool)]
walPragma ([(Text, Bool)] -> [(Text, Bool)])
-> [(Text, Bool)] -> [(Text, Bool)]
forall a b. (a -> b) -> a -> b
$ [(Text, Bool)] -> [(Text, Bool)]
fkPragma ([(Text, Bool)] -> [(Text, Bool)])
-> [(Text, Bool)] -> [(Text, Bool)]
forall a b. (a -> b) -> a -> b
$ (Text -> (Text, Bool)) -> [Text] -> [(Text, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (, Bool
False) ([Text] -> [(Text, Bool)]) -> [Text] -> [(Text, Bool)]
forall a b. (a -> b) -> a -> b
$ SqliteConnectionInfo -> [Text]
_extraPragmas SqliteConnectionInfo
connInfo
[(Text, Bool)] -> ((Text, Bool) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Text, Bool)]
pragmas (((Text, Bool) -> IO ()) -> IO ())
-> ((Text, Bool) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Text
pragma, Bool
shouldRetry) -> (LoggingT IO () -> LogFunc -> IO ())
-> LogFunc -> LoggingT IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT IO () -> LogFunc -> IO ()
forall (m :: * -> *) a. LoggingT m a -> LogFunc -> m a
runLoggingT LogFunc
logFunc (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
(if Bool
shouldRetry then LoggingT IO () -> LoggingT IO ()
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
m a -> m a
retryOnBusy else LoggingT IO () -> LoggingT IO ()
forall a. a -> a
id) (LoggingT IO () -> LoggingT IO ())
-> LoggingT IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> LoggingT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ do
Statement
stmt <- Connection -> Text -> IO Statement
Sqlite.prepare Connection
conn Text
pragma
StepResult
_ <- Connection -> Statement -> IO StepResult
Sqlite.stepConn Connection
conn Statement
stmt
Connection -> Statement -> IO ()
Sqlite.reset Connection
conn Statement
stmt
Statement -> IO ()
Sqlite.finalize Statement
stmt
IORef (Map Text Statement)
smap <- Map Text Statement -> IO (IORef (Map Text Statement))
forall a. a -> IO (IORef a)
newIORef (Map Text Statement -> IO (IORef (Map Text Statement)))
-> Map Text Statement -> IO (IORef (Map Text Statement))
forall a b. (a -> b) -> a -> b
$ Map Text Statement
forall k a. Map k a
Map.empty
SqlBackend -> IO SqlBackend
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlBackend -> IO SqlBackend) -> SqlBackend -> IO SqlBackend
forall a b. (a -> b) -> a -> b
$ SqlBackend :: (Text -> IO Statement)
-> (EntityDef -> [PersistValue] -> InsertSqlResult)
-> Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
-> Maybe
(EntityDef -> NonEmpty (HaskellName, DBName) -> Text -> Text)
-> Maybe (EntityDef -> Int -> Text)
-> IORef (Map Text Statement)
-> IO ()
-> ([EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO (Either [Text] [(Bool, Text)]))
-> ((Text -> IO Statement) -> Maybe IsolationLevel -> IO ())
-> ((Text -> IO Statement) -> IO ())
-> ((Text -> IO Statement) -> IO ())
-> (DBName -> Text)
-> Text
-> Text
-> (CharPos -> Bool -> Text -> Text)
-> LogFunc
-> Maybe Int
-> Maybe (EntityDef -> Int -> Text)
-> SqlBackend
SqlBackend
{ connPrepare :: Text -> IO Statement
connPrepare = Connection -> Text -> IO Statement
prepare' Connection
conn
, connStmtMap :: IORef (Map Text Statement)
connStmtMap = IORef (Map Text Statement)
smap
, connInsertSql :: EntityDef -> [PersistValue] -> InsertSqlResult
connInsertSql = EntityDef -> [PersistValue] -> InsertSqlResult
insertSql'
, connUpsertSql :: Maybe (EntityDef -> NonEmpty (HaskellName, DBName) -> Text -> Text)
connUpsertSql = Maybe (EntityDef -> NonEmpty (HaskellName, DBName) -> Text -> Text)
forall a. Maybe a
Nothing
, connPutManySql :: Maybe (EntityDef -> Int -> Text)
connPutManySql = (EntityDef -> Int -> Text) -> Maybe (EntityDef -> Int -> Text)
forall a. a -> Maybe a
Just EntityDef -> Int -> Text
putManySql
, connInsertManySql :: Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
connInsertManySql = Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
forall a. Maybe a
Nothing
, connClose :: IO ()
connClose = Connection -> IO ()
Sqlite.close Connection
conn
, connMigrateSql :: [EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO (Either [Text] [(Bool, Text)])
connMigrateSql = [EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO (Either [Text] [(Bool, Text)])
migrate'
, connBegin :: (Text -> IO Statement) -> Maybe IsolationLevel -> IO ()
connBegin = \Text -> IO Statement
f Maybe IsolationLevel
_ -> Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper Text
"BEGIN" Text -> IO Statement
f
, connCommit :: (Text -> IO Statement) -> IO ()
connCommit = Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper Text
"COMMIT"
, connRollback :: (Text -> IO Statement) -> IO ()
connRollback = IO () -> IO ()
ignoreExceptions (IO () -> IO ())
-> ((Text -> IO Statement) -> IO ())
-> (Text -> IO Statement)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper Text
"ROLLBACK"
, connEscapeName :: DBName -> Text
connEscapeName = DBName -> Text
escape
, connNoLimit :: Text
connNoLimit = Text
"LIMIT -1"
, connRDBMS :: Text
connRDBMS = Text
"sqlite"
, connLimitOffset :: CharPos -> Bool -> Text -> Text
connLimitOffset = Text -> CharPos -> Bool -> Text -> Text
decorateSQLWithLimitOffset Text
"LIMIT -1"
, connLogFunc :: LogFunc
connLogFunc = LogFunc
logFunc
, connMaxParams :: Maybe Int
connMaxParams = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
999
, connRepsertManySql :: Maybe (EntityDef -> Int -> Text)
connRepsertManySql = (EntityDef -> Int -> Text) -> Maybe (EntityDef -> Int -> Text)
forall a. a -> Maybe a
Just EntityDef -> Int -> Text
repsertManySql
}
where
helper :: t -> (t -> IO Statement) -> IO ()
helper t
t t -> IO Statement
getter = do
Statement
stmt <- t -> IO Statement
getter t
t
Int64
_ <- Statement -> [PersistValue] -> IO Int64
stmtExecute Statement
stmt []
Statement -> IO ()
stmtReset Statement
stmt
ignoreExceptions :: IO () -> IO ()
ignoreExceptions = (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (\(SomeException
_ :: E.SomeException) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
runSqlite :: (MonadUnliftIO m)
=> Text
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> m a
runSqlite :: Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
connstr = ResourceT m a -> m a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT
(ResourceT m a -> m a)
-> (ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> ResourceT m a)
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoLoggingT (ResourceT m) a -> ResourceT m a
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT
(NoLoggingT (ResourceT m) a -> ResourceT m a)
-> (ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> NoLoggingT (ResourceT m) a)
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> ResourceT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> (SqlBackend -> NoLoggingT (ResourceT m) a)
-> NoLoggingT (ResourceT m) a
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
Text -> (SqlBackend -> m a) -> m a
withSqliteConn Text
connstr
((SqlBackend -> NoLoggingT (ResourceT m) a)
-> NoLoggingT (ResourceT m) a)
-> (ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> SqlBackend -> NoLoggingT (ResourceT m) a)
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> NoLoggingT (ResourceT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> SqlBackend -> NoLoggingT (ResourceT m) a
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> backend -> m a
runSqlConn
runSqliteInfo :: (MonadUnliftIO m)
=> SqliteConnectionInfo
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> m a
runSqliteInfo :: SqliteConnectionInfo
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqliteInfo SqliteConnectionInfo
conInfo = ResourceT m a -> m a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT
(ResourceT m a -> m a)
-> (ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> ResourceT m a)
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoLoggingT (ResourceT m) a -> ResourceT m a
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT
(NoLoggingT (ResourceT m) a -> ResourceT m a)
-> (ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> NoLoggingT (ResourceT m) a)
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> ResourceT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqliteConnectionInfo
-> (SqlBackend -> NoLoggingT (ResourceT m) a)
-> NoLoggingT (ResourceT m) a
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
SqliteConnectionInfo -> (SqlBackend -> m a) -> m a
withSqliteConnInfo SqliteConnectionInfo
conInfo
((SqlBackend -> NoLoggingT (ResourceT m) a)
-> NoLoggingT (ResourceT m) a)
-> (ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> SqlBackend -> NoLoggingT (ResourceT m) a)
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> NoLoggingT (ResourceT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> SqlBackend -> NoLoggingT (ResourceT m) a
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> backend -> m a
runSqlConn
prepare' :: Sqlite.Connection -> Text -> IO Statement
prepare' :: Connection -> Text -> IO Statement
prepare' Connection
conn Text
sql = do
Statement
stmt <- Connection -> Text -> IO Statement
Sqlite.prepare Connection
conn Text
sql
Statement -> IO Statement
forall (m :: * -> *) a. Monad m => a -> m a
return Statement :: IO ()
-> IO ()
-> ([PersistValue] -> IO Int64)
-> (forall (m :: * -> *).
MonadIO m =>
[PersistValue] -> Acquire (ConduitM () [PersistValue] m ()))
-> Statement
Statement
{ stmtFinalize :: IO ()
stmtFinalize = Statement -> IO ()
Sqlite.finalize Statement
stmt
, stmtReset :: IO ()
stmtReset = Connection -> Statement -> IO ()
Sqlite.reset Connection
conn Statement
stmt
, stmtExecute :: [PersistValue] -> IO Int64
stmtExecute = Connection -> Statement -> [PersistValue] -> IO Int64
execute' Connection
conn Statement
stmt
, stmtQuery :: forall (m :: * -> *).
MonadIO m =>
[PersistValue] -> Acquire (ConduitM () [PersistValue] m ())
stmtQuery = Connection
-> Statement
-> [PersistValue]
-> Acquire (ConduitM () [PersistValue] m ())
forall (m :: * -> *).
MonadIO m =>
Connection
-> Statement
-> [PersistValue]
-> Acquire (ConduitM () [PersistValue] m ())
withStmt' Connection
conn Statement
stmt
}
insertSql' :: EntityDef -> [PersistValue] -> InsertSqlResult
insertSql' :: EntityDef -> [PersistValue] -> InsertSqlResult
insertSql' EntityDef
ent [PersistValue]
vals =
case EntityDef -> Maybe CompositeDef
entityPrimary EntityDef
ent of
Just CompositeDef
_ ->
Text -> [PersistValue] -> InsertSqlResult
ISRManyKeys Text
sql [PersistValue]
vals
where sql :: Text
sql = [Text] -> Text
T.concat
[ Text
"INSERT INTO "
, DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
ent
, Text
"("
, Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DBName -> Text
escape (DBName -> Text) -> (FieldDef -> DBName) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> DBName
fieldDB) [FieldDef]
cols
, Text
") VALUES("
, Text -> [Text] -> Text
T.intercalate Text
"," ((FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FieldDef -> Text
forall a b. a -> b -> a
const Text
"?") [FieldDef]
cols)
, Text
")"
]
Maybe CompositeDef
Nothing ->
Text -> Text -> InsertSqlResult
ISRInsertGet Text
ins Text
sel
where
sel :: Text
sel = [Text] -> Text
T.concat
[ Text
"SELECT "
, DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> DBName
fieldDB (EntityDef -> FieldDef
entityId EntityDef
ent)
, Text
" FROM "
, DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
ent
, Text
" WHERE _ROWID_=last_insert_rowid()"
]
ins :: Text
ins = [Text] -> Text
T.concat
[ Text
"INSERT INTO "
, DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
ent
, if [FieldDef] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldDef]
cols
then Text
" VALUES(null)"
else [Text] -> Text
T.concat
[ Text
"("
, Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DBName -> Text
escape (DBName -> Text) -> (FieldDef -> DBName) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> DBName
fieldDB) ([FieldDef] -> [Text]) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> a -> b
$ [FieldDef]
cols
, Text
") VALUES("
, Text -> [Text] -> Text
T.intercalate Text
"," ((FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FieldDef -> Text
forall a b. a -> b -> a
const Text
"?") [FieldDef]
cols)
, Text
")"
]
]
where
notGenerated :: FieldDef -> Bool
notGenerated =
Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text -> Bool)
-> (FieldDef -> Maybe Text) -> FieldDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> Maybe Text
fieldGenerated
cols :: [FieldDef]
cols =
(FieldDef -> Bool) -> [FieldDef] -> [FieldDef]
forall a. (a -> Bool) -> [a] -> [a]
filter FieldDef -> Bool
notGenerated ([FieldDef] -> [FieldDef]) -> [FieldDef] -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
entityFields EntityDef
ent
execute' :: Sqlite.Connection -> Sqlite.Statement -> [PersistValue] -> IO Int64
execute' :: Connection -> Statement -> [PersistValue] -> IO Int64
execute' Connection
conn Statement
stmt [PersistValue]
vals = (IO Int64 -> IO () -> IO Int64) -> IO () -> IO Int64 -> IO Int64
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO Int64 -> IO () -> IO Int64
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
finally (IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> Statement -> IO ()
Sqlite.reset Connection
conn Statement
stmt) (IO Int64 -> IO Int64) -> IO Int64 -> IO Int64
forall a b. (a -> b) -> a -> b
$ do
Statement -> [PersistValue] -> IO ()
Sqlite.bind Statement
stmt [PersistValue]
vals
StepResult
_ <- Connection -> Statement -> IO StepResult
Sqlite.stepConn Connection
conn Statement
stmt
Connection -> IO Int64
Sqlite.changes Connection
conn
withStmt'
:: MonadIO m
=> Sqlite.Connection
-> Sqlite.Statement
-> [PersistValue]
-> Acquire (ConduitM () [PersistValue] m ())
withStmt' :: Connection
-> Statement
-> [PersistValue]
-> Acquire (ConduitM () [PersistValue] m ())
withStmt' Connection
conn Statement
stmt [PersistValue]
vals = do
Statement
_ <- IO Statement -> (Statement -> IO ()) -> Acquire Statement
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire
(Statement -> [PersistValue] -> IO ()
Sqlite.bind Statement
stmt [PersistValue]
vals IO () -> IO Statement -> IO Statement
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Statement -> IO Statement
forall (m :: * -> *) a. Monad m => a -> m a
return Statement
stmt)
(Connection -> Statement -> IO ()
Sqlite.reset Connection
conn)
ConduitM () [PersistValue] m ()
-> Acquire (ConduitM () [PersistValue] m ())
forall (m :: * -> *) a. Monad m => a -> m a
return ConduitM () [PersistValue] m ()
pull
where
pull :: ConduitM () [PersistValue] m ()
pull = do
StepResult
x <- IO StepResult -> ConduitT () [PersistValue] m StepResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StepResult -> ConduitT () [PersistValue] m StepResult)
-> IO StepResult -> ConduitT () [PersistValue] m StepResult
forall a b. (a -> b) -> a -> b
$ Connection -> Statement -> IO StepResult
Sqlite.stepConn Connection
conn Statement
stmt
case StepResult
x of
StepResult
Sqlite.Done -> () -> ConduitM () [PersistValue] m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
StepResult
Sqlite.Row -> do
[PersistValue]
cols <- IO [PersistValue] -> ConduitT () [PersistValue] m [PersistValue]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [PersistValue] -> ConduitT () [PersistValue] m [PersistValue])
-> IO [PersistValue] -> ConduitT () [PersistValue] m [PersistValue]
forall a b. (a -> b) -> a -> b
$ Statement -> IO [PersistValue]
Sqlite.columns Statement
stmt
[PersistValue] -> ConduitM () [PersistValue] m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [PersistValue]
cols
ConduitM () [PersistValue] m ()
pull
showSqlType :: SqlType -> Text
showSqlType :: SqlType -> Text
showSqlType SqlType
SqlString = Text
"VARCHAR"
showSqlType SqlType
SqlInt32 = Text
"INTEGER"
showSqlType SqlType
SqlInt64 = Text
"INTEGER"
showSqlType SqlType
SqlReal = Text
"REAL"
showSqlType (SqlNumeric Word32
precision Word32
scale) = [Text] -> Text
T.concat [ Text
"NUMERIC(", String -> Text
T.pack (Word32 -> String
forall a. Show a => a -> String
show Word32
precision), Text
",", String -> Text
T.pack (Word32 -> String
forall a. Show a => a -> String
show Word32
scale), Text
")" ]
showSqlType SqlType
SqlDay = Text
"DATE"
showSqlType SqlType
SqlTime = Text
"TIME"
showSqlType SqlType
SqlDayTime = Text
"TIMESTAMP"
showSqlType SqlType
SqlBlob = Text
"BLOB"
showSqlType SqlType
SqlBool = Text
"BOOLEAN"
showSqlType (SqlOther Text
t) = Text
t
sqliteMkColumns :: [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
sqliteMkColumns :: [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
sqliteMkColumns [EntityDef]
allDefs EntityDef
t = [EntityDef]
-> EntityDef
-> BackendSpecificOverrides
-> ([Column], [UniqueDef], [ForeignDef])
mkColumns [EntityDef]
allDefs EntityDef
t BackendSpecificOverrides
emptyBackendSpecificOverrides
migrate'
:: [EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO (Either [Text] [(Bool, Text)])
migrate' :: [EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO (Either [Text] [(Bool, Text)])
migrate' [EntityDef]
allDefs Text -> IO Statement
getter EntityDef
val = do
let ([Column]
cols, [UniqueDef]
uniqs, [ForeignDef]
fdefs) = [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
sqliteMkColumns [EntityDef]
allDefs EntityDef
val
let newSql :: Text
newSql = Bool -> EntityDef -> ([Column], [UniqueDef], [ForeignDef]) -> Text
mkCreateTable Bool
False EntityDef
def ((Column -> Bool) -> [Column] -> [Column]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Column -> Bool) -> Column -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> DBName -> Bool
safeToRemove EntityDef
val (DBName -> Bool) -> (Column -> DBName) -> Column -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> DBName
cName) [Column]
cols, [UniqueDef]
uniqs, [ForeignDef]
fdefs)
Statement
stmt <- Text -> IO Statement
getter Text
"SELECT sql FROM sqlite_master WHERE type='table' AND name=?"
Maybe Text
oldSql' <- Acquire (ConduitM () [PersistValue] IO ())
-> (ConduitM () [PersistValue] IO () -> IO (Maybe Text))
-> IO (Maybe Text)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
with (Statement
-> [PersistValue] -> Acquire (ConduitM () [PersistValue] IO ())
Statement
-> forall (m :: * -> *).
MonadIO m =>
[PersistValue] -> Acquire (ConduitM () [PersistValue] m ())
stmtQuery Statement
stmt [Text -> PersistValue
PersistText (Text -> PersistValue) -> Text -> PersistValue
forall a b. (a -> b) -> a -> b
$ DBName -> Text
unDBName DBName
table])
(\ConduitM () [PersistValue] IO ()
src -> ConduitT () Void IO (Maybe Text) -> IO (Maybe Text)
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO (Maybe Text) -> IO (Maybe Text))
-> ConduitT () Void IO (Maybe Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ConduitM () [PersistValue] IO ()
src ConduitM () [PersistValue] IO ()
-> ConduitM [PersistValue] Void IO (Maybe Text)
-> ConduitT () Void IO (Maybe Text)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM [PersistValue] Void IO (Maybe Text)
forall o. ConduitT [PersistValue] o IO (Maybe Text)
go)
case Maybe Text
oldSql' of
Maybe Text
Nothing -> Either [Text] [(Bool, Text)] -> IO (Either [Text] [(Bool, Text)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Text] [(Bool, Text)] -> IO (Either [Text] [(Bool, Text)]))
-> Either [Text] [(Bool, Text)]
-> IO (Either [Text] [(Bool, Text)])
forall a b. (a -> b) -> a -> b
$ [(Bool, Text)] -> Either [Text] [(Bool, Text)]
forall a b. b -> Either a b
Right [(Bool
False, Text
newSql)]
Just Text
oldSql -> do
if Text
oldSql Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
newSql
then Either [Text] [(Bool, Text)] -> IO (Either [Text] [(Bool, Text)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Text] [(Bool, Text)] -> IO (Either [Text] [(Bool, Text)]))
-> Either [Text] [(Bool, Text)]
-> IO (Either [Text] [(Bool, Text)])
forall a b. (a -> b) -> a -> b
$ [(Bool, Text)] -> Either [Text] [(Bool, Text)]
forall a b. b -> Either a b
Right []
else do
[(Bool, Text)]
sql <- [EntityDef]
-> (Text -> IO Statement) -> EntityDef -> IO [(Bool, Text)]
getCopyTable [EntityDef]
allDefs Text -> IO Statement
getter EntityDef
val
Either [Text] [(Bool, Text)] -> IO (Either [Text] [(Bool, Text)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Text] [(Bool, Text)] -> IO (Either [Text] [(Bool, Text)]))
-> Either [Text] [(Bool, Text)]
-> IO (Either [Text] [(Bool, Text)])
forall a b. (a -> b) -> a -> b
$ [(Bool, Text)] -> Either [Text] [(Bool, Text)]
forall a b. b -> Either a b
Right [(Bool, Text)]
sql
where
def :: EntityDef
def = EntityDef
val
table :: DBName
table = EntityDef -> DBName
entityDB EntityDef
def
go :: ConduitT [PersistValue] o IO (Maybe Text)
go = do
Maybe [PersistValue]
x <- ConduitT [PersistValue] o IO (Maybe [PersistValue])
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
case Maybe [PersistValue]
x of
Maybe [PersistValue]
Nothing -> Maybe Text -> ConduitT [PersistValue] o IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
Just [PersistText Text
y] -> Maybe Text -> ConduitT [PersistValue] o IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ConduitT [PersistValue] o IO (Maybe Text))
-> Maybe Text -> ConduitT [PersistValue] o IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
y
Just [PersistValue]
y -> String -> ConduitT [PersistValue] o IO (Maybe Text)
forall a. HasCallStack => String -> a
error (String -> ConduitT [PersistValue] o IO (Maybe Text))
-> String -> ConduitT [PersistValue] o IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ String
"Unexpected result from sqlite_master: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
y
mockMigration :: Migration -> IO ()
mockMigration :: Migration -> IO ()
mockMigration Migration
mig = do
IORef (Map Text Statement)
smap <- Map Text Statement -> IO (IORef (Map Text Statement))
forall a. a -> IO (IORef a)
newIORef (Map Text Statement -> IO (IORef (Map Text Statement)))
-> Map Text Statement -> IO (IORef (Map Text Statement))
forall a b. (a -> b) -> a -> b
$ Map Text Statement
forall k a. Map k a
Map.empty
let sqlbackend :: SqlBackend
sqlbackend = SqlBackend :: (Text -> IO Statement)
-> (EntityDef -> [PersistValue] -> InsertSqlResult)
-> Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
-> Maybe
(EntityDef -> NonEmpty (HaskellName, DBName) -> Text -> Text)
-> Maybe (EntityDef -> Int -> Text)
-> IORef (Map Text Statement)
-> IO ()
-> ([EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO (Either [Text] [(Bool, Text)]))
-> ((Text -> IO Statement) -> Maybe IsolationLevel -> IO ())
-> ((Text -> IO Statement) -> IO ())
-> ((Text -> IO Statement) -> IO ())
-> (DBName -> Text)
-> Text
-> Text
-> (CharPos -> Bool -> Text -> Text)
-> LogFunc
-> Maybe Int
-> Maybe (EntityDef -> Int -> Text)
-> SqlBackend
SqlBackend
{ connPrepare :: Text -> IO Statement
connPrepare = \Text
_ -> do
Statement -> IO Statement
forall (m :: * -> *) a. Monad m => a -> m a
return Statement :: IO ()
-> IO ()
-> ([PersistValue] -> IO Int64)
-> (forall (m :: * -> *).
MonadIO m =>
[PersistValue] -> Acquire (ConduitM () [PersistValue] m ()))
-> Statement
Statement
{ stmtFinalize :: IO ()
stmtFinalize = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, stmtReset :: IO ()
stmtReset = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, stmtExecute :: [PersistValue] -> IO Int64
stmtExecute = [PersistValue] -> IO Int64
forall a. HasCallStack => a
undefined
, stmtQuery :: forall (m :: * -> *).
MonadIO m =>
[PersistValue] -> Acquire (ConduitM () [PersistValue] m ())
stmtQuery = \[PersistValue]
_ -> ConduitM () [PersistValue] m ()
-> Acquire (ConduitM () [PersistValue] m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ConduitM () [PersistValue] m ()
-> Acquire (ConduitM () [PersistValue] m ()))
-> ConduitM () [PersistValue] m ()
-> Acquire (ConduitM () [PersistValue] m ())
forall a b. (a -> b) -> a -> b
$ () -> ConduitM () [PersistValue] m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
}
, connStmtMap :: IORef (Map Text Statement)
connStmtMap = IORef (Map Text Statement)
smap
, connInsertSql :: EntityDef -> [PersistValue] -> InsertSqlResult
connInsertSql = EntityDef -> [PersistValue] -> InsertSqlResult
insertSql'
, connInsertManySql :: Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
connInsertManySql = Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
forall a. Maybe a
Nothing
, connClose :: IO ()
connClose = IO ()
forall a. HasCallStack => a
undefined
, connMigrateSql :: [EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO (Either [Text] [(Bool, Text)])
connMigrateSql = [EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO (Either [Text] [(Bool, Text)])
migrate'
, connBegin :: (Text -> IO Statement) -> Maybe IsolationLevel -> IO ()
connBegin = \Text -> IO Statement
f Maybe IsolationLevel
_ -> Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper Text
"BEGIN" Text -> IO Statement
f
, connCommit :: (Text -> IO Statement) -> IO ()
connCommit = Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper Text
"COMMIT"
, connRollback :: (Text -> IO Statement) -> IO ()
connRollback = IO () -> IO ()
ignoreExceptions (IO () -> IO ())
-> ((Text -> IO Statement) -> IO ())
-> (Text -> IO Statement)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper Text
"ROLLBACK"
, connEscapeName :: DBName -> Text
connEscapeName = DBName -> Text
escape
, connNoLimit :: Text
connNoLimit = Text
"LIMIT -1"
, connRDBMS :: Text
connRDBMS = Text
"sqlite"
, connLimitOffset :: CharPos -> Bool -> Text -> Text
connLimitOffset = Text -> CharPos -> Bool -> Text -> Text
decorateSQLWithLimitOffset Text
"LIMIT -1"
, connLogFunc :: LogFunc
connLogFunc = LogFunc
forall a. HasCallStack => a
undefined
, connUpsertSql :: Maybe (EntityDef -> NonEmpty (HaskellName, DBName) -> Text -> Text)
connUpsertSql = Maybe (EntityDef -> NonEmpty (HaskellName, DBName) -> Text -> Text)
forall a. HasCallStack => a
undefined
, connPutManySql :: Maybe (EntityDef -> Int -> Text)
connPutManySql = Maybe (EntityDef -> Int -> Text)
forall a. HasCallStack => a
undefined
, connMaxParams :: Maybe Int
connMaxParams = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
999
, connRepsertManySql :: Maybe (EntityDef -> Int -> Text)
connRepsertManySql = Maybe (EntityDef -> Int -> Text)
forall a. Maybe a
Nothing
}
result :: SqlBackend -> IO (((), [Text]), [(Bool, Text)])
result = ReaderT SqlBackend IO (((), [Text]), [(Bool, Text)])
-> SqlBackend -> IO (((), [Text]), [(Bool, Text)])
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT SqlBackend IO (((), [Text]), [(Bool, Text)])
-> SqlBackend -> IO (((), [Text]), [(Bool, Text)]))
-> (Migration
-> ReaderT SqlBackend IO (((), [Text]), [(Bool, Text)]))
-> Migration
-> SqlBackend
-> IO (((), [Text]), [(Bool, Text)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [(Bool, Text)] (ReaderT SqlBackend IO) ((), [Text])
-> ReaderT SqlBackend IO (((), [Text]), [(Bool, Text)])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [(Bool, Text)] (ReaderT SqlBackend IO) ((), [Text])
-> ReaderT SqlBackend IO (((), [Text]), [(Bool, Text)]))
-> (Migration
-> WriterT [(Bool, Text)] (ReaderT SqlBackend IO) ((), [Text]))
-> Migration
-> ReaderT SqlBackend IO (((), [Text]), [(Bool, Text)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Migration
-> WriterT [(Bool, Text)] (ReaderT SqlBackend IO) ((), [Text])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (Migration -> SqlBackend -> IO (((), [Text]), [(Bool, Text)]))
-> Migration -> SqlBackend -> IO (((), [Text]), [(Bool, Text)])
forall a b. (a -> b) -> a -> b
$ Migration
mig
(((), [Text]), [(Bool, Text)])
resp <- SqlBackend -> IO (((), [Text]), [(Bool, Text)])
result SqlBackend
sqlbackend
(Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> IO ()
TIO.putStrLn ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Bool, Text) -> Text) -> [(Bool, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Text) -> Text
forall a b. (a, b) -> b
snd ([(Bool, Text)] -> [Text]) -> [(Bool, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ (((), [Text]), [(Bool, Text)]) -> [(Bool, Text)]
forall a b. (a, b) -> b
snd (((), [Text]), [(Bool, Text)])
resp
where
helper :: t -> (t -> IO Statement) -> IO ()
helper t
t t -> IO Statement
getter = do
Statement
stmt <- t -> IO Statement
getter t
t
Int64
_ <- Statement -> [PersistValue] -> IO Int64
stmtExecute Statement
stmt []
Statement -> IO ()
stmtReset Statement
stmt
ignoreExceptions :: IO () -> IO ()
ignoreExceptions = (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (\(SomeException
_ :: E.SomeException) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
safeToRemove :: EntityDef -> DBName -> Bool
safeToRemove :: EntityDef -> DBName -> Bool
safeToRemove EntityDef
def (DBName Text
colName)
= (FieldDef -> Bool) -> [FieldDef] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FieldAttr -> [FieldAttr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FieldAttr
FieldAttrSafeToRemove ([FieldAttr] -> Bool)
-> (FieldDef -> [FieldAttr]) -> FieldDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> [FieldAttr]
fieldAttrs)
([FieldDef] -> Bool) -> [FieldDef] -> Bool
forall a b. (a -> b) -> a -> b
$ (FieldDef -> Bool) -> [FieldDef] -> [FieldDef]
forall a. (a -> Bool) -> [a] -> [a]
filter ((DBName -> DBName -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> DBName
DBName Text
colName) (DBName -> Bool) -> (FieldDef -> DBName) -> FieldDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> DBName
fieldDB)
([FieldDef] -> [FieldDef]) -> [FieldDef] -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
entityFields EntityDef
def
getCopyTable :: [EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO [(Bool, Text)]
getCopyTable :: [EntityDef]
-> (Text -> IO Statement) -> EntityDef -> IO [(Bool, Text)]
getCopyTable [EntityDef]
allDefs Text -> IO Statement
getter EntityDef
def = do
Statement
stmt <- Text -> IO Statement
getter (Text -> IO Statement) -> Text -> IO Statement
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [ Text
"PRAGMA table_info(", DBName -> Text
escape DBName
table, Text
")" ]
[Text]
oldCols' <- Acquire (ConduitM () [PersistValue] IO ())
-> (ConduitM () [PersistValue] IO () -> IO [Text]) -> IO [Text]
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
with (Statement
-> [PersistValue] -> Acquire (ConduitM () [PersistValue] IO ())
Statement
-> forall (m :: * -> *).
MonadIO m =>
[PersistValue] -> Acquire (ConduitM () [PersistValue] m ())
stmtQuery Statement
stmt []) (\ConduitM () [PersistValue] IO ()
src -> ConduitT () Void IO [Text] -> IO [Text]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO [Text] -> IO [Text])
-> ConduitT () Void IO [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ ConduitM () [PersistValue] IO ()
src ConduitM () [PersistValue] IO ()
-> ConduitM [PersistValue] Void IO [Text]
-> ConduitT () Void IO [Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM [PersistValue] Void IO [Text]
forall o. ConduitT [PersistValue] o IO [Text]
getCols)
let oldCols :: [DBName]
oldCols = (Text -> DBName) -> [Text] -> [DBName]
forall a b. (a -> b) -> [a] -> [b]
map Text -> DBName
DBName ([Text] -> [DBName]) -> [Text] -> [DBName]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"id") [Text]
oldCols'
let newCols :: [DBName]
newCols = (DBName -> Bool) -> [DBName] -> [DBName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (DBName -> Bool) -> DBName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> DBName -> Bool
safeToRemove EntityDef
def) ([DBName] -> [DBName]) -> [DBName] -> [DBName]
forall a b. (a -> b) -> a -> b
$ (Column -> DBName) -> [Column] -> [DBName]
forall a b. (a -> b) -> [a] -> [b]
map Column -> DBName
cName [Column]
cols
let common :: [DBName]
common = (DBName -> Bool) -> [DBName] -> [DBName]
forall a. (a -> Bool) -> [a] -> [a]
filter (DBName -> [DBName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DBName]
oldCols) [DBName]
newCols
[(Bool, Text)] -> IO [(Bool, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ (Bool
False, Text
tmpSql)
, (Bool
False, [DBName] -> Text
copyToTemp [DBName]
common)
, ([DBName]
common [DBName] -> [DBName] -> Bool
forall a. Eq a => a -> a -> Bool
/= (DBName -> Bool) -> [DBName] -> [DBName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (DBName -> Bool) -> DBName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> DBName -> Bool
safeToRemove EntityDef
def) [DBName]
oldCols, Text
dropOld)
, (Bool
False, Text
newSql)
, (Bool
False, [DBName] -> Text
copyToFinal [DBName]
newCols)
, (Bool
False, Text
dropTmp)
]
where
getCols :: ConduitT [PersistValue] o IO [Text]
getCols = do
Maybe [PersistValue]
x <- ConduitT [PersistValue] o IO (Maybe [PersistValue])
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
case Maybe [PersistValue]
x of
Maybe [PersistValue]
Nothing -> [Text] -> ConduitT [PersistValue] o IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just (PersistValue
_:PersistText Text
name:[PersistValue]
_) -> do
[Text]
names <- ConduitT [PersistValue] o IO [Text]
getCols
[Text] -> ConduitT [PersistValue] o IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> ConduitT [PersistValue] o IO [Text])
-> [Text] -> ConduitT [PersistValue] o IO [Text]
forall a b. (a -> b) -> a -> b
$ Text
name Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
names
Just [PersistValue]
y -> String -> ConduitT [PersistValue] o IO [Text]
forall a. HasCallStack => String -> a
error (String -> ConduitT [PersistValue] o IO [Text])
-> String -> ConduitT [PersistValue] o IO [Text]
forall a b. (a -> b) -> a -> b
$ String
"Invalid result from PRAGMA table_info: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
y
table :: DBName
table = EntityDef -> DBName
entityDB EntityDef
def
tableTmp :: DBName
tableTmp = Text -> DBName
DBName (Text -> DBName) -> Text -> DBName
forall a b. (a -> b) -> a -> b
$ DBName -> Text
unDBName DBName
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_backup"
([Column]
cols, [UniqueDef]
uniqs, [ForeignDef]
fdef) = [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
sqliteMkColumns [EntityDef]
allDefs EntityDef
def
cols' :: [Column]
cols' = (Column -> Bool) -> [Column] -> [Column]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Column -> Bool) -> Column -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> DBName -> Bool
safeToRemove EntityDef
def (DBName -> Bool) -> (Column -> DBName) -> Column -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> DBName
cName) [Column]
cols
newSql :: Text
newSql = Bool -> EntityDef -> ([Column], [UniqueDef], [ForeignDef]) -> Text
mkCreateTable Bool
False EntityDef
def ([Column]
cols', [UniqueDef]
uniqs, [ForeignDef]
fdef)
tmpSql :: Text
tmpSql = Bool -> EntityDef -> ([Column], [UniqueDef], [ForeignDef]) -> Text
mkCreateTable Bool
True EntityDef
def { entityDB :: DBName
entityDB = DBName
tableTmp } ([Column]
cols', [UniqueDef]
uniqs, [])
dropTmp :: Text
dropTmp = Text
"DROP TABLE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DBName -> Text
escape DBName
tableTmp
dropOld :: Text
dropOld = Text
"DROP TABLE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DBName -> Text
escape DBName
table
copyToTemp :: [DBName] -> Text
copyToTemp [DBName]
common = [Text] -> Text
T.concat
[ Text
"INSERT INTO "
, DBName -> Text
escape DBName
tableTmp
, Text
"("
, Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (DBName -> Text) -> [DBName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map DBName -> Text
escape [DBName]
common
, Text
") SELECT "
, Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (DBName -> Text) -> [DBName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map DBName -> Text
escape [DBName]
common
, Text
" FROM "
, DBName -> Text
escape DBName
table
]
copyToFinal :: [DBName] -> Text
copyToFinal [DBName]
newCols = [Text] -> Text
T.concat
[ Text
"INSERT INTO "
, DBName -> Text
escape DBName
table
, Text
" SELECT "
, Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (DBName -> Text) -> [DBName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map DBName -> Text
escape [DBName]
newCols
, Text
" FROM "
, DBName -> Text
escape DBName
tableTmp
]
mkCreateTable :: Bool -> EntityDef -> ([Column], [UniqueDef], [ForeignDef]) -> Text
mkCreateTable :: Bool -> EntityDef -> ([Column], [UniqueDef], [ForeignDef]) -> Text
mkCreateTable Bool
isTemp EntityDef
entity ([Column]
cols, [UniqueDef]
uniqs, [ForeignDef]
fdefs) =
[Text] -> Text
T.concat ([Text]
header [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
columns [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
footer)
where
header :: [Text]
header =
[ Text
"CREATE"
, if Bool
isTemp then Text
" TEMP" else Text
""
, Text
" TABLE "
, DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
entity
, Text
"("
]
footer :: [Text]
footer =
[ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (UniqueDef -> Text) -> [UniqueDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map UniqueDef -> Text
sqlUnique [UniqueDef]
uniqs
, [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (ForeignDef -> Text) -> [ForeignDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ForeignDef -> Text
sqlForeign [ForeignDef]
fdefs
, Text
")"
]
columns :: [Text]
columns = case EntityDef -> Maybe CompositeDef
entityPrimary EntityDef
entity of
Just CompositeDef
pdef ->
[ Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Column -> Text) -> [Column] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Column -> Text
sqlColumn Bool
isTemp) [Column]
cols
, Text
", PRIMARY KEY "
, Text
"("
, Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DBName -> Text
escape (DBName -> Text) -> (FieldDef -> DBName) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> DBName
fieldDB) ([FieldDef] -> [Text]) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> a -> b
$ CompositeDef -> [FieldDef]
compositeFields CompositeDef
pdef
, Text
")"
]
Maybe CompositeDef
Nothing ->
[ DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> DBName
fieldDB (EntityDef -> FieldDef
entityId EntityDef
entity)
, Text
" "
, SqlType -> Text
showSqlType (SqlType -> Text) -> SqlType -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> SqlType
fieldSqlType (FieldDef -> SqlType) -> FieldDef -> SqlType
forall a b. (a -> b) -> a -> b
$ EntityDef -> FieldDef
entityId EntityDef
entity
, Text
" PRIMARY KEY"
, Maybe Text -> Text
mayDefault (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ [FieldAttr] -> Maybe Text
defaultAttribute ([FieldAttr] -> Maybe Text) -> [FieldAttr] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> [FieldAttr]
fieldAttrs (FieldDef -> [FieldAttr]) -> FieldDef -> [FieldAttr]
forall a b. (a -> b) -> a -> b
$ EntityDef -> FieldDef
entityId EntityDef
entity
, [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Column -> Text) -> [Column] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Column -> Text
sqlColumn Bool
isTemp) [Column]
nonIdCols
]
nonIdCols :: [Column]
nonIdCols = (Column -> Bool) -> [Column] -> [Column]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Column
c -> Column -> DBName
cName Column
c DBName -> DBName -> Bool
forall a. Eq a => a -> a -> Bool
/= FieldDef -> DBName
fieldDB (EntityDef -> FieldDef
entityId EntityDef
entity)) [Column]
cols
mayDefault :: Maybe Text -> Text
mayDefault :: Maybe Text -> Text
mayDefault Maybe Text
def = case Maybe Text
def of
Maybe Text
Nothing -> Text
""
Just Text
d -> Text
" DEFAULT " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d
mayGenerated :: Maybe Text -> Text
mayGenerated :: Maybe Text -> Text
mayGenerated Maybe Text
gen = case Maybe Text
gen of
Maybe Text
Nothing -> Text
""
Just Text
g -> Text
" GENERATED ALWAYS AS (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
g Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") STORED"
sqlColumn :: Bool -> Column -> Text
sqlColumn :: Bool -> Column -> Text
sqlColumn Bool
noRef (Column DBName
name Bool
isNull SqlType
typ Maybe Text
def Maybe Text
gen Maybe DBName
_cn Maybe Integer
_maxLen Maybe ColumnReference
ref) = [Text] -> Text
T.concat
[ Text
","
, DBName -> Text
escape DBName
name
, Text
" "
, SqlType -> Text
showSqlType SqlType
typ
, if Bool
isNull then Text
" NULL" else Text
" NOT NULL"
, Maybe Text -> Text
mayDefault Maybe Text
def
, Maybe Text -> Text
mayGenerated Maybe Text
gen
, case Maybe ColumnReference
ref of
Maybe ColumnReference
Nothing -> Text
""
Just ColumnReference {crTableName :: ColumnReference -> DBName
crTableName=DBName
table, crFieldCascade :: ColumnReference -> FieldCascade
crFieldCascade=FieldCascade
cascadeOpts} ->
if Bool
noRef then Text
"" else Text
" REFERENCES " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DBName -> Text
escape DBName
table
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldCascade -> Text
onDelete FieldCascade
cascadeOpts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldCascade -> Text
onUpdate FieldCascade
cascadeOpts
]
where
onDelete :: FieldCascade -> Text
onDelete FieldCascade
opts = Text -> (CascadeAction -> Text) -> Maybe CascadeAction -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
T.append Text
" ON DELETE " (Text -> Text) -> (CascadeAction -> Text) -> CascadeAction -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CascadeAction -> Text
renderCascadeAction) (FieldCascade -> Maybe CascadeAction
fcOnDelete FieldCascade
opts)
onUpdate :: FieldCascade -> Text
onUpdate FieldCascade
opts = Text -> (CascadeAction -> Text) -> Maybe CascadeAction -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
T.append Text
" ON UPDATE " (Text -> Text) -> (CascadeAction -> Text) -> CascadeAction -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CascadeAction -> Text
renderCascadeAction) (FieldCascade -> Maybe CascadeAction
fcOnUpdate FieldCascade
opts)
sqlForeign :: ForeignDef -> Text
sqlForeign :: ForeignDef -> Text
sqlForeign ForeignDef
fdef = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
[ Text
", CONSTRAINT "
, DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ ForeignDef -> DBName
foreignConstraintNameDBName ForeignDef
fdef
, Text
" FOREIGN KEY("
, Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (((HaskellName, DBName), (HaskellName, DBName)) -> Text)
-> [((HaskellName, DBName), (HaskellName, DBName))] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DBName -> Text
escape (DBName -> Text)
-> (((HaskellName, DBName), (HaskellName, DBName)) -> DBName)
-> ((HaskellName, DBName), (HaskellName, DBName))
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HaskellName, DBName) -> DBName
forall a b. (a, b) -> b
snd((HaskellName, DBName) -> DBName)
-> (((HaskellName, DBName), (HaskellName, DBName))
-> (HaskellName, DBName))
-> ((HaskellName, DBName), (HaskellName, DBName))
-> DBName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HaskellName, DBName), (HaskellName, DBName))
-> (HaskellName, DBName)
forall a b. (a, b) -> a
fst) ([((HaskellName, DBName), (HaskellName, DBName))] -> [Text])
-> [((HaskellName, DBName), (HaskellName, DBName))] -> [Text]
forall a b. (a -> b) -> a -> b
$ ForeignDef -> [((HaskellName, DBName), (HaskellName, DBName))]
foreignFields ForeignDef
fdef
, Text
") REFERENCES "
, DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ ForeignDef -> DBName
foreignRefTableDBName ForeignDef
fdef
, Text
"("
, Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (((HaskellName, DBName), (HaskellName, DBName)) -> Text)
-> [((HaskellName, DBName), (HaskellName, DBName))] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DBName -> Text
escape (DBName -> Text)
-> (((HaskellName, DBName), (HaskellName, DBName)) -> DBName)
-> ((HaskellName, DBName), (HaskellName, DBName))
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HaskellName, DBName) -> DBName
forall a b. (a, b) -> b
snd ((HaskellName, DBName) -> DBName)
-> (((HaskellName, DBName), (HaskellName, DBName))
-> (HaskellName, DBName))
-> ((HaskellName, DBName), (HaskellName, DBName))
-> DBName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HaskellName, DBName), (HaskellName, DBName))
-> (HaskellName, DBName)
forall a b. (a, b) -> b
snd) ([((HaskellName, DBName), (HaskellName, DBName))] -> [Text])
-> [((HaskellName, DBName), (HaskellName, DBName))] -> [Text]
forall a b. (a -> b) -> a -> b
$ ForeignDef -> [((HaskellName, DBName), (HaskellName, DBName))]
foreignFields ForeignDef
fdef
, Text
")"
] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
onDelete [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
onUpdate
where
onDelete :: [Text]
onDelete =
(Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
T.append Text
" ON DELETE ")
([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Maybe CascadeAction -> [Text]
showAction
(Maybe CascadeAction -> [Text]) -> Maybe CascadeAction -> [Text]
forall a b. (a -> b) -> a -> b
$ FieldCascade -> Maybe CascadeAction
fcOnDelete
(FieldCascade -> Maybe CascadeAction)
-> FieldCascade -> Maybe CascadeAction
forall a b. (a -> b) -> a -> b
$ ForeignDef -> FieldCascade
foreignFieldCascade ForeignDef
fdef
onUpdate :: [Text]
onUpdate =
(Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
T.append Text
" ON UPDATE ")
([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Maybe CascadeAction -> [Text]
showAction
(Maybe CascadeAction -> [Text]) -> Maybe CascadeAction -> [Text]
forall a b. (a -> b) -> a -> b
$ FieldCascade -> Maybe CascadeAction
fcOnUpdate
(FieldCascade -> Maybe CascadeAction)
-> FieldCascade -> Maybe CascadeAction
forall a b. (a -> b) -> a -> b
$ ForeignDef -> FieldCascade
foreignFieldCascade ForeignDef
fdef
showAction :: Maybe CascadeAction -> [Text]
showAction = Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Maybe Text -> [Text])
-> (Maybe CascadeAction -> Maybe Text)
-> Maybe CascadeAction
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CascadeAction -> Text) -> Maybe CascadeAction -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CascadeAction -> Text
renderCascadeAction
sqlUnique :: UniqueDef -> Text
sqlUnique :: UniqueDef -> Text
sqlUnique (UniqueDef HaskellName
_ DBName
cname [(HaskellName, DBName)]
cols [Text]
_) = [Text] -> Text
T.concat
[ Text
",CONSTRAINT "
, DBName -> Text
escape DBName
cname
, Text
" UNIQUE ("
, Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((HaskellName, DBName) -> Text)
-> [(HaskellName, DBName)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DBName -> Text
escape (DBName -> Text)
-> ((HaskellName, DBName) -> DBName)
-> (HaskellName, DBName)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HaskellName, DBName) -> DBName
forall a b. (a, b) -> b
snd) [(HaskellName, DBName)]
cols
, Text
")"
]
escape :: DBName -> Text
escape :: DBName -> Text
escape (DBName Text
s) =
[Text] -> Text
T.concat [Text
q, (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
go Text
s, Text
q]
where
q :: Text
q = Char -> Text
T.singleton Char
'"'
go :: Char -> Text
go Char
'"' = Text
"\"\""
go Char
c = Char -> Text
T.singleton Char
c
putManySql :: EntityDef -> Int -> Text
putManySql :: EntityDef -> Int -> Text
putManySql EntityDef
ent Int
n = [Text] -> [FieldDef] -> EntityDef -> Int -> Text
putManySql' [Text]
conflictColumns [FieldDef]
fields EntityDef
ent Int
n
where
fields :: [FieldDef]
fields = EntityDef -> [FieldDef]
entityFields EntityDef
ent
conflictColumns :: [Text]
conflictColumns = (UniqueDef -> [Text]) -> [UniqueDef] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((HaskellName, DBName) -> Text)
-> [(HaskellName, DBName)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DBName -> Text
escape (DBName -> Text)
-> ((HaskellName, DBName) -> DBName)
-> (HaskellName, DBName)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HaskellName, DBName) -> DBName
forall a b. (a, b) -> b
snd) ([(HaskellName, DBName)] -> [Text])
-> (UniqueDef -> [(HaskellName, DBName)]) -> UniqueDef -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqueDef -> [(HaskellName, DBName)]
uniqueFields) (EntityDef -> [UniqueDef]
entityUniques EntityDef
ent)
repsertManySql :: EntityDef -> Int -> Text
repsertManySql :: EntityDef -> Int -> Text
repsertManySql EntityDef
ent Int
n = [Text] -> [FieldDef] -> EntityDef -> Int -> Text
putManySql' [Text]
conflictColumns [FieldDef]
fields EntityDef
ent Int
n
where
fields :: [FieldDef]
fields = EntityDef -> [FieldDef]
keyAndEntityFields EntityDef
ent
conflictColumns :: [Text]
conflictColumns = DBName -> Text
escape (DBName -> Text) -> (FieldDef -> DBName) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> DBName
fieldDB (FieldDef -> Text) -> [FieldDef] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EntityDef -> [FieldDef]
entityKeyFields EntityDef
ent
putManySql' :: [Text] -> [FieldDef] -> EntityDef -> Int -> Text
putManySql' :: [Text] -> [FieldDef] -> EntityDef -> Int -> Text
putManySql' [Text]
conflictColumns [FieldDef]
fields EntityDef
ent Int
n = Text
q
where
fieldDbToText :: FieldDef -> Text
fieldDbToText = DBName -> Text
escape (DBName -> Text) -> (FieldDef -> DBName) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> DBName
fieldDB
mkAssignment :: Text -> Text
mkAssignment Text
f = [Text] -> Text
T.concat [Text
f, Text
"=EXCLUDED.", Text
f]
table :: Text
table = DBName -> Text
escape (DBName -> Text) -> (EntityDef -> DBName) -> EntityDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> DBName
entityDB (EntityDef -> Text) -> EntityDef -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef
ent
columns :: Text
columns = [Text] -> Text
Util.commaSeparated ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> Text
fieldDbToText [FieldDef]
fields
placeholders :: [Text]
placeholders = (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FieldDef -> Text
forall a b. a -> b -> a
const Text
"?") [FieldDef]
fields
updates :: [Text]
updates = (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
mkAssignment (Text -> Text) -> (FieldDef -> Text) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> Text
fieldDbToText) [FieldDef]
fields
q :: Text
q = [Text] -> Text
T.concat
[ Text
"INSERT INTO "
, Text
table
, Text -> Text
Util.parenWrapped Text
columns
, Text
" VALUES "
, [Text] -> Text
Util.commaSeparated ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate Int
n
(Text -> [Text]) -> ([Text] -> Text) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.parenWrapped (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Util.commaSeparated ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
placeholders
, Text
" ON CONFLICT "
, Text -> Text
Util.parenWrapped (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Util.commaSeparated ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
conflictColumns
, Text
" DO UPDATE SET "
, [Text] -> Text
Util.commaSeparated [Text]
updates
]
data SqliteConf = SqliteConf
{ SqliteConf -> Text
sqlDatabase :: Text
, SqliteConf -> Int
sqlPoolSize :: Int
}
| SqliteConfInfo
{ SqliteConf -> SqliteConnectionInfo
sqlConnInfo :: SqliteConnectionInfo
, sqlPoolSize :: Int
} deriving Int -> SqliteConf -> String -> String
[SqliteConf] -> String -> String
SqliteConf -> String
(Int -> SqliteConf -> String -> String)
-> (SqliteConf -> String)
-> ([SqliteConf] -> String -> String)
-> Show SqliteConf
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SqliteConf] -> String -> String
$cshowList :: [SqliteConf] -> String -> String
show :: SqliteConf -> String
$cshow :: SqliteConf -> String
showsPrec :: Int -> SqliteConf -> String -> String
$cshowsPrec :: Int -> SqliteConf -> String -> String
Show
instance FromJSON SqliteConf where
parseJSON :: Value -> Parser SqliteConf
parseJSON Value
v = (String -> String) -> Parser SqliteConf -> Parser SqliteConf
forall a. (String -> String) -> Parser a -> Parser a
modifyFailure (String
"Persistent: error loading Sqlite conf: " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (Parser SqliteConf -> Parser SqliteConf)
-> Parser SqliteConf -> Parser SqliteConf
forall a b. (a -> b) -> a -> b
$ ((Object -> Parser SqliteConf) -> Value -> Parser SqliteConf)
-> Value -> (Object -> Parser SqliteConf) -> Parser SqliteConf
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String
-> (Object -> Parser SqliteConf) -> Value -> Parser SqliteConf
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SqliteConf") Value
v Object -> Parser SqliteConf
parser where
parser :: Object -> Parser SqliteConf
parser Object
o = if Text -> Object -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
"database" Object
o
then Text -> Int -> SqliteConf
SqliteConf
(Text -> Int -> SqliteConf)
-> Parser Text -> Parser (Int -> SqliteConf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"database"
Parser (Int -> SqliteConf) -> Parser Int -> Parser SqliteConf
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"poolsize"
else SqliteConnectionInfo -> Int -> SqliteConf
SqliteConfInfo
(SqliteConnectionInfo -> Int -> SqliteConf)
-> Parser SqliteConnectionInfo -> Parser (Int -> SqliteConf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser SqliteConnectionInfo
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"connInfo"
Parser (Int -> SqliteConf) -> Parser Int -> Parser SqliteConf
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"poolsize"
instance PersistConfig SqliteConf where
type PersistConfigBackend SqliteConf = SqlPersistT
type PersistConfigPool SqliteConf = ConnectionPool
createPoolConfig :: SqliteConf -> IO (PersistConfigPool SqliteConf)
createPoolConfig (SqliteConf Text
cs Int
size) = NoLoggingT IO (Pool SqlBackend) -> IO (Pool SqlBackend)
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT (NoLoggingT IO (Pool SqlBackend) -> IO (Pool SqlBackend))
-> NoLoggingT IO (Pool SqlBackend) -> IO (Pool SqlBackend)
forall a b. (a -> b) -> a -> b
$ SqliteConnectionInfo -> Int -> NoLoggingT IO (Pool SqlBackend)
forall (m :: * -> *).
(MonadLogger m, MonadUnliftIO m) =>
SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo (Text -> SqliteConnectionInfo
conStringToInfo Text
cs) Int
size
createPoolConfig (SqliteConfInfo SqliteConnectionInfo
info Int
size) = NoLoggingT IO (Pool SqlBackend) -> IO (Pool SqlBackend)
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT (NoLoggingT IO (Pool SqlBackend) -> IO (Pool SqlBackend))
-> NoLoggingT IO (Pool SqlBackend) -> IO (Pool SqlBackend)
forall a b. (a -> b) -> a -> b
$ SqliteConnectionInfo -> Int -> NoLoggingT IO (Pool SqlBackend)
forall (m :: * -> *).
(MonadLogger m, MonadUnliftIO m) =>
SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo SqliteConnectionInfo
info Int
size
runPool :: SqliteConf
-> PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf
-> m a
runPool SqliteConf
_ = PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf -> m a
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> Pool backend -> m a
runSqlPool
loadConfig :: Value -> Parser SqliteConf
loadConfig = Value -> Parser SqliteConf
forall a. FromJSON a => Value -> Parser a
parseJSON
finally :: MonadUnliftIO m
=> m a
-> m b
-> m a
finally :: m a -> m b -> m a
finally m a
a m b
sequel = (UnliftIO m -> IO a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
(UnliftIO m -> IO a) -> m a
withUnliftIO ((UnliftIO m -> IO a) -> m a) -> (UnliftIO m -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \UnliftIO m
u ->
IO a -> IO b -> IO a
forall a b. IO a -> IO b -> IO a
E.finally (UnliftIO m -> m a -> IO a
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO m
u m a
a)
(UnliftIO m -> m b -> IO b
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO m
u m b
sequel)
{-# INLINABLE finally #-}
mkSqliteConnectionInfo :: Text -> SqliteConnectionInfo
mkSqliteConnectionInfo :: Text -> SqliteConnectionInfo
mkSqliteConnectionInfo Text
fp = Text -> Bool -> Bool -> [Text] -> SqliteConnectionInfo
SqliteConnectionInfo Text
fp Bool
True Bool
True []
conStringToInfo :: Text -> SqliteConnectionInfo
conStringToInfo :: Text -> SqliteConnectionInfo
conStringToInfo Text
connStr = Text -> Bool -> Bool -> [Text] -> SqliteConnectionInfo
SqliteConnectionInfo Text
connStr' Bool
enableWal Bool
True [] where
(Text
connStr', Bool
enableWal) = case () of
()
| Just Text
cs <- Text -> Text -> Maybe Text
T.stripPrefix Text
"WAL=on " Text
connStr -> (Text
cs, Bool
True)
| Just Text
cs <- Text -> Text -> Maybe Text
T.stripPrefix Text
"WAL=off " Text
connStr -> (Text
cs, Bool
False)
| Bool
otherwise -> (Text
connStr, Bool
True)
data SqliteConnectionInfo = SqliteConnectionInfo
{ SqliteConnectionInfo -> Text
_sqlConnectionStr :: Text
, SqliteConnectionInfo -> Bool
_walEnabled :: Bool
, SqliteConnectionInfo -> Bool
_fkEnabled :: Bool
, :: [Text]
} deriving Int -> SqliteConnectionInfo -> String -> String
[SqliteConnectionInfo] -> String -> String
SqliteConnectionInfo -> String
(Int -> SqliteConnectionInfo -> String -> String)
-> (SqliteConnectionInfo -> String)
-> ([SqliteConnectionInfo] -> String -> String)
-> Show SqliteConnectionInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SqliteConnectionInfo] -> String -> String
$cshowList :: [SqliteConnectionInfo] -> String -> String
show :: SqliteConnectionInfo -> String
$cshow :: SqliteConnectionInfo -> String
showsPrec :: Int -> SqliteConnectionInfo -> String -> String
$cshowsPrec :: Int -> SqliteConnectionInfo -> String -> String
Show
instance FromJSON SqliteConnectionInfo where
parseJSON :: Value -> Parser SqliteConnectionInfo
parseJSON Value
v = (String -> String)
-> Parser SqliteConnectionInfo -> Parser SqliteConnectionInfo
forall a. (String -> String) -> Parser a -> Parser a
modifyFailure (String
"Persistent: error loading SqliteConnectionInfo: " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (Parser SqliteConnectionInfo -> Parser SqliteConnectionInfo)
-> Parser SqliteConnectionInfo -> Parser SqliteConnectionInfo
forall a b. (a -> b) -> a -> b
$
((Object -> Parser SqliteConnectionInfo)
-> Value -> Parser SqliteConnectionInfo)
-> Value
-> (Object -> Parser SqliteConnectionInfo)
-> Parser SqliteConnectionInfo
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String
-> (Object -> Parser SqliteConnectionInfo)
-> Value
-> Parser SqliteConnectionInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SqliteConnectionInfo") Value
v ((Object -> Parser SqliteConnectionInfo)
-> Parser SqliteConnectionInfo)
-> (Object -> Parser SqliteConnectionInfo)
-> Parser SqliteConnectionInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Bool -> Bool -> [Text] -> SqliteConnectionInfo
SqliteConnectionInfo
(Text -> Bool -> Bool -> [Text] -> SqliteConnectionInfo)
-> Parser Text
-> Parser (Bool -> Bool -> [Text] -> SqliteConnectionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"connectionString"
Parser (Bool -> Bool -> [Text] -> SqliteConnectionInfo)
-> Parser Bool -> Parser (Bool -> [Text] -> SqliteConnectionInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"walEnabled"
Parser (Bool -> [Text] -> SqliteConnectionInfo)
-> Parser Bool -> Parser ([Text] -> SqliteConnectionInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"fkEnabled"
Parser ([Text] -> SqliteConnectionInfo)
-> Parser [Text] -> Parser SqliteConnectionInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"extraPragmas" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
withRawSqliteConnInfo
:: (MonadUnliftIO m, MonadLogger m)
=> SqliteConnectionInfo
-> (RawSqlite SqlBackend -> m a)
-> m a
withRawSqliteConnInfo :: SqliteConnectionInfo -> (RawSqlite SqlBackend -> m a) -> m a
withRawSqliteConnInfo SqliteConnectionInfo
connInfo RawSqlite SqlBackend -> m a
f = do
LogFunc
logFunc <- m LogFunc
forall (m :: * -> *). (MonadUnliftIO m, MonadLogger m) => m LogFunc
askLogFunc
((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> IO (RawSqlite SqlBackend)
-> (RawSqlite SqlBackend -> IO ())
-> (RawSqlite SqlBackend -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (LogFunc -> IO (RawSqlite SqlBackend)
openBackend LogFunc
logFunc) RawSqlite SqlBackend -> IO ()
closeBackend ((RawSqlite SqlBackend -> IO a) -> IO a)
-> (RawSqlite SqlBackend -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ m a -> IO a
forall a. m a -> IO a
run (m a -> IO a)
-> (RawSqlite SqlBackend -> m a) -> RawSqlite SqlBackend -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSqlite SqlBackend -> m a
f
where
openBackend :: LogFunc -> IO (RawSqlite SqlBackend)
openBackend = (SqlBackend -> Connection -> RawSqlite SqlBackend)
-> SqliteConnectionInfo -> LogFunc -> IO (RawSqlite SqlBackend)
forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> RawSqlite SqlBackend
forall backend. backend -> Connection -> RawSqlite backend
RawSqlite SqliteConnectionInfo
connInfo
closeBackend :: RawSqlite SqlBackend -> IO ()
closeBackend = SqlBackend -> IO ()
forall backend.
BackendCompatible SqlBackend backend =>
backend -> IO ()
close' (SqlBackend -> IO ())
-> (RawSqlite SqlBackend -> SqlBackend)
-> RawSqlite SqlBackend
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSqlite SqlBackend -> SqlBackend
forall backend. RawSqlite backend -> backend
_persistentBackend
createRawSqlitePoolFromInfo
:: (MonadLogger m, MonadUnliftIO m)
=> SqliteConnectionInfo
-> (RawSqlite SqlBackend -> m ())
-> Int
-> m (Pool (RawSqlite SqlBackend))
createRawSqlitePoolFromInfo :: SqliteConnectionInfo
-> (RawSqlite SqlBackend -> m ())
-> Int
-> m (Pool (RawSqlite SqlBackend))
createRawSqlitePoolFromInfo SqliteConnectionInfo
connInfo RawSqlite SqlBackend -> m ()
f Int
n = do
m () -> IO ()
runIO <- m (m () -> IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
let createRawSqlite :: LogFunc -> IO (RawSqlite SqlBackend)
createRawSqlite LogFunc
logFun = do
RawSqlite SqlBackend
result <- (SqlBackend -> Connection -> RawSqlite SqlBackend)
-> SqliteConnectionInfo -> LogFunc -> IO (RawSqlite SqlBackend)
forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> RawSqlite SqlBackend
forall backend. backend -> Connection -> RawSqlite backend
RawSqlite SqliteConnectionInfo
connInfo LogFunc
logFun
RawSqlite SqlBackend
result RawSqlite SqlBackend -> IO () -> IO (RawSqlite SqlBackend)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m () -> IO ()
runIO (RawSqlite SqlBackend -> m ()
f RawSqlite SqlBackend
result)
(LogFunc -> IO (RawSqlite SqlBackend))
-> Int -> m (Pool (RawSqlite SqlBackend))
forall backend (m :: * -> *).
(MonadLogger m, MonadUnliftIO m,
BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> Int -> m (Pool backend)
createSqlPool LogFunc -> IO (RawSqlite SqlBackend)
createRawSqlite Int
n
createRawSqlitePoolFromInfo_
:: (MonadLogger m, MonadUnliftIO m)
=> SqliteConnectionInfo -> Int -> m (Pool (RawSqlite SqlBackend))
createRawSqlitePoolFromInfo_ :: SqliteConnectionInfo -> Int -> m (Pool (RawSqlite SqlBackend))
createRawSqlitePoolFromInfo_ SqliteConnectionInfo
connInfo =
SqliteConnectionInfo
-> (RawSqlite SqlBackend -> m ())
-> Int
-> m (Pool (RawSqlite SqlBackend))
forall (m :: * -> *).
(MonadLogger m, MonadUnliftIO m) =>
SqliteConnectionInfo
-> (RawSqlite SqlBackend -> m ())
-> Int
-> m (Pool (RawSqlite SqlBackend))
createRawSqlitePoolFromInfo SqliteConnectionInfo
connInfo (m () -> RawSqlite SqlBackend -> m ()
forall a b. a -> b -> a
const (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
withRawSqlitePoolInfo
:: (MonadUnliftIO m, MonadLogger m)
=> SqliteConnectionInfo
-> (RawSqlite SqlBackend -> m ())
-> Int
-> (Pool (RawSqlite SqlBackend) -> m a)
-> m a
withRawSqlitePoolInfo :: SqliteConnectionInfo
-> (RawSqlite SqlBackend -> m ())
-> Int
-> (Pool (RawSqlite SqlBackend) -> m a)
-> m a
withRawSqlitePoolInfo SqliteConnectionInfo
connInfo RawSqlite SqlBackend -> m ()
f Int
n Pool (RawSqlite SqlBackend) -> m a
work = do
m () -> IO ()
runIO <- m (m () -> IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
let createRawSqlite :: LogFunc -> IO (RawSqlite SqlBackend)
createRawSqlite LogFunc
logFun = do
RawSqlite SqlBackend
result <- (SqlBackend -> Connection -> RawSqlite SqlBackend)
-> SqliteConnectionInfo -> LogFunc -> IO (RawSqlite SqlBackend)
forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> RawSqlite SqlBackend
forall backend. backend -> Connection -> RawSqlite backend
RawSqlite SqliteConnectionInfo
connInfo LogFunc
logFun
RawSqlite SqlBackend
result RawSqlite SqlBackend -> IO () -> IO (RawSqlite SqlBackend)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m () -> IO ()
runIO (RawSqlite SqlBackend -> m ()
f RawSqlite SqlBackend
result)
(LogFunc -> IO (RawSqlite SqlBackend))
-> Int -> (Pool (RawSqlite SqlBackend) -> m a) -> m a
forall backend (m :: * -> *) a.
(MonadLogger m, MonadUnliftIO m,
BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> Int -> (Pool backend -> m a) -> m a
withSqlPool LogFunc -> IO (RawSqlite SqlBackend)
createRawSqlite Int
n Pool (RawSqlite SqlBackend) -> m a
work
withRawSqlitePoolInfo_
:: (MonadUnliftIO m, MonadLogger m)
=> SqliteConnectionInfo
-> Int
-> (Pool (RawSqlite SqlBackend) -> m a)
-> m a
withRawSqlitePoolInfo_ :: SqliteConnectionInfo
-> Int -> (Pool (RawSqlite SqlBackend) -> m a) -> m a
withRawSqlitePoolInfo_ SqliteConnectionInfo
connInfo =
SqliteConnectionInfo
-> (RawSqlite SqlBackend -> m ())
-> Int
-> (Pool (RawSqlite SqlBackend) -> m a)
-> m a
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
SqliteConnectionInfo
-> (RawSqlite SqlBackend -> m ())
-> Int
-> (Pool (RawSqlite SqlBackend) -> m a)
-> m a
withRawSqlitePoolInfo SqliteConnectionInfo
connInfo (m () -> RawSqlite SqlBackend -> m ()
forall a b. a -> b -> a
const (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
data RawSqlite backend = RawSqlite
{ RawSqlite backend -> backend
_persistentBackend :: backend
, RawSqlite backend -> Connection
_rawSqliteConnection :: Sqlite.Connection
}
instance HasPersistBackend b => HasPersistBackend (RawSqlite b) where
type BaseBackend (RawSqlite b) = BaseBackend b
persistBackend :: RawSqlite b -> BaseBackend (RawSqlite b)
persistBackend = b -> BaseBackend b
forall backend.
HasPersistBackend backend =>
backend -> BaseBackend backend
persistBackend (b -> BaseBackend b)
-> (RawSqlite b -> b) -> RawSqlite b -> BaseBackend b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend
instance BackendCompatible b (RawSqlite b) where
projectBackend :: RawSqlite b -> b
projectBackend = RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend
instance (PersistCore b) => PersistCore (RawSqlite b) where
newtype BackendKey (RawSqlite b) = RawSqliteKey (BackendKey b)
deriving instance (Show (BackendKey b)) => Show (BackendKey (RawSqlite b))
deriving instance (Read (BackendKey b)) => Read (BackendKey (RawSqlite b))
deriving instance (Eq (BackendKey b)) => Eq (BackendKey (RawSqlite b))
deriving instance (Ord (BackendKey b)) => Ord (BackendKey (RawSqlite b))
deriving instance (Num (BackendKey b)) => Num (BackendKey (RawSqlite b))
deriving instance (Integral (BackendKey b)) => Integral (BackendKey (RawSqlite b))
deriving instance (PersistField (BackendKey b)) => PersistField (BackendKey (RawSqlite b))
deriving instance (PersistFieldSql (BackendKey b)) => PersistFieldSql (BackendKey (RawSqlite b))
deriving instance (Real (BackendKey b)) => Real (BackendKey (RawSqlite b))
deriving instance (Enum (BackendKey b)) => Enum (BackendKey (RawSqlite b))
deriving instance (Bounded (BackendKey b)) => Bounded (BackendKey (RawSqlite b))
deriving instance (ToJSON (BackendKey b)) => ToJSON (BackendKey (RawSqlite b))
deriving instance (FromJSON (BackendKey b)) => FromJSON (BackendKey (RawSqlite b))
instance (PersistStoreRead b) => PersistStoreRead (RawSqlite b) where
get :: Key record -> ReaderT (RawSqlite b) m (Maybe record)
get = (RawSqlite b -> b)
-> ReaderT b m (Maybe record)
-> ReaderT (RawSqlite b) m (Maybe record)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Maybe record)
-> ReaderT (RawSqlite b) m (Maybe record))
-> (Key record -> ReaderT b m (Maybe record))
-> Key record
-> ReaderT (RawSqlite b) m (Maybe record)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> ReaderT b m (Maybe record)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get
getMany :: [Key record] -> ReaderT (RawSqlite b) m (Map (Key record) record)
getMany = (RawSqlite b -> b)
-> ReaderT b m (Map (Key record) record)
-> ReaderT (RawSqlite b) m (Map (Key record) record)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Map (Key record) record)
-> ReaderT (RawSqlite b) m (Map (Key record) record))
-> ([Key record] -> ReaderT b m (Map (Key record) record))
-> [Key record]
-> ReaderT (RawSqlite b) m (Map (Key record) record)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Key record] -> ReaderT b m (Map (Key record) record)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
PersistRecordBackend record backend) =>
[Key record] -> ReaderT backend m (Map (Key record) record)
getMany
instance (PersistQueryRead b) => PersistQueryRead (RawSqlite b) where
selectSourceRes :: [Filter record]
-> [SelectOpt record]
-> ReaderT
(RawSqlite b) m1 (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes [Filter record]
filts [SelectOpt record]
opts = (RawSqlite b -> b)
-> ReaderT b m1 (Acquire (ConduitM () (Entity record) m2 ()))
-> ReaderT
(RawSqlite b) m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m1 (Acquire (ConduitM () (Entity record) m2 ()))
-> ReaderT
(RawSqlite b) m1 (Acquire (ConduitM () (Entity record) m2 ())))
-> ReaderT b m1 (Acquire (ConduitM () (Entity record) m2 ()))
-> ReaderT
(RawSqlite b) m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall a b. (a -> b) -> a -> b
$ [Filter record]
-> [SelectOpt record]
-> ReaderT b m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall backend record (m1 :: * -> *) (m2 :: * -> *).
(PersistQueryRead backend, PersistRecordBackend record backend,
MonadIO m1, MonadIO m2) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT backend m1 (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes [Filter record]
filts [SelectOpt record]
opts
selectFirst :: [Filter record]
-> [SelectOpt record]
-> ReaderT (RawSqlite b) m (Maybe (Entity record))
selectFirst [Filter record]
filts [SelectOpt record]
opts = (RawSqlite b -> b)
-> ReaderT b m (Maybe (Entity record))
-> ReaderT (RawSqlite b) m (Maybe (Entity record))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Maybe (Entity record))
-> ReaderT (RawSqlite b) m (Maybe (Entity record)))
-> ReaderT b m (Maybe (Entity record))
-> ReaderT (RawSqlite b) m (Maybe (Entity record))
forall a b. (a -> b) -> a -> b
$ [Filter record]
-> [SelectOpt record] -> ReaderT b m (Maybe (Entity record))
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst [Filter record]
filts [SelectOpt record]
opts
selectKeysRes :: [Filter record]
-> [SelectOpt record]
-> ReaderT
(RawSqlite b) m1 (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
filts [SelectOpt record]
opts = (RawSqlite b -> b)
-> ReaderT b m1 (Acquire (ConduitM () (Key record) m2 ()))
-> ReaderT
(RawSqlite b) m1 (Acquire (ConduitM () (Key record) m2 ()))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m1 (Acquire (ConduitM () (Key record) m2 ()))
-> ReaderT
(RawSqlite b) m1 (Acquire (ConduitM () (Key record) m2 ())))
-> ReaderT b m1 (Acquire (ConduitM () (Key record) m2 ()))
-> ReaderT
(RawSqlite b) m1 (Acquire (ConduitM () (Key record) m2 ()))
forall a b. (a -> b) -> a -> b
$ [Filter record]
-> [SelectOpt record]
-> ReaderT b m1 (Acquire (ConduitM () (Key record) m2 ()))
forall backend (m1 :: * -> *) (m2 :: * -> *) record.
(PersistQueryRead backend, MonadIO m1, MonadIO m2,
PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT backend m1 (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
filts [SelectOpt record]
opts
count :: [Filter record] -> ReaderT (RawSqlite b) m Int
count = (RawSqlite b -> b)
-> ReaderT b m Int -> ReaderT (RawSqlite b) m Int
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m Int -> ReaderT (RawSqlite b) m Int)
-> ([Filter record] -> ReaderT b m Int)
-> [Filter record]
-> ReaderT (RawSqlite b) m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Filter record] -> ReaderT b m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count
exists :: [Filter record] -> ReaderT (RawSqlite b) m Bool
exists = (RawSqlite b -> b)
-> ReaderT b m Bool -> ReaderT (RawSqlite b) m Bool
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m Bool -> ReaderT (RawSqlite b) m Bool)
-> ([Filter record] -> ReaderT b m Bool)
-> [Filter record]
-> ReaderT (RawSqlite b) m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Filter record] -> ReaderT b m Bool
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Bool
exists
instance (PersistQueryWrite b) => PersistQueryWrite (RawSqlite b) where
updateWhere :: [Filter record] -> [Update record] -> ReaderT (RawSqlite b) m ()
updateWhere [Filter record]
filts [Update record]
updates = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall a b. (a -> b) -> a -> b
$ [Filter record] -> [Update record] -> ReaderT b m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
[Filter record] -> [Update record] -> ReaderT backend m ()
updateWhere [Filter record]
filts [Update record]
updates
deleteWhere :: [Filter record] -> ReaderT (RawSqlite b) m ()
deleteWhere = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> ([Filter record] -> ReaderT b m ())
-> [Filter record]
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Filter record] -> ReaderT b m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere
instance (PersistUniqueRead b) => PersistUniqueRead (RawSqlite b) where
getBy :: Unique record -> ReaderT (RawSqlite b) m (Maybe (Entity record))
getBy = (RawSqlite b -> b)
-> ReaderT b m (Maybe (Entity record))
-> ReaderT (RawSqlite b) m (Maybe (Entity record))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Maybe (Entity record))
-> ReaderT (RawSqlite b) m (Maybe (Entity record)))
-> (Unique record -> ReaderT b m (Maybe (Entity record)))
-> Unique record
-> ReaderT (RawSqlite b) m (Maybe (Entity record))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique record -> ReaderT b m (Maybe (Entity record))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy
instance (PersistStoreWrite b) => PersistStoreWrite (RawSqlite b) where
insert :: record -> ReaderT (RawSqlite b) m (Key record)
insert = (RawSqlite b -> b)
-> ReaderT b m (Key record) -> ReaderT (RawSqlite b) m (Key record)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Key record) -> ReaderT (RawSqlite b) m (Key record))
-> (record -> ReaderT b m (Key record))
-> record
-> ReaderT (RawSqlite b) m (Key record)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> ReaderT b m (Key record)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert
insert_ :: record -> ReaderT (RawSqlite b) m ()
insert_ = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> (record -> ReaderT b m ())
-> record
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_
insertMany :: [record] -> ReaderT (RawSqlite b) m [Key record]
insertMany = (RawSqlite b -> b)
-> ReaderT b m [Key record] -> ReaderT (RawSqlite b) m [Key record]
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m [Key record] -> ReaderT (RawSqlite b) m [Key record])
-> ([record] -> ReaderT b m [Key record])
-> [record]
-> ReaderT (RawSqlite b) m [Key record]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [record] -> ReaderT b m [Key record]
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
[record] -> ReaderT backend m [Key record]
insertMany
insertMany_ :: [record] -> ReaderT (RawSqlite b) m ()
insertMany_ = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> ([record] -> ReaderT b m ())
-> [record]
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [record] -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_
insertEntityMany :: [Entity record] -> ReaderT (RawSqlite b) m ()
insertEntityMany = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> ([Entity record] -> ReaderT b m ())
-> [Entity record]
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entity record] -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
[Entity record] -> ReaderT backend m ()
insertEntityMany
insertKey :: Key record -> record -> ReaderT (RawSqlite b) m ()
insertKey Key record
k = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> (record -> ReaderT b m ())
-> record
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> record -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
insertKey Key record
k
repsert :: Key record -> record -> ReaderT (RawSqlite b) m ()
repsert Key record
k = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> (record -> ReaderT b m ())
-> record
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> record -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
repsert Key record
k
repsertMany :: [(Key record, record)] -> ReaderT (RawSqlite b) m ()
repsertMany = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> ([(Key record, record)] -> ReaderT b m ())
-> [(Key record, record)]
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key record, record)] -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
[(Key record, record)] -> ReaderT backend m ()
repsertMany
replace :: Key record -> record -> ReaderT (RawSqlite b) m ()
replace Key record
k = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> (record -> ReaderT b m ())
-> record
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> record -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
replace Key record
k
delete :: Key record -> ReaderT (RawSqlite b) m ()
delete = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> (Key record -> ReaderT b m ())
-> Key record
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete
update :: Key record -> [Update record] -> ReaderT (RawSqlite b) m ()
update Key record
k = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> ([Update record] -> ReaderT b m ())
-> [Update record]
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> [Update record] -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update Key record
k
updateGet :: Key record -> [Update record] -> ReaderT (RawSqlite b) m record
updateGet Key record
k = (RawSqlite b -> b)
-> ReaderT b m record -> ReaderT (RawSqlite b) m record
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m record -> ReaderT (RawSqlite b) m record)
-> ([Update record] -> ReaderT b m record)
-> [Update record]
-> ReaderT (RawSqlite b) m record
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> [Update record] -> ReaderT b m record
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m record
updateGet Key record
k
instance (PersistUniqueWrite b) => PersistUniqueWrite (RawSqlite b) where
deleteBy :: Unique record -> ReaderT (RawSqlite b) m ()
deleteBy = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> (Unique record -> ReaderT b m ())
-> Unique record
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique record -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m ()
deleteBy
insertUnique :: record -> ReaderT (RawSqlite b) m (Maybe (Key record))
insertUnique = (RawSqlite b -> b)
-> ReaderT b m (Maybe (Key record))
-> ReaderT (RawSqlite b) m (Maybe (Key record))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Maybe (Key record))
-> ReaderT (RawSqlite b) m (Maybe (Key record)))
-> (record -> ReaderT b m (Maybe (Key record)))
-> record
-> ReaderT (RawSqlite b) m (Maybe (Key record))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> ReaderT b m (Maybe (Key record))
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
record -> ReaderT backend m (Maybe (Key record))
insertUnique
upsert :: record
-> [Update record] -> ReaderT (RawSqlite b) m (Entity record)
upsert record
rec = (RawSqlite b -> b)
-> ReaderT b m (Entity record)
-> ReaderT (RawSqlite b) m (Entity record)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Entity record)
-> ReaderT (RawSqlite b) m (Entity record))
-> ([Update record] -> ReaderT b m (Entity record))
-> [Update record]
-> ReaderT (RawSqlite b) m (Entity record)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> [Update record] -> ReaderT b m (Entity record)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
PersistRecordBackend record backend, OnlyOneUniqueKey record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
upsert record
rec
upsertBy :: Unique record
-> record
-> [Update record]
-> ReaderT (RawSqlite b) m (Entity record)
upsertBy Unique record
uniq record
rec = (RawSqlite b -> b)
-> ReaderT b m (Entity record)
-> ReaderT (RawSqlite b) m (Entity record)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Entity record)
-> ReaderT (RawSqlite b) m (Entity record))
-> ([Update record] -> ReaderT b m (Entity record))
-> [Update record]
-> ReaderT (RawSqlite b) m (Entity record)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique record
-> record -> [Update record] -> ReaderT b m (Entity record)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
upsertBy Unique record
uniq record
rec
putMany :: [record] -> ReaderT (RawSqlite b) m ()
putMany = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> ([record] -> ReaderT b m ())
-> [record]
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [record] -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
putMany
makeLenses ''RawSqlite