{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# 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
    , ForeignKeyViolation(..)
    , checkForeignKeys
    , 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.Reader (MonadReader)
import Control.Monad.Trans.Resource (MonadResource)
import Control.Monad.Trans.Reader (ReaderT, runReaderT, withReaderT)
import Control.Monad.Trans.Writer (runWriterT)
import Data.Acquire (Acquire, mkAcquire, with)
import Data.Maybe
import Data.Aeson
import Data.Aeson.Types (modifyFailure)
import Data.Conduit
import qualified Data.Conduit.Combinators as C
import qualified Data.Conduit.List as CL
import qualified Data.HashMap.Lazy as HashMap
import Data.Int (Int64)
import Data.IORef
import qualified Data.List as List
import qualified Data.Map as Map
import Data.Monoid ((<>))
import Data.Pool (Pool)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Lens.Micro.TH (makeLenses)
import UnliftIO.Resource (ResourceT, runResourceT)

import Database.Persist.Sql
import qualified Database.Persist.Sql.Util as Util
import qualified Database.Sqlite as Sqlite


-- | 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 SqliteConnectionInfo
connInfo = (LogFunc -> IO SqlBackend) -> Int -> m (Pool SqlBackend)
forall backend (m :: * -> *).
(MonadLogger m, MonadUnliftIO m,
 BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> Int -> m (Pool backend)
createSqlPool ((LogFunc -> IO SqlBackend) -> Int -> m (Pool SqlBackend))
-> (LogFunc -> IO SqlBackend) -> Int -> m (Pool SqlBackend)
forall a b. (a -> b) -> a -> b
$ (SqlBackend -> Connection -> SqlBackend)
-> SqliteConnectionInfo -> LogFunc -> IO SqlBackend
forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> SqlBackend
forall a b. a -> b -> a
const SqliteConnectionInfo
connInfo

-- | 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 Text
connInfo = (LogFunc -> IO SqlBackend)
-> Int -> (Pool SqlBackend -> m a) -> m a
forall backend (m :: * -> *) a.
(MonadLogger m, MonadUnliftIO m,
 BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> Int -> (Pool backend -> m a) -> m a
withSqlPool ((LogFunc -> IO SqlBackend)
 -> Int -> (Pool SqlBackend -> m a) -> m a)
-> (SqliteConnectionInfo -> LogFunc -> IO SqlBackend)
-> SqliteConnectionInfo
-> Int
-> (Pool SqlBackend -> m a)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SqlBackend -> Connection -> SqlBackend)
-> SqliteConnectionInfo -> LogFunc -> IO SqlBackend
forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> SqlBackend
forall a b. a -> b -> a
const (SqliteConnectionInfo -> Int -> (Pool SqlBackend -> m a) -> m a)
-> SqliteConnectionInfo -> Int -> (Pool SqlBackend -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ Text -> SqliteConnectionInfo
conStringToInfo Text
connInfo

-- | 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 SqliteConnectionInfo
connInfo = (LogFunc -> IO SqlBackend)
-> Int -> (Pool SqlBackend -> m a) -> m a
forall backend (m :: * -> *) a.
(MonadLogger m, MonadUnliftIO m,
 BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> Int -> (Pool backend -> m a) -> m a
withSqlPool ((LogFunc -> IO SqlBackend)
 -> Int -> (Pool SqlBackend -> m a) -> m a)
-> (LogFunc -> IO SqlBackend)
-> Int
-> (Pool SqlBackend -> m a)
-> m a
forall a b. (a -> b) -> a -> b
$ (SqlBackend -> Connection -> SqlBackend)
-> SqliteConnectionInfo -> LogFunc -> IO SqlBackend
forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> SqlBackend
forall a b. a -> b -> a
const SqliteConnectionInfo
connInfo

withSqliteConn :: (MonadUnliftIO m, MonadLogger m)
               => Text -> (SqlBackend -> m a) -> m a
withSqliteConn :: Text -> (SqlBackend -> m a) -> m a
withSqliteConn = SqliteConnectionInfo -> (SqlBackend -> m a) -> m a
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
SqliteConnectionInfo -> (SqlBackend -> m a) -> m a
withSqliteConnInfo (SqliteConnectionInfo -> (SqlBackend -> m a) -> m a)
-> (Text -> SqliteConnectionInfo)
-> Text
-> (SqlBackend -> m a)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SqliteConnectionInfo
conStringToInfo

-- | @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 backend (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m,
 BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> (backend -> m a) -> m a
withSqlConn ((LogFunc -> IO SqlBackend) -> (SqlBackend -> m a) -> m a)
-> (SqliteConnectionInfo -> LogFunc -> IO SqlBackend)
-> SqliteConnectionInfo
-> (SqlBackend -> m a)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SqlBackend -> Connection -> SqlBackend)
-> SqliteConnectionInfo -> LogFunc -> IO SqlBackend
forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> SqlBackend
forall a b. a -> b -> a
const

openWith :: (SqlBackend -> Sqlite.Connection -> r)
         -> SqliteConnectionInfo
         -> LogFunc
         -> IO r
openWith :: (SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> r
f SqliteConnectionInfo
connInfo LogFunc
logFunc = do
    Connection
conn <- Text -> IO Connection
Sqlite.open (Text -> IO Connection) -> Text -> IO Connection
forall a b. (a -> b) -> a -> b
$ SqliteConnectionInfo -> Text
_sqlConnectionStr SqliteConnectionInfo
connInfo
    SqlBackend
backend <- SqliteConnectionInfo -> Connection -> LogFunc -> IO SqlBackend
wrapConnectionInfo SqliteConnectionInfo
connInfo Connection
conn LogFunc
logFunc IO SqlBackend -> IO () -> IO SqlBackend
forall a b. IO a -> IO b -> IO a
`E.onException` Connection -> IO ()
Sqlite.close Connection
conn
    r -> IO r
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> IO r) -> r -> IO r
forall a b. (a -> b) -> a -> b
$ SqlBackend -> Connection -> r
f SqlBackend
backend Connection
conn

-- | 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 Text
"")

-- | 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 m a
action =
  [Int] -> m a
start ([Int] -> m a) -> [Int] -> m a
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
20 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> [Int]
forall t. (Ord t, Num t) => t -> [t]
delays Int
1000
  where
    delays :: t -> [t]
delays t
x
      | t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
1000000 = t -> [t]
forall a. a -> [a]
repeat t
x
      | Bool
otherwise = t
x t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
delays (t
x t -> t -> t
forall a. Num a => a -> a -> a
* t
2)

    start :: [Int] -> m a
start [] = do
      Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logWarn Text
"Out of retry attempts"
      m a
action
    start (Int
x:[Int]
xs) = do
      -- 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
$ \forall a. m a -> IO a
run -> IO a -> IO (Either SqliteException a)
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO a -> IO (Either SqliteException a))
-> IO a -> IO (Either SqliteException a)
forall a b. (a -> b) -> a -> b
$ m a -> IO a
forall a. m a -> IO a
run m a
action
      case Either SqliteException a
eres of
        Left (Sqlite.SqliteException { seError :: SqliteException -> Error
Sqlite.seError = Error
Sqlite.ErrorBusy }) -> do
          Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logWarn Text
"Encountered an SQLITE_BUSY, going to retry..."
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
x
          [Int] -> m a
start [Int]
xs
        Left SqliteException
e -> IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ SqliteException -> IO a
forall e a. Exception e => e -> IO a
E.throwIO SqliteException
e
        Right a
y -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y

-- | 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 Text
"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 SqliteConnectionInfo
connInfo Connection
conn 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 = ((Text
"PRAGMA journal_mode=WAL;", Bool
True)(Text, Bool) -> [(Text, Bool)] -> [(Text, Bool)]
forall a. a -> [a] -> [a]
:)
          | Bool
otherwise = [(Text, Bool)] -> [(Text, Bool)]
forall a. a -> a
id

        -- Turn on foreign key constraints
        -- https://github.com/yesodweb/persistent/issues/646
        fkPragma :: [(Text, Bool)] -> [(Text, Bool)]
fkPragma
          | SqliteConnectionInfo -> Bool
_fkEnabled SqliteConnectionInfo
connInfo = ((Text
"PRAGMA foreign_keys = on;", Bool
False)(Text, Bool) -> [(Text, Bool)] -> [(Text, Bool)]
forall a. a -> [a] -> [a]
:)
          | Bool
otherwise = [(Text, Bool)] -> [(Text, Bool)]
forall a. a -> a
id

        -- 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
$ \(Text
pragma, Bool
shouldRetry) -> (LoggingT IO () -> LogFunc -> IO ())
-> LogFunc -> LoggingT IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT IO () -> LogFunc -> IO ()
forall (m :: * -> *) a. LoggingT m a -> LogFunc -> m a
runLoggingT LogFunc
logFunc (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        (if Bool
shouldRetry then LoggingT IO () -> LoggingT IO ()
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
m a -> m a
retryOnBusy else LoggingT IO () -> LoggingT IO ()
forall a. a -> a
id) (LoggingT IO () -> LoggingT IO ())
-> LoggingT IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> LoggingT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LoggingT IO ()) -> IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ do
        Statement
stmt <- Connection -> Text -> IO Statement
Sqlite.prepare Connection
conn Text
pragma
        StepResult
_ <- Connection -> Statement -> IO StepResult
Sqlite.stepConn Connection
conn Statement
stmt
        Connection -> Statement -> IO ()
Sqlite.reset Connection
conn Statement
stmt
        Statement -> IO ()
Sqlite.finalize Statement
stmt

    IORef (Map Text Statement)
smap <- Map Text Statement -> IO (IORef (Map Text Statement))
forall a. a -> IO (IORef a)
newIORef (Map Text Statement -> IO (IORef (Map Text Statement)))
-> Map Text Statement -> IO (IORef (Map Text Statement))
forall a b. (a -> b) -> a -> b
$ Map Text Statement
forall k a. Map k a
Map.empty
    SqlBackend -> IO SqlBackend
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlBackend -> IO SqlBackend) -> SqlBackend -> IO SqlBackend
forall a b. (a -> b) -> a -> b
$ SqlBackend :: (Text -> IO Statement)
-> (EntityDef -> [PersistValue] -> InsertSqlResult)
-> Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
-> Maybe
     (EntityDef -> NonEmpty (HaskellName, DBName) -> Text -> Text)
-> Maybe (EntityDef -> Int -> Text)
-> IORef (Map Text Statement)
-> IO ()
-> ([EntityDef]
    -> (Text -> IO Statement)
    -> EntityDef
    -> IO (Either [Text] [(Bool, Text)]))
-> ((Text -> IO Statement) -> Maybe IsolationLevel -> IO ())
-> ((Text -> IO Statement) -> IO ())
-> ((Text -> IO Statement) -> IO ())
-> (DBName -> Text)
-> Text
-> Text
-> (CharPos -> Bool -> Text -> Text)
-> LogFunc
-> Maybe Int
-> Maybe (EntityDef -> Int -> Text)
-> SqlBackend
SqlBackend
        { connPrepare :: Text -> IO Statement
connPrepare = Connection -> Text -> IO Statement
prepare' Connection
conn
        , connStmtMap :: IORef (Map Text Statement)
connStmtMap = IORef (Map Text Statement)
smap
        , connInsertSql :: EntityDef -> [PersistValue] -> InsertSqlResult
connInsertSql = EntityDef -> [PersistValue] -> InsertSqlResult
insertSql'
        , connUpsertSql :: Maybe (EntityDef -> NonEmpty (HaskellName, DBName) -> Text -> Text)
connUpsertSql = Maybe (EntityDef -> NonEmpty (HaskellName, DBName) -> Text -> Text)
forall a. Maybe a
Nothing
        , connPutManySql :: Maybe (EntityDef -> Int -> Text)
connPutManySql = (EntityDef -> Int -> Text) -> Maybe (EntityDef -> Int -> Text)
forall a. a -> Maybe a
Just EntityDef -> Int -> Text
putManySql
        , connInsertManySql :: Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
connInsertManySql = Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
forall a. Maybe a
Nothing
        , connClose :: IO ()
connClose = Connection -> IO ()
Sqlite.close Connection
conn
        , connMigrateSql :: [EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO (Either [Text] [(Bool, Text)])
connMigrateSql = [EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO (Either [Text] [(Bool, Text)])
migrate'
        , connBegin :: (Text -> IO Statement) -> Maybe IsolationLevel -> IO ()
connBegin = \Text -> IO Statement
f Maybe IsolationLevel
_ -> Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper Text
"BEGIN" Text -> IO Statement
f
        , connCommit :: (Text -> IO Statement) -> IO ()
connCommit = Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper Text
"COMMIT"
        , connRollback :: (Text -> IO Statement) -> IO ()
connRollback = IO () -> IO ()
ignoreExceptions (IO () -> IO ())
-> ((Text -> IO Statement) -> IO ())
-> (Text -> IO Statement)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper Text
"ROLLBACK"
        , connEscapeName :: DBName -> Text
connEscapeName = DBName -> Text
escape
        , connNoLimit :: Text
connNoLimit = Text
"LIMIT -1"
        , connRDBMS :: Text
connRDBMS = Text
"sqlite"
        , connLimitOffset :: CharPos -> Bool -> Text -> Text
connLimitOffset = Text -> CharPos -> Bool -> Text -> Text
decorateSQLWithLimitOffset Text
"LIMIT -1"
        , connLogFunc :: LogFunc
connLogFunc = LogFunc
logFunc
        , connMaxParams :: Maybe Int
connMaxParams = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
999
        , connRepsertManySql :: Maybe (EntityDef -> Int -> Text)
connRepsertManySql = (EntityDef -> Int -> Text) -> Maybe (EntityDef -> Int -> Text)
forall a. a -> Maybe a
Just EntityDef -> Int -> Text
repsertManySql
        }
  where
    helper :: t -> (t -> IO Statement) -> IO ()
helper t
t t -> IO Statement
getter = do
        Statement
stmt <- t -> IO Statement
getter t
t
        Int64
_ <- Statement -> [PersistValue] -> IO Int64
stmtExecute Statement
stmt []
        Statement -> IO ()
stmtReset Statement
stmt
    ignoreExceptions :: IO () -> IO ()
ignoreExceptions = (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (\(SomeException
_ :: E.SomeException) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | 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 Text
connstr = ResourceT m a -> m a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT
                  (ResourceT m a -> m a)
-> (ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
    -> ResourceT m a)
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoLoggingT (ResourceT m) a -> ResourceT m a
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT
                  (NoLoggingT (ResourceT m) a -> ResourceT m a)
-> (ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
    -> NoLoggingT (ResourceT m) a)
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> ResourceT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> (SqlBackend -> NoLoggingT (ResourceT m) a)
-> NoLoggingT (ResourceT m) a
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
Text -> (SqlBackend -> m a) -> m a
withSqliteConn Text
connstr
                  ((SqlBackend -> NoLoggingT (ResourceT m) a)
 -> NoLoggingT (ResourceT m) a)
-> (ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
    -> SqlBackend -> NoLoggingT (ResourceT m) a)
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> NoLoggingT (ResourceT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> SqlBackend -> NoLoggingT (ResourceT m) a
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> backend -> m a
runSqlConn

-- | 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 SqliteConnectionInfo
conInfo = ResourceT m a -> m a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT
                      (ResourceT m a -> m a)
-> (ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
    -> ResourceT m a)
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoLoggingT (ResourceT m) a -> ResourceT m a
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT
                      (NoLoggingT (ResourceT m) a -> ResourceT m a)
-> (ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
    -> NoLoggingT (ResourceT m) a)
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> ResourceT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqliteConnectionInfo
-> (SqlBackend -> NoLoggingT (ResourceT m) a)
-> NoLoggingT (ResourceT m) a
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
SqliteConnectionInfo -> (SqlBackend -> m a) -> m a
withSqliteConnInfo SqliteConnectionInfo
conInfo
                      ((SqlBackend -> NoLoggingT (ResourceT m) a)
 -> NoLoggingT (ResourceT m) a)
-> (ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
    -> SqlBackend -> NoLoggingT (ResourceT m) a)
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> NoLoggingT (ResourceT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SqlBackend (NoLoggingT (ResourceT m)) a
-> SqlBackend -> NoLoggingT (ResourceT m) a
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> backend -> m a
runSqlConn

prepare' :: Sqlite.Connection -> Text -> IO Statement
prepare' :: Connection -> Text -> IO Statement
prepare' Connection
conn Text
sql = do
    Statement
stmt <- Connection -> Text -> IO Statement
Sqlite.prepare Connection
conn Text
sql
    Statement -> IO Statement
forall (m :: * -> *) a. Monad m => a -> m a
return Statement :: IO ()
-> IO ()
-> ([PersistValue] -> IO Int64)
-> (forall (m :: * -> *).
    MonadIO m =>
    [PersistValue] -> Acquire (ConduitM () [PersistValue] m ()))
-> Statement
Statement
        { stmtFinalize :: IO ()
stmtFinalize = Statement -> IO ()
Sqlite.finalize Statement
stmt
        , stmtReset :: IO ()
stmtReset = Connection -> Statement -> IO ()
Sqlite.reset Connection
conn Statement
stmt
        , stmtExecute :: [PersistValue] -> IO Int64
stmtExecute = Connection -> Statement -> [PersistValue] -> IO Int64
execute' Connection
conn Statement
stmt
        , stmtQuery :: forall (m :: * -> *).
MonadIO m =>
[PersistValue] -> Acquire (ConduitM () [PersistValue] m ())
stmtQuery = Connection
-> Statement
-> [PersistValue]
-> Acquire (ConduitM () [PersistValue] m ())
forall (m :: * -> *).
MonadIO m =>
Connection
-> Statement
-> [PersistValue]
-> Acquire (ConduitM () [PersistValue] m ())
withStmt' Connection
conn Statement
stmt
        }

insertSql' :: EntityDef -> [PersistValue] -> InsertSqlResult
insertSql' :: EntityDef -> [PersistValue] -> InsertSqlResult
insertSql' EntityDef
ent [PersistValue]
vals =
    case EntityDef -> Maybe CompositeDef
entityPrimary EntityDef
ent of
        Just CompositeDef
_ ->
          Text -> [PersistValue] -> InsertSqlResult
ISRManyKeys Text
sql [PersistValue]
vals
            where sql :: Text
sql = [Text] -> Text
T.concat
                    [ Text
"INSERT INTO "
                    , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
ent
                    , Text
"("
                    , Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DBName -> Text
escape (DBName -> Text) -> (FieldDef -> DBName) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> DBName
fieldDB) [FieldDef]
cols
                    , Text
") VALUES("
                    , Text -> [Text] -> Text
T.intercalate Text
"," ((FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FieldDef -> Text
forall a b. a -> b -> a
const Text
"?") [FieldDef]
cols)
                    , Text
")"
                    ]
        Maybe CompositeDef
Nothing ->
          Text -> Text -> InsertSqlResult
ISRInsertGet Text
ins Text
sel
            where
              sel :: Text
sel = [Text] -> Text
T.concat
                  [ Text
"SELECT "
                  , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> DBName
fieldDB (EntityDef -> FieldDef
entityId EntityDef
ent)
                  , Text
" FROM "
                  , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
ent
                  , Text
" WHERE _ROWID_=last_insert_rowid()"
                  ]
              ins :: Text
ins = [Text] -> Text
T.concat
                  [ Text
"INSERT INTO "
                  , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
ent
                  , if [FieldDef] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldDef]
cols
                        then Text
" VALUES(null)"
                        else [Text] -> Text
T.concat
                          [ Text
"("
                          , Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DBName -> Text
escape (DBName -> Text) -> (FieldDef -> DBName) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> DBName
fieldDB) ([FieldDef] -> [Text]) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> a -> b
$ [FieldDef]
cols
                          , Text
") VALUES("
                          , Text -> [Text] -> Text
T.intercalate Text
"," ((FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FieldDef -> Text
forall a b. a -> b -> a
const Text
"?") [FieldDef]
cols)
                          , Text
")"
                          ]
                  ]
  where
    notGenerated :: FieldDef -> Bool
notGenerated =
        Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text -> Bool)
-> (FieldDef -> Maybe Text) -> FieldDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> Maybe Text
fieldGenerated
    cols :: [FieldDef]
cols =
        (FieldDef -> Bool) -> [FieldDef] -> [FieldDef]
forall a. (a -> Bool) -> [a] -> [a]
filter FieldDef -> Bool
notGenerated ([FieldDef] -> [FieldDef]) -> [FieldDef] -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
entityFields EntityDef
ent

execute' :: Sqlite.Connection -> Sqlite.Statement -> [PersistValue] -> IO Int64
execute' :: Connection -> Statement -> [PersistValue] -> IO Int64
execute' Connection
conn Statement
stmt [PersistValue]
vals = (IO Int64 -> IO () -> IO Int64) -> IO () -> IO Int64 -> IO Int64
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO Int64 -> IO () -> IO Int64
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
finally (IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> Statement -> IO ()
Sqlite.reset Connection
conn Statement
stmt) (IO Int64 -> IO Int64) -> IO Int64 -> IO Int64
forall a b. (a -> b) -> a -> b
$ do
    Statement -> [PersistValue] -> IO ()
Sqlite.bind Statement
stmt [PersistValue]
vals
    StepResult
_ <- Connection -> Statement -> IO StepResult
Sqlite.stepConn Connection
conn Statement
stmt
    Connection -> IO Int64
Sqlite.changes Connection
conn

withStmt'
          :: MonadIO m
          => Sqlite.Connection
          -> Sqlite.Statement
          -> [PersistValue]
          -> Acquire (ConduitM () [PersistValue] m ())
withStmt' :: Connection
-> Statement
-> [PersistValue]
-> Acquire (ConduitM () [PersistValue] m ())
withStmt' Connection
conn Statement
stmt [PersistValue]
vals = do
    Statement
_ <- IO Statement -> (Statement -> IO ()) -> Acquire Statement
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire
        (Statement -> [PersistValue] -> IO ()
Sqlite.bind Statement
stmt [PersistValue]
vals IO () -> IO Statement -> IO Statement
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Statement -> IO Statement
forall (m :: * -> *) a. Monad m => a -> m a
return Statement
stmt)
        (Connection -> Statement -> IO ()
Sqlite.reset Connection
conn)
    ConduitM () [PersistValue] m ()
-> Acquire (ConduitM () [PersistValue] m ())
forall (m :: * -> *) a. Monad m => a -> m a
return ConduitM () [PersistValue] m ()
pull
  where
    pull :: ConduitM () [PersistValue] m ()
pull = do
        StepResult
x <- IO StepResult -> ConduitT () [PersistValue] m StepResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StepResult -> ConduitT () [PersistValue] m StepResult)
-> IO StepResult -> ConduitT () [PersistValue] m StepResult
forall a b. (a -> b) -> a -> b
$ Connection -> Statement -> IO StepResult
Sqlite.stepConn Connection
conn Statement
stmt
        case StepResult
x of
            StepResult
Sqlite.Done -> () -> ConduitM () [PersistValue] m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            StepResult
Sqlite.Row -> do
                [PersistValue]
cols <- IO [PersistValue] -> ConduitT () [PersistValue] m [PersistValue]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [PersistValue] -> ConduitT () [PersistValue] m [PersistValue])
-> IO [PersistValue] -> ConduitT () [PersistValue] m [PersistValue]
forall a b. (a -> b) -> a -> b
$ Statement -> IO [PersistValue]
Sqlite.columns Statement
stmt
                [PersistValue] -> ConduitM () [PersistValue] m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [PersistValue]
cols
                ConduitM () [PersistValue] m ()
pull

showSqlType :: SqlType -> Text
showSqlType :: SqlType -> Text
showSqlType SqlType
SqlString = Text
"VARCHAR"
showSqlType SqlType
SqlInt32 = Text
"INTEGER"
showSqlType SqlType
SqlInt64 = Text
"INTEGER"
showSqlType SqlType
SqlReal = Text
"REAL"
showSqlType (SqlNumeric Word32
precision Word32
scale) = [Text] -> Text
T.concat [ Text
"NUMERIC(", String -> Text
T.pack (Word32 -> String
forall a. Show a => a -> String
show Word32
precision), Text
",", String -> Text
T.pack (Word32 -> String
forall a. Show a => a -> String
show Word32
scale), Text
")" ]
showSqlType SqlType
SqlDay = Text
"DATE"
showSqlType SqlType
SqlTime = Text
"TIME"
showSqlType SqlType
SqlDayTime = Text
"TIMESTAMP"
showSqlType SqlType
SqlBlob = Text
"BLOB"
showSqlType SqlType
SqlBool = Text
"BOOLEAN"
showSqlType (SqlOther Text
t) = Text
t

sqliteMkColumns :: [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
sqliteMkColumns :: [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
sqliteMkColumns [EntityDef]
allDefs EntityDef
t = [EntityDef]
-> EntityDef
-> BackendSpecificOverrides
-> ([Column], [UniqueDef], [ForeignDef])
mkColumns [EntityDef]
allDefs EntityDef
t BackendSpecificOverrides
emptyBackendSpecificOverrides

migrate'
    :: [EntityDef]
    -> (Text -> IO Statement)
    -> EntityDef
    -> IO (Either [Text] [(Bool, Text)])
migrate' :: [EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO (Either [Text] [(Bool, Text)])
migrate' [EntityDef]
allDefs Text -> IO Statement
getter EntityDef
val = do
    let ([Column]
cols, [UniqueDef]
uniqs, [ForeignDef]
fdefs) = [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
sqliteMkColumns [EntityDef]
allDefs EntityDef
val
    let newSql :: Text
newSql = Bool -> EntityDef -> ([Column], [UniqueDef], [ForeignDef]) -> Text
mkCreateTable Bool
False EntityDef
def ((Column -> Bool) -> [Column] -> [Column]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Column -> Bool) -> Column -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> DBName -> Bool
safeToRemove EntityDef
val (DBName -> Bool) -> (Column -> DBName) -> Column -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> DBName
cName) [Column]
cols, [UniqueDef]
uniqs, [ForeignDef]
fdefs)
    Statement
stmt <- Text -> IO Statement
getter Text
"SELECT sql FROM sqlite_master WHERE type='table' AND name=?"
    Maybe Text
oldSql' <- Acquire (ConduitM () [PersistValue] IO ())
-> (ConduitM () [PersistValue] IO () -> IO (Maybe Text))
-> IO (Maybe Text)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
with (Statement
-> [PersistValue] -> Acquire (ConduitM () [PersistValue] IO ())
Statement
-> forall (m :: * -> *).
   MonadIO m =>
   [PersistValue] -> Acquire (ConduitM () [PersistValue] m ())
stmtQuery Statement
stmt [Text -> PersistValue
PersistText (Text -> PersistValue) -> Text -> PersistValue
forall a b. (a -> b) -> a -> b
$ DBName -> Text
unDBName DBName
table])
      (\ConduitM () [PersistValue] IO ()
src -> ConduitT () Void IO (Maybe Text) -> IO (Maybe Text)
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO (Maybe Text) -> IO (Maybe Text))
-> ConduitT () Void IO (Maybe Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ConduitM () [PersistValue] IO ()
src ConduitM () [PersistValue] IO ()
-> ConduitM [PersistValue] Void IO (Maybe Text)
-> ConduitT () Void IO (Maybe Text)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM [PersistValue] Void IO (Maybe Text)
forall o. ConduitT [PersistValue] o IO (Maybe Text)
go)
    case Maybe Text
oldSql' of
        Maybe Text
Nothing -> Either [Text] [(Bool, Text)] -> IO (Either [Text] [(Bool, Text)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Text] [(Bool, Text)] -> IO (Either [Text] [(Bool, Text)]))
-> Either [Text] [(Bool, Text)]
-> IO (Either [Text] [(Bool, Text)])
forall a b. (a -> b) -> a -> b
$ [(Bool, Text)] -> Either [Text] [(Bool, Text)]
forall a b. b -> Either a b
Right [(Bool
False, Text
newSql)]
        Just Text
oldSql -> do
            if Text
oldSql Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
newSql
                then Either [Text] [(Bool, Text)] -> IO (Either [Text] [(Bool, Text)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Text] [(Bool, Text)] -> IO (Either [Text] [(Bool, Text)]))
-> Either [Text] [(Bool, Text)]
-> IO (Either [Text] [(Bool, Text)])
forall a b. (a -> b) -> a -> b
$ [(Bool, Text)] -> Either [Text] [(Bool, Text)]
forall a b. b -> Either a b
Right []
                else do
                    [(Bool, Text)]
sql <- [EntityDef]
-> (Text -> IO Statement) -> EntityDef -> IO [(Bool, Text)]
getCopyTable [EntityDef]
allDefs Text -> IO Statement
getter EntityDef
val
                    Either [Text] [(Bool, Text)] -> IO (Either [Text] [(Bool, Text)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Text] [(Bool, Text)] -> IO (Either [Text] [(Bool, Text)]))
-> Either [Text] [(Bool, Text)]
-> IO (Either [Text] [(Bool, Text)])
forall a b. (a -> b) -> a -> b
$ [(Bool, Text)] -> Either [Text] [(Bool, Text)]
forall a b. b -> Either a b
Right [(Bool, Text)]
sql
  where
    def :: EntityDef
def = EntityDef
val
    table :: DBName
table = EntityDef -> DBName
entityDB EntityDef
def
    go :: ConduitT [PersistValue] o IO (Maybe Text)
go = do
        Maybe [PersistValue]
x <- ConduitT [PersistValue] o IO (Maybe [PersistValue])
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
        case Maybe [PersistValue]
x of
            Maybe [PersistValue]
Nothing -> Maybe Text -> ConduitT [PersistValue] o IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
            Just [PersistText Text
y] -> Maybe Text -> ConduitT [PersistValue] o IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ConduitT [PersistValue] o IO (Maybe Text))
-> Maybe Text -> ConduitT [PersistValue] o IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
y
            Just [PersistValue]
y -> String -> ConduitT [PersistValue] o IO (Maybe Text)
forall a. HasCallStack => String -> a
error (String -> ConduitT [PersistValue] o IO (Maybe Text))
-> String -> ConduitT [PersistValue] o IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ String
"Unexpected result from sqlite_master: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
y

-- | 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 Migration
mig = do
  IORef (Map Text Statement)
smap <- Map Text Statement -> IO (IORef (Map Text Statement))
forall a. a -> IO (IORef a)
newIORef (Map Text Statement -> IO (IORef (Map Text Statement)))
-> Map Text Statement -> IO (IORef (Map Text Statement))
forall a b. (a -> b) -> a -> b
$ Map Text Statement
forall k a. Map k a
Map.empty
  let sqlbackend :: SqlBackend
sqlbackend = SqlBackend :: (Text -> IO Statement)
-> (EntityDef -> [PersistValue] -> InsertSqlResult)
-> Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
-> Maybe
     (EntityDef -> NonEmpty (HaskellName, DBName) -> Text -> Text)
-> Maybe (EntityDef -> Int -> Text)
-> IORef (Map Text Statement)
-> IO ()
-> ([EntityDef]
    -> (Text -> IO Statement)
    -> EntityDef
    -> IO (Either [Text] [(Bool, Text)]))
-> ((Text -> IO Statement) -> Maybe IsolationLevel -> IO ())
-> ((Text -> IO Statement) -> IO ())
-> ((Text -> IO Statement) -> IO ())
-> (DBName -> Text)
-> Text
-> Text
-> (CharPos -> Bool -> Text -> Text)
-> LogFunc
-> Maybe Int
-> Maybe (EntityDef -> Int -> Text)
-> SqlBackend
SqlBackend
                   { connPrepare :: Text -> IO Statement
connPrepare = \Text
_ -> do
                                     Statement -> IO Statement
forall (m :: * -> *) a. Monad m => a -> m a
return Statement :: IO ()
-> IO ()
-> ([PersistValue] -> IO Int64)
-> (forall (m :: * -> *).
    MonadIO m =>
    [PersistValue] -> Acquire (ConduitM () [PersistValue] m ()))
-> Statement
Statement
                                                { stmtFinalize :: IO ()
stmtFinalize = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                                , stmtReset :: IO ()
stmtReset = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                                , stmtExecute :: [PersistValue] -> IO Int64
stmtExecute = [PersistValue] -> IO Int64
forall a. HasCallStack => a
undefined
                                                , stmtQuery :: forall (m :: * -> *).
MonadIO m =>
[PersistValue] -> Acquire (ConduitM () [PersistValue] m ())
stmtQuery = \[PersistValue]
_ -> ConduitM () [PersistValue] m ()
-> Acquire (ConduitM () [PersistValue] m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ConduitM () [PersistValue] m ()
 -> Acquire (ConduitM () [PersistValue] m ()))
-> ConduitM () [PersistValue] m ()
-> Acquire (ConduitM () [PersistValue] m ())
forall a b. (a -> b) -> a -> b
$ () -> ConduitM () [PersistValue] m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                                }
                   , connStmtMap :: IORef (Map Text Statement)
connStmtMap = IORef (Map Text Statement)
smap
                   , connInsertSql :: EntityDef -> [PersistValue] -> InsertSqlResult
connInsertSql = EntityDef -> [PersistValue] -> InsertSqlResult
insertSql'
                   , connInsertManySql :: Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
connInsertManySql = Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult)
forall a. Maybe a
Nothing
                   , connClose :: IO ()
connClose = IO ()
forall a. HasCallStack => a
undefined
                   , connMigrateSql :: [EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO (Either [Text] [(Bool, Text)])
connMigrateSql = [EntityDef]
-> (Text -> IO Statement)
-> EntityDef
-> IO (Either [Text] [(Bool, Text)])
migrate'
                   , connBegin :: (Text -> IO Statement) -> Maybe IsolationLevel -> IO ()
connBegin = \Text -> IO Statement
f Maybe IsolationLevel
_ -> Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper Text
"BEGIN" Text -> IO Statement
f
                   , connCommit :: (Text -> IO Statement) -> IO ()
connCommit = Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper Text
"COMMIT"
                   , connRollback :: (Text -> IO Statement) -> IO ()
connRollback = IO () -> IO ()
ignoreExceptions (IO () -> IO ())
-> ((Text -> IO Statement) -> IO ())
-> (Text -> IO Statement)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Text -> IO Statement) -> IO ()
forall t. t -> (t -> IO Statement) -> IO ()
helper Text
"ROLLBACK"
                   , connEscapeName :: DBName -> Text
connEscapeName = DBName -> Text
escape
                   , connNoLimit :: Text
connNoLimit = Text
"LIMIT -1"
                   , connRDBMS :: Text
connRDBMS = Text
"sqlite"
                   , connLimitOffset :: CharPos -> Bool -> Text -> Text
connLimitOffset = Text -> CharPos -> Bool -> Text -> Text
decorateSQLWithLimitOffset Text
"LIMIT -1"
                   , connLogFunc :: LogFunc
connLogFunc = LogFunc
forall a. HasCallStack => a
undefined
                   , connUpsertSql :: Maybe (EntityDef -> NonEmpty (HaskellName, DBName) -> Text -> Text)
connUpsertSql = Maybe (EntityDef -> NonEmpty (HaskellName, DBName) -> Text -> Text)
forall a. HasCallStack => a
undefined
                   , connPutManySql :: Maybe (EntityDef -> Int -> Text)
connPutManySql = Maybe (EntityDef -> Int -> Text)
forall a. HasCallStack => a
undefined
                   , connMaxParams :: Maybe Int
connMaxParams = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
999
                   , connRepsertManySql :: Maybe (EntityDef -> Int -> Text)
connRepsertManySql = Maybe (EntityDef -> Int -> Text)
forall a. Maybe a
Nothing
                   }
      result :: SqlBackend -> IO (((), [Text]), [(Bool, Text)])
