{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}

-- Strictly, this could go as low as GHC 8.6.1, which is when DerivingVia was
-- introduced - this base version requires 8.6.5+
#if MIN_VERSION_base(4,12,0)
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE UndecidableInstances #-}
#endif

-- | 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
       , unliftIO
       , withRunInIO
       , withUnliftIO
       )
import Control.Monad.Logger
       ( MonadLoggerIO
       , NoLoggingT
       , askLoggerIO
       , logWarn
       , runLoggingT
       , runNoLoggingT
       )
import Control.Monad.Reader (MonadReader)
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import Control.Monad.Trans.Resource (MonadResource)
#if !MIN_VERSION_base(4,12,0)
import Control.Monad.Trans.Reader (withReaderT)
#endif
import Control.Monad.Trans.Writer (runWriterT)
import Data.Acquire (Acquire, mkAcquire, with)
import Data.Aeson
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KeyMap
#endif
import Data.Aeson.Types (modifyFailure)
import Data.Conduit
import qualified Data.Conduit.Combinators as C
import qualified Data.Conduit.List as CL
import Data.Foldable (toList)
import qualified Data.HashMap.Lazy as HashMap
import Data.Int (Int64)
import Data.IORef (newIORef)
import Data.Maybe
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)

#if MIN_VERSION_base(4,12,0)
import Database.Persist.Compatible
#endif
import Database.Persist.Sql
import qualified Database.Persist.Sql.Util as Util
import Database.Persist.SqlBackend
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 :: (MonadLoggerIO m, MonadUnliftIO m)
                 => Text -> Int -> m (Pool SqlBackend)
createSqlitePool :: forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
Text -> Int -> m (Pool SqlBackend)
createSqlitePool = forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo 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 :: (MonadLoggerIO m, MonadUnliftIO m)
                         => SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo :: forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo SqliteConnectionInfo
connInfo = forall backend (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m,
 BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> Int -> m (Pool backend)
createSqlPool forall a b. (a -> b) -> a -> b
$ forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith 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, MonadLoggerIO m)
               => Text
               -> Int -- ^ number of connections to open
               -> (Pool SqlBackend -> m a) -> m a
withSqlitePool :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m) =>
Text -> Int -> (Pool SqlBackend -> m a) -> m a
withSqlitePool Text
connInfo = forall backend (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m,
 BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> Int -> (Pool backend -> m a) -> m a
withSqlPool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith forall a b. a -> b -> a
const 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, MonadLoggerIO m)
                   => SqliteConnectionInfo
                   -> Int -- ^ number of connections to open
                   -> (Pool SqlBackend -> m a) -> m a
withSqlitePoolInfo :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m) =>
SqliteConnectionInfo -> Int -> (Pool SqlBackend -> m a) -> m a
withSqlitePoolInfo SqliteConnectionInfo
connInfo = forall backend (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m,
 BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> Int -> (Pool backend -> m a) -> m a
withSqlPool forall a b. (a -> b) -> a -> b
$ forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith forall a b. a -> b -> a
const SqliteConnectionInfo
connInfo

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

-- | @since 2.6.2
withSqliteConnInfo :: (MonadUnliftIO m, MonadLoggerIO m)
                   => SqliteConnectionInfo -> (SqlBackend -> m a) -> m a
withSqliteConnInfo :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m) =>
SqliteConnectionInfo -> (SqlBackend -> m a) -> m a
withSqliteConnInfo = forall backend (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m,
 BackendCompatible SqlBackend backend) =>
(LogFunc -> IO backend) -> (backend -> m a) -> m a
withSqlConn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith forall a b. a -> b -> a
const

openWith :: (SqlBackend -> Sqlite.Connection -> r)
         -> SqliteConnectionInfo
         -> LogFunc
         -> IO r
openWith :: forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith SqlBackend -> Connection -> r
f SqliteConnectionInfo
connInfo LogFunc
logFunc = do
    Connection
conn <- Text -> IO Connection
Sqlite.open 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 forall a b. IO a -> IO b -> IO a
`E.onException` Connection -> IO ()
Sqlite.close Connection
conn
    forall (m :: * -> *) a. Monad m => a -> m a
return 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, MonadLoggerIO m) => m a -> m a
retryOnBusy :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m) =>
m a -> m a
retryOnBusy m a
action =
  [Int] -> m a
start forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
20 forall a b. (a -> b) -> a -> b
$ forall {t}. (Ord t, Num t) => t -> [t]
delays Int
1000
  where
    delays :: t -> [t]
delays t
x
      | t
x forall a. Ord a => a -> a -> Bool
>= t
1000000 = forall a. a -> [a]
repeat t
x
      | Bool
otherwise = t
x forall a. a -> [a] -> [a]
: t -> [t]
delays (t
x 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 -> 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 (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ 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 -> 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..."
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
x
          [Int] -> m a
start [Int]
xs
        Left SqliteException
e -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
E.throwIO SqliteException
e
        Right a
y -> 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, MonadLoggerIO m, BackendCompatible SqlBackend backend)
    => ReaderT backend m ()
waitForDatabase :: forall (m :: * -> *) backend.
(MonadUnliftIO m, MonadLoggerIO m,
 BackendCompatible SqlBackend backend) =>
ReaderT backend m ()
waitForDatabase = forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m) =>
m a -> m a
retryOnBusy forall a b. (a -> b) -> a -> b
$ 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)forall a. a -> [a] -> [a]
:)
          | Bool
