{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Database.Groundhog.Sqlite
  ( withSqlitePool,
    withSqliteConn,
    createSqlitePool,
    runDbConn,
    Sqlite (..),
    module Database.Groundhog,
    module Database.Groundhog.Generic.Sql.Functions,
  )
where

import Control.Arrow ((***))
import Control.Monad (forM)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Trans.Reader (ask, runReaderT)
import Control.Monad.Trans.State (mapStateT)
import Data.Acquire (mkAcquire)
import qualified Data.ByteString.Char8 as BS
import Data.Char (toUpper)
import Data.Function (on)
import qualified Data.HashMap.Strict as Map
import Data.IORef
import Data.Int (Int64)
import Data.List (groupBy, intercalate, isInfixOf, partition, sort)
import Data.Maybe (fromMaybe)
import Data.Pool
import qualified Data.Text as T
import Database.Groundhog
import Database.Groundhog.Core
import Database.Groundhog.Expression
import Database.Groundhog.Generic
import Database.Groundhog.Generic.Migration hiding (MigrationPack (..))
import qualified Database.Groundhog.Generic.Migration as GM
import qualified Database.Groundhog.Generic.PersistBackendHelpers as H
import Database.Groundhog.Generic.Sql
import Database.Groundhog.Generic.Sql.Functions
import qualified Database.SQLite3 as S
import qualified Database.SQLite3.Direct as SD

-- typical operations for connection: OPEN, BEGIN, COMMIT, ROLLBACK, CLOSE
data Sqlite = Sqlite S.Database (IORef (Map.HashMap BS.ByteString S.Statement))

instance DbDescriptor Sqlite where
  type AutoKeyType Sqlite = Int64
  type QueryRaw Sqlite = Snippet Sqlite
  backendName :: proxy Sqlite -> String
backendName proxy Sqlite
_ = String
"sqlite"

instance SqlDb Sqlite where
  append :: a -> b -> Expr Sqlite r String
append a
a b
b = Snippet Sqlite r -> Expr Sqlite r String
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Sqlite r -> Expr Sqlite r String)
-> Snippet Sqlite r -> Expr Sqlite r String
forall a b. (a -> b) -> a -> b
$ Int -> String -> a -> b -> Snippet Sqlite r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
50 String
"||" a
a b
b
  signum' :: x -> Expr Sqlite r a
signum' x
x = Snippet Sqlite r -> Expr Sqlite r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Sqlite r -> Expr Sqlite r a)
-> Snippet Sqlite r -> Expr Sqlite r a
forall a b. (a -> b) -> a -> b
$
    (RenderConfig -> Int -> [RenderS Sqlite r]) -> Snippet Sqlite r
forall db r.
(RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
Snippet ((RenderConfig -> Int -> [RenderS Sqlite r]) -> Snippet Sqlite r)
-> (RenderConfig -> Int -> [RenderS Sqlite r]) -> Snippet Sqlite r
forall a b. (a -> b) -> a -> b
$ \RenderConfig
esc Int
_ ->
      let x' :: RenderS Sqlite r
x' = RenderConfig -> UntypedExpr Sqlite r -> RenderS Sqlite r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
esc (x -> UntypedExpr Sqlite r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr x
x)
       in [RenderS Sqlite r
"case when (" RenderS Sqlite r -> RenderS Sqlite r -> RenderS Sqlite r
forall a. Semigroup a => a -> a -> a
<> RenderS Sqlite r
x' RenderS Sqlite r -> RenderS Sqlite r -> RenderS Sqlite r
forall a. Semigroup a => a -> a -> a
<> RenderS Sqlite r
") > 0 then 1 when (" RenderS Sqlite r -> RenderS Sqlite r -> RenderS Sqlite r
forall a. Semigroup a => a -> a -> a
<> RenderS Sqlite r
x' RenderS Sqlite r -> RenderS Sqlite r -> RenderS Sqlite r
forall a. Semigroup a => a -> a -> a
<> RenderS Sqlite r
") < 0 then -1 else 0 end"]
  quotRem' :: x -> y -> (Expr Sqlite r a, Expr Sqlite r a)
quotRem' x
x y
y = (Snippet Sqlite r -> Expr Sqlite r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Sqlite r -> Expr Sqlite r a)
-> Snippet Sqlite r -> Expr Sqlite r a
forall a b. (a -> b) -> a -> b
$ Int -> String -> x -> y -> Snippet Sqlite r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
70 String
"/" x
x y
y, Snippet Sqlite r -> Expr Sqlite r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Sqlite r -> Expr Sqlite r a)
-> Snippet Sqlite r -> Expr Sqlite r a
forall a b. (a -> b) -> a -> b
$ Int -> String -> x -> y -> Snippet Sqlite r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
70 String
"%" x
x y
y)
  equalsOperator :: RenderS Sqlite r -> RenderS Sqlite r -> RenderS Sqlite r
equalsOperator RenderS Sqlite r
a RenderS Sqlite r
b = RenderS Sqlite r
a RenderS Sqlite r -> RenderS Sqlite r -> RenderS Sqlite r
forall a. Semigroup a => a -> a -> a
<> RenderS Sqlite r
" IS " RenderS Sqlite r -> RenderS Sqlite r -> RenderS Sqlite r
forall a. Semigroup a => a -> a -> a
<> RenderS Sqlite r
b
  notEqualsOperator :: RenderS Sqlite r -> RenderS Sqlite r -> RenderS Sqlite r
notEqualsOperator RenderS Sqlite r
a RenderS Sqlite r
b = RenderS Sqlite r
a RenderS Sqlite r -> RenderS Sqlite r -> RenderS Sqlite r
forall a. Semigroup a => a -> a -> a
<> RenderS Sqlite r
" IS NOT " RenderS Sqlite r -> RenderS Sqlite r -> RenderS Sqlite r
forall a. Semigroup a => a -> a -> a
<> RenderS Sqlite r
b

instance PersistBackendConn Sqlite where
  insert :: v -> m (AutoKey v)
insert v
v = Action (Conn m) (AutoKey v) -> m (AutoKey v)
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) (AutoKey v) -> m (AutoKey v))
-> Action (Conn m) (AutoKey v) -> m (AutoKey v)
forall a b. (a -> b) -> a -> b
$ v -> Action Sqlite (AutoKey v)
forall v. PersistEntity v => v -> Action Sqlite (AutoKey v)
insert' v
v
  insert_ :: v -> m ()
insert_ v
v = Action (Conn m) () -> m ()
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) () -> m ()) -> Action (Conn m) () -> m ()
forall a b. (a -> b) -> a -> b
$ v -> Action Sqlite ()
forall v. PersistEntity v => v -> Action Sqlite ()
insert_' v
v
  insertBy :: u (UniqueMarker v) -> v -> m (Either (AutoKey v) (AutoKey v))
insertBy u (UniqueMarker v)
u v
v = Action (Conn m) (Either (AutoKey v) (AutoKey v))
-> m (Either (AutoKey v) (AutoKey v))
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) (Either (AutoKey v) (AutoKey v))
 -> m (Either (AutoKey v) (AutoKey v)))
-> Action (Conn m) (Either (AutoKey v) (AutoKey v))
-> m (Either (AutoKey v) (AutoKey v))
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8
    -> [PersistValue] -> Action Sqlite (RowStream [PersistValue]))
-> Bool
-> u (UniqueMarker v)
-> v
-> Action Sqlite (Either (AutoKey v) (AutoKey v))
forall conn v (u :: (* -> *) -> *).
(PersistBackendConn conn, PersistEntity v,
 IsUniqueKey (Key v (Unique u))) =>
RenderConfig
-> (Utf8
    -> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Bool
-> u (UniqueMarker v)
-> v
-> Action conn (Either (AutoKey v) (AutoKey v))
H.insertBy RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached' Bool
True u (UniqueMarker v)
u v
v
  insertByAll :: v -> m (Either (AutoKey v) (AutoKey v))
insertByAll v
v = Action (Conn m) (Either (AutoKey v) (AutoKey v))
-> m (Either (AutoKey v) (AutoKey v))
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) (Either (AutoKey v) (AutoKey v))
 -> m (Either (AutoKey v) (AutoKey v)))
-> Action (Conn m) (Either (AutoKey v) (AutoKey v))
-> m (Either (AutoKey v) (AutoKey v))
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8
    -> [PersistValue] -> Action Sqlite (RowStream [PersistValue]))
-> Bool
-> v
-> Action Sqlite (Either (AutoKey v) (AutoKey v))
forall conn v.
(PersistBackendConn conn, PersistEntity v) =>
RenderConfig
-> (Utf8
    -> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Bool
-> v
-> Action conn (Either (AutoKey v) (AutoKey v))
H.insertByAll RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached' Bool
True v
v
  replace :: Key v BackendSpecific -> v -> m ()
replace Key v BackendSpecific
k v
v = Action (Conn m) () -> m ()
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) () -> m ()) -> Action (Conn m) () -> m ()
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8
    -> [PersistValue] -> Action Sqlite (RowStream [PersistValue]))
-> (Utf8 -> [PersistValue] -> Action Sqlite ())
-> (Bool
    -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS Sqlite Any)
-> Key v BackendSpecific
-> v
-> Action Sqlite ()
forall conn r v.
(PersistBackendConn conn, PersistEntity v,
 PrimitivePersistField (Key v BackendSpecific)) =>
RenderConfig
-> (Utf8
    -> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> (Utf8 -> [PersistValue] -> Action conn ())
-> (Bool
    -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS conn r)
-> Key v BackendSpecific
-> v
-> Action conn ()
H.replace RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached' Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' Bool
-> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS Sqlite Any
forall db r.
Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r
insertIntoConstructorTable Key v BackendSpecific
k v
v
  replaceBy :: u (UniqueMarker v) -> v -> m ()
replaceBy u (UniqueMarker v)
k v
v = Action (Conn m) () -> m ()
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) () -> m ()) -> Action (Conn m) () -> m ()
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8 -> [PersistValue] -> Action Sqlite ())
-> u (UniqueMarker v)
-> v
-> Action Sqlite ()
forall conn v (u :: (* -> *) -> *).
(PersistBackendConn conn, PersistEntity v,
 IsUniqueKey (Key v (Unique u))) =>
RenderConfig
-> (Utf8 -> [PersistValue] -> Action conn ())
-> u (UniqueMarker v)
-> v
-> Action conn ()
H.replaceBy RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' u (UniqueMarker v)
k v
v
  select :: opts -> m [v]
select opts
options = Action (Conn m) [v] -> m [v]
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) [v] -> m [v]) -> Action (Conn m) [v] -> m [v]
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8
    -> [PersistValue] -> Action Sqlite (RowStream [PersistValue]))
-> (opts -> RenderS Sqlite (RestrictionHolder v c))
-> Utf8
-> opts
-> Action Sqlite [v]
forall conn r v (c :: (* -> *) -> *) opts.
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn,
 PersistEntity v, EntityConstr v c, HasSelectOptions opts conn r) =>
RenderConfig
-> (Utf8
    -> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> (opts -> RenderS conn r)
-> Utf8
-> opts
-> Action conn [v]
H.select RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached' opts -> RenderS Sqlite (RestrictionHolder v c)
forall opts db r.
HasSelectOptions opts db r =>
opts -> RenderS db r
preColumns Utf8
"LIMIT -1" opts
options
  selectStream :: opts -> m (RowStream v)
selectStream opts
options = Action (Conn m) (RowStream v) -> m (RowStream v)
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) (RowStream v) -> m (RowStream v))
-> Action (Conn m) (RowStream v) -> m (RowStream v)
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8
    -> [PersistValue] -> Action Sqlite (RowStream [PersistValue]))
-> (opts -> RenderS Sqlite (RestrictionHolder v c))
-> Utf8
-> opts
-> Action Sqlite (RowStream v)
forall conn r v (c :: (* -> *) -> *) opts.
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn,
 PersistEntity v, EntityConstr v c, HasSelectOptions opts conn r) =>
RenderConfig
-> (Utf8
    -> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> (opts -> RenderS conn r)
-> Utf8
-> opts
-> Action conn (RowStream v)
H.selectStream RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached' opts -> RenderS Sqlite (RestrictionHolder v c)
forall opts db r.
HasSelectOptions opts db r =>
opts -> RenderS db r
preColumns Utf8
"LIMIT -1" opts
options
  selectAll :: m [(AutoKey v, v)]
selectAll = Action (Conn m) [(AutoKey v, v)] -> m [(AutoKey v, v)]
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) [(AutoKey v, v)] -> m [(AutoKey v, v)])
-> Action (Conn m) [(AutoKey v, v)] -> m [(AutoKey v, v)]
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8
    -> [PersistValue] -> Action Sqlite (RowStream [PersistValue]))
-> Action Sqlite [(AutoKey v, v)]
forall conn v.
(PersistBackendConn conn, PersistEntity v) =>
RenderConfig
-> (Utf8
    -> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Action conn [(AutoKey v, v)]
H.selectAll RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached'
  selectAllStream :: m (RowStream (AutoKey v, v))
selectAllStream = Action (Conn m) (RowStream (AutoKey v, v))
-> m (RowStream (AutoKey v, v))
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) (RowStream (AutoKey v, v))
 -> m (RowStream (AutoKey v, v)))
-> Action (Conn m) (RowStream (AutoKey v, v))
-> m (RowStream (AutoKey v, v))
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8
    -> [PersistValue] -> Action Sqlite (RowStream [PersistValue]))
-> Action Sqlite (RowStream (AutoKey v, v))
forall conn v.
(PersistBackendConn conn, PersistEntity v) =>
RenderConfig
-> (Utf8
    -> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Action conn (RowStream (AutoKey v, v))
H.selectAllStream RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached'
  get :: Key v BackendSpecific -> m (Maybe v)
get Key v BackendSpecific
k = Action (Conn m) (Maybe v) -> m (Maybe v)
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) (Maybe v) -> m (Maybe v))
-> Action (Conn m) (Maybe v) -> m (Maybe v)
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8
    -> [PersistValue] -> Action Sqlite (RowStream [PersistValue]))
-> Key v BackendSpecific
-> Action Sqlite (Maybe v)
forall conn v.
(PersistBackendConn conn, PersistEntity v,
 PrimitivePersistField (Key v BackendSpecific)) =>
RenderConfig
-> (Utf8
    -> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Key v BackendSpecific
-> Action conn (Maybe v)
H.get RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached' Key v BackendSpecific
k
  getBy :: Key v (Unique u) -> m (Maybe v)
getBy Key v (Unique u)
k = Action (Conn m) (Maybe v) -> m (Maybe v)
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) (Maybe v) -> m (Maybe v))
-> Action (Conn m) (Maybe v) -> m (Maybe v)
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8
    -> [PersistValue] -> Action Sqlite (RowStream [PersistValue]))
-> Key v (Unique u)
-> Action Sqlite (Maybe v)
forall conn v (u :: (* -> *) -> *).
(PersistBackendConn conn, PersistEntity v,
 IsUniqueKey (Key v (Unique u))) =>
RenderConfig
-> (Utf8
    -> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Key v (Unique u)
-> Action conn (Maybe v)
H.getBy RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached' Key v (Unique u)
k
  update :: [Update Sqlite (RestrictionHolder v c)]
-> Cond Sqlite (RestrictionHolder v c) -> m ()
update [Update Sqlite (RestrictionHolder v c)]
upds Cond Sqlite (RestrictionHolder v c)
cond = Action (Conn m) () -> m ()
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) () -> m ()) -> Action (Conn m) () -> m ()
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8 -> [PersistValue] -> Action Sqlite ())
-> [Update Sqlite (RestrictionHolder v c)]
-> Cond Sqlite (RestrictionHolder v c)
-> Action Sqlite ()
forall conn r v (c :: (* -> *) -> *).
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn,
 PersistEntity v, EntityConstr v c) =>