result = ReaderT SqlBackend IO (((), [Text]), [(Bool, Text)])
-> SqlBackend -> IO (((), [Text]), [(Bool, Text)])
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT SqlBackend IO (((), [Text]), [(Bool, Text)])
 -> SqlBackend -> IO (((), [Text]), [(Bool, Text)]))
-> (Migration
    -> ReaderT SqlBackend IO (((), [Text]), [(Bool, Text)]))
-> Migration
-> SqlBackend
-> IO (((), [Text]), [(Bool, Text)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [(Bool, Text)] (ReaderT SqlBackend IO) ((), [Text])
-> ReaderT SqlBackend IO (((), [Text]), [(Bool, Text)])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [(Bool, Text)] (ReaderT SqlBackend IO) ((), [Text])
 -> ReaderT SqlBackend IO (((), [Text]), [(Bool, Text)]))
-> (Migration
    -> WriterT [(Bool, Text)] (ReaderT SqlBackend IO) ((), [Text]))
-> Migration
-> ReaderT SqlBackend IO (((), [Text]), [(Bool, Text)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Migration
-> WriterT [(Bool, Text)] (ReaderT SqlBackend IO) ((), [Text])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (Migration -> SqlBackend -> IO (((), [Text]), [(Bool, Text)]))
-> Migration -> SqlBackend -> IO (((), [Text]), [(Bool, Text)])
forall a b. (a -> b) -> a -> b
$ Migration
mig
  (((), [Text]), [(Bool, Text)])
resp <- SqlBackend -> IO (((), [Text]), [(Bool, Text)])
result SqlBackend
sqlbackend
  (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> IO ()
TIO.putStrLn ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Bool, Text) -> Text) -> [(Bool, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Text) -> Text
forall a b. (a, b) -> b
snd ([(Bool, Text)] -> [Text]) -> [(Bool, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ (((), [Text]), [(Bool, Text)]) -> [(Bool, Text)]
forall a b. (a, b) -> b
snd (((), [Text]), [(Bool, Text)])
resp
    where
      helper :: t -> (t -> IO Statement) -> IO ()
helper t
t t -> IO Statement
getter = do
                      Statement
stmt <- t -> IO Statement
getter t
t
                      Int64
_ <- Statement -> [PersistValue] -> IO Int64
stmtExecute Statement
stmt []
                      Statement -> IO ()
stmtReset Statement
stmt
      ignoreExceptions :: IO () -> IO ()
ignoreExceptions = (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (\(SomeException
_ :: E.SomeException) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | 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 EntityDef
def (DBName Text
colName)
    = (FieldDef -> Bool) -> [FieldDef] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FieldAttr -> [FieldAttr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FieldAttr
FieldAttrSafeToRemove ([FieldAttr] -> Bool)
-> (FieldDef -> [FieldAttr]) -> FieldDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> [FieldAttr]
fieldAttrs)
    ([FieldDef] -> Bool) -> [FieldDef] -> Bool
forall a b. (a -> b) -> a -> b
$ (FieldDef -> Bool) -> [FieldDef] -> [FieldDef]
forall a. (a -> Bool) -> [a] -> [a]
filter ((DBName -> DBName -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> DBName
DBName Text
colName) (DBName -> Bool) -> (FieldDef -> DBName) -> FieldDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> DBName
fieldDB)
    ([FieldDef] -> [FieldDef]) -> [FieldDef] -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
entityFields EntityDef
def

getCopyTable :: [EntityDef]
             -> (Text -> IO Statement)
             -> EntityDef
             -> IO [(Bool, Text)]
getCopyTable :: [EntityDef]
-> (Text -> IO Statement) -> EntityDef -> IO [(Bool, Text)]
getCopyTable [EntityDef]
allDefs Text -> IO Statement
getter EntityDef
def = do
    Statement
stmt <- Text -> IO Statement
getter (Text -> IO Statement) -> Text -> IO Statement
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [ Text
"PRAGMA table_info(", DBName -> Text
escape DBName
table, Text
")" ]
    [Text]
oldCols' <- Acquire (ConduitM () [PersistValue] IO ())
-> (ConduitM () [PersistValue] IO () -> IO [Text]) -> IO [Text]
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
with (Statement
-> [PersistValue] -> Acquire (ConduitM () [PersistValue] IO ())
Statement
-> forall (m :: * -> *).
   MonadIO m =>
   [PersistValue] -> Acquire (ConduitM () [PersistValue] m ())
stmtQuery Statement
stmt []) (\ConduitM () [PersistValue] IO ()
src -> ConduitT () Void IO [Text] -> IO [Text]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO [Text] -> IO [Text])
-> ConduitT () Void IO [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ ConduitM () [PersistValue] IO ()
src ConduitM () [PersistValue] IO ()
-> ConduitM [PersistValue] Void IO [Text]
-> ConduitT () Void IO [Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM [PersistValue] Void IO [Text]
forall o. ConduitT [PersistValue] o IO [Text]
getCols)
    let oldCols :: [DBName]
oldCols = (Text -> DBName) -> [Text] -> [DBName]
forall a b. (a -> b) -> [a] -> [b]
map Text -> DBName
DBName [Text]
oldCols'
    let newCols :: [DBName]
newCols = (DBName -> Bool) -> [DBName] -> [DBName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (DBName -> Bool) -> DBName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> DBName -> Bool
safeToRemove EntityDef
def) ([DBName] -> [DBName]) -> [DBName] -> [DBName]
forall a b. (a -> b) -> a -> b
$ (Column -> DBName) -> [Column] -> [DBName]
forall a b. (a -> b) -> [a] -> [b]
map Column -> DBName
cName [Column]
cols
    let common :: [DBName]
common = (DBName -> Bool) -> [DBName] -> [DBName]
forall a. (a -> Bool) -> [a] -> [a]
filter (DBName -> [DBName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DBName]
oldCols) [DBName]
newCols
    [(Bool, Text)] -> IO [(Bool, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return [ (Bool
False, Text
tmpSql)
           , (Bool
False, [DBName] -> Text
copyToTemp [DBName]
common)
           , ([DBName]
common [DBName] -> [DBName] -> Bool
forall a. Eq a => a -> a -> Bool
/= (DBName -> Bool) -> [DBName] -> [DBName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (DBName -> Bool) -> DBName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> DBName -> Bool
safeToRemove EntityDef
def) [DBName]
oldCols, Text
dropOld)
           , (Bool
False, Text
newSql)
           , (Bool
False, [DBName] -> Text
copyToFinal [DBName]
newCols)
           , (Bool
False, Text
dropTmp)
           ]
  where
    getCols :: ConduitT [PersistValue] o IO [Text]
getCols = do
        Maybe [PersistValue]
x <- ConduitT [PersistValue] o IO (Maybe [PersistValue])
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
        case Maybe [PersistValue]
x of
            Maybe [PersistValue]
Nothing -> [Text] -> ConduitT [PersistValue] o IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []
            Just (PersistValue
_:PersistText Text
name:[PersistValue]
_) -> do
                [Text]
names <- ConduitT [PersistValue] o IO [Text]
getCols
                [Text] -> ConduitT [PersistValue] o IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> ConduitT [PersistValue] o IO [Text])
-> [Text] -> ConduitT [PersistValue] o IO [Text]
forall a b. (a -> b) -> a -> b
$ Text
name Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
names
            Just [PersistValue]
y -> String -> ConduitT [PersistValue] o IO [Text]
forall a. HasCallStack => String -> a
error (String -> ConduitT [PersistValue] o IO [Text])
-> String -> ConduitT [PersistValue] o IO [Text]
forall a b. (a -> b) -> a -> b
$ String
"Invalid result from PRAGMA table_info: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
y
    table :: DBName
table = EntityDef -> DBName
entityDB EntityDef
def
    tableTmp :: DBName
tableTmp = Text -> DBName
DBName (Text -> DBName) -> Text -> DBName
forall a b. (a -> b) -> a -> b
$ DBName -> Text
unDBName DBName
table Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_backup"
    ([Column]
cols, [UniqueDef]
uniqs, [ForeignDef]
fdef) = [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
sqliteMkColumns [EntityDef]
allDefs EntityDef
def
    cols' :: [Column]
cols' = (Column -> Bool) -> [Column] -> [Column]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Column -> Bool) -> Column -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> DBName -> Bool
safeToRemove EntityDef
def (DBName -> Bool) -> (Column -> DBName) -> Column -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> DBName
cName) [Column]
cols
    newSql :: Text
newSql = Bool -> EntityDef -> ([Column], [UniqueDef], [ForeignDef]) -> Text
mkCreateTable Bool
False EntityDef
def ([Column]
cols', [UniqueDef]
uniqs, [ForeignDef]
fdef)
    tmpSql :: Text
tmpSql = Bool -> EntityDef -> ([Column], [UniqueDef], [ForeignDef]) -> Text
mkCreateTable Bool
True EntityDef
def { entityDB :: DBName
entityDB = DBName
tableTmp } ([Column]
cols', [UniqueDef]
uniqs, [])
    dropTmp :: Text
dropTmp = Text
"DROP TABLE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DBName -> Text
escape DBName
tableTmp
    dropOld :: Text
dropOld = Text
"DROP TABLE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DBName -> Text
escape DBName
table
    copyToTemp :: [DBName] -> Text
copyToTemp [DBName]
common = [Text] -> Text
T.concat
        [ Text
"INSERT INTO "
        , DBName -> Text
escape DBName
tableTmp
        , Text
"("
        , Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (DBName -> Text) -> [DBName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map DBName -> Text
escape [DBName]
common
        , Text
") SELECT "
        , Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (DBName -> Text) -> [DBName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map DBName -> Text
escape [DBName]
common
        , Text
" FROM "
        , DBName -> Text
escape DBName
table
        ]
    copyToFinal :: [DBName] -> Text
copyToFinal [DBName]
newCols = [Text] -> Text
T.concat
        [ Text
"INSERT INTO "
        , DBName -> Text
escape DBName
table
        , Text
" SELECT "
        , Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (DBName -> Text) -> [DBName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map DBName -> Text
escape [DBName]
newCols
        , Text
" FROM "
        , DBName -> Text
escape DBName
tableTmp
        ]

mkCreateTable :: Bool -> EntityDef -> ([Column], [UniqueDef], [ForeignDef]) -> Text
mkCreateTable :: Bool -> EntityDef -> ([Column], [UniqueDef], [ForeignDef]) -> Text
mkCreateTable Bool
isTemp EntityDef
entity ([Column]
cols, [UniqueDef]
uniqs, [ForeignDef]
fdefs) =
    [Text] -> Text
T.concat ([Text]
header [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
columns [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
footer)
  where
    header :: [Text]
header =
        [ Text
"CREATE"
        , if Bool
isTemp then Text
" TEMP" else Text
""
        , Text
" TABLE "
        , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef -> DBName
entityDB EntityDef
entity
        , Text
"("
        ]

    footer :: [Text]
footer =
        [ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (UniqueDef -> Text) -> [UniqueDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map UniqueDef -> Text
sqlUnique [UniqueDef]
uniqs
        , [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (ForeignDef -> Text) -> [ForeignDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ForeignDef -> Text
sqlForeign [ForeignDef]
fdefs
        , Text
")"
        ]

    columns :: [Text]
columns = case EntityDef -> Maybe CompositeDef
entityPrimary EntityDef
entity of
        Just CompositeDef
pdef ->
            [ Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Column -> Text) -> [Column] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Column -> Text
sqlColumn Bool
isTemp) [Column]
cols
            , Text
", PRIMARY KEY "
            , Text
"("
            , Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DBName -> Text
escape (DBName -> Text) -> (FieldDef -> DBName) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> DBName
fieldDB) ([FieldDef] -> [Text]) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> a -> b
$ CompositeDef -> [FieldDef]
compositeFields CompositeDef
pdef
            , Text
")"
            ]

        Maybe CompositeDef
Nothing ->
            [ DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> DBName
fieldDB (EntityDef -> FieldDef
entityId EntityDef
entity)
            , Text
" "
            , SqlType -> Text
showSqlType (SqlType -> Text) -> SqlType -> Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> SqlType
fieldSqlType (FieldDef -> SqlType) -> FieldDef -> SqlType
forall a b. (a -> b) -> a -> b
$ EntityDef -> FieldDef
entityId EntityDef
entity
            , Text
" PRIMARY KEY"
            , Maybe Text -> Text
mayDefault (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ [FieldAttr] -> Maybe Text
defaultAttribute ([FieldAttr] -> Maybe Text) -> [FieldAttr] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ FieldDef -> [FieldAttr]
fieldAttrs (FieldDef -> [FieldAttr]) -> FieldDef -> [FieldAttr]
forall a b. (a -> b) -> a -> b
$ EntityDef -> FieldDef
entityId EntityDef
entity
            , [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Column -> Text) -> [Column] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Column -> Text
sqlColumn Bool
isTemp) [Column]
nonIdCols
            ]

    nonIdCols :: [Column]
nonIdCols = (Column -> Bool) -> [Column] -> [Column]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Column
c -> Column -> DBName
cName Column
c DBName -> DBName -> Bool
forall a. Eq a => a -> a -> Bool
/= FieldDef -> DBName
fieldDB (EntityDef -> FieldDef
entityId EntityDef
entity)) [Column]
cols

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

mayGenerated :: Maybe Text -> Text
mayGenerated :: Maybe Text -> Text
mayGenerated Maybe Text
gen = case Maybe Text
gen of
    Maybe Text
Nothing -> Text
""
    Just Text
g -> Text
" GENERATED ALWAYS AS (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
g Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") STORED"

sqlColumn :: Bool -> Column -> Text
sqlColumn :: Bool -> Column -> Text
sqlColumn Bool
noRef (Column DBName
name Bool
isNull SqlType
typ Maybe Text
def Maybe Text
gen Maybe DBName
_cn Maybe Integer
_maxLen Maybe ColumnReference
ref) = [Text] -> Text
T.concat
    [ Text
","
    , DBName -> Text
escape DBName
name
    , Text
" "
    , SqlType -> Text
showSqlType SqlType
typ
    , if Bool
isNull then Text
" NULL" else Text
" NOT NULL"
    , Maybe Text -> Text
mayDefault Maybe Text
def
    , Maybe Text -> Text
mayGenerated Maybe Text
gen
    , case Maybe ColumnReference
ref of
        Maybe ColumnReference
Nothing -> Text
""
        Just ColumnReference {crTableName :: ColumnReference -> DBName
crTableName=DBName
table, crFieldCascade :: ColumnReference -> FieldCascade
crFieldCascade=FieldCascade
cascadeOpts} ->
          if Bool
noRef then Text
"" else Text
" REFERENCES " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DBName -> Text
escape DBName
table
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldCascade -> Text
onDelete FieldCascade
cascadeOpts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldCascade -> Text
onUpdate FieldCascade
cascadeOpts
    ]
  where
    onDelete :: FieldCascade -> Text
onDelete FieldCascade
opts = Text -> (CascadeAction -> Text) -> Maybe CascadeAction -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
T.append Text
" ON DELETE " (Text -> Text) -> (CascadeAction -> Text) -> CascadeAction -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CascadeAction -> Text
renderCascadeAction) (FieldCascade -> Maybe CascadeAction
fcOnDelete FieldCascade
opts)
    onUpdate :: FieldCascade -> Text
onUpdate FieldCascade
opts = Text -> (CascadeAction -> Text) -> Maybe CascadeAction -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
T.append Text
" ON UPDATE " (Text -> Text) -> (CascadeAction -> Text) -> CascadeAction -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CascadeAction -> Text
renderCascadeAction) (FieldCascade -> Maybe CascadeAction
fcOnUpdate FieldCascade
opts)

sqlForeign :: ForeignDef -> Text
sqlForeign :: ForeignDef -> Text
sqlForeign ForeignDef
fdef = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [ Text
", CONSTRAINT "
    , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ ForeignDef -> DBName
foreignConstraintNameDBName ForeignDef
fdef
    , Text
" FOREIGN KEY("
    , Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (((HaskellName, DBName), (HaskellName, DBName)) -> Text)
-> [((HaskellName, DBName), (HaskellName, DBName))] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DBName -> Text
escape (DBName -> Text)
-> (((HaskellName, DBName), (HaskellName, DBName)) -> DBName)
-> ((HaskellName, DBName), (HaskellName, DBName))
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HaskellName, DBName) -> DBName
forall a b. (a, b) -> b
snd((HaskellName, DBName) -> DBName)
-> (((HaskellName, DBName), (HaskellName, DBName))
    -> (HaskellName, DBName))
-> ((HaskellName, DBName), (HaskellName, DBName))
-> DBName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HaskellName, DBName), (HaskellName, DBName))
-> (HaskellName, DBName)
forall a b. (a, b) -> a
fst) ([((HaskellName, DBName), (HaskellName, DBName))] -> [Text])
-> [((HaskellName, DBName), (HaskellName, DBName))] -> [Text]
forall a b. (a -> b) -> a -> b
$ ForeignDef -> [((HaskellName, DBName), (HaskellName, DBName))]
foreignFields ForeignDef
fdef
    , Text
") REFERENCES "
    , DBName -> Text
escape (DBName -> Text) -> DBName -> Text
forall a b. (a -> b) -> a -> b
$ ForeignDef -> DBName
foreignRefTableDBName ForeignDef
fdef
    , Text
"("
    , Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (((HaskellName, DBName), (HaskellName, DBName)) -> Text)
-> [((HaskellName, DBName), (HaskellName, DBName))] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DBName -> Text
escape (DBName -> Text)
-> (((HaskellName, DBName), (HaskellName, DBName)) -> DBName)
-> ((HaskellName, DBName), (HaskellName, DBName))
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HaskellName, DBName) -> DBName
forall a b. (a, b) -> b
snd ((HaskellName, DBName) -> DBName)
-> (((HaskellName, DBName), (HaskellName, DBName))
    -> (HaskellName, DBName))
-> ((HaskellName, DBName), (HaskellName, DBName))
-> DBName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HaskellName, DBName), (HaskellName, DBName))
-> (HaskellName, DBName)
forall a b. (a, b) -> b
snd) ([((HaskellName, DBName), (HaskellName, DBName))] -> [Text])
-> [((HaskellName, DBName), (HaskellName, DBName))] -> [Text]
forall a b. (a -> b) -> a -> b
$ ForeignDef -> [((HaskellName, DBName), (HaskellName, DBName))]
foreignFields ForeignDef
fdef
    , Text
")"
    ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
onDelete [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
onUpdate
  where
    onDelete :: [Text]
onDelete =
        (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
T.append Text
" ON DELETE ")
        ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Maybe CascadeAction -> [Text]
showAction
        (Maybe CascadeAction -> [Text]) -> Maybe CascadeAction -> [Text]
forall a b. (a -> b) -> a -> b
$ FieldCascade -> Maybe CascadeAction
fcOnDelete
        (FieldCascade -> Maybe CascadeAction)
-> FieldCascade -> Maybe CascadeAction
forall a b. (a -> b) -> a -> b
$ ForeignDef -> FieldCascade
foreignFieldCascade ForeignDef
fdef
    onUpdate :: [Text]
onUpdate =
        (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
T.append Text
" ON UPDATE ")
        ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Maybe CascadeAction -> [Text]
showAction
        (Maybe CascadeAction -> [Text]) -> Maybe CascadeAction -> [Text]
forall a b. (a -> b) -> a -> b
$ FieldCascade -> Maybe CascadeAction
fcOnUpdate
        (FieldCascade -> Maybe CascadeAction)
-> FieldCascade -> Maybe CascadeAction
forall a b. (a -> b) -> a -> b
$ ForeignDef -> FieldCascade
foreignFieldCascade ForeignDef
fdef

    showAction :: Maybe CascadeAction -> [Text]
showAction = Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Maybe Text -> [Text])
-> (Maybe CascadeAction -> Maybe Text)
-> Maybe CascadeAction
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CascadeAction -> Text) -> Maybe CascadeAction -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CascadeAction -> Text
renderCascadeAction

sqlUnique :: UniqueDef -> Text
sqlUnique :: UniqueDef -> Text
sqlUnique (UniqueDef HaskellName
_ DBName
cname [(HaskellName, DBName)]
cols [Text]
_) = [Text] -> Text
T.concat
    [ Text
",CONSTRAINT "
    , DBName -> Text
escape DBName
cname
    , Text
" UNIQUE ("
    , Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((HaskellName, DBName) -> Text)
-> [(HaskellName, DBName)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DBName -> Text
escape (DBName -> Text)
-> ((HaskellName, DBName) -> DBName)
-> (HaskellName, DBName)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HaskellName, DBName) -> DBName
forall a b. (a, b) -> b
snd) [(HaskellName, DBName)]
cols
    , Text
")"
    ]

escape :: DBName -> Text
escape :: DBName -> Text
escape (DBName Text
s) =
    [Text] -> Text
T.concat [Text
q, (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
go Text
s, Text
q]
  where
    q :: Text
q = Char -> Text
T.singleton Char
'"'
    go :: Char -> Text
go Char
'"' = Text
"\"\""
    go Char
c = Char -> Text
T.singleton Char
c

putManySql :: EntityDef -> Int -> Text
putManySql :: EntityDef -> Int -> Text
putManySql EntityDef
ent Int
n = [Text] -> [FieldDef] -> EntityDef -> Int -> Text
putManySql' [Text]
conflictColumns [FieldDef]
fields EntityDef
ent Int
n
  where
    fields :: [FieldDef]
fields = EntityDef -> [FieldDef]
entityFields EntityDef
ent
    conflictColumns :: [Text]
conflictColumns = (UniqueDef -> [Text]) -> [UniqueDef] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((HaskellName, DBName) -> Text)
-> [(HaskellName, DBName)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DBName -> Text
escape (DBName -> Text)
-> ((HaskellName, DBName) -> DBName)
-> (HaskellName, DBName)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HaskellName, DBName) -> DBName
forall a b. (a, b) -> b
snd) ([(HaskellName, DBName)] -> [Text])
-> (UniqueDef -> [(HaskellName, DBName)]) -> UniqueDef -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqueDef -> [(HaskellName, DBName)]
uniqueFields) (EntityDef -> [UniqueDef]
entityUniques EntityDef
ent)

repsertManySql :: EntityDef -> Int -> Text
repsertManySql :: EntityDef -> Int -> Text
repsertManySql EntityDef
ent Int
n = [Text] -> [FieldDef] -> EntityDef -> Int -> Text
putManySql' [Text]
conflictColumns [FieldDef]
fields EntityDef
ent Int
n
  where
    fields :: [FieldDef]
fields = EntityDef -> [FieldDef]
keyAndEntityFields EntityDef
ent
    conflictColumns :: [Text]
conflictColumns = DBName -> Text
escape (DBName -> Text) -> (FieldDef -> DBName) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> DBName
fieldDB (FieldDef -> Text) -> [FieldDef] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EntityDef -> [FieldDef]
entityKeyFields EntityDef
ent

putManySql' :: [Text] -> [FieldDef] -> EntityDef -> Int -> Text
putManySql' :: [Text] -> [FieldDef] -> EntityDef -> Int -> Text
putManySql' [Text]
conflictColumns [FieldDef]
fields EntityDef
ent Int
n = Text
q
  where
    fieldDbToText :: FieldDef -> Text
fieldDbToText = DBName -> Text
escape (DBName -> Text) -> (FieldDef -> DBName) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> DBName
fieldDB
    mkAssignment :: Text -> Text
mkAssignment Text
f = [Text] -> Text
T.concat [Text
f, Text
"=EXCLUDED.", Text
f]

    table :: Text
table = DBName -> Text
escape (DBName -> Text) -> (EntityDef -> DBName) -> EntityDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> DBName
entityDB (EntityDef -> Text) -> EntityDef -> Text
forall a b. (a -> b) -> a -> b
$ EntityDef
ent
    columns :: Text
columns = [Text] -> Text
Util.commaSeparated ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> Text
fieldDbToText [FieldDef]
fields
    placeholders :: [Text]
placeholders = (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FieldDef -> Text
forall a b. a -> b -> a
const Text
"?") [FieldDef]
fields
    updates :: [Text]
updates = (FieldDef -> Text) -> [FieldDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
mkAssignment (Text -> Text) -> (FieldDef -> Text) -> FieldDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> Text
fieldDbToText) [FieldDef]
fields

    q :: Text
q = [Text] -> Text
T.concat
        [ Text
"INSERT INTO "
        , Text
table
        , Text -> Text
Util.parenWrapped Text
columns
        , Text
" VALUES "
        , [Text] -> Text
Util.commaSeparated ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate Int
n
            (Text -> [Text]) -> ([Text] -> Text) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.parenWrapped (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Util.commaSeparated ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
placeholders
        , Text
" ON CONFLICT "
        , Text -> Text
Util.parenWrapped (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Util.commaSeparated ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
conflictColumns
        , Text
" DO UPDATE SET "
        , [Text] -> Text
Util.commaSeparated [Text]
updates
        ]

-- | 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 Value
v = (String -> String) -> Parser SqliteConf -> Parser SqliteConf
forall a. (String -> String) -> Parser a -> Parser a
modifyFailure (String
"Persistent: error loading Sqlite conf: " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (Parser SqliteConf -> Parser SqliteConf)
-> Parser SqliteConf -> Parser SqliteConf
forall a b. (a -> b) -> a -> b
$ ((Object -> Parser SqliteConf) -> Value -> Parser SqliteConf)
-> Value -> (Object -> Parser SqliteConf) -> Parser SqliteConf
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String
-> (Object -> Parser SqliteConf) -> Value -> Parser SqliteConf
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SqliteConf") Value
v Object -> Parser SqliteConf
parser where
        parser :: Object -> Parser SqliteConf
parser Object
o = if Text -> Object -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
"database" Object
o
                      then Text -> Int -> SqliteConf
SqliteConf
                            (Text -> Int -> SqliteConf)
-> Parser Text -> Parser (Int -> SqliteConf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"database"
                            Parser (Int -> SqliteConf) -> Parser Int -> Parser SqliteConf
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"poolsize"
                      else SqliteConnectionInfo -> Int -> SqliteConf
SqliteConfInfo
                            (SqliteConnectionInfo -> Int -> SqliteConf)
-> Parser SqliteConnectionInfo -> Parser (Int -> SqliteConf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser SqliteConnectionInfo
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"connInfo"
                            Parser (Int -> SqliteConf) -> Parser Int -> Parser SqliteConf
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"poolsize"

instance PersistConfig SqliteConf where
    type PersistConfigBackend SqliteConf = SqlPersistT
    type PersistConfigPool SqliteConf = ConnectionPool
    createPoolConfig :: SqliteConf -> IO (PersistConfigPool SqliteConf)
createPoolConfig (SqliteConf Text
cs Int
size) = NoLoggingT IO (Pool SqlBackend) -> IO (Pool SqlBackend)
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT (NoLoggingT IO (Pool SqlBackend) -> IO (Pool SqlBackend))
-> NoLoggingT IO (Pool SqlBackend) -> IO (Pool SqlBackend)
forall a b. (a -> b) -> a -> b
$ SqliteConnectionInfo -> Int -> NoLoggingT IO (Pool SqlBackend)
forall (m :: * -> *).
(MonadLogger m, MonadUnliftIO m) =>
SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo (Text -> SqliteConnectionInfo
conStringToInfo Text
cs) Int
size -- FIXME
    createPoolConfig (SqliteConfInfo SqliteConnectionInfo
info Int
size) = NoLoggingT IO (Pool SqlBackend) -> IO (Pool SqlBackend)
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT (NoLoggingT IO (Pool SqlBackend) -> IO (Pool SqlBackend))
-> NoLoggingT IO (Pool SqlBackend) -> IO (Pool SqlBackend)
forall a b. (a -> b) -> a -> b
$ SqliteConnectionInfo -> Int -> NoLoggingT IO (Pool SqlBackend)
forall (m :: * -> *).
(MonadLogger m, MonadUnliftIO m) =>
SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo SqliteConnectionInfo
info Int
size -- FIXME
    runPool :: SqliteConf
-> PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf
-> m a
runPool SqliteConf
_ = PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf -> m a
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> Pool backend -> m a
runSqlPool
    loadConfig :: Value -> Parser SqliteConf
loadConfig = Value -> Parser SqliteConf
forall a. FromJSON a => Value -> Parser a
parseJSON

finally :: MonadUnliftIO m
        => m a -- ^ 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 m a
a m b
sequel = (UnliftIO m -> IO a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
(UnliftIO m -> IO a) -> m a
withUnliftIO ((UnliftIO m -> IO a) -> m a) -> (UnliftIO m -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \UnliftIO m
u ->
                     IO a -> IO b -> IO a
forall a b. IO a -> IO b -> IO a
E.finally (UnliftIO m -> m a -> IO a
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO m
u m a
a)
                               (UnliftIO m -> m b -> IO b
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO m
u m b
sequel)
{-# INLINABLE finally #-}
-- | Creates a SqliteConnectionInfo from a connection string, with the
-- default settings.
--
-- @since 2.6.2
mkSqliteConnectionInfo :: Text -> SqliteConnectionInfo
mkSqliteConnectionInfo :: Text -> SqliteConnectionInfo
mkSqliteConnectionInfo 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 Text
connStr = Text -> Bool -> Bool -> [Text] -> SqliteConnectionInfo
SqliteConnectionInfo Text
connStr' Bool
enableWal Bool
True [] where
    (Text
connStr', Bool
enableWal) = case () of
        ()
            | Just Text
cs <- Text -> Text -> Maybe Text
T.stripPrefix Text
"WAL=on "  Text
connStr -> (Text
cs, Bool
True)
            | Just Text
cs <- Text -> Text -> Maybe Text
T.stripPrefix Text
"WAL=off " Text
connStr -> (Text
cs, Bool
False)
            | Bool
otherwise                                   -> (Text
connStr, Bool
True)

-- | 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 Value
v = (String -> String)
-> Parser SqliteConnectionInfo -> Parser SqliteConnectionInfo
forall a. (String -> String) -> Parser a -> Parser a
modifyFailure (String
"Persistent: error loading SqliteConnectionInfo: " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (Parser SqliteConnectionInfo -> Parser SqliteConnectionInfo)
-> Parser SqliteConnectionInfo -> Parser SqliteConnectionInfo
forall a b. (a -> b) -> a -> b
$
      ((Object -> Parser SqliteConnectionInfo)
 -> Value -> Parser SqliteConnectionInfo)
-> Value
-> (Object -> Parser SqliteConnectionInfo)
-> Parser SqliteConnectionInfo
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String
-> (Object -> Parser SqliteConnectionInfo)
-> Value
-> Parser SqliteConnectionInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SqliteConnectionInfo") Value
v ((Object -> Parser SqliteConnectionInfo)
 -> Parser SqliteConnectionInfo)
-> (Object -> Parser SqliteConnectionInfo)
-> Parser SqliteConnectionInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Bool -> Bool -> [Text] -> SqliteConnectionInfo
SqliteConnectionInfo
        (Text -> Bool -> Bool -> [Text] -> SqliteConnectionInfo)
-> Parser Text
-> Parser (Bool -> Bool -> [Text] -> SqliteConnectionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"connectionString"
        Parser (Bool -> Bool -> [Text] -> SqliteConnectionInfo)
-> Parser Bool -> Parser (Bool -> [Text] -> SqliteConnectionInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"walEnabled"
        Parser (Bool -> [Text] -> SqliteConnectionInfo)
-> Parser Bool -> Parser ([Text] -> SqliteConnectionInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"fkEnabled"
        Parser ([Text] -> SqliteConnectionInfo)
-> Parser [Text] -> Parser SqliteConnectionInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"extraPragmas" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

-- | Data type for reporting foreign key violations using 'checkForeignKeys'.
--
-- @since 2.11.1
data ForeignKeyViolation = ForeignKeyViolation
    { ForeignKeyViolation -> Text
foreignKeyTable :: Text -- ^ The table of the violated constraint
    , ForeignKeyViolation -> Text
foreignKeyColumn :: Text -- ^ The column of the violated constraint
    , ForeignKeyViolation -> Int64
foreignKeyRowId :: Int64 -- ^ The ROWID of the row with the violated foreign key constraint
    } deriving (ForeignKeyViolation -> ForeignKeyViolation -> Bool
(ForeignKeyViolation -> ForeignKeyViolation -> Bool)
-> (ForeignKeyViolation -> ForeignKeyViolation -> Bool)
-> Eq ForeignKeyViolation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ForeignKeyViolation -> ForeignKeyViolation -> Bool
$c/= :: ForeignKeyViolation -> ForeignKeyViolation -> Bool
== :: ForeignKeyViolation -> ForeignKeyViolation -> Bool
$c== :: ForeignKeyViolation -> ForeignKeyViolation -> Bool
Eq, Eq ForeignKeyViolation
Eq ForeignKeyViolation
-> (ForeignKeyViolation -> ForeignKeyViolation -> Ordering)
-> (ForeignKeyViolation -> ForeignKeyViolation -> Bool)
-> (ForeignKeyViolation -> ForeignKeyViolation -> Bool)
-> (ForeignKeyViolation -> ForeignKeyViolation -> Bool)
-> (ForeignKeyViolation -> ForeignKeyViolation -> Bool)
-> (ForeignKeyViolation
    -> ForeignKeyViolation -> ForeignKeyViolation)
-> (ForeignKeyViolation
    -> ForeignKeyViolation -> ForeignKeyViolation)
-> Ord ForeignKeyViolation
ForeignKeyViolation -> ForeignKeyViolation -> Bool
ForeignKeyViolation -> ForeignKeyViolation -> Ordering
ForeignKeyViolation -> ForeignKeyViolation -> ForeignKeyViolation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ForeignKeyViolation -> ForeignKeyViolation -> ForeignKeyViolation
$cmin :: ForeignKeyViolation -> ForeignKeyViolation -> ForeignKeyViolation
max :: ForeignKeyViolation -> ForeignKeyViolation -> ForeignKeyViolation
$cmax :: ForeignKeyViolation -> ForeignKeyViolation -> ForeignKeyViolation
>= :: ForeignKeyViolation -> ForeignKeyViolation -> Bool
$c>= :: ForeignKeyViolation -> ForeignKeyViolation -> Bool
> :: ForeignKeyViolation -> ForeignKeyViolation -> Bool
$c> :: ForeignKeyViolation -> ForeignKeyViolation -> Bool
<= :: ForeignKeyViolation -> ForeignKeyViolation -> Bool
$c<= :: ForeignKeyViolation -> ForeignKeyViolation -> Bool
< :: ForeignKeyViolation -> ForeignKeyViolation -> Bool
$c< :: ForeignKeyViolation -> ForeignKeyViolation -> Bool
compare :: ForeignKeyViolation -> ForeignKeyViolation -> Ordering
$ccompare :: ForeignKeyViolation -> ForeignKeyViolation -> Ordering
$cp1Ord :: Eq ForeignKeyViolation
Ord, Int -> ForeignKeyViolation -> String -> String
[ForeignKeyViolation] -> String -> String
ForeignKeyViolation -> String
(Int -> ForeignKeyViolation -> String -> String)
-> (ForeignKeyViolation -> String)
-> ([ForeignKeyViolation] -> String -> String)
-> Show ForeignKeyViolation
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ForeignKeyViolation] -> String -> String
$cshowList :: [ForeignKeyViolation] -> String -> String
show :: ForeignKeyViolation -> String
$cshow :: ForeignKeyViolation -> String
showsPrec :: Int -> ForeignKeyViolation -> String -> String
$cshowsPrec :: Int -> ForeignKeyViolation -> String -> String
Show)

-- | Outputs all (if any) the violated foreign key constraints in the database.
--
-- The main use is to validate that no foreign key constraints were
-- broken/corrupted by anyone operating on the database with foreign keys
-- disabled. See 'fkEnabled'.
--
-- @since 2.11.1
checkForeignKeys
    :: (MonadResource m, MonadReader env m, BackendCompatible SqlBackend env)
    => ConduitM () ForeignKeyViolation m ()
checkForeignKeys :: ConduitM () ForeignKeyViolation m ()
checkForeignKeys = Text -> [PersistValue] -> ConduitM () [PersistValue] m ()
forall (m :: * -> *) env.
(MonadResource m, MonadReader env m,
 BackendCompatible SqlBackend env) =>
Text -> [PersistValue] -> ConduitM () [PersistValue] m ()
rawQuery Text
query [] ConduitM () [PersistValue] m ()
-> ConduitM [PersistValue] ForeignKeyViolation m ()
-> ConduitM () ForeignKeyViolation m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ([PersistValue] -> m ForeignKeyViolation)
-> ConduitM [PersistValue] ForeignKeyViolation m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
C.mapM [PersistValue] -> m ForeignKeyViolation
forall (m :: * -> *).
MonadIO m =>
[PersistValue] -> m ForeignKeyViolation
parse
  where
    parse :: [PersistValue] -> m ForeignKeyViolation
parse [PersistValue]
l = case [PersistValue]
l of
        [ PersistInt64 Int64
rowid , PersistText Text
table , PersistText Text
column ] ->
            ForeignKeyViolation -> m ForeignKeyViolation
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignKeyViolation :: Text -> Text -> Int64 -> ForeignKeyViolation
ForeignKeyViolation
                { foreignKeyTable :: Text
foreignKeyTable = Text
table
                , foreignKeyColumn :: Text
foreignKeyColumn = Text
column
                , foreignKeyRowId :: Int64
foreignKeyRowId = Int64
rowid
                }
        [PersistValue]
_ -> IO ForeignKeyViolation -> m ForeignKeyViolation
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ForeignKeyViolation -> m ForeignKeyViolation)
-> (Text -> IO ForeignKeyViolation)
-> Text
-> m ForeignKeyViolation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PersistException -> IO ForeignKeyViolation
forall e a. Exception e => e -> IO a
E.throwIO (PersistException -> IO ForeignKeyViolation)
-> (Text -> PersistException) -> Text -> IO ForeignKeyViolation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PersistException
PersistMarshalError (Text -> m ForeignKeyViolation) -> Text -> m ForeignKeyViolation
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"Unexpected result from foreign key check:\n", String -> Text
T.pack ([PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
l) ]

    query :: Text
query = Text
"\
\ SELECT origin.rowid, origin.\"table\", group_concat(foreignkeys.\"from\")\n\
\ FROM pragma_foreign_key_check() AS origin\n\
\ INNER JOIN pragma_foreign_key_list(origin.\"table\") AS foreignkeys\n\
\ ON origin.fkid = foreignkeys.id AND origin.parent = foreignkeys.\"table\"\n\
\ GROUP BY origin.rowid"

-- | 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 SqliteConnectionInfo
connInfo RawSqlite SqlBackend -> m a
f = do
    LogFunc
logFunc <- m LogFunc
forall (m :: * -> *). (MonadUnliftIO m, MonadLogger m) => m LogFunc
askLogFunc
    ((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> IO (RawSqlite SqlBackend)
-> (RawSqlite SqlBackend -> IO ())
-> (RawSqlite SqlBackend -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (LogFunc -> IO (RawSqlite SqlBackend)
openBackend LogFunc
logFunc) RawSqlite SqlBackend -> IO ()
closeBackend ((RawSqlite SqlBackend -> IO a) -> IO a)
-> (RawSqlite SqlBackend -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ m a -> IO a
forall a. m a -> IO a
run (m a -> IO a)
-> (RawSqlite SqlBackend -> m a) -> RawSqlite SqlBackend -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSqlite SqlBackend -> m a
f
  where
    openBackend :: LogFunc -> IO (RawSqlite SqlBackend)
openBackend = (SqlBackend -> Connection -> RawSqlite SqlBackend)
-> SqliteConnectionInfo -> LogFunc -> IO (RawSqlite SqlBackend)
forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> RawSqlite SqlBackend
forall backend. backend -> Connection -> RawSqlite backend
RawSqlite SqliteConnectionInfo
connInfo
    closeBackend :: RawSqlite SqlBackend -> IO ()
closeBackend = SqlBackend -> IO ()
forall backend.
BackendCompatible SqlBackend backend =>
backend -> IO ()
close' (SqlBackend -> IO ())
-> (RawSqlite SqlBackend -> SqlBackend)
-> RawSqlite SqlBackend
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSqlite SqlBackend -> SqlBackend
forall backend. RawSqlite backend -> backend
_persistentBackend

-- | 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 SqliteConnectionInfo
connInfo RawSqlite SqlBackend -> m ()
f Int
n = do
    m () -> IO ()
runIO <- m (m () -> IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
    let createRawSqlite :: LogFunc -> IO (RawSqlite SqlBackend)
createRawSqlite LogFunc
logFun = do
            RawSqlite SqlBackend
result <- (SqlBackend -> Connection -> RawSqlite SqlBackend)
-> SqliteConnectionInfo -> LogFunc -> IO (RawSqlite SqlBackend)
forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> RawSqlite SqlBackend
forall backend. backend -> Connection -> RawSqlite backend
RawSqlite SqliteConnectionInfo
connInfo LogFunc
logFun
            RawSqlite SqlBackend
result RawSqlite SqlBackend -> IO () -> IO (RawSqlite SqlBackend)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m () -> IO ()
runIO (RawSqlite SqlBackend -> m ()
f RawSqlite SqlBackend
result)

    (LogFunc -> IO (RawSqlite SqlBackend))
-> Int -> m (Pool (RawSqlite SqlBackend))
forall backend (m :: * -> *).
(MonadLogger m, MonadUnliftIO m,
 BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> Int -> m (Pool backend)
createSqlPool LogFunc -> IO (RawSqlite SqlBackend)
createRawSqlite Int
n

-- | 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_ 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 SqliteConnectionInfo
connInfo RawSqlite SqlBackend -> m ()
f Int
n Pool (RawSqlite SqlBackend) -> m a
work = do
    m () -> IO ()
runIO <- m (m () -> IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
    let createRawSqlite :: LogFunc -> IO (RawSqlite SqlBackend)
createRawSqlite LogFunc
logFun = do
            RawSqlite SqlBackend
result <- (SqlBackend -> Connection -> RawSqlite SqlBackend)
-> SqliteConnectionInfo -> LogFunc -> IO (RawSqlite SqlBackend)
forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> RawSqlite SqlBackend
forall backend. backend -> Connection -> RawSqlite backend
RawSqlite SqliteConnectionInfo
connInfo LogFunc
logFun
            RawSqlite SqlBackend
result RawSqlite SqlBackend -> IO () -> IO (RawSqlite SqlBackend)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m () -> IO ()
runIO (RawSqlite SqlBackend -> m ()
f RawSqlite SqlBackend
result)

    (LogFunc -> IO (RawSqlite SqlBackend))
-> Int -> (Pool (RawSqlite SqlBackend) -> m a) -> m a
forall backend (m :: * -> *) a.
(MonadLogger m, MonadUnliftIO m,
 BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> Int -> (Pool backend -> m a) -> m a
withSqlPool LogFunc -> IO (RawSqlite SqlBackend)
createRawSqlite Int
n Pool (RawSqlite SqlBackend) -> m a
work

-- | 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_ 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 record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get
    getMany :: [Key record] -> ReaderT (RawSqlite b) m (Map (Key record) record)
getMany = (RawSqlite b -> b)
-> ReaderT b m (Map (Key record) record)
-> ReaderT (RawSqlite b) m (Map (Key record) record)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Map (Key record) record)
 -> ReaderT (RawSqlite b) m (Map (Key record) record))
-> ([Key record] -> ReaderT b m (Map (Key record) record))
-> [Key record]
-> ReaderT (RawSqlite b) m (Map (Key record) record)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Key record] -> ReaderT b m (Map (Key record) record)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Key record] -> ReaderT backend m (Map (Key record) record)
getMany

instance (PersistQueryRead b) => PersistQueryRead (RawSqlite b) where
    selectSourceRes :: [Filter record]
-> [SelectOpt record]
-> ReaderT
     (RawSqlite b) m1 (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes [Filter record]
filts [SelectOpt record]
opts = (RawSqlite b -> b)
-> ReaderT b m1 (Acquire (ConduitM () (Entity record) m2 ()))
-> ReaderT
     (RawSqlite b) m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m1 (Acquire (ConduitM () (Entity record) m2 ()))
 -> ReaderT
      (RawSqlite b) m1 (Acquire (ConduitM () (Entity record) m2 ())))
-> ReaderT b m1 (Acquire (ConduitM () (Entity record) m2 ()))
-> ReaderT
     (RawSqlite b) m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall a b. (a -> b) -> a -> b
$ [Filter record]
-> [SelectOpt record]
-> ReaderT b m1 (Acquire (ConduitM () (Entity record) m2 ()))
forall backend record (m1 :: * -> *) (m2 :: * -> *).
(PersistQueryRead backend, PersistRecordBackend record backend,
 MonadIO m1, MonadIO m2) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT backend m1 (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes [Filter record]
filts [SelectOpt record]
opts
    selectFirst :: [Filter record]
-> [SelectOpt record]
-> ReaderT (RawSqlite b) m (Maybe (Entity record))
selectFirst [Filter record]
filts [SelectOpt record]
opts = (RawSqlite b -> b)
-> ReaderT b m (Maybe (Entity record))
-> ReaderT (RawSqlite b) m (Maybe (Entity record))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Maybe (Entity record))
 -> ReaderT (RawSqlite b) m (Maybe (Entity record)))
-> ReaderT b m (Maybe (Entity record))
-> ReaderT (RawSqlite b) m (Maybe (Entity record))
forall a b. (a -> b) -> a -> b
$ [Filter record]
-> [SelectOpt record] -> ReaderT b m (Maybe (Entity record))
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst [Filter record]
filts [SelectOpt record]
opts
    selectKeysRes :: [Filter record]
-> [SelectOpt record]
-> ReaderT
     (RawSqlite b) m1 (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
filts [SelectOpt record]
opts = (RawSqlite b -> b)
-> ReaderT b m1 (Acquire (ConduitM () (Key record) m2 ()))
-> ReaderT
     (RawSqlite b) m1 (Acquire (ConduitM () (Key record) m2 ()))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m1 (Acquire (ConduitM () (Key record) m2 ()))
 -> ReaderT
      (RawSqlite b) m1 (Acquire (ConduitM () (Key record) m2 ())))
-> ReaderT b m1 (Acquire (ConduitM () (Key record) m2 ()))
-> ReaderT
     (RawSqlite b) m1 (Acquire (ConduitM () (Key record) m2 ()))
forall a b. (a -> b) -> a -> b
$ [Filter record]
-> [SelectOpt record]
-> ReaderT b m1 (Acquire (ConduitM () (Key record) m2 ()))
forall backend (m1 :: * -> *) (m2 :: * -> *) record.
(PersistQueryRead backend, MonadIO m1, MonadIO m2,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT backend m1 (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
filts [SelectOpt record]
opts
    count :: [Filter record] -> ReaderT (RawSqlite b) m Int
count = (RawSqlite b -> b)
-> ReaderT b m Int -> ReaderT (RawSqlite b) m Int
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m Int -> ReaderT (RawSqlite b) m Int)
-> ([Filter record] -> ReaderT b m Int)
-> [Filter record]
-> ReaderT (RawSqlite b) m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Filter record] -> ReaderT b m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count
    exists :: [Filter record] -> ReaderT (RawSqlite b) m Bool
exists = (RawSqlite b -> b)
-> ReaderT b m Bool -> ReaderT (RawSqlite b) m Bool
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m Bool -> ReaderT (RawSqlite b) m Bool)
-> ([Filter record] -> ReaderT b m Bool)
-> [Filter record]
-> ReaderT (RawSqlite b) m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Filter record] -> ReaderT b m Bool
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Bool
exists

instance (PersistQueryWrite b) => PersistQueryWrite (RawSqlite b) where
    updateWhere :: [Filter record] -> [Update record] -> ReaderT (RawSqlite b) m ()
updateWhere [Filter record]
filts [Update record]
updates = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall a b. (a -> b) -> a -> b
$ [Filter record] -> [Update record] -> ReaderT b m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> [Update record] -> ReaderT backend m ()
updateWhere [Filter record]
filts [Update record]
updates
    deleteWhere :: [Filter record] -> ReaderT (RawSqlite b) m ()
deleteWhere = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> ([Filter record] -> ReaderT b m ())
-> [Filter record]
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Filter record] -> ReaderT b m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere

instance (PersistUniqueRead b) => PersistUniqueRead (RawSqlite b) where
    getBy :: Unique record -> ReaderT (RawSqlite b) m (Maybe (Entity record))
getBy = (RawSqlite b -> b)
-> ReaderT b m (Maybe (Entity record))
-> ReaderT (RawSqlite b) m (Maybe (Entity record))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Maybe (Entity record))
 -> ReaderT (RawSqlite b) m (Maybe (Entity record)))
-> (Unique record -> ReaderT b m (Maybe (Entity record)))
-> Unique record
-> ReaderT (RawSqlite b) m (Maybe (Entity record))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique record -> ReaderT b m (Maybe (Entity record))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy

instance (PersistStoreWrite b) => PersistStoreWrite (RawSqlite b) where
    insert :: record -> ReaderT (RawSqlite b) m (Key record)
insert = (RawSqlite b -> b)
-> ReaderT b m (Key record) -> ReaderT (RawSqlite b) m (Key record)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Key record) -> ReaderT (RawSqlite b) m (Key record))
-> (record -> ReaderT b m (Key record))
-> record
-> ReaderT (RawSqlite b) m (Key record)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> ReaderT b m (Key record)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert
    insert_ :: record -> ReaderT (RawSqlite b) m ()
insert_ = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> (record -> ReaderT b m ())
-> record
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_
    insertMany :: [record] -> ReaderT (RawSqlite b) m [Key record]
insertMany = (RawSqlite b -> b)
-> ReaderT b m [Key record] -> ReaderT (RawSqlite b) m [Key record]
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m [Key record] -> ReaderT (RawSqlite b) m [Key record])
-> ([record] -> ReaderT b m [Key record])
-> [record]
-> ReaderT (RawSqlite b) m [Key record]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [record] -> ReaderT b m [Key record]
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m [Key record]
insertMany
    insertMany_ :: [record] -> ReaderT (RawSqlite b) m ()
insertMany_ = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> ([record] -> ReaderT b m ())
-> [record]
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [record] -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_
    insertEntityMany :: [Entity record] -> ReaderT (RawSqlite b) m ()
insertEntityMany = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> ([Entity record] -> ReaderT b m ())
-> [Entity record]
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entity record] -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Entity record] -> ReaderT backend m ()
insertEntityMany
    insertKey :: Key record -> record -> ReaderT (RawSqlite b) m ()
insertKey Key record
k = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> (record -> ReaderT b m ())
-> record
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> record -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
insertKey Key record
k
    repsert :: Key record -> record -> ReaderT (RawSqlite b) m ()
repsert Key record
k = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> (record -> ReaderT b m ())
-> record
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> record -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
repsert Key record
k
    repsertMany :: [(Key record, record)] -> ReaderT (RawSqlite b) m ()
repsertMany = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> ([(Key record, record)] -> ReaderT b m ())
-> [(Key record, record)]
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key record, record)] -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[(Key record, record)] -> ReaderT backend m ()
repsertMany
    replace :: Key record -> record -> ReaderT (RawSqlite b) m ()
replace Key record
k = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> (record -> ReaderT b m ())
-> record
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> record -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
replace Key record
k
    delete :: Key record -> ReaderT (RawSqlite b) m ()
delete = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> (Key record -> ReaderT b m ())
-> Key record
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete
    update :: Key record -> [Update record] -> ReaderT (RawSqlite b) m ()
update Key record
k = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> ([Update record] -> ReaderT b m ())
-> [Update record]
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> [Update record] -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update Key record
k
    updateGet :: Key record -> [Update record] -> ReaderT (RawSqlite b) m record
updateGet Key record
k = (RawSqlite b -> b)
-> ReaderT b m record -> ReaderT (RawSqlite b) m record
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m record -> ReaderT (RawSqlite b) m record)
-> ([Update record] -> ReaderT b m record)
-> [Update record]
-> ReaderT (RawSqlite b) m record
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> [Update record] -> ReaderT b m record
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m record
updateGet Key record
k

instance (PersistUniqueWrite b) => PersistUniqueWrite (RawSqlite b) where
    deleteBy :: Unique record -> ReaderT (RawSqlite b) m ()
deleteBy = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> (Unique record -> ReaderT b m ())
-> Unique record
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique record -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m ()
deleteBy
    insertUnique :: record -> ReaderT (RawSqlite b) m (Maybe (Key record))
insertUnique = (RawSqlite b -> b)
-> ReaderT b m (Maybe (Key record))
-> ReaderT (RawSqlite b) m (Maybe (Key record))
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Maybe (Key record))
 -> ReaderT (RawSqlite b) m (Maybe (Key record)))