otherwise = 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)forall a. a -> [a] -> [a]
:)
          | Bool
otherwise = 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 forall a b. (a -> b) -> a -> b
$ [(Text, Bool)] -> [(Text, Bool)]
fkPragma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (, Bool
False) forall a b. (a -> b) -> a -> b
$ SqliteConnectionInfo -> [Text]
_extraPragmas SqliteConnectionInfo
connInfo

    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Text, Bool)]
pragmas forall a b. (a -> b) -> a -> b
$ \(Text
pragma, Bool
shouldRetry) -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. LoggingT m a -> LogFunc -> m a
runLoggingT LogFunc
logFunc forall a b. (a -> b) -> a -> b
$
        (if Bool
shouldRetry then forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m) =>
m a -> m a
retryOnBusy else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 <- forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        Int -> SqlBackend -> SqlBackend
setConnMaxParams Int
999 forall a b. (a -> b) -> a -> b
$
        (EntityDef -> Int -> Text) -> SqlBackend -> SqlBackend
setConnPutManySql EntityDef -> Int -> Text
putManySql forall a b. (a -> b) -> a -> b
$
        (EntityDef -> Int -> Text) -> SqlBackend -> SqlBackend
setConnRepsertManySql EntityDef -> Int -> Text
repsertManySql forall a b. (a -> b) -> a -> b
$
        MkSqlBackendArgs -> SqlBackend
mkSqlBackend MkSqlBackendArgs
            { 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'
            , 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
_ -> forall {t}. t -> (t -> IO Statement) -> IO ()
helper Text
"BEGIN" Text -> IO Statement
f
            , connCommit :: (Text -> IO Statement) -> IO ()
connCommit = forall {t}. t -> (t -> IO Statement) -> IO ()
helper Text
"COMMIT"
            , connRollback :: (Text -> IO Statement) -> IO ()
connRollback = IO () -> IO ()
ignoreExceptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t}. t -> (t -> IO Statement) -> IO ()
helper Text
"ROLLBACK"
            , connEscapeFieldName :: FieldNameDB -> Text
connEscapeFieldName = Text -> Text
escape forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNameDB -> Text
unFieldNameDB
            , connEscapeTableName :: EntityDef -> Text
connEscapeTableName = Text -> Text
escape forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityNameDB -> Text
unEntityNameDB forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> EntityNameDB
getEntityDBName
            , connEscapeRawName :: Text -> Text
connEscapeRawName = Text -> Text
escape
            , connNoLimit :: Text
connNoLimit = Text
"LIMIT -1"
            , connRDBMS :: Text
connRDBMS = Text
"sqlite"
            , connLimitOffset :: CharPos -> Text -> Text
connLimitOffset = Text -> CharPos -> Text -> Text
decorateSQLWithLimitOffset Text
"LIMIT -1"
            , connLogFunc :: LogFunc
connLogFunc = LogFunc
logFunc
            }
  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 = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (\(SomeException
_ :: E.SomeException) -> 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 :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqlite Text
connstr = forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m) =>
Text -> (SqlBackend -> m a) -> m a
withSqliteConn Text
connstr
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a.
MonadUnliftIO m =>
SqliteConnectionInfo
-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runSqliteInfo SqliteConnectionInfo
conInfo = forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m) =>
SqliteConnectionInfo -> (SqlBackend -> m a) -> m a
withSqliteConnInfo SqliteConnectionInfo
conInfo
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall (m :: * -> *) a. Monad m => a -> m a
return 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 = 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 -> EntityIdDef
getEntityId EntityDef
ent of
        EntityIdNaturalKey CompositeDef
_ ->
          Text -> [PersistValue] -> InsertSqlResult
ISRManyKeys Text
sql [PersistValue]
vals
            where sql :: Text
sql = [Text] -> Text
T.concat
                    [ Text
"INSERT INTO "
                    , EntityNameDB -> Text
escapeE forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
ent
                    , Text
"("
                    , Text -> [Text] -> Text
T.intercalate Text
"," forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FieldNameDB -> Text
escapeF forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> FieldNameDB
fieldDB) [FieldDef]
cols
                    , Text
") VALUES("
                    , Text -> [Text] -> Text
T.intercalate Text
"," (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const Text
"?") [FieldDef]
cols)
                    , Text
")"
                    ]
        EntityIdField FieldDef
fd ->
          Text -> Text -> InsertSqlResult
ISRInsertGet Text
ins Text
sel
            where
              sel :: Text
sel = [Text] -> Text
T.concat
                  [ Text
"SELECT "
                  , FieldNameDB -> Text
escapeF forall a b. (a -> b) -> a -> b
$ FieldDef -> FieldNameDB
fieldDB FieldDef
fd
                  , Text
" FROM "
                  , EntityNameDB -> Text
escapeE forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
ent
                  , Text
" WHERE _ROWID_=last_insert_rowid()"
                  ]
              ins :: Text