RenderConfig
-> (Utf8 -> [PersistValue] -> Action conn ())
-> [Update conn r]
-> Cond conn r
-> Action conn ()
H.update RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' [Update Sqlite (RestrictionHolder v c)]
upds Cond Sqlite (RestrictionHolder v c)
cond
  delete :: Cond Sqlite (RestrictionHolder v c) -> m ()
delete Cond Sqlite (RestrictionHolder v c)
cond = Action (Conn m) () -> m ()
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) () -> m ()) -> Action (Conn m) () -> m ()
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8 -> [PersistValue] -> Action Sqlite ())
-> Cond Sqlite (RestrictionHolder v c)
-> Action Sqlite ()
forall conn r v (c :: (* -> *) -> *).
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn,
 PersistEntity v, EntityConstr v c) =>
RenderConfig
-> (Utf8 -> [PersistValue] -> Action conn ())
-> Cond conn r
-> Action conn ()
H.delete RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' Cond Sqlite (RestrictionHolder v c)
cond
  deleteBy :: Key v BackendSpecific -> m ()
deleteBy Key v BackendSpecific
k = Action (Conn m) () -> m ()
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) () -> m ()) -> Action (Conn m) () -> m ()
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8 -> [PersistValue] -> Action Sqlite ())
-> Key v BackendSpecific
-> Action Sqlite ()
forall conn v.
(PersistBackendConn conn, PersistEntity v,
 PrimitivePersistField (Key v BackendSpecific)) =>
RenderConfig
-> (Utf8 -> [PersistValue] -> Action conn ())
-> Key v BackendSpecific
-> Action conn ()
H.deleteBy RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' Key v BackendSpecific
k
  deleteAll :: v -> m ()
deleteAll v
v = Action (Conn m) () -> m ()
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) () -> m ()) -> Action (Conn m) () -> m ()
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8 -> [PersistValue] -> Action Sqlite ())
-> v
-> Action Sqlite ()
forall conn v.
(PersistBackendConn conn, PersistEntity v) =>
RenderConfig
-> (Utf8 -> [PersistValue] -> Action conn ())
-> v
-> Action conn ()
H.deleteAll RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' v
v
  count :: Cond Sqlite (RestrictionHolder v c) -> m Int
count Cond Sqlite (RestrictionHolder v c)
cond = Action (Conn m) Int -> m Int
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) Int -> m Int) -> Action (Conn m) Int -> m Int
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8
    -> [PersistValue] -> Action Sqlite (RowStream [PersistValue]))
-> Cond Sqlite (RestrictionHolder v c)
-> Action Sqlite Int
forall conn r v (c :: (* -> *) -> *).
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn,
 PersistEntity v, EntityConstr v c) =>
RenderConfig
-> (Utf8
    -> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> Cond conn r
-> Action conn Int
H.count RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached' Cond Sqlite (RestrictionHolder v c)
cond
  countAll :: v -> m Int
countAll v
fakeV = Action (Conn m) Int -> m Int
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) Int -> m Int) -> Action (Conn m) Int -> m Int
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8
    -> [PersistValue] -> Action Sqlite (RowStream [PersistValue]))
-> v
-> Action Sqlite Int
forall conn v.
(PersistBackendConn conn, PersistEntity v) =>
RenderConfig
-> (Utf8
    -> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> v
-> Action conn Int
H.countAll RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached' v
fakeV
  project :: p -> opts -> m [a]
project p
p opts
options = Action (Conn m) [a] -> m [a]
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) [a] -> m [a]) -> Action (Conn m) [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8
    -> [PersistValue] -> Action Sqlite (RowStream [PersistValue]))
-> (opts -> RenderS Sqlite (RestrictionHolder v c))
-> Utf8
-> p
-> opts
-> Action Sqlite [a]
forall conn r v (c :: (* -> *) -> *) p opts a'.
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn,
 PersistEntity v, EntityConstr v c, Projection p a',
 ProjectionDb p conn, ProjectionRestriction p r,
 HasSelectOptions opts conn r) =>
RenderConfig
-> (Utf8
    -> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> (opts -> RenderS conn r)
-> Utf8
-> p
-> opts
-> Action conn [a']
H.project RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached' opts -> RenderS Sqlite (RestrictionHolder v c)
forall opts db r.
HasSelectOptions opts db r =>
opts -> RenderS db r
preColumns Utf8
"LIMIT -1" p
p opts
options
  projectStream :: p -> opts -> m (RowStream a)
projectStream p
p opts
options = Action (Conn m) (RowStream a) -> m (RowStream a)
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) (RowStream a) -> m (RowStream a))
-> Action (Conn m) (RowStream a) -> m (RowStream a)
forall a b. (a -> b) -> a -> b
$ RenderConfig
-> (Utf8
    -> [PersistValue] -> Action Sqlite (RowStream [PersistValue]))
-> (opts -> RenderS Sqlite (RestrictionHolder v c))
-> Utf8
-> p
-> opts
-> Action Sqlite (RowStream a)
forall conn r v (c :: (* -> *) -> *) p opts a'.
(SqlDb conn, r ~ RestrictionHolder v c, PersistBackendConn conn,
 PersistEntity v, EntityConstr v c, Projection p a',
 ProjectionDb p conn, ProjectionRestriction p r,
 HasSelectOptions opts conn r) =>
RenderConfig
-> (Utf8
    -> [PersistValue] -> Action conn (RowStream [PersistValue]))
-> (opts -> RenderS conn r)
-> Utf8
-> p
-> opts
-> Action conn (RowStream a')
H.projectStream RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached' opts -> RenderS Sqlite (RestrictionHolder v c)
forall opts db r.
HasSelectOptions opts db r =>
opts -> RenderS db r
preColumns Utf8
"LIMIT -1" p
p opts
options
  migrate :: v -> Migration m
migrate v
fakeV = (Action Sqlite ((), NamedMigrations) -> m ((), NamedMigrations))
-> StateT NamedMigrations (Action Sqlite) () -> Migration m
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT Action Sqlite ((), NamedMigrations) -> m ((), NamedMigrations)
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (StateT NamedMigrations (Action Sqlite) () -> Migration m)
-> StateT NamedMigrations (Action Sqlite) () -> Migration m
forall a b. (a -> b) -> a -> b
$ v -> StateT NamedMigrations (Action Sqlite) ()
forall v.
PersistEntity v =>
v -> StateT NamedMigrations (Action Sqlite) ()
migrate' v
fakeV

  executeRaw :: Bool -> String -> [PersistValue] -> m ()
executeRaw Bool
False String
query [PersistValue]
ps = Action (Conn m) () -> m ()
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) () -> m ()) -> Action (Conn m) () -> m ()
forall a b. (a -> b) -> a -> b
$ Utf8 -> [PersistValue] -> Action Sqlite ()
executeRaw' (String -> Utf8
forall a. IsString a => String -> a
fromString String
query) [PersistValue]
ps
  executeRaw Bool
True String
query [PersistValue]
ps = Action (Conn m) () -> m ()
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) () -> m ()) -> Action (Conn m) () -> m ()
forall a b. (a -> b) -> a -> b
$ Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' (String -> Utf8
forall a. IsString a => String -> a
fromString String
query) [PersistValue]
ps
  queryRaw :: Bool -> String -> [PersistValue] -> m (RowStream [PersistValue])
queryRaw Bool
False String
query [PersistValue]
ps = Action (Conn m) (RowStream [PersistValue])
-> m (RowStream [PersistValue])
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) (RowStream [PersistValue])
 -> m (RowStream [PersistValue]))
-> Action (Conn m) (RowStream [PersistValue])
-> m (RowStream [PersistValue])
forall a b. (a -> b) -> a -> b
$ Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRaw' (String -> Utf8
forall a. IsString a => String -> a
fromString String
query) [PersistValue]
ps
  queryRaw Bool
True String
query [PersistValue]
ps = Action (Conn m) (RowStream [PersistValue])
-> m (RowStream [PersistValue])
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) (RowStream [PersistValue])
 -> m (RowStream [PersistValue]))
-> Action (Conn m) (RowStream [PersistValue])
-> m (RowStream [PersistValue])
forall a b. (a -> b) -> a -> b
$ Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached' (String -> Utf8
forall a. IsString a => String -> a
fromString String
query) [PersistValue]
ps

  insertList :: [a] -> m Int64
insertList [a]
l = Action (Conn m) Int64 -> m Int64
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) Int64 -> m Int64)
-> Action (Conn m) Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ [a] -> Action Sqlite Int64
forall a. PersistField a => [a] -> Action Sqlite Int64
insertList' [a]
l
  getList :: Int64 -> m [a]
getList Int64
k = Action (Conn m) [a] -> m [a]
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) [a] -> m [a]) -> Action (Conn m) [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ Int64 -> Action Sqlite [a]
forall a. PersistField a => Int64 -> Action Sqlite [a]
getList' Int64
k

instance SchemaAnalyzer Sqlite where
  schemaExists :: String -> m Bool
schemaExists String
_ = String -> m Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"schemaExists: is not supported by Sqlite"
  getCurrentSchema :: m (Maybe String)
getCurrentSchema = Maybe String -> m (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
  listTables :: Maybe String -> m [String]
listTables Maybe String
Nothing = Action (Conn m) [String] -> m [String]
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) [String] -> m [String])
-> Action (Conn m) [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRaw' Utf8
"SELECT name FROM sqlite_master WHERE type='table'" [] Action Sqlite (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Sqlite IO (RowStream String))
-> ReaderT Sqlite IO (RowStream String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action Sqlite String)
-> RowStream [PersistValue] -> ReaderT Sqlite IO (RowStream String)
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream (String -> Action Sqlite String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Action Sqlite String)
-> ([PersistValue] -> String)
-> [PersistValue]
-> Action Sqlite String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [PersistValue]) -> String
forall a b. (a, b) -> a
fst ((String, [PersistValue]) -> String)
-> ([PersistValue] -> (String, [PersistValue]))
-> [PersistValue]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> (String, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues) ReaderT Sqlite IO (RowStream String)
-> (RowStream String -> ReaderT Sqlite IO [String])
-> ReaderT Sqlite IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream String -> ReaderT Sqlite IO [String]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
  listTables Maybe String
sch = String -> m [String]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m [String]) -> String -> m [String]
forall a b. (a -> b) -> a -> b
$ String
"listTables: schemas are not supported by Sqlite: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
sch
  listTableTriggers :: QualifiedName -> m [String]
listTableTriggers (Maybe String
Nothing, String
name) = Action (Conn m) [String] -> m [String]
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) [String] -> m [String])
-> Action (Conn m) [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRaw' Utf8
"SELECT name FROM sqlite_master WHERE type='trigger' AND tbl_name=?" [String -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue String
name] Action Sqlite (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Sqlite IO (RowStream String))
-> ReaderT Sqlite IO (RowStream String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action Sqlite String)
-> RowStream [PersistValue] -> ReaderT Sqlite IO (RowStream String)
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream (String -> Action Sqlite String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Action Sqlite String)
-> ([PersistValue] -> String)
-> [PersistValue]
-> Action Sqlite String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [PersistValue]) -> String
forall a b. (a, b) -> a
fst ((String, [PersistValue]) -> String)
-> ([PersistValue] -> (String, [PersistValue]))
-> [PersistValue]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> (String, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues) ReaderT Sqlite IO (RowStream String)
-> (RowStream String -> ReaderT Sqlite IO [String])
-> ReaderT Sqlite IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream String -> ReaderT Sqlite IO [String]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
  listTableTriggers (Maybe String
sch, String
_) = String -> m [String]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m [String]) -> String -> m [String]
forall a b. (a -> b) -> a -> b
$ String
"listTableTriggers: schemas are not supported by Sqlite: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
sch
  analyzeTable :: QualifiedName -> m (Maybe TableInfo)
analyzeTable = ReaderT Sqlite IO (Maybe TableInfo) -> m (Maybe TableInfo)
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (ReaderT Sqlite IO (Maybe TableInfo) -> m (Maybe TableInfo))
-> (QualifiedName -> ReaderT Sqlite IO (Maybe TableInfo))
-> QualifiedName
-> m (Maybe TableInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedName -> ReaderT Sqlite IO (Maybe TableInfo)
analyzeTable'
  analyzeTrigger :: QualifiedName -> m (Maybe String)
analyzeTrigger (Maybe String
Nothing, String
name) = Action (Conn m) (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) (Maybe String) -> m (Maybe String))
-> Action (Conn m) (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
    Maybe [PersistValue]
x <- Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRaw' Utf8
"SELECT sql FROM sqlite_master WHERE type='trigger' AND name=?" [String -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue String
name] Action Sqlite (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Sqlite IO (Maybe [PersistValue]))
-> ReaderT Sqlite IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue]
-> ReaderT Sqlite IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow
    case Maybe [PersistValue]
x of
      Maybe [PersistValue]
Nothing -> Maybe String -> ReaderT Sqlite IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
      Just [PersistValue]
src -> Maybe String -> ReaderT Sqlite IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe String, [PersistValue]) -> Maybe String
forall a b. (a, b) -> a
fst ((Maybe String, [PersistValue]) -> Maybe String)
-> (Maybe String, [PersistValue]) -> Maybe String
forall a b. (a -> b) -> a -> b
$ [PersistValue] -> (Maybe String, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues [PersistValue]
src)
  analyzeTrigger (Maybe String
sch, String
_) = String -> m (Maybe String)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Maybe String)) -> String -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String
"analyzeTrigger: schemas are not supported by Sqlite: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
sch
  analyzeFunction :: QualifiedName
-> m (Maybe
        (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String))
analyzeFunction QualifiedName
_ = String
-> m (Maybe
        (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"analyzeFunction: is not supported by Sqlite"
  getMigrationPack :: m (MigrationPack Sqlite)
getMigrationPack = MigrationPack Sqlite -> m (MigrationPack Sqlite)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MigrationPack Sqlite
migrationPack

withSqlitePool ::
  (MonadBaseControl IO m, MonadIO m) =>
  -- | connection string
  String ->
  -- | number of connections to open
  Int ->
  (Pool Sqlite -> m a) ->
  m a
withSqlitePool :: String -> Int -> (Pool Sqlite -> m a) -> m a
withSqlitePool String
s Int
connCount Pool Sqlite -> m a
f = String -> Int -> m (Pool Sqlite)
forall (m :: * -> *). MonadIO m => String -> Int -> m (Pool Sqlite)
createSqlitePool String
s Int
connCount m (Pool Sqlite) -> (Pool Sqlite -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pool Sqlite -> m a
f

withSqliteConn ::
  (MonadBaseControl IO m, MonadIO m) =>
  -- | connection string
  String ->
  (Sqlite -> m a) ->
  m a
withSqliteConn :: String -> (Sqlite -> m a) -> m a
withSqliteConn String
s = m Sqlite -> (Sqlite -> m ()) -> (Sqlite -> m a) -> m a
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (IO Sqlite -> m Sqlite
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Sqlite -> m Sqlite) -> IO Sqlite -> m Sqlite
forall a b. (a -> b) -> a -> b
$ String -> IO Sqlite
open' String
s) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Sqlite -> IO ()) -> Sqlite -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sqlite -> IO ()
close')

createSqlitePool ::
  MonadIO m =>
  -- | connection string
  String ->
  -- | number of connections to open
  Int ->
  m (Pool Sqlite)
createSqlitePool :: String -> Int -> m (Pool Sqlite)
createSqlitePool String
s Int
connCount = IO (Pool Sqlite) -> m (Pool Sqlite)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Pool Sqlite) -> m (Pool Sqlite))
-> IO (Pool Sqlite) -> m (Pool Sqlite)
forall a b. (a -> b) -> a -> b
$ IO Sqlite
-> (Sqlite -> IO ())
-> Int
-> NominalDiffTime
-> Int
-> IO (Pool Sqlite)
forall a.
IO a
-> (a -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool a)
createPool (String -> IO Sqlite
open' String
s) Sqlite -> IO ()
close' Int
1 NominalDiffTime
20 Int
connCount

