{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
-- | A sqlite backend for persistent.
--
-- Note: If you prepend @WAL=off @ to your connection string, it will disable
-- the write-ahead log. This functionality is now deprecated in favour of using SqliteConnectionInfo.
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.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.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


-- | Create a pool of SQLite connections.
--
-- Note that this should not be used with the @:memory:@ connection string, as
-- the pool will regularly remove connections, destroying your database.
-- Instead, use 'withSqliteConn'.
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

-- | Create a pool of SQLite connections.
--
-- Note that this should not be used with the @:memory:@ connection string, as
-- the pool will regularly remove connections, destroying your database.
-- Instead, use 'withSqliteConn'.
--
-- @since 2.6.2
createSqlitePoolFromInfo :: (MonadLogger m, MonadUnliftIO m)
                         => SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo :: SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo connInfo :: SqliteConnectionInfo
connInfo = (LogFunc -> IO SqlBackend) -> Int -> m (Pool SqlBackend)
forall (m :: * -> *) backend.
(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

-- | Run the given action with a connection pool.
--
-- Like 'createSqlitePool', this should not be used with @:memory:@.
withSqlitePool :: (MonadUnliftIO m, MonadLogger m)
               => Text
               -> Int -- ^ number of connections to open
               -> (Pool SqlBackend -> m a) -> m a
withSqlitePool :: Text -> Int -> (Pool SqlBackend -> m a) -> m a
withSqlitePool connInfo :: Text
connInfo = (LogFunc -> IO SqlBackend)
-> Int -> (Pool SqlBackend -> m a) -> m a
forall (m :: * -> *) backend 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

-- | Run the given action with a connection pool.
--
-- Like 'createSqlitePool', this should not be used with @:memory:@.
--
-- @since 2.6.2
withSqlitePoolInfo :: (MonadUnliftIO m, MonadLogger m)
                   => SqliteConnectionInfo
                   -> Int -- ^ number of connections to open
                   -> (Pool SqlBackend -> m a) -> m a
withSqlitePoolInfo :: SqliteConnectionInfo -> Int -> (Pool SqlBackend -> m a) -> m a
withSqlitePoolInfo connInfo :: SqliteConnectionInfo
connInfo = (LogFunc -> IO SqlBackend)
-> Int -> (Pool SqlBackend -> m a) -> m a
forall (m :: * -> *) backend 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

-- | @since 2.6.2
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 (m :: * -> *) backend 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 f :: SqlBackend -> Connection -> r
f connInfo :: SqliteConnectionInfo
connInfo logFunc :: 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

-- | Wrap up a raw 'Sqlite.Connection' as a Persistent SQL 'Connection'.
--
-- === __Example usage__
--
-- > {-# LANGUAGE GADTs #-}
-- > {-# LANGUAGE ScopedTypeVariables #-}
-- > {-# LANGUAGE OverloadedStrings #-}
-- > {-# LANGUAGE MultiParamTypeClasses #-}
-- > {-# LANGUAGE TypeFamilies #-}
-- > {-# LANGUAGE TemplateHaskell #-}
-- > {-# LANGUAGE QuasiQuotes #-}
-- > {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- >
-- > import Control.Monad.IO.Class  (liftIO)
-- > import Database.Persist
-- > import Database.Sqlite
-- > import Database.Persist.Sqlite
-- > import Database.Persist.TH
-- >
-- > share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
-- > Person
-- >   name String
-- >   age Int Maybe
-- >   deriving Show
-- > |]
-- >
-- > main :: IO ()
-- > main = do
-- >   conn <- open "/home/sibi/test.db"
-- >   (backend :: SqlBackend) <- wrapConnection conn (\_ _ _ _ -> return ())
-- >   flip runSqlPersistM backend $ do
-- >          runMigration migrateAll
-- >          insert_ $ Person "John doe" $ Just 35
-- >          insert_ $ Person "Hema" $ Just 36
-- >          (pers :: [Entity Person]) <- selectList [] []
-- >          liftIO $ print pers
-- >   close' backend
--
-- On executing it, you get this output:
--
-- > Migrating: CREATE TABLE "person"("id" INTEGER PRIMARY KEY,"name" VARCHAR NOT NULL,"age" INTEGER NULL)
-- > [Entity {entityKey = PersonKey {unPersonKey = SqlBackendKey {unSqlBackendKey = 1}}, entityVal = Person {personName = "John doe", personAge = Just 35}},Entity {entityKey = PersonKey {unPersonKey = SqlBackendKey {unSqlBackendKey = 2}}, entityVal = Person {personName = "Hema", personAge = Just 36}}]
--
-- @since 1.1.5
wrapConnection :: Sqlite.Connection -> LogFunc -> IO SqlBackend
wrapConnection :: Connection -> LogFunc -> IO SqlBackend
wrapConnection = SqliteConnectionInfo -> Connection -> LogFunc -> IO SqlBackend
wrapConnectionInfo (Text -> SqliteConnectionInfo
mkSqliteConnectionInfo "")

-- | Retry if a Busy is thrown, following an exponential backoff strategy.
--
-- @since 2.9.3
retryOnBusy :: (MonadUnliftIO m, MonadLogger m) => m a -> m a
retryOnBusy :: m a -> m a
retryOnBusy action :: 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 20 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> [Int]
forall t. (Ord t, Num t) => t -> [t]
delays 1000
  where
    delays :: t -> [t]
delays x :: t
x
      | t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= 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
* 2)

    start :: [Int] -> m a
start [] = do
      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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logWarn "Out of retry attempts"
      m a
action
    start (x :: Int
x:xs :: [Int]
xs) = do
      -- Using try instead of catch to avoid creating a stack overflow
      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
$ \run :: 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
          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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logWarn "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 e :: 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 y :: a
y -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y

-- | Wait until some noop action on the database does not return an 'Sqlite.ErrorBusy'. See 'retryOnBusy'.
--
-- @since 2.9.3
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 "SELECT 42" []

-- | Wrap up a raw 'Sqlite.Connection' as a Persistent SQL
-- 'Connection', allowing full control over WAL and FK constraints.
--
-- @since 2.6.2
wrapConnectionInfo
    :: SqliteConnectionInfo
    -> Sqlite.Connection
    -> LogFunc
    -> IO SqlBackend
wrapConnectionInfo :: SqliteConnectionInfo -> Connection -> LogFunc -> IO SqlBackend
wrapConnectionInfo connInfo :: SqliteConnectionInfo
connInfo conn :: Connection
conn logFunc :: LogFunc
logFunc = do
    let
        -- Turn on the write-ahead log
        -- https://github.com/yesodweb/persistent/issues/363
        walPragma :: [(Text, Bool)] -> [(Text, Bool)]
walPragma
          | SqliteConnectionInfo -> Bool
_walEnabled SqliteConnectionInfo
connInfo = (("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

        -- Turn on foreign key constraints
        -- https://github.com/yesodweb/persistent/issues/646
        fkPragma :: [(Text, Bool)] -> [(Text, Bool)]
fkPragma
          | SqliteConnectionInfo -> Bool
_fkEnabled SqliteConnectionInfo
connInfo = (("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

        -- Allow arbitrary additional pragmas to be set
        -- https://github.com/commercialhaskell/stack/issues/4247
        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
$ \(pragma :: Text
pragma, shouldRetry :: 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 UniqueDef -> 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 UniqueDef -> Text -> Text)
connUpsertSql = Maybe (EntityDef -> NonEmpty UniqueDef -> 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 = \f :: Text -> IO Statement
f _ -> Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper "BEGIN" Text -> IO Statement
f
        , connCommit :: (Text -> IO Statement) -> IO ()
connCommit = Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper "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 "ROLLBACK"
        , connEscapeName :: DBName -> Text
connEscapeName = DBName -> Text
escape
        , connNoLimit :: Text
connNoLimit = "LIMIT -1"
        , connRDBMS :: Text
connRDBMS = "sqlite"
        , connLimitOffset :: CharPos -> Bool -> Text -> Text
connLimitOffset = Text -> CharPos -> Bool -> Text -> Text
decorateSQLWithLimitOffset "LIMIT -1"
        , connLogFunc :: LogFunc
connLogFunc = LogFunc
logFunc
        , connMaxParams :: Maybe Int
connMaxParams = Int -> Maybe Int
forall a. a -> Maybe a
Just 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 getter :: 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 ())

-- | A convenience helper which creates a new database connection and runs the
-- given block, handling @MonadResource@ and @MonadLogger@ requirements. Note
-- that all log messages are discarded.
--
-- @since 1.1.4
runSqlite :: (MonadUnliftIO m)
          => Text -- ^ connection string
          -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -- ^ database action
          -> m a
runSqlite :: Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite connstr :: 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 (m :: * -> *) backend a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> backend -> m a
runSqlConn

-- | A convenience helper which creates a new database connection and runs the
-- given block, handling @MonadResource@ and @MonadLogger@ requirements. Note
-- that all log messages are discarded.
--
-- @since 2.6.2
runSqliteInfo :: (MonadUnliftIO m)
              => SqliteConnectionInfo
              -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -- ^ database action
              -> m a
runSqliteInfo :: SqliteConnectionInfo
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqliteInfo conInfo :: 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 (m :: * -> *) backend 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' conn :: Connection
conn sql :: 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' ent :: EntityDef
ent vals :: [PersistValue]
vals =
  case EntityDef -> Maybe CompositeDef
entityPrimary EntityDef
ent of
    Just _ ->
      Text -> [PersistValue] -> InsertSqlResult
ISRManyKeys Text
sql [PersistValue]
vals
        where sql :: Text
sql = [Text] -> Text
T.concat
                [ "INSERT INTO "
                , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
ent
                , "("
                , Text -> [Text] -> Text
T.intercalate "," ([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
$ EntityDef -> [FieldDef]
entityFields EntityDef
ent
                , ") VALUES("
                , Text -> [Text] -> Text
T.intercalate "," ((FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FieldDef -> Text
forall a b. a -> b -> a
const "?") ([FieldDef] -> [Text]) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
entityFields EntityDef
ent)
                , ")"
                ]
    Nothing ->
      Text -> Text -> InsertSqlResult
ISRInsertGet Text
ins Text
sel
        where
          sel :: Text
sel = [Text] -> Text
T.concat
              [ "SELECT "
              , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> DBName
fieldDB (EntityDef -> FieldDef
entityId EntityDef
ent)
              , " FROM "
              , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
ent
              , " WHERE _ROWID_=last_insert_rowid()"
              ]
          ins :: Text
ins = [Text] -> Text
T.concat
              [ "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 (EntityDef -> [FieldDef]
entityFields EntityDef
ent)
                    then " VALUES(null)"
                    else [Text] -> Text
T.concat
                      [ "("
                      , Text -> [Text] -> Text
T.intercalate "," ([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
$ EntityDef -> [FieldDef]
entityFields EntityDef
ent
                      , ") VALUES("
                      , Text -> [Text] -> Text
T.intercalate "," ((FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FieldDef -> Text
forall a b. a -> b -> a
const "?") ([FieldDef] -> [Text]) -> [FieldDef] -> [Text]
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' conn :: Connection
conn stmt :: Statement
stmt vals :: [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' conn :: Connection
conn stmt :: Statement
stmt vals :: [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
            Sqlite.Done -> () -> ConduitM () [PersistValue] m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            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 SqlString = "VARCHAR"
showSqlType SqlInt32 = "INTEGER"
showSqlType SqlInt64 = "INTEGER"
showSqlType SqlReal = "REAL"
showSqlType (SqlNumeric precision :: Word32
precision scale :: Word32
scale) = [Text] -> Text
T.concat [ "NUMERIC(", String -> Text
T.pack (Word32 -> String
forall a. Show a => a -> String
show Word32
precision), ",", String -> Text
T.pack (Word32 -> String
forall a. Show a => a -> String
show Word32
scale), ")" ]
showSqlType SqlDay = "DATE"
showSqlType SqlTime = "TIME"
showSqlType SqlDayTime = "TIMESTAMP"
showSqlType SqlBlob = "BLOB"
showSqlType SqlBool = "BOOLEAN"
showSqlType (SqlOther t :: Text
t) = Text
t

migrate' :: [EntityDef]
         -> (Text -> IO Statement)
         -> EntityDef
         -> IO (Either [Text] [(Bool, Text)])
migrate' :: [EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO (Either [Text] [(Bool, Text)])
migrate' allDefs :: [EntityDef]
allDefs getter :: Text -> IO Statement
getter val :: EntityDef
val = do
    let (cols :: [Column]
cols, uniqs :: [UniqueDef]
uniqs, fdefs :: [ForeignDef]
fdefs) = [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
mkColumns [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 "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])
      (\src :: 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
        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 oldSql :: 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
            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 y :: 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 y :: [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
$ "Unexpected result from sqlite_master: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
y

-- | Mock a migration even when the database is not present.
-- This function performs the same functionality of 'printMigration'
-- with the difference that an actual database isn't needed for it.
mockMigration :: Migration -> IO ()
mockMigration :: Migration -> IO ()
mockMigration mig :: 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 UniqueDef -> 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 = \_ -> 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 = \_ -> ConduitT () [PersistValue] m ()
-> Acquire (ConduitT () [PersistValue] m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ConduitT () [PersistValue] m ()
 -> Acquire (ConduitT () [PersistValue] m ()))
-> ConduitT () [PersistValue] m ()
-> Acquire (ConduitT () [PersistValue] m ())
forall a b. (a -> b) -> a -> b
$ () -> ConduitT () [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 = \f :: Text -> IO Statement
f _ -> Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper "BEGIN" Text -> IO Statement
f
                   , connCommit :: (Text -> IO Statement) -> IO ()
connCommit = Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper "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 "ROLLBACK"
                   , connEscapeName :: DBName -> Text
connEscapeName = DBName -> Text
escape
                   , connNoLimit :: Text
connNoLimit = "LIMIT -1"
                   , connRDBMS :: Text
connRDBMS = "sqlite"
                   , connLimitOffset :: CharPos -> Bool -> Text -> Text
connLimitOffset = Text -> CharPos -> Bool -> Text -> Text
decorateSQLWithLimitOffset "LIMIT -1"
                   , connLogFunc :: LogFunc
connLogFunc = LogFunc
forall a. HasCallStack => a
undefined
                   , connUpsertSql :: Maybe (EntityDef -> NonEmpty UniqueDef -> Text -> Text)
connUpsertSql = Maybe (EntityDef -> NonEmpty UniqueDef -> 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 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 getter :: 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 ())

-- | Check if a column name is listed as the "safe to remove" in the entity
-- list.
safeToRemove :: EntityDef -> DBName -> Bool
safeToRemove :: EntityDef -> DBName -> Bool
safeToRemove def :: EntityDef
def (DBName colName :: Text
colName)
    = (FieldDef -> Bool) -> [FieldDef] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem "SafeToRemove" ([Text] -> Bool) -> (FieldDef -> [Text]) -> FieldDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> [Text]
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 allDefs :: [EntityDef]
allDefs getter :: Text -> IO Statement
getter def :: 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 [ "PRAGMA table_info(", DBName -> Text
escape DBName
table, ")" ]
    [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 []) (\src :: 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
/= "id") [Text]
oldCols' -- need to update for table id attribute ?
    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] -> Text) -> [DBName] -> Text
forall a b. (a -> b) -> a -> b
$ [DBName] -> [DBName]
addIdCol [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] -> Text) -> [DBName] -> Text
forall a b. (a -> b) -> a -> b
$ [DBName] -> [DBName]
addIdCol [DBName]
newCols)
           , (Bool
False, Text
dropTmp)
           ]
  where
    addIdCol :: [DBName] -> [DBName]
addIdCol = case EntityDef -> Maybe CompositeDef
entityPrimary EntityDef
def of
        Nothing -> (FieldDef -> DBName
fieldDB (EntityDef -> FieldDef
entityId EntityDef
def) DBName -> [DBName] -> [DBName]
forall a. a -> [a] -> [a]
:)
        Just _ -> [DBName] -> [DBName]
forall a. a -> a
id

    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
            Nothing -> [Text] -> ConduitT [PersistValue] o IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
            Just (_:PersistText name :: Text
name:_) -> 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 y :: [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
$ "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
<> "_backup"
    (cols :: [Column]
cols, uniqs :: [UniqueDef]
uniqs, fdef :: [ForeignDef]
fdef) = [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
mkColumns [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 = "DROP TABLE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DBName -> Text
escape DBName
tableTmp
    dropOld :: Text
dropOld = "DROP TABLE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DBName -> Text
escape DBName
table
    copyToTemp :: [DBName] -> Text
copyToTemp common :: [DBName]
common = [Text] -> Text
T.concat
        [ "INSERT INTO "
        , DBName -> Text
escape DBName
tableTmp
        , "("
        , Text -> [Text] -> Text
T.intercalate "," ([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
        , ") SELECT "
        , Text -> [Text] -> Text
T.intercalate "," ([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
        , " FROM "
        , DBName -> Text
escape DBName
table
        ]
    copyToFinal :: [DBName] -> Text
copyToFinal newCols :: [DBName]
newCols = [Text] -> Text
T.concat
        [ "INSERT INTO "
        , DBName -> Text
escape DBName
table
        , " SELECT "
        , Text -> [Text] -> Text
T.intercalate "," ([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
        , " FROM "
        , DBName -> Text
escape DBName
tableTmp
        ]

mkCreateTable :: Bool -> EntityDef -> ([Column], [UniqueDef], [ForeignDef]) -> Text
mkCreateTable :: Bool -> EntityDef -> ([Column], [UniqueDef], [ForeignDef]) -> Text
mkCreateTable isTemp :: Bool
isTemp entity :: EntityDef
entity (cols :: [Column]
cols, uniqs :: [UniqueDef]
uniqs, fdefs :: [ForeignDef]
fdefs) =
  case EntityDef -> Maybe CompositeDef
entityPrimary EntityDef
entity of
    Just pdef :: CompositeDef
pdef ->
       [Text] -> Text
T.concat
        [ "CREATE"
        , if Bool
isTemp then " TEMP" else ""
        , " TABLE "
        , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
entity
        , "("
        , Int -> Text -> Text
T.drop 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
        , ", PRIMARY KEY "
        , "("
        , Text -> [Text] -> Text
T.intercalate "," ([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] -> 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
        , ")"
        ]
    Nothing -> [Text] -> Text
T.concat
        [ "CREATE"
        , if Bool
isTemp then " TEMP" else ""
        , " TABLE "
        , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
entity
        , "("
        , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> DBName
fieldDB (EntityDef -> FieldDef
entityId EntityDef
entity)
        , " "
        , 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
        ," PRIMARY KEY"
        , Maybe Text -> Text
mayDefault (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe Text
defaultAttribute ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> [Text]
fieldAttrs (FieldDef -> [Text]) -> FieldDef -> [Text]
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]
cols
        , [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
        , ")"
        ]

mayDefault :: Maybe Text -> Text
mayDefault :: Maybe Text -> Text
mayDefault def :: Maybe Text
def = case Maybe Text
def of
    Nothing -> ""
    Just d :: Text
d -> " DEFAULT " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d

sqlColumn :: Bool -> Column -> Text
sqlColumn :: Bool -> Column -> Text
sqlColumn noRef :: Bool
noRef (Column name :: DBName
name isNull :: Bool
isNull typ :: SqlType
typ def :: Maybe Text
def _cn :: Maybe DBName
_cn _maxLen :: Maybe Integer
_maxLen ref :: Maybe (DBName, DBName)
ref) = [Text] -> Text
T.concat
    [ ","
    , DBName -> Text
escape DBName
name
    , " "
    , SqlType -> Text
showSqlType SqlType
typ
    , if Bool
isNull then " NULL" else " NOT NULL"
    , Maybe Text -> Text
mayDefault Maybe Text
def
    , case Maybe (DBName, DBName)
ref of
        Nothing -> ""
        Just (table :: DBName
table, _) -> if Bool
noRef then "" else " REFERENCES " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DBName -> Text
escape DBName
table
    ]

sqlForeign :: ForeignDef -> Text
sqlForeign :: ForeignDef -> Text
sqlForeign fdef :: ForeignDef
fdef = [Text] -> Text
T.concat
    [ ", CONSTRAINT "
    , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ ForeignDef -> DBName
foreignConstraintNameDBName ForeignDef
fdef
    , " FOREIGN KEY("
    , Text -> [Text] -> Text
T.intercalate "," ([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
    , ") REFERENCES "
    , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ ForeignDef -> DBName
foreignRefTableDBName ForeignDef
fdef
    , "("
    , Text -> [Text] -> Text
T.intercalate "," ([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
    , ")"
    ]

sqlUnique :: UniqueDef -> Text
sqlUnique :: UniqueDef -> Text
sqlUnique (UniqueDef _ cname :: DBName
cname cols :: [(HaskellName, DBName)]
cols _) = [Text] -> Text
T.concat
    [ ",CONSTRAINT "
    , DBName -> Text
escape DBName
cname
    , " UNIQUE ("
    , Text -> [Text] -> Text
T.intercalate "," ([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
    , ")"
    ]

escape :: DBName -> Text
escape :: DBName -> Text
escape (DBName s :: 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 '"'
    go :: Char -> Text
go '"' = "\"\""
    go c :: Char
c = Char -> Text
T.singleton Char
c

putManySql :: EntityDef -> Int -> Text
putManySql :: EntityDef -> Int -> Text
putManySql ent :: EntityDef
ent n :: 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 ent :: EntityDef
ent n :: 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' conflictColumns :: [Text]
conflictColumns fields :: [FieldDef]
fields ent :: EntityDef
ent n :: 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 f :: Text
f = [Text] -> Text
T.concat [Text
f, "=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 "?") [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
        [ "INSERT INTO "
        , Text
table
        , Text -> Text
Util.parenWrapped Text
columns
        , " 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
        , " 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
        , " DO UPDATE SET "
        , [Text] -> Text
Util.commaSeparated [Text]
updates
        ]

-- | Information required to setup a connection pool.
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 v :: Value
v = (String -> String) -> Parser SqliteConf -> Parser SqliteConf
forall a. (String -> String) -> Parser a -> Parser a
modifyFailure ("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 "SqliteConf") Value
v Object -> Parser SqliteConf
parser where
        parser :: Object -> Parser SqliteConf
parser o :: Object
o = if Text -> Object -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member "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
.: "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
.: "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
.: "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
.: "poolsize"

instance PersistConfig SqliteConf where
    type PersistConfigBackend SqliteConf = SqlPersistT
    type PersistConfigPool SqliteConf = ConnectionPool
    createPoolConfig :: SqliteConf -> IO (PersistConfigPool SqliteConf)
createPoolConfig (SqliteConf cs :: Text
cs size :: Int
size) = NoLoggingT IO (Pool SqlBackend)
-> IO (PersistConfigPool SqliteConf)
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT (NoLoggingT IO (Pool SqlBackend)
 -> IO (PersistConfigPool SqliteConf))
-> NoLoggingT IO (Pool SqlBackend)
-> IO (PersistConfigPool SqliteConf)
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 -- FIXME
    createPoolConfig (SqliteConfInfo info :: SqliteConnectionInfo
info size :: Int
size) = NoLoggingT IO (Pool SqlBackend)
-> IO (PersistConfigPool SqliteConf)
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT (NoLoggingT IO (Pool SqlBackend)
 -> IO (PersistConfigPool SqliteConf))
-> NoLoggingT IO (Pool SqlBackend)
-> IO (PersistConfigPool SqliteConf)
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 -- FIXME
    runPool :: SqliteConf
-> PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf
-> m a
runPool _ = PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf -> m a
forall (m :: * -> *) backend 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 -- ^ computation to run first
        -> m b -- ^ computation to run afterward (even if an exception was raised)
        -> m a
finally :: m a -> m b -> m a
finally a :: m a
a sequel :: 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
$ \u :: 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 #-}
-- | Creates a SqliteConnectionInfo from a connection string, with the
-- default settings.
--
-- @since 2.6.2
mkSqliteConnectionInfo :: Text -> SqliteConnectionInfo
mkSqliteConnectionInfo :: Text -> SqliteConnectionInfo
mkSqliteConnectionInfo fp :: Text
fp = Text -> Bool -> Bool -> [Text] -> SqliteConnectionInfo
SqliteConnectionInfo Text
fp Bool
True Bool
True []

-- | Parses connection options from a connection string. Used only to provide deprecated API.
conStringToInfo :: Text -> SqliteConnectionInfo
conStringToInfo :: Text -> SqliteConnectionInfo
conStringToInfo connStr :: Text
connStr = Text -> Bool -> Bool -> [Text] -> SqliteConnectionInfo
SqliteConnectionInfo Text
connStr' Bool
enableWal Bool
True [] where
    (connStr' :: Text
connStr', enableWal :: Bool
enableWal) = case () of
        ()
            | Just cs :: Text
cs <- Text -> Text -> Maybe Text
T.stripPrefix "WAL=on "  Text
connStr -> (Text
cs, Bool
True)
            | Just cs :: Text
cs <- Text -> Text -> Maybe Text
T.stripPrefix "WAL=off " Text
connStr -> (Text
cs, Bool
False)
            | Bool
otherwise                                   -> (Text
connStr, Bool
True)

-- | Information required to connect to a sqlite database. We export
-- lenses instead of fields to avoid being limited to the current
-- implementation.
--
-- @since 2.6.2
data SqliteConnectionInfo = SqliteConnectionInfo
    { SqliteConnectionInfo -> Text
_sqlConnectionStr :: Text -- ^ connection string for the database. Use @:memory:@ for an in-memory database.
    , SqliteConnectionInfo -> Bool
_walEnabled :: Bool -- ^ if the write-ahead log is enabled - see https://github.com/yesodweb/persistent/issues/363.
    , SqliteConnectionInfo -> Bool
_fkEnabled :: Bool -- ^ if foreign-key constraints are enabled.
    , SqliteConnectionInfo -> [Text]
_extraPragmas :: [Text] -- ^ additional pragmas to be set on initialization
    } 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 v :: Value
v = (String -> String)
-> Parser SqliteConnectionInfo -> Parser SqliteConnectionInfo
forall a. (String -> String) -> Parser a -> Parser a
modifyFailure ("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 "SqliteConnectionInfo") Value
v ((Object -> Parser SqliteConnectionInfo)
 -> Parser SqliteConnectionInfo)
-> (Object -> Parser SqliteConnectionInfo)
-> Parser SqliteConnectionInfo
forall a b. (a -> b) -> a -> b
$ \o :: 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
.: "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
.: "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
.: "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)
.:? "extraPragmas" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

-- | Like `withSqliteConnInfo`, but exposes the internal `Sqlite.Connection`.
-- For power users who want to manually interact with SQLite's C API via
-- internals exposed by "Database.Sqlite.Internal"
--
-- @since 2.10.2
withRawSqliteConnInfo
    :: (MonadUnliftIO m, MonadLogger m)
    => SqliteConnectionInfo
    -> (RawSqlite SqlBackend -> m a)
    -> m a
withRawSqliteConnInfo :: SqliteConnectionInfo -> (RawSqlite SqlBackend -> m a) -> m a
withRawSqliteConnInfo connInfo :: SqliteConnectionInfo
connInfo f :: 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
$ \run :: 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

-- | Like `createSqlitePoolFromInfo`, but like `withRawSqliteConnInfo` it
-- exposes the internal `Sqlite.Connection`.
--
-- For power users who want to manually interact with SQLite's C API via
-- internals exposed by "Database.Sqlite.Internal". The callback can be used to
-- run arbitrary actions on the connection upon allocation from the pool.
--
-- @since 2.10.6
createRawSqlitePoolFromInfo
    :: (MonadLogger m, MonadUnliftIO m)
    => SqliteConnectionInfo
    -> (RawSqlite SqlBackend -> m ())
    -- ^ An action that is run whenever a new `RawSqlite` connection is
    -- allocated in the pool. The main use of this function is to register
    -- custom functions with the SQLite connection upon creation.
    -> Int
    -> m (Pool (RawSqlite SqlBackend))
createRawSqlitePoolFromInfo :: SqliteConnectionInfo
-> (RawSqlite SqlBackend -> m ())
-> Int
-> m (Pool (RawSqlite SqlBackend))
createRawSqlitePoolFromInfo connInfo :: SqliteConnectionInfo
connInfo f :: RawSqlite SqlBackend -> m ()
f n :: 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 logFun :: 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 (m :: * -> *) backend.
(MonadLogger m, MonadUnliftIO m,
 BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> Int -> m (Pool backend)
createSqlPool LogFunc -> IO (RawSqlite SqlBackend)
createRawSqlite Int
n

-- | Like `createRawSqlitePoolFromInfo`, but doesn't require a callback
-- operating on the connection.
--
-- @since 2.10.6
createRawSqlitePoolFromInfo_
    :: (MonadLogger m, MonadUnliftIO m)
    => SqliteConnectionInfo -> Int -> m (Pool (RawSqlite SqlBackend))
createRawSqlitePoolFromInfo_ :: SqliteConnectionInfo -> Int -> m (Pool (RawSqlite SqlBackend))
createRawSqlitePoolFromInfo_ connInfo :: 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 ()))

-- | Like `createSqlitePoolInfo`, but based on `createRawSqlitePoolFromInfo`.
--
-- @since 2.10.6
withRawSqlitePoolInfo
    :: (MonadUnliftIO m, MonadLogger m)
    => SqliteConnectionInfo
    -> (RawSqlite SqlBackend -> m ())
    -> Int -- ^ number of connections to open
    -> (Pool (RawSqlite SqlBackend) -> m a)
    -> m a
withRawSqlitePoolInfo :: SqliteConnectionInfo
-> (RawSqlite SqlBackend -> m ())
-> Int
-> (Pool (RawSqlite SqlBackend) -> m a)
-> m a
withRawSqlitePoolInfo connInfo :: SqliteConnectionInfo
connInfo f :: RawSqlite SqlBackend -> m ()
f n :: Int
n work :: 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 logFun :: 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 (m :: * -> *) backend 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

-- | Like `createSqlitePoolInfo`, but based on `createRawSqlitePoolFromInfo_`.
--
-- @since 2.10.6
withRawSqlitePoolInfo_
    :: (MonadUnliftIO m, MonadLogger m)
    => SqliteConnectionInfo
    -> Int -- ^ number of connections to open
    -> (Pool (RawSqlite SqlBackend) -> m a)
    -> m a
withRawSqlitePoolInfo_ :: SqliteConnectionInfo
-> Int -> (Pool (RawSqlite SqlBackend) -> m a) -> m a
withRawSqlitePoolInfo_ connInfo :: 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 ()))

-- | Wrapper for persistent SqlBackends that carry the corresponding
-- `Sqlite.Connection`.
--
-- @since 2.10.2
data RawSqlite backend = RawSqlite
    { RawSqlite backend -> backend
_persistentBackend :: backend -- ^ The persistent backend
    , RawSqlite backend -> Connection
_rawSqliteConnection :: Sqlite.Connection -- ^ The underlying `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 (m :: * -> *) record.
(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 (m :: * -> *) record.
(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 filts :: [Filter record]
filts opts :: [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 filts :: [Filter record]
filts opts :: [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 filts :: [Filter record]
filts opts :: [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

instance (PersistQueryWrite b) => PersistQueryWrite (RawSqlite b) where
    updateWhere :: [Filter record] -> [Update record] -> ReaderT (RawSqlite b) m ()
updateWhere filts :: [Filter record]
filts updates :: [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 (m :: * -> *) record.
(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 (m :: * -> *) record.
(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 (m :: * -> *) record.
(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 (m :: * -> *) record.
(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 (m :: * -> *) record.
(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 (m :: * -> *) record.
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Entity record] -> ReaderT backend m ()
insertEntityMany
    insertKey :: Key record -> record -> ReaderT (RawSqlite b) m ()
insertKey k :: 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 (m :: * -> *) record.
(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 k :: 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 (m :: * -> *) record.
(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 (m :: * -> *) record.
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[(Key record, record)] -> ReaderT backend m ()
repsertMany
    replace :: Key record -> record -> ReaderT (RawSqlite b) m ()
replace k :: 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 (m :: * -> *) record.
(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 (m :: * -> *) record.
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete
    update :: Key record -> [Update record] -> ReaderT (RawSqlite b) m ()
update k :: 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 (m :: * -> *) record.
(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 k :: 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 (m :: * -> *) record.
(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 (m :: * -> *) record.
(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 (m :: * -> *) record.
(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 rec :: 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 (m :: * -> *) record.
(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 uniq :: Unique record
uniq rec :: 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 (m :: * -> *) record.
(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 (m :: * -> *) record.
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
putMany

makeLenses ''RawSqlite
makeLenses ''SqliteConnectionInfo