ins = [Text] -> Text
T.concat
                  [ Text
"INSERT INTO "
                  , EntityNameDB -> Text
escapeE forall a b. (a -> b) -> a -> b
$ EntityDef -> EntityNameDB
getEntityDBName EntityDef
ent
                  , if 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
"," forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FieldNameDB -> Text
escapeF forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> FieldNameDB
fieldDB) forall a b. (a -> b) -> a -> b
$ [FieldDef]
cols
                          , Text
") VALUES("
                          , Text -> [Text] -> Text
T.intercalate Text
"," (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const Text
"?") [FieldDef]
cols)
                          , Text
")"
                          ]
                  ]
  where
    notGenerated :: FieldDef -> Bool
notGenerated =
        forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> Maybe Text
fieldGenerated
    cols :: [FieldDef]
cols =
        forall a. (a -> Bool) -> [a] -> [a]
filter FieldDef -> Bool
notGenerated forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
getEntityFields EntityDef
ent

execute' :: Sqlite.Connection -> Sqlite.Statement -> [PersistValue] -> IO Int64
execute' :: Connection -> Statement -> [PersistValue] -> IO Int64
execute' Connection
conn Statement
stmt [PersistValue]
vals = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
finally (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Connection -> Statement -> IO ()
Sqlite.reset Connection
conn Statement
stmt) 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' :: forall (m :: * -> *).
MonadIO m =>
Connection
-> Statement
-> [PersistValue]
-> Acquire (ConduitM () [PersistValue] m ())
withStmt' Connection
conn Statement
stmt [PersistValue]
vals = do
    Statement
_ <- forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire
        (Statement -> [PersistValue] -> IO ()
Sqlite.bind Statement
stmt [PersistValue]
vals forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Statement
stmt)
        (Connection -> Statement -> IO ()
Sqlite.reset Connection
conn)
    forall (m :: * -> *) a. Monad m => a -> m a
return ConduitM () [PersistValue] m ()
pull
  where
    pull :: ConduitM () [PersistValue] m ()
pull = do
        StepResult
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Connection -> Statement -> IO StepResult
Sqlite.stepConn Connection
conn Statement
stmt
        case StepResult
x of
            StepResult
Sqlite.Done -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            StepResult
Sqlite.Row -> do
                [PersistValue]
cols <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Statement -> IO [PersistValue]
Sqlite.columns Statement
stmt
                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 (forall a. Show a => a -> String
show Word32
precision), Text
",", String -> Text
T.pack (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] CautiousMigration)
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 (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> FieldNameDB -> Bool
safeToRemove EntityDef
val forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> FieldNameDB
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' <- forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
with (Statement
-> forall (m :: * -> *).
   MonadIO m =>
   [PersistValue] -> Acquire (ConduitM () [PersistValue] m ())
stmtQuery Statement
stmt [Text -> PersistValue
PersistText forall a b. (a -> b) -> a -> b
$ EntityNameDB -> Text
unEntityNameDB EntityNameDB
table])
      (\ConduitM () [PersistValue] IO ()
src -> forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ ConduitM () [PersistValue] IO ()
src forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall {o}. ConduitT [PersistValue] o IO (Maybe Text)
go)
    case Maybe Text
oldSql' of
        Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right [(Bool
False, Text
newSql)]
        Just Text
oldSql -> do
            if Text
oldSql forall a. Eq a => a -> a -> Bool
== Text
newSql
                then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right [(Bool, Text)]
sql
  where
    def :: EntityDef
def = EntityDef
val
    table :: EntityNameDB
table = EntityDef -> EntityNameDB
getEntityDBName EntityDef
def
    go :: ConduitT [PersistValue] o IO (Maybe Text)
go = do
        Maybe [PersistValue]
x <- forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
CL.head
        case Maybe [PersistValue]
x of
            Maybe [PersistValue]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            Just [PersistText Text
y] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
y
            Just [PersistValue]
y -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unexpected result from sqlite_master: " forall a. [a] -> [a] -> [a]
++ 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 <- forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty
    let sqlbackend :: SqlBackend
sqlbackend =
            Int -> SqlBackend -> SqlBackend
setConnMaxParams Int
999 forall a b. (a -> b) -> a -> b
$
            MkSqlBackendArgs -> SqlBackend
mkSqlBackend MkSqlBackendArgs
                { connPrepare :: Text -> IO Statement
connPrepare = \Text
_ -> do
                    forall (m :: * -> *) a. Monad m => a -> m a
return Statement
                        { stmtFinalize :: IO ()
stmtFinalize = forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        , stmtReset :: IO ()
stmtReset = forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        , stmtExecute :: [PersistValue] -> IO Int64
stmtExecute = forall a. HasCallStack => a
undefined
                        , stmtQuery :: forall (m :: * -> *).
MonadIO m =>
[PersistValue] -> Acquire (ConduitM () [PersistValue] m ())
stmtQuery = \[PersistValue]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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'
                , connClose :: IO ()
connClose = 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
_ -> forall {t}. t -> (t -> IO Statement) -> IO ()
helper Text
"BEGIN" Text -> IO Statement
f
                , connCommit :: (Text -> IO Statement) -> IO ()
connCommit = forall {t}. t -> (t -> IO Statement) -> IO ()
helper Text
"COMMIT"
                , connRollback :: (Text -> IO Statement) -> IO ()
connRollback = IO () -> IO ()
ignoreExceptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t}. t -> (t -> IO Statement) -> IO ()
helper Text
"ROLLBACK"
                , connEscapeFieldName :: FieldNameDB -> Text
connEscapeFieldName = Text -> Text
escape forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNameDB -> Text
unFieldNameDB
                , connEscapeTableName :: EntityDef -> Text
connEscapeTableName = Text -> Text
escape forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityNameDB -> Text
unEntityNameDB forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> EntityNameDB
getEntityDBName
                , connEscapeRawName :: Text -> Text
connEscapeRawName = Text -> Text
escape
                , connNoLimit :: Text
connNoLimit = Text
"LIMIT -1"
                , connRDBMS :: Text
connRDBMS = Text
"sqlite"
                , connLimitOffset :: CharPos -> Text -> Text
connLimitOffset = Text -> CharPos -> Text -> Text
decorateSQLWithLimitOffset Text
"LIMIT -1"
                , connLogFunc :: LogFunc
connLogFunc = forall a. HasCallStack => a
undefined
                }
        result :: SqlBackend -> IO (((), [Text]), [(Bool, Text)])
result = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall a b. (a -> b) -> a -> b
$ Migration
mig
    (((), [Text]), [(Bool, Text)])
resp <- SqlBackend -> IO (((), [Text]), [(Bool, Text)])
result SqlBackend
sqlbackend
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> IO ()
TIO.putStrLn forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ 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 =
        forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (\(SomeException
_ :: E.SomeException) -> 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 -> FieldNameDB -> Bool
safeToRemove :: EntityDef -> FieldNameDB -> Bool
safeToRemove EntityDef
def (FieldNameDB Text
colName)
    = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FieldAttr
FieldAttrSafeToRemove forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> [FieldAttr]
fieldAttrs)
    forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== Text -> FieldNameDB
FieldNameDB Text
colName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> FieldNameDB
fieldDB)
    forall a b. (a -> b) -> a -> b