-> (record -> ReaderT b m (Maybe (Key record)))
-> record
-> ReaderT (RawSqlite b) m (Maybe (Key record))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> ReaderT b m (Maybe (Key record))
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Maybe (Key record))
insertUnique
    upsert :: record
-> [Update record] -> ReaderT (RawSqlite b) m (Entity record)
upsert record
rec = (RawSqlite b -> b)
-> ReaderT b m (Entity record)
-> ReaderT (RawSqlite b) m (Entity record)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Entity record)
 -> ReaderT (RawSqlite b) m (Entity record))
-> ([Update record] -> ReaderT b m (Entity record))
-> [Update record]
-> ReaderT (RawSqlite b) m (Entity record)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record -> [Update record] -> ReaderT b m (Entity record)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
upsert record
rec
    upsertBy :: Unique record
-> record
-> [Update record]
-> ReaderT (RawSqlite b) m (Entity record)
upsertBy Unique record
uniq record
rec = (RawSqlite b -> b)
-> ReaderT b m (Entity record)
-> ReaderT (RawSqlite b) m (Entity record)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m (Entity record)
 -> ReaderT (RawSqlite b) m (Entity record))
-> ([Update record] -> ReaderT b m (Entity record))
-> [Update record]
-> ReaderT (RawSqlite b) m (Entity record)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique record
-> record -> [Update record] -> ReaderT b m (Entity record)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
upsertBy Unique record
uniq record
rec
    putMany :: [record] -> ReaderT (RawSqlite b) m ()
putMany = (RawSqlite b -> b) -> ReaderT b m () -> ReaderT (RawSqlite b) m ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT RawSqlite b -> b
forall backend. RawSqlite backend -> backend
_persistentBackend (ReaderT b m () -> ReaderT (RawSqlite b) m ())
-> ([record] -> ReaderT b m ())
-> [record]
-> ReaderT (RawSqlite b) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [record] -> ReaderT b m ()
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
putMany

makeLenses ''RawSqlite
makeLenses ''SqliteConnectionInfo