instance Savepoint Sqlite where
  withConnSavepoint :: String -> m a -> Sqlite -> m a
withConnSavepoint String
name m a
m (Sqlite Database
c IORef (HashMap ByteString Statement)
_) = do
    let name' :: Text
name' = String -> Text
forall a. IsString a => String -> a
fromString String
name
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Database -> Text -> IO ()
S.exec Database
c (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"SAVEPOINT " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name'
    a
x <- m a -> m () -> m a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
onException m a
m (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Database -> Text -> IO ()
S.exec Database
c (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"ROLLBACK TO " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name')
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Database -> Text -> IO ()
S.exec Database
c (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"RELEASE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name'
    a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

instance ConnectionManager Sqlite where
  withConn :: (Sqlite -> m a) -> Sqlite -> m a
withConn Sqlite -> m a
f conn :: Sqlite
conn@(Sqlite Database
c IORef (HashMap ByteString Statement)
_) = do
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Database -> Text -> IO ()
S.exec Database
c Text
"BEGIN"
    a
x <- m a -> m () -> m a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
onException (Sqlite -> m a
f Sqlite
conn) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Database -> Text -> IO ()
S.exec Database
c Text
"ROLLBACK")
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Database -> Text -> IO ()
S.exec Database
c Text
"COMMIT"
    a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

instance TryConnectionManager Sqlite where
  tryWithConn :: (Sqlite -> n a)
-> (n a -> m (Either SomeException a))
-> Sqlite
-> m (Either SomeException a)
tryWithConn Sqlite -> n a
f n a -> m (Either SomeException a)
g conn :: Sqlite
conn@(Sqlite Database
c IORef (HashMap ByteString Statement)
_) = do
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Database -> Text -> IO ()
S.exec Database
c Text
"BEGIN"
    Either SomeException a
x <- n a -> m (Either SomeException a)
g (Sqlite -> n a
f Sqlite
conn)
    case Either SomeException a
x of
      Left SomeException
_ -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Database -> Text -> IO ()
S.exec Database
c Text
"ROLLBACK"
      Right a
_ -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Database -> Text -> IO ()
S.exec Database
c Text
"COMMIT"
    Either SomeException a -> m (Either SomeException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
x

instance ExtractConnection Sqlite Sqlite where
  extractConn :: (Sqlite -> m a) -> Sqlite -> m a
extractConn Sqlite -> m a
f Sqlite
conn = Sqlite -> m a
f Sqlite
conn

instance ExtractConnection (Pool Sqlite) Sqlite where
  extractConn :: (Sqlite -> m a) -> Pool Sqlite -> m a
extractConn Sqlite -> m a
f Pool Sqlite
pconn = Pool Sqlite -> (Sqlite -> m a) -> m a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Pool a -> (a -> m b) -> m b
withResource Pool Sqlite
pconn Sqlite -> m a
f

open' :: String -> IO Sqlite
open' :: String -> IO Sqlite
open' String
s = do
  Database
conn <- Text -> IO Database
S.open (Text -> IO Database) -> Text -> IO Database
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
  Database -> Text -> IO Statement
S.prepare Database
conn Text
"PRAGMA foreign_keys = ON" IO Statement -> (Statement -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Statement
stmt -> Statement -> IO StepResult
S.step Statement
stmt IO StepResult -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Statement -> IO ()
S.finalize Statement
stmt
  IORef (HashMap ByteString Statement)
cache <- HashMap ByteString Statement
-> IO (IORef (HashMap ByteString Statement))
forall a. a -> IO (IORef a)
newIORef HashMap ByteString Statement
forall k v. HashMap k v
Map.empty
  Sqlite -> IO Sqlite
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sqlite -> IO Sqlite) -> Sqlite -> IO Sqlite
forall a b. (a -> b) -> a -> b
$ Database -> IORef (HashMap ByteString Statement) -> Sqlite
Sqlite Database
conn IORef (HashMap ByteString Statement)
cache

close' :: Sqlite -> IO ()
close' :: Sqlite -> IO ()
close' (Sqlite Database
conn IORef (HashMap ByteString Statement)
smap) = do
  IORef (HashMap ByteString Statement)
-> IO (HashMap ByteString Statement)
forall a. IORef a -> IO a
readIORef IORef (HashMap ByteString Statement)
smap IO (HashMap ByteString Statement)
-> (HashMap ByteString Statement -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Statement -> IO ()) -> [Statement] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Statement -> IO ()
S.finalize ([Statement] -> IO ())
-> (HashMap ByteString Statement -> [Statement])
-> HashMap ByteString Statement
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap ByteString Statement -> [Statement]
forall k v. HashMap k v -> [v]
Map.elems
  Database -> IO ()
S.close Database
conn

migrate' :: PersistEntity v => v -> Migration (Action Sqlite)
migrate' :: v -> StateT NamedMigrations (Action Sqlite) ()
migrate' = (String -> ReaderT Sqlite IO SingleMigration)
-> (EntityDef -> ReaderT Sqlite IO SingleMigration)
-> (DbType -> ReaderT Sqlite IO SingleMigration)
-> v
-> StateT NamedMigrations (Action Sqlite) ()
forall (m :: * -> *) v.
(PersistBackend m, PersistEntity v) =>
(String -> m SingleMigration)
-> (EntityDef -> m SingleMigration)
-> (DbType -> m SingleMigration)
-> v
-> Migration m
migrateRecursively (ReaderT Sqlite IO SingleMigration
-> String -> ReaderT Sqlite IO SingleMigration
forall a b. a -> b -> a
const (ReaderT Sqlite IO SingleMigration
 -> String -> ReaderT Sqlite IO SingleMigration)
-> ReaderT Sqlite IO SingleMigration
-> String
-> ReaderT Sqlite IO SingleMigration
forall a b. (a -> b) -> a -> b
$ SingleMigration -> ReaderT Sqlite IO SingleMigration
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SingleMigration -> ReaderT Sqlite IO SingleMigration)
-> SingleMigration -> ReaderT Sqlite IO SingleMigration
forall a b. (a -> b) -> a -> b
$ [(Bool, Int, String)] -> SingleMigration
forall a b. b -> Either a b
Right []) (MigrationPack Sqlite
-> EntityDef -> ReaderT Sqlite IO SingleMigration
forall conn.
(SchemaAnalyzer conn, PersistBackendConn conn) =>
MigrationPack conn -> EntityDef -> Action conn SingleMigration
migrateEntity MigrationPack Sqlite
migrationPack) (MigrationPack Sqlite -> DbType -> ReaderT Sqlite IO SingleMigration
forall conn.
(SchemaAnalyzer conn, PersistBackendConn conn) =>
MigrationPack conn -> DbType -> Action conn SingleMigration
migrateList MigrationPack Sqlite
migrationPack)

migrationPack :: GM.MigrationPack Sqlite
migrationPack :: MigrationPack Sqlite
migrationPack =
  (DbTypePrimitive -> DbTypePrimitive -> Bool)
-> ((Maybe String, Reference) -> (Maybe String, Reference) -> Bool)
-> (UniqueDefInfo -> UniqueDefInfo -> Bool)
-> (String -> String -> Bool)
-> (QualifiedName
    -> [(String, String)] -> Action Sqlite (Bool, [AlterDB]))
-> (QualifiedName
    -> [(String, String)] -> Action Sqlite [(Bool, [AlterDB])])
-> (EntityDef
    -> ConstructorDef -> Action Sqlite (Bool, SingleMigration))
-> (String -> String)
-> String
-> String
-> Int
-> ([UniqueDefInfo] -> [Reference] -> ([String], [AlterTable]))
-> (DbTypePrimitive -> String)
-> (Column -> String)
-> (AlterDB -> SingleMigration)
-> ReferenceActionType
-> ReferenceActionType
-> MigrationPack Sqlite
forall conn.
(DbTypePrimitive -> DbTypePrimitive -> Bool)
-> ((Maybe String, Reference) -> (Maybe String, Reference) -> Bool)
-> (UniqueDefInfo -> UniqueDefInfo -> Bool)
-> (String -> String -> Bool)
-> (QualifiedName
    -> [(String, String)] -> Action conn (Bool, [AlterDB]))
-> (QualifiedName
    -> [(String, String)] -> Action conn [(Bool, [AlterDB])])
-> (EntityDef
    -> ConstructorDef -> Action conn (Bool, SingleMigration))
-> (String -> String)
-> String
-> String
-> Int
-> ([UniqueDefInfo] -> [Reference] -> ([String], [AlterTable]))
-> (DbTypePrimitive -> String)
-> (Column -> String)
-> (AlterDB -> SingleMigration)
-> ReferenceActionType
-> ReferenceActionType
-> MigrationPack conn
GM.MigrationPack
    DbTypePrimitive -> DbTypePrimitive -> Bool
compareTypes
    (Maybe String, Reference) -> (Maybe String, Reference) -> Bool
compareRefs
    UniqueDefInfo -> UniqueDefInfo -> Bool
compareUniqs
    String -> String -> Bool
compareDefaults
    QualifiedName
-> [(String, String)] -> Action Sqlite (Bool, [AlterDB])
migTriggerOnDelete
    QualifiedName
-> [(String, String)] -> Action Sqlite [(Bool, [AlterDB])]
migTriggerOnUpdate
    (MigrationPack Sqlite
-> EntityDef
-> ConstructorDef
-> Action Sqlite (Bool, SingleMigration)
forall conn.
(SchemaAnalyzer conn, PersistBackendConn conn) =>
MigrationPack conn
-> EntityDef
-> ConstructorDef
-> Action conn (Bool, SingleMigration)
GM.defaultMigConstr MigrationPack Sqlite
migrationPack)
    String -> String
escape
    String
"INTEGER PRIMARY KEY NOT NULL"
    String
mainTableId
    Int
defaultPriority
    [UniqueDefInfo] -> [Reference] -> ([String], [AlterTable])
addUniquesReferences
    DbTypePrimitive -> String
showSqlType
    Column -> String
showColumn
    AlterDB -> SingleMigration
showAlterDb
    ReferenceActionType
NoAction
    ReferenceActionType
NoAction

addUniquesReferences :: [UniqueDefInfo] -> [Reference] -> ([String], [AlterTable])
addUniquesReferences :: [UniqueDefInfo] -> [Reference] -> ([String], [AlterTable])
addUniquesReferences [UniqueDefInfo]
uniques [Reference]
refs = ((UniqueDefInfo -> String) -> [UniqueDefInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map UniqueDefInfo -> String
sqlUnique [UniqueDefInfo]
constraints [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Reference -> String) -> [Reference] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Reference -> String
sqlReference [Reference]
refs, (UniqueDefInfo -> AlterTable) -> [UniqueDefInfo] -> [AlterTable]
forall a b. (a -> b) -> [a] -> [b]
map UniqueDefInfo -> AlterTable
AddUnique [UniqueDefInfo]
indexes)
  where
    ([UniqueDefInfo]
constraints, [UniqueDefInfo]
indexes) = (UniqueDefInfo -> Bool)
-> [UniqueDefInfo] -> ([UniqueDefInfo], [UniqueDefInfo])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((UniqueType -> UniqueType -> Bool
forall a. Eq a => a -> a -> Bool
/= UniqueType
UniqueIndex) (UniqueType -> Bool)
-> (UniqueDefInfo -> UniqueType) -> UniqueDefInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqueDefInfo -> UniqueType
forall str field. UniqueDef' str field -> UniqueType
uniqueDefType) [UniqueDefInfo]
uniques

migTriggerOnDelete :: QualifiedName -> [(String, String)] -> Action Sqlite (Bool, [AlterDB])
migTriggerOnDelete :: QualifiedName
-> [(String, String)] -> Action Sqlite (Bool, [AlterDB])
migTriggerOnDelete QualifiedName
qualifiedName [(String, String)]
deletes = do
  let addTrigger :: AlterDB
addTrigger = QualifiedName -> QualifiedName -> String -> AlterDB
AddTriggerOnDelete QualifiedName
qualifiedName QualifiedName
qualifiedName (((String, String) -> String) -> [(String, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> String
forall a b. (a, b) -> b
snd [(String, String)]
deletes)
  Maybe String
x <- QualifiedName -> ReaderT Sqlite IO (Maybe String)
forall conn (m :: * -> *).
(SchemaAnalyzer conn, PersistBackend m, Conn m ~ conn) =>
QualifiedName -> m (Maybe String)
analyzeTrigger QualifiedName
qualifiedName
  (Bool, [AlterDB]) -> Action Sqlite (Bool, [AlterDB])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Bool, [AlterDB]) -> Action Sqlite (Bool, [AlterDB]))
-> (Bool, [AlterDB]) -> Action Sqlite (Bool, [AlterDB])
forall a b. (a -> b) -> a -> b
$ case Maybe String
x of
    Maybe String
Nothing | [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
deletes -> (Bool
False, [])
    Maybe String
Nothing -> (Bool
False, [AlterDB
addTrigger])
    Just String
sql ->
      ( Bool
True,
        if [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
deletes -- remove old trigger if a datatype earlier had fields of ephemeral types
          then [QualifiedName -> QualifiedName -> AlterDB
DropTrigger QualifiedName
qualifiedName QualifiedName
qualifiedName]
          else
            if [(Bool, Int, String)] -> SingleMigration
forall a b. b -> Either a b
Right [(Bool
False, Int
triggerPriority, String
sql)] SingleMigration -> SingleMigration -> Bool
forall a. Eq a => a -> a -> Bool
== AlterDB -> SingleMigration
showAlterDb AlterDB
addTrigger
              then []
              else -- this can happen when an ephemeral field was added or removed.
                [QualifiedName -> QualifiedName -> AlterDB
DropTrigger QualifiedName
qualifiedName QualifiedName
qualifiedName, AlterDB
addTrigger]
      )

-- | Schema name, table name and a list of field names and according delete statements
-- assume that this function is called only for ephemeral fields
migTriggerOnUpdate :: QualifiedName -> [(String, String)] -> Action Sqlite [(Bool, [AlterDB])]
migTriggerOnUpdate :: QualifiedName
-> [(String, String)] -> Action Sqlite [(Bool, [AlterDB])]
migTriggerOnUpdate QualifiedName
name [(String, String)]
dels = [(String, String)]
-> ((String, String) -> Action Sqlite (Bool, [AlterDB]))
-> Action Sqlite [(Bool, [AlterDB])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(String, String)]
dels (((String, String) -> Action Sqlite (Bool, [AlterDB]))
 -> Action Sqlite [(Bool, [AlterDB])])
-> ((String, String) -> Action Sqlite (Bool, [AlterDB]))
-> Action Sqlite [(Bool, [AlterDB])]
forall a b. (a -> b) -> a -> b
$ \(String
fieldName, String
del) -> do
  let trigName :: QualifiedName
trigName = (Maybe String
forall a. Maybe a
Nothing, QualifiedName -> String
forall a b. (a, b) -> b
snd QualifiedName
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: String
fieldName)
  let addTrigger :: AlterDB
addTrigger = QualifiedName -> QualifiedName -> Maybe String -> String -> AlterDB
AddTriggerOnUpdate QualifiedName
trigName QualifiedName
name (String -> Maybe String
forall a. a -> Maybe a
Just String
fieldName) String
del
  Maybe String
x <- QualifiedName -> ReaderT Sqlite IO (Maybe String)
forall conn (m :: * -> *).
(SchemaAnalyzer conn, PersistBackend m, Conn m ~ conn) =>
QualifiedName -> m (Maybe String)
analyzeTrigger QualifiedName
trigName
  (Bool, [AlterDB]) -> Action Sqlite (Bool, [AlterDB])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Bool, [AlterDB]) -> Action Sqlite (Bool, [AlterDB]))
-> (Bool, [AlterDB]) -> Action Sqlite (Bool, [AlterDB])
forall a b. (a -> b) -> a -> b
$ case Maybe String
x of
    Maybe String
Nothing -> (Bool
False, [AlterDB
addTrigger])
    Just String
sql ->
      ( Bool
True,
        if [(Bool, Int, String)] -> SingleMigration
forall a b. b -> Either a b
Right [(Bool
False, Int
triggerPriority, String
sql)] SingleMigration -> SingleMigration -> Bool
forall a. Eq a => a -> a -> Bool
== AlterDB -> SingleMigration
showAlterDb AlterDB
addTrigger
          then []
          else [QualifiedName -> QualifiedName -> AlterDB
DropTrigger QualifiedName
trigName QualifiedName
name, AlterDB
addTrigger]
      )

analyzeTable' :: QualifiedName -> Action Sqlite (Maybe TableInfo)
analyzeTable' :: QualifiedName -> ReaderT Sqlite IO (Maybe TableInfo)
analyzeTable' (Maybe String
Nothing, String
tName) = do
  let fromName :: String -> Utf8
fromName = Utf8 -> Utf8
escapeS (Utf8 -> Utf8) -> (String -> Utf8) -> String -> Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Utf8
forall a. IsString a => String -> a
fromString
  [(Int, (String, String, Int, Maybe String, Int))]
tableInfo <- Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRaw' (Utf8
"pragma table_info(" Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> String -> Utf8
fromName String
tName Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
")") [] Action Sqlite (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT
         Sqlite
         IO
         (RowStream (Int, (String, String, Int, Maybe String, Int))))
-> ReaderT
     Sqlite
     IO
     (RowStream (Int, (String, String, Int, Maybe String, Int)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue]
 -> Action Sqlite (Int, (String, String, Int, Maybe String, Int)))
-> RowStream [PersistValue]
-> ReaderT
     Sqlite
     IO
     (RowStream (Int, (String, String, Int, Maybe String, Int)))
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream ((Int, (String, String, Int, Maybe String, Int))
-> Action Sqlite (Int, (String, String, Int, Maybe String, Int))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int, (String, String, Int, Maybe String, Int))
 -> Action Sqlite (Int, (String, String, Int, Maybe String, Int)))