$ [FieldDef]
allEntityFields
  where
    allEntityFields :: [FieldDef]
allEntityFields =
        EntityDef -> [FieldDef]
getEntityFieldsDatabase EntityDef
def forall a. Semigroup a => a -> a -> a
<> case EntityDef -> EntityIdDef
getEntityId EntityDef
def of
            EntityIdField FieldDef
fdef ->
                [FieldDef
fdef]
            EntityIdDef
_ ->
                []

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

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

    columns :: [Text]
columns = case EntityDef -> EntityIdDef
getEntityId EntityDef
entity of
        EntityIdNaturalKey CompositeDef
pdef ->
            [ Int -> Text -> Text
T.drop Int
1 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ 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
"," forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FieldNameDB -> Text
escapeF forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> FieldNameDB
fieldDB) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ CompositeDef -> NonEmpty FieldDef
compositeFields CompositeDef
pdef
            , Text
")"
            ]

        EntityIdField FieldDef
fd ->
            [ FieldNameDB -> Text
escapeF forall a b. (a -> b) -> a -> b
$ FieldDef -> FieldNameDB
fieldDB FieldDef
fd
            , Text
" "
            , SqlType -> Text
showSqlType forall a b. (a -> b) -> a -> b
$ FieldDef -> SqlType
fieldSqlType FieldDef
fd
            , Text
" PRIMARY KEY"
            , Maybe Text -> Text
mayDefault forall a b. (a -> b) -> a -> b
$ [FieldAttr] -> Maybe Text
defaultAttribute forall a b. (a -> b) -> a -> b
$ FieldDef -> [FieldAttr]
fieldAttrs FieldDef
fd
            , [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Column -> Text
sqlColumn Bool
isTemp) [Column]
nonIdCols
            ]

    nonIdCols :: [Column]
nonIdCols = forall a. (a -> Bool) -> [a] -> [a]
filter (\Column
c -> forall a. a -> Maybe a
Just (Column -> FieldNameDB
cName Column
c) forall a. Eq a => a -> a -> Bool
/= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldDef -> FieldNameDB
fieldDB (EntityDef -> Maybe FieldDef
getEntityIdField 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 " 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 (" forall a. Semigroup a => a -> a -> a
<> Text
g forall a. Semigroup a => a -> a -> a
<> Text
") STORED"

sqlColumn :: Bool -> Column -> Text
sqlColumn :: Bool -> Column -> Text
sqlColumn Bool
noRef (Column FieldNameDB
name Bool
isNull SqlType
typ Maybe Text
def Maybe Text
gen Maybe ConstraintNameDB
_cn Maybe Integer
_maxLen Maybe ColumnReference
ref) = [Text] -> Text
T.concat
    [ Text
","
    , FieldNameDB -> Text
escapeF FieldNameDB
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 -> EntityNameDB
crTableName=EntityNameDB
table, crFieldCascade :: ColumnReference -> FieldCascade
crFieldCascade=FieldCascade
cascadeOpts} ->
          if Bool
noRef then Text
"" else Text
" REFERENCES " forall a. Semigroup a => a -> a -> a
<> EntityNameDB -> Text
escapeE EntityNameDB
table
            forall a. Semigroup a => a -> a -> a
<> FieldCascade -> Text
onDelete FieldCascade
cascadeOpts forall a. Semigroup a => a -> a -> a
<> FieldCascade -> Text
onUpdate FieldCascade
cascadeOpts
    ]
  where
    onDelete :: FieldCascade -> Text
onDelete FieldCascade
opts = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
T.append Text
" ON DELETE " 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
T.append Text
" ON UPDATE " 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 forall a b. (a -> b) -> a -> b
$
    [ Text
", CONSTRAINT "
    , ConstraintNameDB -> Text
escapeC forall a b. (a -> b) -> a -> b
$ ForeignDef -> ConstraintNameDB
foreignConstraintNameDBName ForeignDef
fdef
    , Text
" FOREIGN KEY("
    , Text -> [Text] -> Text
T.intercalate Text
"," forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FieldNameDB -> Text
escapeF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
sndforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ ForeignDef -> [(ForeignFieldDef, ForeignFieldDef)]
foreignFields ForeignDef
fdef
    , Text
") REFERENCES "
    , EntityNameDB -> Text
escapeE forall a b. (a -> b) -> a -> b
$ ForeignDef -> EntityNameDB
foreignRefTableDBName ForeignDef
fdef
    , Text
"("
    , Text -> [Text] -> Text
T.intercalate Text
"," forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FieldNameDB -> Text
escapeF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ ForeignDef -> [(ForeignFieldDef, ForeignFieldDef)]
foreignFields ForeignDef
fdef
    , Text
")"
    ] forall a. [a] -> [a] -> [a]
++ [Text]
onDelete forall a. [a] -> [a] -> [a]
++ [Text]
onUpdate
  where
    onDelete :: [Text]
onDelete =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
T.append Text
" ON DELETE ")
        forall a b. (a -> b) -> a -> b
$ Maybe CascadeAction -> [Text]
showAction
        forall a b. (a -> b) -> a -> b
$ FieldCascade -> Maybe CascadeAction
fcOnDelete
        forall a b. (a -> b) -> a -> b
$ ForeignDef -> FieldCascade
foreignFieldCascade ForeignDef
fdef
    onUpdate :: [Text]
onUpdate =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text -> Text
T.append Text
" ON UPDATE ")
        forall a b. (a -> b) -> a -> b
$ Maybe CascadeAction -> [Text]
showAction
        forall a b. (a -> b) -> a -> b
$ FieldCascade -> Maybe CascadeAction
fcOnUpdate
        forall a b. (a -> b) -> a -> b
$ ForeignDef -> FieldCascade
foreignFieldCascade ForeignDef
fdef

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

sqlUnique :: UniqueDef -> Text
sqlUnique :: UniqueDef -> Text
sqlUnique (UniqueDef ConstraintNameHS
_ ConstraintNameDB
cname NonEmpty ForeignFieldDef
cols [Text]
_) = [Text] -> Text
T.concat
    [ Text
",CONSTRAINT "
    , ConstraintNameDB -> Text
escapeC ConstraintNameDB
cname
    , Text
" UNIQUE ("
    , Text -> [Text] -> Text
T.intercalate Text
"," forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FieldNameDB -> Text
escapeF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty ForeignFieldDef
cols
    , Text
")"
    ]

escapeC :: ConstraintNameDB -> Text
escapeC :: ConstraintNameDB -> Text
escapeC = forall a str. DatabaseName a => (Text -> str) -> a -> str
escapeWith Text -> Text
escape

escapeE :: EntityNameDB -> Text
escapeE :: EntityNameDB -> Text
escapeE = forall a str. DatabaseName a => (Text -> str) -> a -> str
escapeWith Text -> Text
escape

escapeF :: FieldNameDB -> Text
escapeF :: FieldNameDB -> Text
escapeF = forall a str. DatabaseName a => (Text -> str) -> a -> str
escapeWith Text -> Text
escape

escape :: Text -> Text
escape :: Text -> Text
escape 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 (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [FieldDef]
fields) EntityDef
ent Int
n
  where
    fields :: [FieldDef]
fields = EntityDef -> [FieldDef]
getEntityFields EntityDef
ent
    conflictColumns :: [Text]
conflictColumns = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map (FieldNameDB -> Text
escapeF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqueDef -> NonEmpty ForeignFieldDef
uniqueFields) (EntityDef -> [UniqueDef]
getEntityUniques EntityDef
ent)

repsertManySql :: EntityDef -> Int -> Text
repsertManySql :: EntityDef -> Int -> Text
repsertManySql EntityDef
ent Int
n = [Text] -> [FieldDef] -> EntityDef -> Int -> Text
putManySql' [Text]
conflictColumns (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty FieldDef
fields) EntityDef
ent Int
n
  where
    fields :: NonEmpty FieldDef