-> ([PersistValue]
    -> (Int, (String, String, Int, Maybe String, Int)))
-> [PersistValue]
-> Action Sqlite (Int, (String, String, Int, Maybe String, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, (String, String, Int, Maybe String, Int)), [PersistValue])
-> (Int, (String, String, Int, Maybe String, Int))
forall a b. (a, b) -> a
fst (((Int, (String, String, Int, Maybe String, Int)), [PersistValue])
 -> (Int, (String, String, Int, Maybe String, Int)))
-> ([PersistValue]
    -> ((Int, (String, String, Int, Maybe String, Int)),
        [PersistValue]))
-> [PersistValue]
-> (Int, (String, String, Int, Maybe String, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> ((Int, (String, String, Int, Maybe String, Int)),
    [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues) ReaderT
  Sqlite
  IO
  (RowStream (Int, (String, String, Int, Maybe String, Int)))
-> (RowStream (Int, (String, String, Int, Maybe String, Int))
    -> ReaderT
         Sqlite IO [(Int, (String, String, Int, Maybe String, Int))])
-> ReaderT
     Sqlite IO [(Int, (String, String, Int, Maybe String, Int))]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream (Int, (String, String, Int, Maybe String, Int))
-> ReaderT
     Sqlite IO [(Int, (String, String, Int, Maybe String, Int))]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
  case [(Int, (String, String, Int, Maybe String, Int))]
tableInfo of
    [] -> Maybe TableInfo -> ReaderT Sqlite IO (Maybe TableInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TableInfo
forall a. Maybe a
Nothing
    [(Int, (String, String, Int, Maybe String, Int))]
rawColumns -> do
      let mkColumn :: (Int, (String, String, Int, Maybe String, Int)) -> Column
          mkColumn :: (Int, (String, String, Int, Maybe String, Int)) -> Column
mkColumn (Int
_, (String
name, String
typ, Int
isNotNull, Maybe String
defaultValue, Int
_)) = String -> Bool -> DbTypePrimitive -> Maybe String -> Column
Column String
name (Int
isNotNull Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (String -> DbTypePrimitive
readSqlType String
typ) Maybe String
defaultValue
          primaryKeyColumnNames :: [String]
primaryKeyColumnNames = ((Int, (String, String, Int, Maybe String, Int))
 -> [String] -> [String])
-> [String]
-> [(Int, (String, String, Int, Maybe String, Int))]
-> [String]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
_, (String
name, String
_, Int
_, Maybe String
_, Int
primaryIndex)) [String]
xs -> if Int
primaryIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then String
name String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs else [String]
xs) [] [(Int, (String, String, Int, Maybe String, Int))]
rawColumns
          columns :: [Column]
columns = ((Int, (String, String, Int, Maybe String, Int)) -> Column)
-> [(Int, (String, String, Int, Maybe String, Int))] -> [Column]
forall a b. (a -> b) -> [a] -> [b]
map (Int, (String, String, Int, Maybe String, Int)) -> Column
mkColumn [(Int, (String, String, Int, Maybe String, Int))]
rawColumns
      [(Int, String, Bool)]
indexList <- Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRaw' (Utf8
"pragma index_list(" Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> String -> Utf8
fromName String
tName Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
")") [] Action Sqlite (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Sqlite IO (RowStream (Int, String, Bool)))
-> ReaderT Sqlite IO (RowStream (Int, String, Bool))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action Sqlite (Int, String, Bool))
-> RowStream [PersistValue]
-> ReaderT Sqlite IO (RowStream (Int, String, Bool))
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream ((Int, String, Bool) -> Action Sqlite (Int, String, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int, String, Bool) -> Action Sqlite (Int, String, Bool))
-> ([PersistValue] -> (Int, String, Bool))
-> [PersistValue]
-> Action Sqlite (Int, String, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, String, Bool), [PersistValue]) -> (Int, String, Bool)
forall a b. (a, b) -> a
fst (((Int, String, Bool), [PersistValue]) -> (Int, String, Bool))
-> ([PersistValue] -> ((Int, String, Bool), [PersistValue]))
-> [PersistValue]
-> (Int, String, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> ((Int, String, Bool), [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues) ReaderT Sqlite IO (RowStream (Int, String, Bool))
-> (RowStream (Int, String, Bool)
    -> ReaderT Sqlite IO [(Int, String, Bool)])
-> ReaderT Sqlite IO [(Int, String, Bool)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream (Int, String, Bool)
-> ReaderT Sqlite IO [(Int, String, Bool)]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
      let uniqueNames :: [String]
uniqueNames = ((Int, String, Bool) -> String)
-> [(Int, String, Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_ :: Int, String
name, Bool
_) -> String
name) ([(Int, String, Bool)] -> [String])
-> [(Int, String, Bool)] -> [String]
forall a b. (a -> b) -> a -> b
$ ((Int, String, Bool) -> Bool)
-> [(Int, String, Bool)] -> [(Int, String, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
_, String
_, Bool
isUnique) -> Bool
isUnique) [(Int, String, Bool)]
indexList
      [UniqueDefInfo]
uniques <- [String]
-> (String -> ReaderT Sqlite IO UniqueDefInfo)
-> ReaderT Sqlite IO [UniqueDefInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
uniqueNames ((String -> ReaderT Sqlite IO UniqueDefInfo)
 -> ReaderT Sqlite IO [UniqueDefInfo])
-> (String -> ReaderT Sqlite IO UniqueDefInfo)
-> ReaderT Sqlite IO [UniqueDefInfo]
forall a b. (a -> b) -> a -> b
$ \String
name -> do
        [(Int, Int, String)]
uFields <- Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRaw' (Utf8
"pragma index_info(" Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> String -> Utf8
fromName String
name Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
")") [] Action Sqlite (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Sqlite IO (RowStream (Int, Int, String)))
-> ReaderT Sqlite IO (RowStream (Int, Int, String))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action Sqlite (Int, Int, String))
-> RowStream [PersistValue]
-> ReaderT Sqlite IO (RowStream (Int, Int, String))
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream ((Int, Int, String) -> Action Sqlite (Int, Int, String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int, Int, String) -> Action Sqlite (Int, Int, String))
-> ([PersistValue] -> (Int, Int, String))
-> [PersistValue]
-> Action Sqlite (Int, Int, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int, String), [PersistValue]) -> (Int, Int, String)
forall a b. (a, b) -> a
fst (((Int, Int, String), [PersistValue]) -> (Int, Int, String))
-> ([PersistValue] -> ((Int, Int, String), [PersistValue]))
-> [PersistValue]
-> (Int, Int, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> ((Int, Int, String), [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues) ReaderT Sqlite IO (RowStream (Int, Int, String))
-> (RowStream (Int, Int, String)
    -> ReaderT Sqlite IO [(Int, Int, String)])
-> ReaderT Sqlite IO [(Int, Int, String)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream (Int, Int, String)
-> ReaderT Sqlite IO [(Int, Int, String)]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
        Maybe [PersistValue]
sql <- Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRaw' Utf8
"select sql from sqlite_master where type = 'index' and name = ?" [String -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue String
name] Action Sqlite (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Sqlite IO (Maybe [PersistValue]))
-> ReaderT Sqlite IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue]
-> ReaderT Sqlite IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow
        let columnNames :: [String]
columnNames = ((Int, Int, String) -> String) -> [(Int, Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_, Int
_, String
columnName) -> String
columnName) ([(Int, Int, String)]
uFields :: [(Int, Int, String)])
            uType :: UniqueType
uType =
              if Maybe [PersistValue]
sql Maybe [PersistValue] -> Maybe [PersistValue] -> Bool
forall a. Eq a => a -> a -> Bool
== [PersistValue] -> Maybe [PersistValue]
forall a. a -> Maybe a
Just [PersistValue
PersistNull]
                then if [String] -> [String]
forall a. Ord a => [a] -> [a]
sort [String]
columnNames [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> [String]
forall a. Ord a => [a] -> [a]
sort [String]
primaryKeyColumnNames then Bool -> UniqueType
UniquePrimary Bool
False else UniqueType
UniqueConstraint
                else UniqueType
UniqueIndex
        UniqueDefInfo -> ReaderT Sqlite IO UniqueDefInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UniqueDefInfo -> ReaderT Sqlite IO UniqueDefInfo)
-> UniqueDefInfo -> ReaderT Sqlite IO UniqueDefInfo
forall a b. (a -> b) -> a -> b
$ Maybe String
-> UniqueType -> [Either String String] -> UniqueDefInfo
forall str field.
Maybe str -> UniqueType -> [field] -> UniqueDef' str field
UniqueDef (String -> Maybe String
forall a. a -> Maybe a
Just String
name) UniqueType
uType ((String -> Either String String)
-> [String] -> [Either String String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Either String String
forall a b. a -> Either a b
Left [String]
columnNames)
      [(Int,
  (Int, String, (String, Maybe String), (String, String, String)))]
foreignKeyList <- Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRaw' (Utf8
"pragma foreign_key_list(" Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> String -> Utf8
fromName String
tName Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
")") [] Action Sqlite (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT
         Sqlite
         IO
         (RowStream
            (Int,
             (Int, String, (String, Maybe String), (String, String, String)))))
-> ReaderT
     Sqlite
     IO
     (RowStream
        (Int,
         (Int, String, (String, Maybe String), (String, String, String))))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue]
 -> Action
      Sqlite
      (Int,
       (Int, String, (String, Maybe String), (String, String, String))))
-> RowStream [PersistValue]
-> ReaderT
     Sqlite
     IO
     (RowStream
        (Int,
         (Int, String, (String, Maybe String), (String, String, String))))
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream ((Int,
 (Int, String, (String, Maybe String), (String, String, String)))
-> Action
     Sqlite
     (Int,
      (Int, String, (String, Maybe String), (String, String, String)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int,
  (Int, String, (String, Maybe String), (String, String, String)))
 -> Action
      Sqlite
      (Int,
       (Int, String, (String, Maybe String), (String, String, String))))
-> ([PersistValue]
    -> (Int,
        (Int, String, (String, Maybe String), (String, String, String))))
-> [PersistValue]
-> Action
     Sqlite
     (Int,
      (Int, String, (String, Maybe String), (String, String, String)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int,
  (Int, String, (String, Maybe String), (String, String, String))),
 [PersistValue])
-> (Int,
    (Int, String, (String, Maybe String), (String, String, String)))
forall a b. (a, b) -> a
fst (((Int,
   (Int, String, (String, Maybe String), (String, String, String))),
  [PersistValue])
 -> (Int,
     (Int, String, (String, Maybe String), (String, String, String))))
-> ([PersistValue]
    -> ((Int,
         (Int, String, (String, Maybe String), (String, String, String))),
        [PersistValue]))
-> [PersistValue]
-> (Int,
    (Int, String, (String, Maybe String), (String, String, String)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> ((Int,
     (Int, String, (String, Maybe String), (String, String, String))),
    [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues) ReaderT
  Sqlite
  IO
  (RowStream
     (Int,
      (Int, String, (String, Maybe String), (String, String, String))))
-> (RowStream
      (Int,
       (Int, String, (String, Maybe String), (String, String, String)))
    -> ReaderT
         Sqlite
         IO
         [(Int,
           (Int, String, (String, Maybe String), (String, String, String)))])
-> ReaderT
     Sqlite
     IO
     [(Int,
       (Int, String, (String, Maybe String), (String, String, String)))]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream
  (Int,
   (Int, String, (String, Maybe String), (String, String, String)))
-> ReaderT
     Sqlite
     IO
     [(Int,
       (Int, String, (String, Maybe String), (String, String, String)))]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
      ([(Maybe String, Reference)]
foreigns :: [(Maybe String, Reference)]) <- do
        let foreigns :: [[(Int, (Int, String, (String, Maybe String), (String, String, String)))]]
            foreigns :: [[(Int,
   (Int, String, (String, Maybe String), (String, String, String)))]]
foreigns = ((Int,
  (Int, String, (String, Maybe String), (String, String, String)))
 -> (Int,
     (Int, String, (String, Maybe String), (String, String, String)))
 -> Bool)
-> [(Int,
     (Int, String, (String, Maybe String), (String, String, String)))]
-> [[(Int,
      (Int, String, (String, Maybe String), (String, String, String)))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> ((Int,
     (Int, String, (String, Maybe String), (String, String, String)))
    -> Int)
-> (Int,
    (Int, String, (String, Maybe String), (String, String, String)))
-> (Int,
    (Int, String, (String, Maybe String), (String, String, String)))
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int,
 (Int, String, (String, Maybe String), (String, String, String)))
-> Int
forall a b. (a, b) -> a
fst) ([(Int,
   (Int, String, (String, Maybe String), (String, String, String)))]
 -> [[(Int,
       (Int, String, (String, Maybe String), (String, String, String)))]])
-> ([(Int,
      (Int, String, (String, Maybe String), (String, String, String)))]
    -> [(Int,
         (Int, String, (String, Maybe String), (String, String, String)))])
-> [(Int,
     (Int, String, (String, Maybe String), (String, String, String)))]
-> [[(Int,
      (Int, String, (String, Maybe String), (String, String, String)))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int,
  (Int, String, (String, Maybe String), (String, String, String)))]
-> [(Int,
     (Int, String, (String, Maybe String), (String, String, String)))]
forall a. Ord a => [a] -> [a]
sort ([(Int,
   (Int, String, (String, Maybe String), (String, String, String)))]
 -> [[(Int,
       (Int, String, (String, Maybe String), (String, String, String)))]])
-> [(Int,
     (Int, String, (String, Maybe String), (String, String, String)))]
-> [[(Int,
      (Int, String, (String, Maybe String), (String, String, String)))]]
forall a b. (a -> b) -> a -> b
$ [(Int,
  (Int, String, (String, Maybe String), (String, String, String)))]
foreignKeyList -- sort by foreign key number and column number inside key (first and second integers)
            mkAction :: String -> Maybe ReferenceActionType
mkAction String
c = ReferenceActionType -> Maybe ReferenceActionType
forall a. a -> Maybe a
Just (ReferenceActionType -> Maybe ReferenceActionType)
-> ReferenceActionType -> Maybe ReferenceActionType
forall a b. (a -> b) -> a -> b
$ ReferenceActionType
-> Maybe ReferenceActionType -> ReferenceActionType
forall a. a -> Maybe a -> a
fromMaybe (String -> ReferenceActionType
forall a. HasCallStack => String -> a
error (String -> ReferenceActionType) -> String -> ReferenceActionType
forall a b. (a -> b) -> a -> b
$ String
"unknown reference action type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c) (Maybe ReferenceActionType -> ReferenceActionType)
-> Maybe ReferenceActionType -> ReferenceActionType
forall a b. (a -> b) -> a -> b
$ String -> Maybe ReferenceActionType
readReferenceAction String
c
        [[(Int,
   (Int, String, (String, Maybe String), (String, String, String)))]]
-> ([(Int,
      (Int, String, (String, Maybe String), (String, String, String)))]
    -> ReaderT Sqlite IO (Maybe String, Reference))
-> ReaderT Sqlite IO [(Maybe String, Reference)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[(Int,
   (Int, String, (String, Maybe String), (String, String, String)))]]
foreigns (([(Int,
    (Int, String, (String, Maybe String), (String, String, String)))]
  -> ReaderT Sqlite IO (Maybe String, Reference))
 -> ReaderT Sqlite IO [(Maybe String, Reference)])
-> ([(Int,
      (Int, String, (String, Maybe String), (String, String, String)))]
    -> ReaderT Sqlite IO (Maybe String, Reference))
-> ReaderT Sqlite IO [(Maybe String, Reference)]
forall a b. (a -> b) -> a -> b
$ \[(Int,
  (Int, String, (String, Maybe String), (String, String, String)))]
rows -> do
          let (Int
_, (Int
_, String
foreignTable, (String, Maybe String)
_, (String
onUpdate, String
onDelete, String
_))) = [(Int,
  (Int, String, (String, Maybe String), (String, String, String)))]
-> (Int,
    (Int, String, (String, Maybe String), (String, String, String)))
forall a. [a] -> a
head [(Int,
  (Int, String, (String, Maybe String), (String, String, String)))]
rows
              ([String]
children, [Maybe String]
parents) = [(String, Maybe String)] -> ([String], [Maybe String])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(String, Maybe String)] -> ([String], [Maybe String]))
-> [(String, Maybe String)] -> ([String], [Maybe String])
forall a b. (a -> b) -> a -> b
$ ((Int,
  (Int, String, (String, Maybe String), (String, String, String)))
 -> (String, Maybe String))
-> [(Int,
     (Int, String, (String, Maybe String), (String, String, String)))]
-> [(String, Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_, (Int
_, String
_, (String, Maybe String)
pair, (String, String, String)
_)) -> (String, Maybe String)
pair) [(Int,
  (Int, String, (String, Maybe String), (String, String, String)))]
rows
          [String]
parents' <- case [Maybe String] -> Maybe String
forall a. [a] -> a
head [Maybe String]
parents of
            Maybe String
Nothing ->
              String -> Action Sqlite (Maybe [String])
analyzePrimaryKey String
foreignTable Action Sqlite (Maybe [String])
-> (Maybe [String] -> ReaderT Sqlite IO [String])
-> ReaderT Sqlite IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just [String]
primaryCols -> [String] -> ReaderT Sqlite IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
primaryCols
                Maybe [String]
Nothing -> String -> ReaderT Sqlite IO [String]
forall a. HasCallStack => String -> a
error (String -> ReaderT Sqlite IO [String])
-> String -> ReaderT Sqlite IO [String]
forall a b. (a -> b) -> a -> b
$ String
"analyzeTable: cannot find primary key for table " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
foreignTable String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" which is referenced without specifying column names"
            Just String
_ -> [String] -> ReaderT Sqlite IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> ReaderT Sqlite IO [String])
-> [String] -> ReaderT Sqlite IO [String]
forall a b. (a -> b) -> a -> b
$ (Maybe String -> String) -> [Maybe String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> String
forall a. HasCallStack => String -> a
error String
"analyzeTable: all parents must be either NULL or values")) [Maybe String]
parents
          let refs :: [(String, String)]
refs = [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
children [String]
parents'
          (Maybe String, Reference)
-> ReaderT Sqlite IO (Maybe String, Reference)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String
forall a. Maybe a
Nothing, QualifiedName
-> [(String, String)]
-> Maybe ReferenceActionType
-> Maybe ReferenceActionType
-> Reference
Reference (Maybe String
forall a. Maybe a
Nothing, String
foreignTable) [(String, String)]
refs (String -> Maybe ReferenceActionType
mkAction String
onDelete) (String -> Maybe ReferenceActionType
mkAction String
onUpdate))
      let notPrimary :: UniqueType -> Bool
notPrimary UniqueType
x = case UniqueType
x of
            UniquePrimary Bool
_ -> Bool
False
            UniqueType
_ -> Bool
True
          uniques' :: [UniqueDefInfo]
uniques' =
            [UniqueDefInfo]
uniques
              [UniqueDefInfo] -> [UniqueDefInfo] -> [UniqueDefInfo]
forall a. [a] -> [a] -> [a]
++ if (UniqueDefInfo -> Bool) -> [UniqueDefInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (UniqueType -> Bool
notPrimary (UniqueType -> Bool)
-> (UniqueDefInfo -> UniqueType) -> UniqueDefInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqueDefInfo -> UniqueType
forall str field. UniqueDef' str field -> UniqueType
uniqueDefType) [UniqueDefInfo]
uniques Bool -> Bool -> Bool
&& Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
primaryKeyColumnNames)
                then [Maybe String
-> UniqueType -> [Either String String] -> UniqueDefInfo
forall str field.
Maybe str -> UniqueType -> [field] -> UniqueDef' str field
UniqueDef Maybe String
forall a. Maybe a
Nothing (Bool -> UniqueType
UniquePrimary Bool
True) ((String -> Either String String)
-> [String] -> [Either String String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Either String String
forall a b. a -> Either a b
Left [String]
primaryKeyColumnNames)]
                else []
      Maybe TableInfo -> ReaderT Sqlite IO (Maybe TableInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TableInfo -> ReaderT Sqlite IO (Maybe TableInfo))
-> Maybe TableInfo -> ReaderT Sqlite IO (Maybe TableInfo)
forall a b. (a -> b) -> a -> b
$ TableInfo -> Maybe TableInfo
forall a. a -> Maybe a
Just (TableInfo -> Maybe TableInfo) -> TableInfo -> Maybe TableInfo
forall a b. (a -> b) -> a -> b
$ [Column]
-> [UniqueDefInfo] -> [(Maybe String, Reference)] -> TableInfo
TableInfo [Column]
columns [UniqueDefInfo]
uniques' [(Maybe String, Reference)]
foreigns
analyzeTable' (Maybe String
sch, String
_) = String -> ReaderT Sqlite IO (Maybe TableInfo)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReaderT Sqlite IO (Maybe TableInfo))
-> String -> ReaderT Sqlite IO (Maybe TableInfo)
forall a b. (a -> b) -> a -> b
$ String
"analyzeTable: schemas are not supported by Sqlite: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
sch

analyzePrimaryKey :: String -> Action Sqlite (Maybe [String])
analyzePrimaryKey :: String -> Action Sqlite (Maybe [String])
analyzePrimaryKey String
tName = do
  [(Int, (String, String, Int, Maybe String, Int))]
tableInfo <- Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRaw' (Utf8
"pragma table_info(" Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8 -> Utf8
escapeS (String -> Utf8
forall a. IsString a => String -> a
fromString String
tName) Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
")") [] Action Sqlite (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT
         Sqlite
         IO
         (RowStream (Int, (String, String, Int, Maybe String, Int))))