fields = EntityDef -> NonEmpty FieldDef
keyAndEntityFields EntityDef
ent
    conflictColumns :: [Text]
conflictColumns = FieldNameDB -> Text
escapeF forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> FieldNameDB
fieldDB forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (EntityDef -> NonEmpty FieldDef
getEntityKeyFields 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 = FieldNameDB -> Text
escapeF forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> FieldNameDB
fieldDB
    mkAssignment :: Text -> Text
mkAssignment Text
f = [Text] -> Text
T.concat [Text
f, Text
"=EXCLUDED.", Text
f]

    table :: Text
table = EntityNameDB -> Text
escapeE forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> EntityNameDB
getEntityDBName forall a b. (a -> b) -> a -> b
$ EntityDef
ent
    columns :: Text
columns = [Text] -> Text
Util.commaSeparated forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> Text
fieldDbToText [FieldDef]
fields
    placeholders :: [Text]
placeholders = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const Text
"?") [FieldDef]
fields
    updates :: [Text]
updates = forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
mkAssignment 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
replicate Int
n
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.parenWrapped forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Util.commaSeparated forall a b. (a -> b) -> a -> b
$ [Text]
placeholders
        , Text
" ON CONFLICT "
        , Text -> Text
Util.parenWrapped forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Util.commaSeparated 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 -> ShowS
[SqliteConf] -> ShowS
SqliteConf -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SqliteConf] -> ShowS
$cshowList :: [SqliteConf] -> ShowS
show :: SqliteConf -> String
$cshow :: SqliteConf -> String
showsPrec :: Int -> SqliteConf -> ShowS
$cshowsPrec :: Int -> SqliteConf -> ShowS
Show

instance FromJSON SqliteConf where
    parseJSON :: Value -> Parser SqliteConf
parseJSON Value
v = forall a. ShowS -> Parser a -> Parser a
modifyFailure (String
"Persistent: error loading Sqlite conf: " forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip (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 Key
"database" forall {a}. Key -> KeyMap a -> Bool
`isMember` Object
o
                      then Text -> Int -> SqliteConf
SqliteConf
                            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"database"
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"poolsize"
                      else SqliteConnectionInfo -> Int -> SqliteConf
SqliteConfInfo
                            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"connInfo"
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"poolsize"
#if MIN_VERSION_aeson(2,0,0)
        isMember :: Key -> KeyMap a -> Bool
isMember = forall {a}. Key -> KeyMap a -> Bool
KeyMap.member
#else
        isMember = HashMap.member
#endif

instance PersistConfig SqliteConf where
    type PersistConfigBackend SqliteConf = SqlPersistT
    type PersistConfigPool SqliteConf = ConnectionPool
    createPoolConfig :: SqliteConf -> IO (PersistConfigPool SqliteConf)
createPoolConfig (SqliteConf Text
cs Int
size) = forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo (Text -> SqliteConnectionInfo
conStringToInfo Text
cs) Int
size -- FIXME
    createPoolConfig (SqliteConfInfo SqliteConnectionInfo
info Int
size) = forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo SqliteConnectionInfo
info Int
size -- FIXME
    runPool :: forall (m :: * -> *) a.
MonadUnliftIO m =>
SqliteConf
-> PersistConfigBackend SqliteConf m a
-> PersistConfigPool SqliteConf
-> m a
runPool SqliteConf
_ = forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> Pool backend -> m a
runSqlPool
    loadConfig :: Value -> Parser SqliteConf
loadConfig = 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 :: forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
finally m a
a m b
sequel = forall (m :: * -> *) a.
MonadUnliftIO m =>
(UnliftIO m -> IO a) -> m a
withUnliftIO forall a b. (a -> b) -> a -> b
$ \UnliftIO m
u ->
                     forall a b. IO a -> IO b -> IO a
E.finally (forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO m
u m a
a)
                               (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 -> ShowS
[SqliteConnectionInfo] -> ShowS
SqliteConnectionInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SqliteConnectionInfo] -> ShowS
$cshowList :: [SqliteConnectionInfo] -> ShowS
show :: SqliteConnectionInfo -> String
$cshow :: SqliteConnectionInfo -> String
showsPrec :: Int -> SqliteConnectionInfo -> ShowS
$cshowsPrec :: Int -> SqliteConnectionInfo -> ShowS
Show

instance FromJSON SqliteConnectionInfo where
    parseJSON :: Value -> Parser SqliteConnectionInfo
parseJSON Value
v = forall a. ShowS -> Parser a -> Parser a
modifyFailure (String
"Persistent: error loading SqliteConnectionInfo: " forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$
      forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SqliteConnectionInfo") Value
v forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Bool -> Bool -> [Text] -> SqliteConnectionInfo
SqliteConnectionInfo
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"connectionString"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"walEnabled"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fkEnabled"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"extraPragmas" 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
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
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
Ord, Int -> ForeignKeyViolation -> ShowS
[ForeignKeyViolation] -> ShowS
ForeignKeyViolation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForeignKeyViolation] -> ShowS
$cshowList :: [ForeignKeyViolation] -> ShowS
show :: ForeignKeyViolation -> String
$cshow :: ForeignKeyViolation -> String
showsPrec :: Int -> ForeignKeyViolation -> ShowS
$cshowsPrec :: Int -> ForeignKeyViolation -> ShowS
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 :: forall (m :: * -> *) env.
(MonadResource m, MonadReader env m,
 BackendCompatible SqlBackend env) =>
ConduitM () ForeignKeyViolation m ()
checkForeignKeys = forall (m :: * -> *) env.
(MonadResource m, MonadReader env m,
 BackendCompatible SqlBackend env) =>
Text -> [PersistValue] -> ConduitM () [PersistValue] m ()
rawQuery Text
query [] forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
C.mapM 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 ] ->
            forall (m :: * -> *) a. Monad m => a -> m a
return ForeignKeyViolation
                { foreignKeyTable :: Text
foreignKeyTable = Text
table
                , foreignKeyColumn :: Text
foreignKeyColumn = Text
column
                , foreignKeyRowId :: Int64
foreignKeyRowId = Int64
rowid
                }
        [PersistValue]
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
E.throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PersistException
PersistMarshalError forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
            [ Text
"Unexpected result from foreign key check:\n", String -> Text
T.pack (forall a. Show a => a -> String
show [PersistValue]
l) ]

    query :: Text
query = [Text] -> Text
T.unlines
        [ Text
"SELECT origin.rowid, origin.\"table\", group_concat(foreignkeys.\"from\")"
        , Text
"FROM pragma_foreign_key_check() AS origin"
        , Text
"INNER JOIN pragma_foreign_key_list(origin.\"table\") AS foreignkeys"
        , Text
"ON origin.fkid = foreignkeys.id AND origin.parent = foreignkeys.\"table\""
        , Text
"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, MonadLoggerIO m)
    => SqliteConnectionInfo
    -> (RawSqlite SqlBackend -> m a)
    -> m a
withRawSqliteConnInfo :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m) =>
SqliteConnectionInfo -> (RawSqlite SqlBackend -> m a) -> m a
withRawSqliteConnInfo SqliteConnectionInfo
connInfo RawSqlite SqlBackend -> m a
f = do
    LogFunc
logFunc <- forall (m :: * -> *). MonadLoggerIO m => m LogFunc
askLoggerIO
    forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> 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 forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSqlite SqlBackend -> m a
f
  where
    openBackend :: LogFunc -> IO (RawSqlite SqlBackend)
openBackend = forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith forall backend. backend -> Connection -> RawSqlite backend
RawSqlite SqliteConnectionInfo
connInfo
    closeBackend :: RawSqlite SqlBackend -> IO ()
closeBackend = forall backend.
BackendCompatible SqlBackend backend =>
backend -> IO ()
close' forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    :: (MonadLoggerIO 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 :: forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
SqliteConnectionInfo
-> (RawSqlite SqlBackend -> m ())
-> Int
-> m (Pool (RawSqlite SqlBackend))
createRawSqlitePoolFromInfo SqliteConnectionInfo
connInfo RawSqlite SqlBackend -> m ()
f Int
n = do
    m () -> IO ()
runIO <- forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
    let createRawSqlite :: LogFunc -> IO (RawSqlite SqlBackend)
createRawSqlite LogFunc
logFun = do
            RawSqlite SqlBackend
result <- forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith forall backend. backend -> Connection -> RawSqlite backend
RawSqlite SqliteConnectionInfo
connInfo LogFunc
logFun
            RawSqlite SqlBackend
result forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m () -> IO ()
runIO (RawSqlite SqlBackend -> m ()
f RawSqlite SqlBackend
result)

    forall backend (m :: * -> *).
(MonadLoggerIO 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_
    :: (MonadLoggerIO m, MonadUnliftIO m)
    => SqliteConnectionInfo -> Int -> m (Pool (RawSqlite SqlBackend))
createRawSqlitePoolFromInfo_ :: forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
SqliteConnectionInfo -> Int -> m (Pool (RawSqlite SqlBackend))
createRawSqlitePoolFromInfo_ SqliteConnectionInfo
connInfo =
  forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
SqliteConnectionInfo
-> (RawSqlite SqlBackend -> m ())
-> Int
-> m (Pool (RawSqlite SqlBackend))
createRawSqlitePoolFromInfo SqliteConnectionInfo
connInfo (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ()))

-- | Like `createSqlitePoolInfo`, but based on `createRawSqlitePoolFromInfo`.
--
-- @since 2.10.6
withRawSqlitePoolInfo
    :: (MonadUnliftIO m, MonadLoggerIO m)
    => SqliteConnectionInfo
    -> (RawSqlite SqlBackend -> m ())
    -> Int -- ^ number of connections to open
    -> (Pool (RawSqlite SqlBackend) -> m a)
    -> m a
withRawSqlitePoolInfo :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m) =>
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 <- forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
    let createRawSqlite :: LogFunc -> IO (RawSqlite SqlBackend)
createRawSqlite LogFunc
logFun = do
            RawSqlite SqlBackend