-> ReaderT
     Sqlite
     IO
     (RowStream (Int, (String, String, Int, Maybe String, Int)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue]
 -> Action Sqlite (Int, (String, String, Int, Maybe String, Int)))
-> RowStream [PersistValue]
-> ReaderT
     Sqlite
     IO
     (RowStream (Int, (String, String, Int, Maybe String, Int)))
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream ((Int, (String, String, Int, Maybe String, Int))
-> Action Sqlite (Int, (String, String, Int, Maybe String, Int))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int, (String, String, Int, Maybe String, Int))
 -> Action Sqlite (Int, (String, String, Int, Maybe String, Int)))
-> ([PersistValue]
    -> (Int, (String, String, Int, Maybe String, Int)))
-> [PersistValue]
-> Action Sqlite (Int, (String, String, Int, Maybe String, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, (String, String, Int, Maybe String, Int)), [PersistValue])
-> (Int, (String, String, Int, Maybe String, Int))
forall a b. (a, b) -> a
fst (((Int, (String, String, Int, Maybe String, Int)), [PersistValue])
 -> (Int, (String, String, Int, Maybe String, Int)))
-> ([PersistValue]
    -> ((Int, (String, String, Int, Maybe String, Int)),
        [PersistValue]))
-> [PersistValue]
-> (Int, (String, String, Int, Maybe String, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> ((Int, (String, String, Int, Maybe String, Int)),
    [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues) ReaderT
  Sqlite
  IO
  (RowStream (Int, (String, String, Int, Maybe String, Int)))
-> (RowStream (Int, (String, String, Int, Maybe String, Int))
    -> ReaderT
         Sqlite IO [(Int, (String, String, Int, Maybe String, Int))])
-> ReaderT
     Sqlite IO [(Int, (String, String, Int, Maybe String, Int))]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream (Int, (String, String, Int, Maybe String, Int))
-> ReaderT
     Sqlite IO [(Int, (String, String, Int, Maybe String, Int))]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
  let cols :: [(Int, String)]
cols = ((Int, (String, String, Int, Maybe String, Int)) -> (Int, String))
-> [(Int, (String, String, Int, Maybe String, Int))]
-> [(Int, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_, (String
name, String
_, Int
_, Maybe String
_, Int
primaryIndex)) -> (Int
primaryIndex, String
name)) ([(Int, (String, String, Int, Maybe String, Int))]
tableInfo :: [(Int, (String, String, Int, Maybe String, Int))])
      cols' :: [String]
cols' = ((Int, String) -> String) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> String
forall a b. (a, b) -> b
snd ([(Int, String)] -> [String]) -> [(Int, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ [(Int, String)] -> [(Int, String)]
forall a. Ord a => [a] -> [a]
sort ([(Int, String)] -> [(Int, String)])
-> [(Int, String)] -> [(Int, String)]
forall a b. (a -> b) -> a -> b
$ ((Int, String) -> Bool) -> [(Int, String)] -> [(Int, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> Bool) -> ((Int, String) -> Int) -> (Int, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, String) -> Int
forall a b. (a, b) -> a
fst) [(Int, String)]
cols
  Maybe [String] -> Action Sqlite (Maybe [String])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [String] -> Action Sqlite (Maybe [String]))
-> Maybe [String] -> Action Sqlite (Maybe [String])
forall a b. (a -> b) -> a -> b
$
    if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cols'
      then Maybe [String]
forall a. Maybe a
Nothing
      else [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
cols'

getStatementCached :: Utf8 -> Action Sqlite S.Statement
getStatementCached :: Utf8 -> Action Sqlite Statement
getStatementCached Utf8
sql = do
  Sqlite Database
conn IORef (HashMap ByteString Statement)
smap <- ReaderT Sqlite IO Sqlite
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  IO Statement -> Action Sqlite Statement
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Statement -> Action Sqlite Statement)
-> IO Statement -> Action Sqlite Statement
forall a b. (a -> b) -> a -> b
$ do
    HashMap ByteString Statement
smap' <- IORef (HashMap ByteString Statement)
-> IO (HashMap ByteString Statement)
forall a. IORef a -> IO a
readIORef IORef (HashMap ByteString Statement)
smap
    let sql' :: ByteString
sql' = Utf8 -> ByteString
fromUtf8 Utf8
sql
    case ByteString -> HashMap ByteString Statement -> Maybe Statement
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup ByteString
sql' HashMap ByteString Statement
smap' of
      Maybe Statement
Nothing -> do
        Statement
stmt <- Database -> Utf8 -> IO Statement
S.prepareUtf8 Database
conn (Utf8 -> IO Statement) -> Utf8 -> IO Statement
forall a b. (a -> b) -> a -> b
$ ByteString -> Utf8
SD.Utf8 ByteString
sql'
        IORef (HashMap ByteString Statement)
-> HashMap ByteString Statement -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (HashMap ByteString Statement)
smap (ByteString
-> Statement
-> HashMap ByteString Statement
-> HashMap ByteString Statement
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
Map.insert ByteString
sql' Statement
stmt HashMap ByteString Statement
smap')
        Statement -> IO Statement
forall (f :: * -> *) a. Applicative f => a -> f a
pure Statement
stmt
      Just Statement
stmt -> Statement -> IO Statement
forall (f :: * -> *) a. Applicative f => a -> f a
pure Statement
stmt

getStatement :: Utf8 -> Action Sqlite S.Statement
getStatement :: Utf8 -> Action Sqlite Statement
getStatement Utf8
sql = do
  Sqlite Database
conn IORef (HashMap ByteString Statement)
_ <- ReaderT Sqlite IO Sqlite
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  IO Statement -> Action Sqlite Statement
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Statement -> Action Sqlite Statement)
-> IO Statement -> Action Sqlite Statement
forall a b. (a -> b) -> a -> b
$ Database -> Utf8 -> IO Statement
S.prepareUtf8 Database
conn (Utf8 -> IO Statement) -> Utf8 -> IO Statement
forall a b. (a -> b) -> a -> b
$ ByteString -> Utf8
SD.Utf8 (ByteString -> Utf8) -> ByteString -> Utf8
forall a b. (a -> b) -> a -> b
$ Utf8 -> ByteString
fromUtf8 Utf8
sql

showSqlType :: DbTypePrimitive -> String
showSqlType :: DbTypePrimitive -> String
showSqlType DbTypePrimitive
t = case DbTypePrimitive
t of
  DbTypePrimitive
DbString -> String
"VARCHAR"
  DbTypePrimitive
DbInt32 -> String
"INTEGER"
  DbTypePrimitive
DbInt64 -> String
"INTEGER"
  DbTypePrimitive
DbReal -> String
"REAL"
  DbTypePrimitive
DbBool -> String
"BOOLEAN"
  DbTypePrimitive
DbDay -> String
"DATE"
  DbTypePrimitive
DbTime -> String
"TIME"
  DbTypePrimitive
DbDayTime -> String
"TIMESTAMP"
  DbTypePrimitive
DbDayTimeZoned -> String
"TIMESTAMP WITH TIME ZONE"
  DbTypePrimitive
DbBlob -> String
"BLOB"
  DbOther (OtherTypeDef [Either String DbTypePrimitive]
ts) -> (Either String DbTypePrimitive -> String)
-> [Either String DbTypePrimitive] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> String)
-> (DbTypePrimitive -> String)
-> Either String DbTypePrimitive
-> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
forall a. a -> a
id DbTypePrimitive -> String
showSqlType) [Either String DbTypePrimitive]
ts

readSqlType :: String -> DbTypePrimitive
readSqlType :: String -> DbTypePrimitive
readSqlType String
typ = case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
typ of
  String
"VARCHAR" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbString
  String
"INTEGER" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt64
  String
"REAL" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbReal
  String
"BOOLEAN" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbBool
  String
"DATE" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbDay
  String
"TIME" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbTime
  String
"TIMESTAMP" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbDayTime
  String
"TIMESTAMP WITH TIME ZONE" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbDayTimeZoned
  String
"BLOB" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbBlob
  String
_ -> OtherTypeDef' String -> DbTypePrimitive
forall str. OtherTypeDef' str -> DbTypePrimitive' str
DbOther (OtherTypeDef' String -> DbTypePrimitive)
-> OtherTypeDef' String -> DbTypePrimitive
forall a b. (a -> b) -> a -> b
$ [Either String DbTypePrimitive] -> OtherTypeDef' String
forall str.
[Either str (DbTypePrimitive' str)] -> OtherTypeDef' str
OtherTypeDef [String -> Either String DbTypePrimitive
forall a b. a -> Either a b
Left String
typ]

data Affinity = TEXT | NUMERIC | INTEGER | REAL | NONE deriving (Affinity -> Affinity -> Bool
(Affinity -> Affinity -> Bool)
-> (Affinity -> Affinity -> Bool) -> Eq Affinity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Affinity -> Affinity -> Bool
$c/= :: Affinity -> Affinity -> Bool
== :: Affinity -> Affinity -> Bool
$c== :: Affinity -> Affinity -> Bool
Eq, Int -> Affinity -> String -> String
[Affinity] -> String -> String
Affinity -> String
(Int -> Affinity -> String -> String)
-> (Affinity -> String)
-> ([Affinity] -> String -> String)
-> Show Affinity
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Affinity] -> String -> String
$cshowList :: [Affinity] -> String -> String
show :: Affinity -> String
$cshow :: Affinity -> String
showsPrec :: Int -> Affinity -> String -> String
$cshowsPrec :: Int -> Affinity -> String -> String
Show)

dbTypeAffinity :: DbTypePrimitive -> Affinity
dbTypeAffinity :: DbTypePrimitive -> Affinity
dbTypeAffinity = String -> Affinity
readSqlTypeAffinity (String -> Affinity)
-> (DbTypePrimitive -> String) -> DbTypePrimitive -> Affinity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DbTypePrimitive -> String
showSqlType

readSqlTypeAffinity :: String -> Affinity
readSqlTypeAffinity :: String -> Affinity
readSqlTypeAffinity String
typ = Affinity
affinity
  where
    contains :: [String] -> Bool
contains = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
typ)
    affinity :: Affinity
affinity = case () of
      ()
_ | [String] -> Bool
contains [String
"INT"] -> Affinity
INTEGER
      ()
_ | [String] -> Bool
contains [String
"CHAR", String
"CLOB", String
"TEXT"] -> Affinity
TEXT
      ()
_ | [String] -> Bool
contains [String
"BLOB"] Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
typ -> Affinity
NONE
      ()
_ | [String] -> Bool
contains [String
"REAL", String
"FLOA", String
"DOUB"] -> Affinity
REAL
      ()
_ -> Affinity
NUMERIC

showColumn :: Column -> String
showColumn :: Column -> String
showColumn (Column String
name Bool
nullable DbTypePrimitive
typ Maybe String
def) = String -> String
escape String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DbTypePrimitive -> String
showSqlType DbTypePrimitive
typ String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rest
  where
    rest :: String
rest =
      (if Bool -> Bool
not Bool
nullable then String
" NOT NULL" else String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
" DEFAULT " String -> String -> String
forall a. [a] -> [a] -> [a]
++) Maybe String
def

sqlReference :: Reference -> String
sqlReference :: Reference -> String
sqlReference Reference {[(String, String)]
Maybe ReferenceActionType
QualifiedName
referencedTableName :: Reference -> QualifiedName
referencedColumns :: Reference -> [(String, String)]
referenceOnDelete :: Reference -> Maybe ReferenceActionType
referenceOnUpdate :: Reference -> Maybe ReferenceActionType
referenceOnUpdate :: Maybe ReferenceActionType
referenceOnDelete :: Maybe ReferenceActionType
referencedColumns :: [(String, String)]
referencedTableName :: QualifiedName
..} = String
"FOREIGN KEY(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ourKey String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") REFERENCES " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape (QualifiedName -> String
forall a b. (a, b) -> b
snd QualifiedName
referencedTableName) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
foreignKey String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
actions
  where
    actions :: String
actions =
      String
-> (ReferenceActionType -> String)
-> Maybe ReferenceActionType
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
" ON DELETE " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (ReferenceActionType -> String) -> ReferenceActionType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReferenceActionType -> String
showReferenceAction) Maybe ReferenceActionType
referenceOnDelete
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
-> (ReferenceActionType -> String)
-> Maybe ReferenceActionType
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
" ON UPDATE " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (ReferenceActionType -> String) -> ReferenceActionType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReferenceActionType -> String
showReferenceAction) Maybe ReferenceActionType
referenceOnUpdate
    (String
ourKey, String
foreignKey) = [String] -> String
f ([String] -> String)
-> ([String] -> String) -> ([String], [String]) -> (String, String)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [String] -> String
f (([String], [String]) -> (String, String))
-> ([String], [String]) -> (String, String)
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> ([String], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, String)]
referencedColumns
    f :: [String] -> String
f = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
escape

sqlUnique :: UniqueDefInfo -> String
sqlUnique :: UniqueDefInfo -> String
sqlUnique (UniqueDef Maybe String
name UniqueType
typ [Either String String]
cols) =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\String
x -> String
"CONSTRAINT " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") Maybe String
name,
      String
constraintType,
      String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Either String String -> String)
-> [Either String String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String)
-> (String -> String) -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
escape String -> String
forall a. a -> a
id) [Either String String]
cols,
      String
")"
    ]
  where
    constraintType :: String
constraintType = case UniqueType
typ of
      UniquePrimary Bool
_ -> String
"PRIMARY KEY("
      UniqueType
UniqueConstraint -> String
"UNIQUE("
      UniqueType
UniqueIndex -> String -> String
forall a. HasCallStack => String -> a
error String
"sqlUnique: does not handle indexes"

insert' :: PersistEntity v => v -> Action Sqlite (AutoKey v)
insert' :: v -> Action Sqlite (AutoKey v)
insert' v
v = do
  -- constructor number and the rest of the field values
  [PersistValue]
vals <- v -> Action Sqlite [PersistValue]
forall v. PersistEntity v => v -> Action Sqlite [PersistValue]
toEntityPersistValues' v
v
  let e :: EntityDef
e = Any Sqlite -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any Sqlite
forall (proxy :: * -> *). proxy Sqlite
proxy v
v
  let constructorNum :: Int
constructorNum = PersistValue -> Int
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue ([PersistValue] -> PersistValue
forall a. [a] -> a
head [PersistValue]
vals)

  ((AutoKey v, [PersistValue]) -> AutoKey v)
-> ReaderT Sqlite IO (AutoKey v, [PersistValue])
-> Action Sqlite (AutoKey v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AutoKey v, [PersistValue]) -> AutoKey v
forall a b. (a, b) -> a
fst (ReaderT Sqlite IO (AutoKey v, [PersistValue])
 -> Action Sqlite (AutoKey v))
-> ReaderT Sqlite IO (AutoKey v, [PersistValue])
-> Action Sqlite (AutoKey v)
forall a b. (a -> b) -> a -> b
$
    if [ConstructorDef] -> Bool
isSimple (EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e)
      then do
        let constr :: ConstructorDef
constr = [ConstructorDef] -> ConstructorDef
forall a. [a] -> a
head ([ConstructorDef] -> ConstructorDef)
-> [ConstructorDef] -> ConstructorDef
forall a b. (a -> b) -> a -> b
$ EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e
        let RenderS Utf8
query [PersistValue] -> [PersistValue]
vals' = Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS Any Any
forall db r.
Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r
insertIntoConstructorTable Bool
False ((Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
escapeS EntityDef
e ConstructorDef
constr) ConstructorDef
constr ([PersistValue] -> [PersistValue]
forall a. [a] -> [a]
tail [PersistValue]
vals)
        Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' Utf8
query ([PersistValue] -> [PersistValue]
vals' [])
        case ConstructorDef -> Maybe String
forall str dbType. ConstructorDef' str dbType -> Maybe str
constrAutoKeyName ConstructorDef
constr of
          Maybe String
Nothing -> [PersistValue] -> ReaderT Sqlite IO (AutoKey v, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PurePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
pureFromPersistValue []
          Just String
_ -> Action Sqlite PersistValue
getLastInsertRowId Action Sqlite PersistValue
-> (PersistValue -> ReaderT Sqlite IO (AutoKey v, [PersistValue]))
-> ReaderT Sqlite IO (AutoKey v, [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PersistValue
rowid -> [PersistValue] -> ReaderT Sqlite IO (AutoKey v, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PurePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
pureFromPersistValue [PersistValue
rowid]
      else do
        let constr :: ConstructorDef
constr = EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e [ConstructorDef] -> Int -> ConstructorDef
forall a. [a] -> Int -> a
!! Int
constructorNum
        let query :: Utf8
query = Utf8
"INSERT INTO " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> Utf8
forall s. StringLike s => (s -> s) -> EntityDef -> s
mainTableName Utf8 -> Utf8
escapeS EntityDef
e Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
"(discr)VALUES(?)"
        Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' Utf8
query ([PersistValue] -> Action Sqlite ())
-> [PersistValue] -> Action Sqlite ()
forall a b. (a -> b) -> a -> b
$ Int -> [PersistValue] -> [PersistValue]
forall a. Int -> [a] -> [a]
take Int
1 [PersistValue]
vals
        PersistValue
rowid <- Action Sqlite PersistValue
getLastInsertRowId
        let RenderS Utf8
cQuery [PersistValue] -> [PersistValue]
vals' = Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS Any Any
forall db r.
Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r
insertIntoConstructorTable Bool
True ((Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
escapeS EntityDef
e ConstructorDef
constr) ConstructorDef
constr (PersistValue
rowid PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
: [PersistValue] -> [PersistValue]
forall a. [a] -> [a]
tail [PersistValue]
vals)
        Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' Utf8
cQuery ([PersistValue] -> [PersistValue]
vals' [])
        [PersistValue] -> ReaderT Sqlite IO (AutoKey v, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PurePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
pureFromPersistValue [PersistValue
rowid]

insert_' :: PersistEntity v => v -> Action Sqlite ()
insert_' :: v -> Action Sqlite ()
insert_' v
v = do
  -- constructor number and the rest of the field values
  [PersistValue]
vals <- v -> Action Sqlite [PersistValue]
forall v. PersistEntity v => v -> Action Sqlite [PersistValue]
toEntityPersistValues' v
v
  let e :: EntityDef
e = Any Sqlite -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any Sqlite
forall (proxy :: * -> *). proxy Sqlite
proxy v
v
  let constructorNum :: Int
constructorNum = PersistValue -> Int
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue ([PersistValue] -> PersistValue
forall a. [a] -> a
head [PersistValue]
vals)

  if [ConstructorDef] -> Bool
isSimple (EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e)
    then do
      let constr :: ConstructorDef
constr = [ConstructorDef] -> ConstructorDef
forall a. [a] -> a
head ([ConstructorDef] -> ConstructorDef)
-> [ConstructorDef] -> ConstructorDef
forall a b. (a -> b) -> a -> b
$ EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e
      let RenderS Utf8
query [PersistValue] -> [PersistValue]
vals' = Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS Any Any
forall db r.
Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r
insertIntoConstructorTable Bool
False ((Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
escapeS EntityDef
e ConstructorDef
constr) ConstructorDef
constr ([PersistValue] -> [PersistValue]
forall a. [a] -> [a]
tail [PersistValue]
vals)
      Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' Utf8
query ([PersistValue] -> [PersistValue]
vals' [])
    else do
      let constr :: ConstructorDef
constr = EntityDef -> [ConstructorDef]
forall str dbType.
EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors EntityDef
e [ConstructorDef] -> Int -> ConstructorDef
forall a. [a] -> Int -> a
!! Int
constructorNum
      let query :: Utf8
query = Utf8
"INSERT INTO " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> EntityDef -> Utf8
forall s. StringLike s => (s -> s) -> EntityDef -> s
mainTableName Utf8 -> Utf8
escapeS EntityDef
e Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
"(discr)VALUES(?)"
      Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' Utf8
query ([PersistValue] -> Action Sqlite ())
-> [PersistValue] -> Action Sqlite ()
forall a b. (a -> b) -> a -> b
$ Int -> [PersistValue] -> [PersistValue]
forall a. Int -> [a] -> [a]
take Int
1 [PersistValue]
vals
      PersistValue
rowid <- Action Sqlite PersistValue
getLastInsertRowId
      let RenderS Utf8
cQuery [PersistValue] -> [PersistValue]
vals' = Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS Any Any
forall db r.
Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r
insertIntoConstructorTable Bool
True ((Utf8 -> Utf8) -> EntityDef -> ConstructorDef -> Utf8
forall s.
StringLike s =>
(s -> s) -> EntityDef -> ConstructorDef -> s
tableName Utf8 -> Utf8
escapeS EntityDef
e ConstructorDef
constr) ConstructorDef
constr (PersistValue
rowid PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
: [PersistValue] -> [PersistValue]
forall a. [a] -> [a]
tail [PersistValue]
vals)
      Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' Utf8
cQuery ([PersistValue] -> [PersistValue]
vals' [])

-- TODO: In Sqlite we can insert null to the id column. If so, id will be generated automatically. Check performance change from this.
insertIntoConstructorTable :: Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r
insertIntoConstructorTable :: Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r
insertIntoConstructorTable Bool
withId Utf8
tName ConstructorDef
c [PersistValue]
vals = Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
forall db r.
Utf8 -> ([PersistValue] -> [PersistValue]) -> RenderS db r
RenderS Utf8
query [PersistValue] -> [PersistValue]
vals'
  where
    query :: Utf8
query = Utf8
"INSERT INTO " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
tName Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
columnsValues
    fields :: [(String, DbType)]
fields = case ConstructorDef -> Maybe String
forall str dbType. ConstructorDef' str dbType -> Maybe str
constrAutoKeyName ConstructorDef
c of
      Just String
idName | Bool
withId -> (String
idName, Any Sqlite -> Int64 -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType Any Sqlite
forall (proxy :: * -> *). proxy Sqlite
proxy (Int64
0 :: Int64)) (String, DbType) -> [(String, DbType)] -> [(String, DbType)]
forall a. a -> [a] -> [a]
: ConstructorDef -> [(String, DbType)]
forall str dbType. ConstructorDef' str dbType -> [(str, dbType)]
constrParams ConstructorDef
c
      Maybe String
_ -> ConstructorDef -> [(String, DbType)]
forall str dbType. ConstructorDef' str dbType -> [(str, dbType)]
constrParams ConstructorDef
c
    columnsValues :: Utf8
columnsValues = case ((String, DbType) -> [Utf8] -> [Utf8])
-> [Utf8] -> [(String, DbType)] -> [Utf8]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Utf8 -> Utf8) -> (String, DbType) -> [Utf8] -> [Utf8]
forall s.
StringLike s =>
(s -> s) -> (String, DbType) -> [s] -> [s]
flatten Utf8 -> Utf8
escapeS) [] [(String, DbType)]
fields of
      [] -> Utf8
" DEFAULT VALUES"
      [Utf8]
xs -> Utf8
"(" Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> [Utf8] -> Utf8
forall s. StringLike s => [s] -> s
commasJoin [Utf8]
xs Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
") VALUES(" Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
placeholders Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
")"
    RenderS Utf8
placeholders [PersistValue] -> [PersistValue]
vals' = [RenderS Any Any] -> RenderS Any Any
forall s. StringLike s => [s] -> s
commasJoin ([RenderS Any Any] -> RenderS Any Any)
-> [RenderS Any Any] -> RenderS Any Any
forall a b. (a -> b) -> a -> b
$ (PersistValue -> RenderS Any Any)
-> [PersistValue] -> [RenderS Any Any]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> RenderS Any Any
forall db r. PersistValue -> RenderS db r
renderPersistValue [PersistValue]
vals

insertList' :: forall a. PersistField a => [a] -> Action Sqlite Int64
insertList' :: [a] -> Action Sqlite Int64
insertList' [a]
l = do
  let mainName :: Utf8
mainName = Utf8
"List" Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
delim' Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
delim' Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> String -> Utf8
forall a. IsString a => String -> a
fromString (a -> String
forall a. PersistField a => a -> String
persistName (a
forall a. HasCallStack => a
undefined :: a))
  Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' (Utf8
"INSERT INTO " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8 -> Utf8
escapeS Utf8
mainName Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" DEFAULT VALUES") []
  PersistValue
k <- Action Sqlite PersistValue
getLastInsertRowId
  let valuesName :: Utf8
valuesName = Utf8
mainName Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
delim' Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
"values"
  let fields :: [(String, DbType)]
fields = [(String
"ord", Any Sqlite -> Int -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType Any Sqlite
forall (proxy :: * -> *). proxy Sqlite
proxy (Int
0 :: Int)), (String
"value", Any Sqlite -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType Any Sqlite
forall (proxy :: * -> *). proxy Sqlite
proxy (a
forall a. HasCallStack => a
undefined :: a))]
  let query :: Utf8
query = Utf8
"INSERT INTO " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8 -> Utf8
escapeS Utf8
valuesName Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
"(id," Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> [(String, DbType)] -> Utf8
forall s. StringLike s => (s -> s) -> [(String, DbType)] -> s
renderFields Utf8 -> Utf8
escapeS [(String, DbType)]
fields Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
")VALUES(?," Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> [(String, DbType)] -> Utf8
forall s. StringLike s => (s -> s) -> [(String, DbType)] -> s
renderFields (Utf8 -> Utf8 -> Utf8
forall a b. a -> b -> a
const (Utf8 -> Utf8 -> Utf8) -> Utf8 -> Utf8 -> Utf8
forall a b. (a -> b) -> a -> b
$ Char -> Utf8
forall a. StringLike a => Char -> a
fromChar Char
'?') [(String, DbType)]
fields Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
")"
  let go :: Int -> [a] -> Action Sqlite ()
      go :: Int -> [a] -> Action Sqlite ()
go Int
n (a
x : [a]
xs) = do
        [PersistValue] -> [PersistValue]
x' <- a -> ReaderT Sqlite IO ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues a
x
        Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' Utf8
query ([PersistValue] -> Action Sqlite ())
-> [PersistValue] -> Action Sqlite ()
forall a b. (a -> b) -> a -> b
$ (PersistValue
k PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
:) ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue Int
n PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
:) ([PersistValue] -> [PersistValue])
-> ([PersistValue] -> [PersistValue])
-> [PersistValue]
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> [PersistValue]
x' ([PersistValue] -> [PersistValue])
-> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> a -> b
$ []
        Int -> [a] -> Action Sqlite ()
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs
      go Int
_ [] = () -> Action Sqlite ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Int -> [a] -> Action Sqlite ()
go Int
0 [a]
l
  Int64 -> Action Sqlite Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Action Sqlite Int64) -> Int64 -> Action Sqlite Int64
forall a b. (a -> b) -> a -> b
$ PersistValue -> Int64
forall a. PrimitivePersistField a => PersistValue -> a
fromPrimitivePersistValue PersistValue
k

getList' :: forall a. PersistField a => Int64 -> Action Sqlite [a]
getList' :: Int64 -> Action Sqlite [a]
getList' Int64
k = do
  let mainName :: Utf8
mainName = Utf8
"List" Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
delim' Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
delim' Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> String -> Utf8
forall a. IsString a => String -> a
fromString (a -> String
forall a. PersistField a => a -> String
persistName (a
forall a. HasCallStack => a
undefined :: a))
      valuesName :: Utf8
valuesName = Utf8
mainName Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
delim' Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
"values"
      value :: (String, DbType)
value = (String
"value", Any Sqlite -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType Any Sqlite
forall (proxy :: * -> *). proxy Sqlite
proxy (a
forall a. HasCallStack => a
undefined :: a))
      query :: Utf8
query = Utf8
"SELECT " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> (Utf8 -> Utf8) -> [(String, DbType)] -> Utf8
forall s. StringLike s => (s -> s) -> [(String, DbType)] -> s
renderFields Utf8 -> Utf8
escapeS [(String, DbType)
value] Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" FROM " Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8 -> Utf8
escapeS Utf8
valuesName Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
" WHERE id=? ORDER BY ord"
  Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached' Utf8
query [Int64 -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue Int64
k] Action Sqlite (RowStream [PersistValue])
-> (RowStream [PersistValue] -> ReaderT Sqlite IO (RowStream a))
-> ReaderT Sqlite IO (RowStream a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action Sqlite a)
-> RowStream [PersistValue] -> ReaderT Sqlite IO (RowStream a)
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream (((a, [PersistValue]) -> a)
-> ReaderT Sqlite IO (a, [PersistValue]) -> Action Sqlite a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, [PersistValue]) -> a
forall a b. (a, b) -> a
fst (ReaderT Sqlite IO (a, [PersistValue]) -> Action Sqlite a)
-> ([PersistValue] -> ReaderT Sqlite IO (a, [PersistValue]))
-> [PersistValue]
-> Action Sqlite a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> ReaderT Sqlite IO (a, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues) ReaderT Sqlite IO (RowStream a)
-> (RowStream a -> Action Sqlite [a]) -> Action Sqlite [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream a -> Action Sqlite [a]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList

getLastInsertRowId :: Action Sqlite PersistValue
getLastInsertRowId :: Action Sqlite PersistValue
getLastInsertRowId = do
  Sqlite Database
conn IORef (HashMap ByteString Statement)
_ <- ReaderT Sqlite IO Sqlite
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  IO Int64 -> Action Sqlite Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Database -> IO Int64
SD.lastInsertRowId Database
conn) Action Sqlite Int64
-> (Int64 -> Action Sqlite PersistValue)
-> Action Sqlite PersistValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int64 -> Action Sqlite PersistValue
forall a (m :: * -> *).
(SinglePersistField a, PersistBackend m) =>
a -> m PersistValue
toSinglePersistValue

----------

bind :: S.Statement -> [PersistValue] -> IO ()
bind :: Statement -> [PersistValue] -> IO ()
bind Statement
stmt = ParamIndex -> [PersistValue] -> IO ()
go ParamIndex
1
  where
    go :: ParamIndex -> [PersistValue] -> IO ()
go ParamIndex
_ [] = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    go ParamIndex
i (PersistValue
x : [PersistValue]
xs) = do
      case PersistValue
x of
        PersistInt64 Int64
int64 -> Statement -> ParamIndex -> Int64 -> IO ()
S.bindInt64 Statement
stmt ParamIndex
i Int64
int64
        PersistText Text
text -> Statement -> ParamIndex -> Text -> IO ()
S.bindText Statement
stmt ParamIndex
i Text
text
        PersistString String
text -> Statement -> ParamIndex -> Text -> IO ()
S.bindText Statement
stmt ParamIndex
i (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
text
        PersistDouble Double
double -> Statement -> ParamIndex -> Double -> IO ()
S.bindDouble Statement
stmt ParamIndex
i Double
double
        PersistBool Bool
b -> Statement -> ParamIndex -> Int64 -> IO ()
S.bindInt64 Statement
stmt ParamIndex
i (Int64 -> IO ()) -> Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$ if Bool
b then Int64
1 else Int64
0
        PersistByteString ByteString
blob -> Statement -> ParamIndex -> ByteString -> IO ()
S.bindBlob Statement
stmt ParamIndex
i ByteString
blob
        PersistValue
PersistNull -> Statement -> ParamIndex -> IO ()
S.bindNull Statement
stmt ParamIndex
i
        PersistDay Day
d -> Statement -> ParamIndex -> Text -> IO ()
S.bindText Statement
stmt ParamIndex
i (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Day -> String
forall a. Show a => a -> String
show Day
d
        PersistTimeOfDay TimeOfDay
d -> Statement -> ParamIndex -> Text -> IO ()
S.bindText Statement
stmt ParamIndex
i (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> String
forall a. Show a => a -> String
show TimeOfDay
d
        PersistUTCTime UTCTime
d -> Statement -> ParamIndex -> Text -> IO ()
S.bindText Statement
stmt ParamIndex
i (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime -> String
forall a. Show a => a -> String
show UTCTime
d
        PersistZonedTime (ZT ZonedTime
d) -> Statement -> ParamIndex -> Text -> IO ()
S.bindText Statement
stmt ParamIndex
i (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ZonedTime -> String
forall a. Show a => a -> String
show ZonedTime
d
        PersistCustom Utf8
_ [PersistValue]
_ -> String -> IO ()
forall a. HasCallStack => String -> a
error String
"bind: unexpected PersistCustom"
      ParamIndex -> [PersistValue] -> IO ()
go (ParamIndex
i ParamIndex -> ParamIndex -> ParamIndex
forall a. Num a => a -> a -> a
+ ParamIndex
1) [PersistValue]
xs

executeRaw' :: Utf8 -> [PersistValue] -> Action Sqlite ()
executeRaw' :: Utf8 -> [PersistValue] -> Action Sqlite ()
executeRaw' Utf8
query [PersistValue]
vals = do
  --  $logDebugS "SQL" $ T.pack $ show (fromUtf8 query) ++ " " ++ show vals
  Statement
stmt <- Utf8 -> Action Sqlite Statement
getStatement Utf8
query
  IO () -> Action Sqlite ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action Sqlite ()) -> IO () -> Action Sqlite ()
forall a b. (a -> b) -> a -> b
$
    (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
finally (Statement -> IO ()
S.finalize Statement
stmt) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Statement -> [PersistValue] -> IO ()
bind Statement
stmt [PersistValue]
vals
      StepResult
S.Done <- Statement -> IO StepResult
S.step Statement
stmt
      () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

executeRawCached' :: Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' :: Utf8 -> [PersistValue] -> Action Sqlite ()
executeRawCached' Utf8
query [PersistValue]
vals = do
  --  $logDebugS "SQL" $ T.pack $ show (fromUtf8 query) ++ " " ++ show vals
  Statement
stmt <- Utf8 -> Action Sqlite Statement
getStatementCached Utf8
query
  IO () -> Action Sqlite ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action Sqlite ()) -> IO () -> Action Sqlite ()
forall a b. (a -> b) -> a -> b
$
    (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
finally (Statement -> IO ()
S.reset Statement
stmt) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Statement -> [PersistValue] -> IO ()
bind Statement
stmt [PersistValue]
vals
      StepResult
S.Done <- Statement -> IO StepResult
S.step Statement
stmt
      () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

runQuery :: (Utf8 -> Action Sqlite S.Statement) -> (S.Statement -> IO ()) -> Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
runQuery :: (Utf8 -> Action Sqlite Statement)
-> (Statement -> IO ())
-> Utf8
-> [PersistValue]
-> Action Sqlite (RowStream [PersistValue])
runQuery Utf8 -> Action Sqlite Statement
getStmt Statement -> IO ()
close Utf8
query [PersistValue]
vals = do
  --  $logDebugS "SQL" $ T.pack $ show (fromUtf8 query) ++ " " ++ show vals
  Sqlite
conn <- ReaderT Sqlite IO Sqlite
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let open :: IO Statement
open = do
        Statement
stmt <- Action Sqlite Statement -> Sqlite -> IO Statement
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Utf8 -> Action Sqlite Statement
getStmt Utf8
query) Sqlite
conn
        Statement -> [PersistValue] -> IO ()
bind Statement
stmt [PersistValue]
vals
        Statement -> IO Statement
forall (f :: * -> *) a. Applicative f => a -> f a
pure Statement
stmt
      mkNext :: Statement -> IO (Maybe [PersistValue])
mkNext Statement
stmt = do
        StepResult
x <- Statement -> IO StepResult
S.step Statement
stmt
        case StepResult
x of
          StepResult
S.Done -> Maybe [PersistValue] -> IO (Maybe [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [PersistValue]
forall a. Maybe a
Nothing
          StepResult
S.Row -> [PersistValue] -> Maybe [PersistValue]
forall a. a -> Maybe a
Just ([PersistValue] -> Maybe [PersistValue])
-> ([SQLData] -> [PersistValue])
-> [SQLData]
-> Maybe [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SQLData -> PersistValue) -> [SQLData] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map SQLData -> PersistValue
pFromSql ([SQLData] -> Maybe [PersistValue])
-> IO [SQLData] -> IO (Maybe [PersistValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Statement -> IO [SQLData]
S.columns Statement
stmt
  RowStream [PersistValue]
-> Action Sqlite (RowStream [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RowStream [PersistValue]
 -> Action Sqlite (RowStream [PersistValue]))
-> RowStream [PersistValue]
-> Action Sqlite (RowStream [PersistValue])
forall a b. (a -> b) -> a -> b
$ Statement -> IO (Maybe [PersistValue])
mkNext (Statement -> IO (Maybe [PersistValue]))
-> Acquire Statement -> RowStream [PersistValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Statement -> (Statement -> IO ()) -> Acquire Statement
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO Statement
open Statement -> IO ()
close

queryRaw', queryRawCached' :: Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRaw' :: Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRaw' = (Utf8 -> Action Sqlite Statement)
-> (Statement -> IO ())
-> Utf8
-> [PersistValue]
-> Action Sqlite (RowStream [PersistValue])
runQuery Utf8 -> Action Sqlite Statement
getStatement Statement -> IO ()
S.finalize
queryRawCached' :: Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])
queryRawCached' = (Utf8 -> Action Sqlite Statement)
-> (Statement -> IO ())
-> Utf8
-> [PersistValue]
-> Action Sqlite (RowStream [PersistValue])
runQuery Utf8 -> Action Sqlite Statement
getStatementCached Statement -> IO ()
S.reset

pFromSql :: S.SQLData -> PersistValue
pFromSql :: SQLData -> PersistValue
pFromSql (S.SQLInteger Int64
i) = Int64 -> PersistValue
PersistInt64 Int64
i
pFromSql (S.SQLFloat Double
i) = Double -> PersistValue
PersistDouble Double
i
pFromSql (S.SQLText Text
s) = Text -> PersistValue
PersistText Text
s
pFromSql (S.SQLBlob ByteString
bs) = ByteString -> PersistValue
PersistByteString ByteString
bs
pFromSql SQLData
S.SQLNull = PersistValue
PersistNull

-- It is used to escape table names and columns, which can include only symbols allowed in Haskell datatypes and '$' delimiter. We need it mostly to support names that coincide with SQL keywords
escape :: String -> String
escape :: String -> String
escape String
s = Char
'\"' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""

escapeS :: Utf8 -> Utf8
escapeS :: Utf8 -> Utf8
escapeS Utf8
a = let q :: Utf8
q = Char -> Utf8
forall a. StringLike a => Char -> a
fromChar Char
'"' in Utf8
q Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
a Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
q

renderConfig :: RenderConfig
renderConfig :: RenderConfig
renderConfig =
  RenderConfig :: (Utf8 -> Utf8) -> RenderConfig
RenderConfig
    { esc :: Utf8 -> Utf8
esc = Utf8 -> Utf8
escapeS
    }

defaultPriority, triggerPriority :: Int
defaultPriority :: Int
defaultPriority = Int
0
triggerPriority :: Int
triggerPriority = Int
1

proxy :: proxy Sqlite
proxy :: proxy Sqlite
proxy = String -> proxy Sqlite
forall a. HasCallStack => String -> a
error String
"proxy Sqlite"

delim' :: Utf8
delim' :: Utf8
delim' = Char -> Utf8
forall a. StringLike a => Char -> a
fromChar Char
delim

toEntityPersistValues' :: PersistEntity v => v -> Action Sqlite [PersistValue]
toEntityPersistValues' :: v -> Action Sqlite [PersistValue]
toEntityPersistValues' = (([PersistValue] -> [PersistValue]) -> [PersistValue])
-> ReaderT Sqlite IO ([PersistValue] -> [PersistValue])
-> Action Sqlite [PersistValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([PersistValue] -> [PersistValue])
-> [PersistValue] -> [PersistValue]
forall a b. (a -> b) -> a -> b
$ []) (ReaderT Sqlite IO ([PersistValue] -> [PersistValue])
 -> Action Sqlite [PersistValue])
-> (v -> ReaderT Sqlite IO ([PersistValue] -> [PersistValue]))
-> v
-> Action Sqlite [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ReaderT Sqlite IO ([PersistValue] -> [PersistValue])
forall v (m :: * -> *).
(PersistEntity v, PersistBackend m) =>
v -> m ([PersistValue] -> [PersistValue])
toEntityPersistValues

compareUniqs :: UniqueDefInfo -> UniqueDefInfo -> Bool
compareUniqs :: UniqueDefInfo -> UniqueDefInfo -> Bool
compareUniqs (UniqueDef Maybe String
_ (UniquePrimary Bool
_) [Either String String]
cols1) (UniqueDef Maybe String
_ (UniquePrimary Bool
_) [Either String String]
cols2) = (Either String String -> Either String String -> Bool)
-> [Either String String] -> [Either String String] -> Bool
forall a b. Show a => (a -> b -> Bool) -> [a] -> [b] -> Bool
haveSameElems Either String String -> Either String String -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Either String String]
cols1 [Either String String]
cols2
compareUniqs (UniqueDef Maybe String
_ UniqueType
type1 [Either String String]
cols1) (UniqueDef Maybe String
_ UniqueType
type2 [Either String String]
cols2) = (Either String String -> Either String String -> Bool)
-> [Either String String] -> [Either String String] -> Bool
forall a b. Show a => (a -> b -> Bool) -> [a] -> [b] -> Bool
haveSameElems Either String String -> Either String String -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Either String String]
cols1 [Either String String]
cols2 Bool -> Bool -> Bool
&& UniqueType
type1 UniqueType -> UniqueType -> Bool
forall a. Eq a => a -> a -> Bool
== UniqueType
type2

compareRefs :: (Maybe String, Reference) -> (Maybe String, Reference) -> Bool
compareRefs :: (Maybe String, Reference) -> (Maybe String, Reference) -> Bool
compareRefs (Maybe String
_, Reference QualifiedName
tbl1 [(String, String)]
pairs1 Maybe ReferenceActionType
onDel1 Maybe ReferenceActionType
onUpd1) (Maybe String
_, Reference QualifiedName
tbl2 [(String, String)]
pairs2 Maybe ReferenceActionType
onDel2 Maybe ReferenceActionType
onUpd2) =
  String -> String
unescape (QualifiedName -> String
forall a b. (a, b) -> b
snd QualifiedName
tbl1) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> String
unescape (QualifiedName -> String
forall a b. (a, b) -> b
snd QualifiedName
tbl2)
    Bool -> Bool -> Bool
&& ((String, String) -> (String, String) -> Bool)
-> [(String, String)] -> [(String, String)] -> Bool
forall a b. Show a => (a -> b -> Bool) -> [a] -> [b] -> Bool
haveSameElems (String, String) -> (String, String) -> Bool
forall a. Eq a => a -> a -> Bool
(==) [(String, String)]
pairs1 [(String, String)]
pairs2
    Bool -> Bool -> Bool
&& ReferenceActionType
-> Maybe ReferenceActionType -> ReferenceActionType
forall a. a -> Maybe a -> a
fromMaybe ReferenceActionType
NoAction Maybe ReferenceActionType
onDel1 ReferenceActionType -> ReferenceActionType -> Bool
forall a. Eq a => a -> a -> Bool
== ReferenceActionType
-> Maybe ReferenceActionType -> ReferenceActionType
forall a. a -> Maybe a -> a
fromMaybe ReferenceActionType
NoAction Maybe ReferenceActionType
onDel2
    Bool -> Bool -> Bool
&& ReferenceActionType
-> Maybe ReferenceActionType -> ReferenceActionType
forall a. a -> Maybe a -> a
fromMaybe ReferenceActionType
NoAction Maybe ReferenceActionType
onUpd1 ReferenceActionType -> ReferenceActionType -> Bool
forall a. Eq a => a -> a -> Bool
== ReferenceActionType
-> Maybe ReferenceActionType -> ReferenceActionType
forall a. a -> Maybe a -> a
fromMaybe ReferenceActionType
NoAction Maybe ReferenceActionType
onUpd2
  where
    unescape :: String -> String
unescape String
name = if String -> Char
forall a. [a] -> a
head String
name Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
last String
name Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' then String -> String
forall a. [a] -> [a]
tail (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
init String
name else String
name

compareTypes :: DbTypePrimitive -> DbTypePrimitive -> Bool
compareTypes :: DbTypePrimitive -> DbTypePrimitive -> Bool
compareTypes DbTypePrimitive
type1 DbTypePrimitive
type2 = DbTypePrimitive -> Affinity
dbTypeAffinity DbTypePrimitive
type1 Affinity -> Affinity -> Bool
forall a. Eq a => a -> a -> Bool
== DbTypePrimitive -> Affinity
dbTypeAffinity DbTypePrimitive
type2

--compareTypes type1 type2 = showSqlType type1 == showSqlType type2

compareDefaults :: String -> String -> Bool
compareDefaults :: String -> String -> Bool
compareDefaults = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==)

mainTableId :: String
mainTableId :: String
mainTableId = String
"id"

showAlterDb :: AlterDB -> SingleMigration
showAlterDb :: AlterDB -> SingleMigration
showAlterDb (AddTable String
s) = [(Bool, Int, String)] -> SingleMigration
forall a b. b -> Either a b
Right [(Bool
False, Int
defaultPriority, String
s)]
showAlterDb (AlterTable (Maybe String
_, String
table) String
createTable (TableInfo [Column]
oldCols [UniqueDefInfo]
_ [(Maybe String, Reference)]
_) (TableInfo [Column]
newCols [UniqueDefInfo]
_ [(Maybe String, Reference)]
_) [AlterTable]
alts) = case (AlterTable -> Maybe (Bool, Int, String))
-> [AlterTable] -> Maybe [(Bool, Int, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> AlterTable -> Maybe (Bool, Int, String)
showAlterTable String
table) [AlterTable]
alts of
  Just [(Bool, Int, String)]
alts' -> [(Bool, Int, String)] -> SingleMigration
forall a b. b -> Either a b
Right [(Bool, Int, String)]
alts'
  Maybe [(Bool, Int, String)]
Nothing ->
    [(Bool, Int, String)] -> SingleMigration
forall a b. b -> Either a b
Right
      [ (Bool
False, Int
defaultPriority, String
"CREATE TEMP TABLE " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape String
tableTmp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
columnsTmp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"),
        (Bool
False, Int
defaultPriority, (String, String) -> (String, String) -> String
copy (String
table, String
columnsTmp) (String
tableTmp, String
columnsTmp)),
        (Bool -> Bool
not ([Column] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Column]
oldOnlyColumns), Int
defaultPriority, String
"DROP TABLE " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape String
table),
        (Bool
False, Int
defaultPriority, String
createTable),
        (Bool
False, Int
defaultPriority, (String, String) -> (String, String) -> String
copy (String
tableTmp, String
columnsTmp) (String
table, String
columnsNew)),
        (Bool
False, Int
defaultPriority, String
"DROP TABLE " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape String
tableTmp)
      ]
    where
      tableTmp :: String
tableTmp = String
table String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_backup"
      copy :: (String, String) -> (String, String) -> String
copy (String
from, String
fromCols) (String
to, String
toCols) = String
"INSERT INTO " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape String
to String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
toCols String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") SELECT " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fromCols String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" FROM " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape String
from
      ([Column]
oldOnlyColumns, [Column]
_, [(Column, Column)]
commonColumns) = (Column -> Column -> Bool)
-> [Column] -> [Column] -> ([Column], [Column], [(Column, Column)])
forall a b.
Show a =>
(a -> b -> Bool) -> [a] -> [b] -> ([a], [b], [(a, b)])
matchElements (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> (Column -> String) -> Column -> Column -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Column -> String
colName) [Column]
oldCols [Column]
newCols
      columnsTmp :: String
columnsTmp = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((Column, Column) -> String) -> [(Column, Column)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
escape (String -> String)
-> ((Column, Column) -> String) -> (Column, Column) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> String
colName (Column -> String)
-> ((Column, Column) -> Column) -> (Column, Column) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Column, Column) -> Column
forall a b. (a, b) -> b
snd) [(Column, Column)]
commonColumns
      columnsNew :: String
columnsNew = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((Column, Column) -> String) -> [(Column, Column)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
escape (String -> String)
-> ((Column, Column) -> String) -> (Column, Column) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> String
colName (Column -> String)
-> ((Column, Column) -> Column) -> (Column, Column) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Column, Column) -> Column
forall a b. (a, b) -> b
snd) [(Column, Column)]
commonColumns
showAlterDb (DropTrigger QualifiedName
trigName QualifiedName
_) = [(Bool, Int, String)] -> SingleMigration
forall a b. b -> Either a b
Right [(Bool
False, Int
triggerPriority, String
"DROP TRIGGER " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape (QualifiedName -> String
forall a b. (a, b) -> b
snd QualifiedName
trigName))]
showAlterDb (AddTriggerOnDelete QualifiedName
trigName QualifiedName
tName String
body) =
  [(Bool, Int, String)] -> SingleMigration
forall a b. b -> Either a b
Right
    [ ( Bool
False,
        Int
triggerPriority,
        String
"CREATE TRIGGER " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape (QualifiedName -> String
forall a b. (a, b) -> b
snd QualifiedName
trigName) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" DELETE ON " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape (QualifiedName -> String
forall a b. (a, b) -> b
snd QualifiedName
tName) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" BEGIN " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
body String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"END"
      )
    ]
showAlterDb (AddTriggerOnUpdate QualifiedName
trigName QualifiedName
tName Maybe String
fieldName String
body) =
  [(Bool, Int, String)] -> SingleMigration
forall a b. b -> Either a b
Right
    [ ( Bool
False,
        Int
triggerPriority,
        String
"CREATE TRIGGER " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape (QualifiedName -> String
forall a b. (a, b) -> b
snd QualifiedName
trigName) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" UPDATE OF " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fieldName' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ON " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape (QualifiedName -> String
forall a b. (a, b) -> b
snd QualifiedName
tName) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" BEGIN " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
body String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"END"
      )
    ]
  where
    fieldName' :: String
fieldName' = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"showAlterDb: AddTriggerOnUpdate does not have fieldName for trigger " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualifiedName -> String
forall a. Show a => a -> String
show QualifiedName
trigName) String -> String
escape Maybe String
fieldName
showAlterDb AlterDB
alt = String -> SingleMigration
forall a. HasCallStack => String -> a
error (String -> SingleMigration) -> String -> SingleMigration
forall a b. (a -> b) -> a -> b
$ String
"showAlterDb: does not support " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AlterDB -> String
forall a. Show a => a -> String
show AlterDB
alt

showAlterTable :: String -> AlterTable -> Maybe (Bool, Int, String)
showAlterTable :: String -> AlterTable -> Maybe (Bool, Int, String)
showAlterTable String
table (AddColumn Column
col) =
  (Bool, Int, String) -> Maybe (Bool, Int, String)
forall a. a -> Maybe a
Just
    ( Bool
False,
      Int
defaultPriority,
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"ALTER TABLE ",
          String -> String
escape String
table,
          String
" ADD COLUMN ",
          Column -> String
showColumn Column
col
        ]
    )
showAlterTable String
table (AlterColumn Column
col [UpdateValue String
s]) =
  (Bool, Int, String) -> Maybe (Bool, Int, String)
forall a. a -> Maybe a
Just
    ( Bool
False,
      Int
defaultPriority,
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"UPDATE ",
          String -> String
escape String
table,
          String
" SET ",
          String -> String
escape (Column -> String
colName Column
col),
          String
"=",
          String
s,
          String
" WHERE ",
          String -> String
escape (Column -> String
colName Column
col),
          String
" IS NULL"
        ]
    )
showAlterTable String
table (AddUnique (UniqueDef Maybe String
uName UniqueType
UniqueIndex [Either String String]
cols)) =
  (Bool, Int, String) -> Maybe (Bool, Int, String)
forall a. a -> Maybe a
Just
    ( Bool
False,
      Int
defaultPriority,
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"CREATE UNIQUE INDEX ",
          String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"showAlterTable: index for table " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
table String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" does not have a name") String -> String
escape Maybe String
uName,
          String
" ON ",
          String -> String
escape String
table,
          String
"(",
          String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Either String String -> String)
-> [Either String String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String)
-> (String -> String) -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
escape String -> String
forall a. a -> a
id) [Either String String]
cols,
          String
")"
        ]
    )
showAlterTable String
_ (DropIndex String
uName) =
  (Bool, Int, String) -> Maybe (Bool, Int, String)
forall a. a -> Maybe a
Just
    ( Bool
False,
      Int
defaultPriority,
      String
"DROP INDEX " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape String
uName
    )
showAlterTable String
_ AlterTable
_ = Maybe (Bool, Int, String)
forall a. Maybe a
Nothing

preColumns :: HasSelectOptions opts db r => opts -> RenderS db r
preColumns :: opts -> RenderS db r
preColumns opts
_ = RenderS db r
forall a. Monoid a => a
mempty