result <- forall r.
(SqlBackend -> Connection -> r)
-> SqliteConnectionInfo -> LogFunc -> IO r
openWith forall backend. backend -> Connection -> RawSqlite backend
RawSqlite SqliteConnectionInfo
connInfo LogFunc
logFun
            RawSqlite SqlBackend
result forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m () -> IO ()
runIO (RawSqlite SqlBackend -> m ()
f RawSqlite SqlBackend
result)

    forall backend (m :: * -> *) a.
(MonadLoggerIO 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, MonadLoggerIO m)
    => SqliteConnectionInfo
    -> Int -- ^ number of connections to open
    -> (Pool (RawSqlite SqlBackend) -> m a)
    -> m a
withRawSqlitePoolInfo_ :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m) =>
SqliteConnectionInfo
-> Int -> (Pool (RawSqlite SqlBackend) -> m a) -> m a
withRawSqlitePoolInfo_ SqliteConnectionInfo
connInfo =
  forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLoggerIO m) =>
SqliteConnectionInfo
-> (RawSqlite SqlBackend -> m ())
-> Int
-> (Pool (RawSqlite SqlBackend) -> m a)
-> m a
withRawSqlitePoolInfo SqliteConnectionInfo
connInfo (forall a b. a -> b -> a
const (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
    { forall backend. RawSqlite backend -> backend
_persistentBackend :: backend -- ^ The persistent backend
    , forall backend. RawSqlite backend -> Connection
_rawSqliteConnection :: Sqlite.Connection -- ^ The underlying `Sqlite.Connection`
    }

instance BackendCompatible b (RawSqlite b) where
    projectBackend :: RawSqlite b -> b
projectBackend = forall backend. RawSqlite backend -> backend
_persistentBackend

#if MIN_VERSION_base(4,12,0)
instance (PersistCore b) => PersistCore (RawSqlite b) where
  newtype BackendKey (RawSqlite b) = RawSqliteKey { forall b.
BackendKey (RawSqlite b) -> BackendKey (Compatible b (RawSqlite b))
unRawSqliteKey :: BackendKey (Compatible b (RawSqlite b)) }

makeCompatibleKeyInstances [t| forall b. Compatible b (RawSqlite b) |]
#else
instance (PersistCore b) => PersistCore (RawSqlite b) where
  newtype BackendKey (RawSqlite b) = RawSqliteKey { unRawSqliteKey :: BackendKey (RawSqlite 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))
#endif


#if MIN_VERSION_base(4,12,0)
$(pure [])

makeCompatibleInstances [t| forall b. Compatible b (RawSqlite b) |]
#else
instance HasPersistBackend b => HasPersistBackend (RawSqlite b) where
    type BaseBackend (RawSqlite b) = BaseBackend b
    persistBackend = persistBackend . _persistentBackend

instance (PersistStoreRead b) => PersistStoreRead (RawSqlite b) where
    get = withReaderT _persistentBackend . get
    getMany = withReaderT _persistentBackend . getMany

instance (PersistQueryRead b) => PersistQueryRead (RawSqlite b) where
    selectSourceRes filts opts = withReaderT _persistentBackend $ selectSourceRes filts opts
    selectFirst filts opts = withReaderT _persistentBackend $ selectFirst filts opts
    selectKeysRes filts opts = withReaderT _persistentBackend $ selectKeysRes filts opts
    count = withReaderT _persistentBackend . count
    exists = withReaderT _persistentBackend . exists

instance (PersistQueryWrite b) => PersistQueryWrite (RawSqlite b) where
    updateWhere filts updates = withReaderT _persistentBackend $ updateWhere filts updates
    deleteWhere = withReaderT _persistentBackend . deleteWhere

instance (PersistUniqueRead b) => PersistUniqueRead (RawSqlite b) where
    getBy = withReaderT _persistentBackend . getBy

instance (PersistStoreWrite b) => PersistStoreWrite (RawSqlite b) where
    insert = withReaderT _persistentBackend . insert
    insert_ = withReaderT _persistentBackend . insert_
    insertMany = withReaderT _persistentBackend . insertMany
    insertMany_ = withReaderT _persistentBackend . insertMany_
    insertEntityMany = withReaderT _persistentBackend . insertEntityMany
    insertKey k = withReaderT _persistentBackend . insertKey k
    repsert k = withReaderT _persistentBackend . repsert k
    repsertMany = withReaderT _persistentBackend . repsertMany
    replace k = withReaderT _persistentBackend . replace k
    delete = withReaderT _persistentBackend . delete
    update k = withReaderT _persistentBackend . update k
    updateGet k = withReaderT _persistentBackend . updateGet k

instance (PersistUniqueWrite b) => PersistUniqueWrite (RawSqlite b) where
    deleteBy = withReaderT _persistentBackend . deleteBy
    insertUnique = withReaderT _persistentBackend . insertUnique
    upsert rec = withReaderT _persistentBackend . upsert rec
    upsertBy uniq rec = withReaderT _persistentBackend . upsertBy uniq rec
    putMany = withReaderT _persistentBackend . putMany
#endif

makeLenses ''RawSqlite
makeLenses ''SqliteConnectionInfo