{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Database.Groundhog.Postgresql
  ( withPostgresqlPool,
    withPostgresqlConn,
    createPostgresqlPool,
    runDbConn,
    Postgresql (..),
    module Database.Groundhog,
    module Database.Groundhog.Generic.Sql.Functions,
    explicitType,
    castType,
    distinctOn,
    -- other
    showSqlType,
  )
where

import Control.Arrow (second, (***))
import Control.Exception (throw)
import Control.Monad (forM, liftM2, (>=>))
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Trans.Reader (ask)
import Control.Monad.Trans.State (mapStateT)
import Data.Acquire (mkAcquire)
-- work around for no Semigroup instance of PG.Query prior to
-- postgresql-simple 0.5.3.0
import qualified Data.ByteString as B
import Data.ByteString.Char8 (copy, pack, unpack)
import Data.Char (isAlphaNum, isSpace, toUpper)
import Data.Function (on)
import Data.IORef
import Data.Int (Int64)
import Data.List (groupBy, intercalate, isPrefixOf, stripPrefix)
import Data.Maybe (fromJust, fromMaybe, isJust, mapMaybe)
import Data.Pool
import Data.Time.LocalTime (localTimeToUTC, utc)
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.PostgreSQL.LibPQ as LibPQ
import qualified Database.PostgreSQL.Simple as PG
import qualified Database.PostgreSQL.Simple.FromField as PGFF
import qualified Database.PostgreSQL.Simple.Internal as PG
import Database.PostgreSQL.Simple.Ok (Ok (..))
import qualified Database.PostgreSQL.Simple.ToField as PGTF
import qualified Database.PostgreSQL.Simple.Types as PG

-- typical operations for connection: OPEN, BEGIN, COMMIT, ROLLBACK, CLOSE
newtype Postgresql = Postgresql PG.Connection

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

instance SqlDb Postgresql where
  append :: a -> b -> Expr Postgresql r String
append a
a b
b = Snippet Postgresql r -> Expr Postgresql r String
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r String)
-> Snippet Postgresql r -> Expr Postgresql r String
forall a b. (a -> b) -> a -> b
$ Int -> String -> a -> b -> Snippet Postgresql 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 Postgresql r a
signum' x
x = Snippet Postgresql r -> Expr Postgresql r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r a)
-> Snippet Postgresql r -> Expr Postgresql r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr Postgresql r] -> Snippet Postgresql r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"sign" [x -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr x
x]
  quotRem' :: x -> y -> (Expr Postgresql r a, Expr Postgresql r a)
quotRem' x
x y
y = (Snippet Postgresql r -> Expr Postgresql r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r a)
-> Snippet Postgresql r -> Expr Postgresql r a
forall a b. (a -> b) -> a -> b
$ Int -> String -> x -> y -> Snippet Postgresql 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 Postgresql r -> Expr Postgresql r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r a)
-> Snippet Postgresql r -> Expr Postgresql r a
forall a b. (a -> b) -> a -> b
$ Int -> String -> x -> y -> Snippet Postgresql 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 Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
equalsOperator RenderS Postgresql r
a RenderS Postgresql r
b = RenderS Postgresql r
a RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderS Postgresql r
" IS NOT DISTINCT FROM " RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderS Postgresql r
b
  notEqualsOperator :: RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
notEqualsOperator RenderS Postgresql r
a RenderS Postgresql r
b = RenderS Postgresql r
a RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderS Postgresql r
" IS DISTINCT FROM " RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderS Postgresql r
b

instance FloatingSqlDb Postgresql where
  log' :: x -> Expr Postgresql r a
log' x
x = Snippet Postgresql r -> Expr Postgresql r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r a)
-> Snippet Postgresql r -> Expr Postgresql r a
forall a b. (a -> b) -> a -> b
$ String -> [UntypedExpr Postgresql r] -> Snippet Postgresql r
forall db r.
SqlDb db =>
String -> [UntypedExpr db r] -> Snippet db r
function String
"ln" [x -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr x
x]
  logBase' :: b -> x -> Expr Postgresql r a
logBase' b
b x
x = Expr Postgresql r a -> Expr Postgresql r a
forall a. Floating a => a -> a
log (x -> Expr Postgresql r a
forall db r a a'. ExpressionOf db r a a' => a -> Expr db r a'
liftExpr x
x) Expr Postgresql r a -> Expr Postgresql r a -> Expr Postgresql r a
forall a. Fractional a => a -> a -> a
/ Expr Postgresql r a -> Expr Postgresql r a
forall a. Floating a => a -> a
log (b -> Expr Postgresql r a
forall db r a a'. ExpressionOf db r a a' => a -> Expr db r a'
liftExpr b
b)

instance PersistBackendConn Postgresql 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 Postgresql (AutoKey v)
forall v. PersistEntity v => v -> Action Postgresql (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 Postgresql ()
forall v. PersistEntity v => v -> Action Postgresql ()
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 Postgresql (RowStream [PersistValue]))
-> Bool
-> u (UniqueMarker v)
-> v
-> Action Postgresql (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 Postgresql (RowStream [PersistValue])
queryRaw' 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 Postgresql (RowStream [PersistValue]))
-> Bool
-> v
-> Action Postgresql (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 Postgresql (RowStream [PersistValue])
queryRaw' 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 Postgresql (RowStream [PersistValue]))
-> (Utf8 -> [PersistValue] -> Action Postgresql ())
-> (Bool
    -> Utf8
    -> ConstructorDef
    -> [PersistValue]
    -> RenderS Postgresql Any)
-> Key v BackendSpecific
-> v
-> Action Postgresql ()
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 Postgresql (RowStream [PersistValue])
queryRaw' Utf8 -> [PersistValue] -> Action Postgresql ()
executeRaw' (Bool
-> Bool
-> Utf8
-> ConstructorDef
-> [PersistValue]
-> RenderS Postgresql Any
forall db r.
Bool
-> Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r
insertIntoConstructorTable Bool
False) 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 Postgresql ())
-> u (UniqueMarker v)
-> v
-> Action Postgresql ()
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 Postgresql ()
executeRaw' 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 Postgresql (RowStream [PersistValue]))
-> (opts -> RenderS Postgresql (RestrictionHolder v c))
-> Utf8
-> opts
-> Action Postgresql [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 Postgresql (RowStream [PersistValue])
queryRaw' opts -> RenderS Postgresql (RestrictionHolder v c)
forall opts r.
HasSelectOptions opts Postgresql r =>
opts -> RenderS Postgresql r
preColumns Utf8
"" 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 Postgresql (RowStream [PersistValue]))
-> (opts -> RenderS Postgresql (RestrictionHolder v c))
-> Utf8
-> opts
-> Action Postgresql (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 Postgresql (RowStream [PersistValue])
queryRaw' opts -> RenderS Postgresql (RestrictionHolder v c)
forall opts r.
HasSelectOptions opts Postgresql r =>
opts -> RenderS Postgresql r
preColumns Utf8
"" 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 Postgresql (RowStream [PersistValue]))
-> Action Postgresql [(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 Postgresql (RowStream [PersistValue])
queryRaw'
  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 Postgresql (RowStream [PersistValue]))
-> Action Postgresql (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 Postgresql (RowStream [PersistValue])
queryRaw'
  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 Postgresql (RowStream [PersistValue]))
-> Key v BackendSpecific
-> Action Postgresql (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 Postgresql (RowStream [PersistValue])
queryRaw' 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 Postgresql (RowStream [PersistValue]))
-> Key v (Unique u)
-> Action Postgresql (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 Postgresql (RowStream [PersistValue])
queryRaw' Key v (Unique u)
k
  update :: [Update Postgresql (RestrictionHolder v c)]
-> Cond Postgresql (RestrictionHolder v c) -> m ()
update [Update Postgresql (RestrictionHolder v c)]
upds Cond Postgresql (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 Postgresql ())
-> [Update Postgresql (RestrictionHolder v c)]
-> Cond Postgresql (RestrictionHolder v c)
-> Action Postgresql ()
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 Postgresql ()
executeRaw' [Update Postgresql (RestrictionHolder v c)]
upds Cond Postgresql (RestrictionHolder v c)
cond
  delete :: Cond Postgresql (RestrictionHolder v c) -> m ()
delete Cond Postgresql (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 Postgresql ())
-> Cond Postgresql (RestrictionHolder v c)
-> Action Postgresql ()
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 Postgresql ()
executeRaw' Cond Postgresql (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 Postgresql ())
-> Key v BackendSpecific
-> Action Postgresql ()
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 Postgresql ()
executeRaw' 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 Postgresql ())
-> v
-> Action Postgresql ()
forall conn v.
(PersistBackendConn conn, PersistEntity v) =>
RenderConfig
-> (Utf8 -> [PersistValue] -> Action conn ())
-> v
-> Action conn ()
H.deleteAll RenderConfig
renderConfig Utf8 -> [PersistValue] -> Action Postgresql ()
executeRaw' v
v
  count :: Cond Postgresql (RestrictionHolder v c) -> m Int
count Cond Postgresql (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 Postgresql (RowStream [PersistValue]))
-> Cond Postgresql (RestrictionHolder v c)
-> Action Postgresql 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 Postgresql (RowStream [PersistValue])
queryRaw' Cond Postgresql (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 Postgresql (RowStream [PersistValue]))
-> v
-> Action Postgresql 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 Postgresql (RowStream [PersistValue])
queryRaw' 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 Postgresql (RowStream [PersistValue]))
-> (opts -> RenderS Postgresql (RestrictionHolder v c))
-> Utf8
-> p
-> opts
-> Action Postgresql [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 Postgresql (RowStream [PersistValue])
queryRaw' opts -> RenderS Postgresql (RestrictionHolder v c)
forall opts r.
HasSelectOptions opts Postgresql r =>
opts -> RenderS Postgresql r
preColumns Utf8
"" 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 Postgresql (RowStream [PersistValue]))
-> (opts -> RenderS Postgresql (RestrictionHolder v c))
-> Utf8
-> p
-> opts
-> Action Postgresql (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 Postgresql (RowStream [PersistValue])
queryRaw' opts -> RenderS Postgresql (RestrictionHolder v c)
forall opts r.
HasSelectOptions opts Postgresql r =>
opts -> RenderS Postgresql r
preColumns Utf8
"" p
p opts
options
  migrate :: v -> Migration m
migrate v
fakeV = (Action Postgresql ((), NamedMigrations)
 -> m ((), NamedMigrations))
-> StateT NamedMigrations (Action Postgresql) () -> Migration m
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT Action Postgresql ((), NamedMigrations) -> m ((), NamedMigrations)
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (StateT NamedMigrations (Action Postgresql) () -> Migration m)
-> StateT NamedMigrations (Action Postgresql) () -> Migration m
forall a b. (a -> b) -> a -> b
$ v -> StateT NamedMigrations (Action Postgresql) ()
forall v.
PersistEntity v =>
v -> StateT NamedMigrations (Action Postgresql) ()
migrate' v
fakeV

  executeRaw :: Bool -> String -> [PersistValue] -> m ()
executeRaw Bool
_ 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 Postgresql ()
executeRaw' (String -> Utf8
forall a. IsString a => String -> a
fromString String
query) [PersistValue]
ps
  queryRaw :: Bool -> String -> [PersistValue] -> m (RowStream [PersistValue])
queryRaw Bool
_ 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 Postgresql (RowStream [PersistValue])
queryRaw' (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 Postgresql Int64
forall a. PersistField a => [a] -> Action Postgresql 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 Postgresql [a]
forall a. PersistField a => Int64 -> Action Postgresql [a]
getList' Int64
k

instance SchemaAnalyzer Postgresql where
  schemaExists :: String -> m Bool
schemaExists String
schema = Action (Conn m) Bool -> m Bool
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action (Conn m) Bool -> m Bool) -> Action (Conn m) Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Utf8
-> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' Utf8
"SELECT 1 FROM pg_catalog.pg_namespace WHERE nspname=?" [String -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue String
schema] Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Postgresql IO (Maybe [PersistValue]))
-> ReaderT Postgresql IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue]
-> ReaderT Postgresql IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow ReaderT Postgresql IO (Maybe [PersistValue])
-> (Maybe [PersistValue] -> ReaderT Postgresql IO Bool)
-> ReaderT Postgresql IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ReaderT Postgresql IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ReaderT Postgresql IO Bool)
-> (Maybe [PersistValue] -> Bool)
-> Maybe [PersistValue]
-> ReaderT Postgresql IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [PersistValue] -> Bool
forall a. Maybe a -> Bool
isJust
  getCurrentSchema :: m (Maybe String)
getCurrentSchema = 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
$ Utf8
-> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' Utf8
"SELECT current_schema()" [] Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Postgresql IO (Maybe [PersistValue]))
-> ReaderT Postgresql IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue]
-> ReaderT Postgresql IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow ReaderT Postgresql IO (Maybe [PersistValue])
-> (Maybe [PersistValue] -> ReaderT Postgresql IO (Maybe String))
-> ReaderT Postgresql IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> ReaderT Postgresql IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> ReaderT Postgresql IO (Maybe String))
-> (Maybe [PersistValue] -> Maybe String)
-> Maybe [PersistValue]
-> ReaderT Postgresql IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [PersistValue]
-> ([PersistValue] -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe String, [PersistValue]) -> Maybe String
forall a b. (a, b) -> a
fst ((Maybe String, [PersistValue]) -> Maybe String)
-> ([PersistValue] -> (Maybe String, [PersistValue]))
-> [PersistValue]
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> (Maybe String, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues)
  listTables :: Maybe String -> m [String]
listTables Maybe String
schema = 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 Postgresql (RowStream [PersistValue])
queryRaw' Utf8
"SELECT table_name FROM information_schema.tables WHERE table_schema=coalesce(?,current_schema())" [Maybe String -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue Maybe String
schema] Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Postgresql IO (RowStream String))
-> ReaderT Postgresql IO (RowStream String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action Postgresql String)
-> RowStream [PersistValue]
-> ReaderT Postgresql IO (RowStream String)
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream (String -> Action Postgresql String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Action Postgresql String)
-> ([PersistValue] -> String)
-> [PersistValue]
-> Action Postgresql 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 Postgresql IO (RowStream String)
-> (RowStream String -> ReaderT Postgresql IO [String])
-> ReaderT Postgresql IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream String -> ReaderT Postgresql IO [String]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
  listTableTriggers :: QualifiedName -> m [String]
listTableTriggers QualifiedName
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 Postgresql (RowStream [PersistValue])
queryRaw' Utf8
"SELECT trigger_name FROM information_schema.triggers WHERE event_object_schema=coalesce(?,current_schema()) AND event_object_table=?" (QualifiedName -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues QualifiedName
name []) Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Postgresql IO (RowStream String))
-> ReaderT Postgresql IO (RowStream String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action Postgresql String)
-> RowStream [PersistValue]
-> ReaderT Postgresql IO (RowStream String)
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream (String -> Action Postgresql String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Action Postgresql String)
-> ([PersistValue] -> String)
-> [PersistValue]
-> Action Postgresql 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 Postgresql IO (RowStream String)
-> (RowStream String -> ReaderT Postgresql IO [String])
-> ReaderT Postgresql IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream String -> ReaderT Postgresql IO [String]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
  analyzeTable :: QualifiedName -> m (Maybe TableInfo)
analyzeTable = ReaderT Postgresql IO (Maybe TableInfo) -> m (Maybe TableInfo)
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (ReaderT Postgresql IO (Maybe TableInfo) -> m (Maybe TableInfo))
-> (QualifiedName -> ReaderT Postgresql IO (Maybe TableInfo))
-> QualifiedName
-> m (Maybe TableInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedName -> ReaderT Postgresql IO (Maybe TableInfo)
analyzeTable'
  analyzeTrigger :: QualifiedName -> m (Maybe String)
analyzeTrigger QualifiedName
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 Postgresql (RowStream [PersistValue])
queryRaw' Utf8
"SELECT action_statement FROM information_schema.triggers WHERE trigger_schema=coalesce(?,current_schema()) AND trigger_name=?" (QualifiedName -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues QualifiedName
name []) Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Postgresql IO (Maybe [PersistValue]))
-> ReaderT Postgresql IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue]
-> ReaderT Postgresql IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow
    Maybe String -> ReaderT Postgresql IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> ReaderT Postgresql IO (Maybe String))
-> Maybe String -> ReaderT Postgresql IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ case Maybe [PersistValue]
x of
      Maybe [PersistValue]
Nothing -> Maybe String
forall a. Maybe a
Nothing
      Just [PersistValue]
src -> (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
  analyzeFunction :: QualifiedName
-> m (Maybe
        (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String))
analyzeFunction QualifiedName
name = Action
  (Conn m)
  (Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String))
-> m (Maybe
        (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String))
forall (m :: * -> *) a.
PersistBackend m =>
Action (Conn m) a -> m a
runDb' (Action
   (Conn m)
   (Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String))
 -> m (Maybe
         (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)))
-> Action
     (Conn m)
     (Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String))
-> m (Maybe
        (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String))
forall a b. (a -> b) -> a -> b
$ do
    let query :: Utf8
query =
          Utf8
"SELECT arg_types.typname, arg_types.typndims, arg_types_te.typname, ret.typname, ret.typndims, ret_te.typname, p.prosrc\
          \     FROM pg_catalog.pg_namespace n\
          \     INNER JOIN pg_catalog.pg_proc p ON p.pronamespace = n.oid\
          \     LEFT JOIN (SELECT oid, unnest(coalesce(proallargtypes, proargtypes)) as arg FROM pg_catalog.pg_proc) as args ON p.oid = args.oid\
          \     LEFT JOIN pg_type arg_types ON arg_types.oid = args.arg\
          \     LEFT JOIN pg_type arg_types_te ON arg_types_te.oid = arg_types.typelem\
          \     INNER JOIN pg_type ret ON p.prorettype = ret.oid\
          \     LEFT JOIN pg_type ret_te ON ret_te.oid = ret.typelem\
          \     WHERE n.nspname = coalesce(?,current_schema()) AND p.proname = ?"
    [((Maybe String, (Int, Maybe String)),
  ((String, (Int, Maybe String)), String))]
result <- Utf8
-> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' Utf8
query (QualifiedName -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues QualifiedName
name []) Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT
         Postgresql
         IO
         (RowStream
            ((Maybe String, (Int, Maybe String)),
             ((String, (Int, Maybe String)), String))))
-> ReaderT
     Postgresql
     IO
     (RowStream
        ((Maybe String, (Int, Maybe String)),
         ((String, (Int, Maybe String)), String)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue]
 -> Action
      Postgresql
      ((Maybe String, (Int, Maybe String)),
       ((String, (Int, Maybe String)), String)))
-> RowStream [PersistValue]
-> ReaderT
     Postgresql
     IO
     (RowStream
        ((Maybe String, (Int, Maybe String)),
         ((String, (Int, Maybe String)), String)))
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream (((Maybe String, (Int, Maybe String)),
 ((String, (Int, Maybe String)), String))
-> Action
     Postgresql
     ((Maybe String, (Int, Maybe String)),
      ((String, (Int, Maybe String)), String))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((Maybe String, (Int, Maybe String)),
  ((String, (Int, Maybe String)), String))
 -> Action
      Postgresql
      ((Maybe String, (Int, Maybe String)),
       ((String, (Int, Maybe String)), String)))
-> ([PersistValue]
    -> ((Maybe String, (Int, Maybe String)),
        ((String, (Int, Maybe String)), String)))
-> [PersistValue]
-> Action
     Postgresql
     ((Maybe String, (Int, Maybe String)),
      ((String, (Int, Maybe String)), String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Maybe String, (Int, Maybe String)),
  ((String, (Int, Maybe String)), String)),
 [PersistValue])
-> ((Maybe String, (Int, Maybe String)),
    ((String, (Int, Maybe String)), String))
forall a b. (a, b) -> a
fst ((((Maybe String, (Int, Maybe String)),
   ((String, (Int, Maybe String)), String)),
  [PersistValue])
 -> ((Maybe String, (Int, Maybe String)),
     ((String, (Int, Maybe String)), String)))
-> ([PersistValue]
    -> (((Maybe String, (Int, Maybe String)),
         ((String, (Int, Maybe String)), String)),
        [PersistValue]))
-> [PersistValue]
-> ((Maybe String, (Int, Maybe String)),
    ((String, (Int, Maybe String)), String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> (((Maybe String, (Int, Maybe String)),
     ((String, (Int, Maybe String)), String)),
    [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues) ReaderT
  Postgresql
  IO
  (RowStream
     ((Maybe String, (Int, Maybe String)),
      ((String, (Int, Maybe String)), String)))
-> (RowStream
      ((Maybe String, (Int, Maybe String)),
       ((String, (Int, Maybe String)), String))
    -> ReaderT
         Postgresql
         IO
         [((Maybe String, (Int, Maybe String)),
           ((String, (Int, Maybe String)), String))])
-> ReaderT
     Postgresql
     IO
     [((Maybe String, (Int, Maybe String)),
       ((String, (Int, Maybe String)), String))]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream
  ((Maybe String, (Int, Maybe String)),
   ((String, (Int, Maybe String)), String))
-> ReaderT
     Postgresql
     IO
     [((Maybe String, (Int, Maybe String)),
       ((String, (Int, Maybe String)), String))]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
    let read' :: (String, (Int, Maybe String)) -> DbTypePrimitive
read' (String
typ, (Int, Maybe String)
arr) = String
-> (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String)
-> (Int, Maybe String)
-> DbTypePrimitive
readSqlType String
typ (Maybe Int
forall a. Maybe a
Nothing, Maybe Int
forall a. Maybe a
Nothing, Maybe Int
forall a. Maybe a
Nothing, Maybe Int
forall a. Maybe a
Nothing, Maybe String
forall a. Maybe a
Nothing) (Int, Maybe String)
arr
    Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
-> ReaderT
     Postgresql
     IO
     (Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
 -> ReaderT
      Postgresql
      IO
      (Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)))
-> Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
-> ReaderT
     Postgresql
     IO
     (Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String))
forall a b. (a -> b) -> a -> b
$ case [((Maybe String, (Int, Maybe String)),
  ((String, (Int, Maybe String)), String))]
result of
      [] -> Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
forall a. Maybe a
Nothing
      (((Maybe String, (Int, Maybe String))
_, ((String, (Int, Maybe String))
ret, String
src)) : [((Maybe String, (Int, Maybe String)),
  ((String, (Int, Maybe String)), String))]
_) -> (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
-> Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
forall a. a -> Maybe a
Just ([DbTypePrimitive] -> Maybe [DbTypePrimitive]
forall a. a -> Maybe a
Just ([DbTypePrimitive] -> Maybe [DbTypePrimitive])
-> [DbTypePrimitive] -> Maybe [DbTypePrimitive]
forall a b. (a -> b) -> a -> b
$ ((String, (Int, Maybe String)) -> DbTypePrimitive)
-> [(String, (Int, Maybe String))] -> [DbTypePrimitive]
forall a b. (a -> b) -> [a] -> [b]
map (String, (Int, Maybe String)) -> DbTypePrimitive
read' [(String, (Int, Maybe String))]
args, DbTypePrimitive -> Maybe DbTypePrimitive
forall a. a -> Maybe a
Just (DbTypePrimitive -> Maybe DbTypePrimitive)
-> DbTypePrimitive -> Maybe DbTypePrimitive
forall a b. (a -> b) -> a -> b
$ (String, (Int, Maybe String)) -> DbTypePrimitive
read' (String, (Int, Maybe String))
ret, String
src)
        where
          args :: [(String, (Int, Maybe String))]
args = ((Maybe String, (Int, Maybe String))
 -> Maybe (String, (Int, Maybe String)))
-> [(Maybe String, (Int, Maybe String))]
-> [(String, (Int, Maybe String))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Maybe String
typ, (Int, Maybe String)
arr) -> (String -> (String, (Int, Maybe String)))
-> Maybe String -> Maybe (String, (Int, Maybe String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
typ' -> (String
typ', (Int, Maybe String)
arr)) Maybe String
typ) ([(Maybe String, (Int, Maybe String))]
 -> [(String, (Int, Maybe String))])
-> [(Maybe String, (Int, Maybe String))]
-> [(String, (Int, Maybe String))]
forall a b. (a -> b) -> a -> b
$ (((Maybe String, (Int, Maybe String)),
  ((String, (Int, Maybe String)), String))
 -> (Maybe String, (Int, Maybe String)))
-> [((Maybe String, (Int, Maybe String)),
     ((String, (Int, Maybe String)), String))]
-> [(Maybe String, (Int, Maybe String))]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe String, (Int, Maybe String)),
 ((String, (Int, Maybe String)), String))
-> (Maybe String, (Int, Maybe String))
forall a b. (a, b) -> a
fst [((Maybe String, (Int, Maybe String)),
  ((String, (Int, Maybe String)), String))]
result
  getMigrationPack :: m (MigrationPack Postgresql)
getMigrationPack = (Maybe String -> MigrationPack Postgresql)
-> m (Maybe String) -> m (MigrationPack Postgresql)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> MigrationPack Postgresql
migrationPack (String -> MigrationPack Postgresql)
-> (Maybe String -> String)
-> Maybe String
-> MigrationPack Postgresql
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust) m (Maybe String)
forall conn (m :: * -> *).
(SchemaAnalyzer conn, PersistBackend m, Conn m ~ conn) =>
m (Maybe String)
getCurrentSchema

withPostgresqlPool ::
  (MonadBaseControl IO m, MonadIO m) =>
  -- | connection string in keyword\/value format like "host=localhost port=5432 dbname=mydb". For more details and options see http://www.postgresql.org/docs/9.4/static/libpq-connect.html#LIBPQ-PARAMKEYWORDS
  String ->
  -- | number of connections to open
  Int ->
  (Pool Postgresql -> m a) ->
  m a
withPostgresqlPool :: String -> Int -> (Pool Postgresql -> m a) -> m a
withPostgresqlPool String
s Int
connCount Pool Postgresql -> m a
f = String -> Int -> m (Pool Postgresql)
forall (m :: * -> *).
MonadIO m =>
String -> Int -> m (Pool Postgresql)
createPostgresqlPool String
s Int
connCount m (Pool Postgresql) -> (Pool Postgresql -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pool Postgresql -> m a
f

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

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

-- Not sure of the best way to handle Semigroup/Monoid changes in ghc 8.4
-- here. It appears that the long SQL query text interferes with the use
-- of CPP here.
--
-- Manually copying over https://github.com/lpsmith/postgresql-simple/commit/44c0bb8dec3b71e8daefe104cf643c0c4fb26768#diff-75d19972de474bc8fa181e4733f3f0d6R94
-- but this is not really a good idea.
--
combine :: PG.Query -> PG.Query -> PG.Query
-- combine = (<>)
combine :: Query -> Query -> Query
combine (PG.Query ByteString
a) (PG.Query ByteString
b) = ByteString -> Query
PG.Query (ByteString -> ByteString -> ByteString
B.append ByteString
a ByteString
b)

instance Savepoint Postgresql where
  withConnSavepoint :: String -> m a -> Postgresql -> m a
withConnSavepoint String
name m a
m (Postgresql Connection
c) = do
    let name' :: Query
name' = String -> Query
forall a. IsString a => String -> a
fromString String
name
    Int64
_ <- IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> IO Int64
PG.execute_ Connection
c (Query -> IO Int64) -> Query -> IO Int64
forall a b. (a -> b) -> a -> b
$ Query
"SAVEPOINT " Query -> Query -> Query
`combine` Query
name'
    a
x <- m a -> m Int64 -> m a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
onException m a
m (IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> IO Int64
PG.execute_ Connection
c (Query -> IO Int64) -> Query -> IO Int64
forall a b. (a -> b) -> a -> b
$ Query
"ROLLBACK TO SAVEPOINT " Query -> Query -> Query
`combine` Query
name')
    Int64
_ <- IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> IO Int64
PG.execute_ Connection
c (Query -> IO Int64) -> Query -> IO Int64
forall a b. (a -> b) -> a -> b
$ Query
"RELEASE SAVEPOINT" Query -> Query -> Query
`combine` Query
name'
    a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

instance ConnectionManager Postgresql where
  withConn :: (Postgresql -> m a) -> Postgresql -> m a
withConn Postgresql -> m a
f conn :: Postgresql
conn@(Postgresql Connection
c) = do
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Connection -> IO ()
PG.begin Connection
c
    a
x <- m a -> m () -> m a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
onException (Postgresql -> m a
f Postgresql
conn) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Connection -> IO ()
PG.rollback Connection
c)
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Connection -> IO ()
PG.commit Connection
c
    a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

instance TryConnectionManager Postgresql where
  tryWithConn :: (Postgresql -> n a)
-> (n a -> m (Either SomeException a))
-> Postgresql
-> m (Either SomeException a)
tryWithConn Postgresql -> n a
f n a -> m (Either SomeException a)
g conn :: Postgresql
conn@(Postgresql Connection
c) = do
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Connection -> IO ()
PG.begin Connection
c
    Either SomeException a
x <- n a -> m (Either SomeException a)
g (Postgresql -> n a
f Postgresql
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
$ Connection -> IO ()
PG.rollback Connection
c
      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
$ Connection -> IO ()
PG.commit Connection
c
    Either SomeException a -> m (Either SomeException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
x

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

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

open' :: String -> IO Postgresql
open' :: String -> IO Postgresql
open' String
s = do
  Connection
conn <- ByteString -> IO Connection
PG.connectPostgreSQL (ByteString -> IO Connection) -> ByteString -> IO Connection
forall a b. (a -> b) -> a -> b
$ String -> ByteString
pack String
s
  Int64
_ <- Connection -> Query -> IO Int64
PG.execute_ Connection
conn (Query -> IO Int64) -> Query -> IO Int64
forall a b. (a -> b) -> a -> b
$ Utf8 -> Query
getStatement Utf8
"SET client_min_messages TO WARNING"
  Postgresql -> IO Postgresql
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Postgresql -> IO Postgresql) -> Postgresql -> IO Postgresql
forall a b. (a -> b) -> a -> b
$ Connection -> Postgresql
Postgresql Connection
conn

close' :: Postgresql -> IO ()
close' :: Postgresql -> IO ()
close' (Postgresql Connection
conn) = Connection -> IO ()
PG.close Connection
conn

insert' :: (PersistEntity v) => v -> Action Postgresql (AutoKey v)
insert' :: v -> Action Postgresql (AutoKey v)
insert' v
v = do
  -- constructor number and the rest of the field values
  [PersistValue]
vals <- v -> Action Postgresql [PersistValue]
forall v. PersistEntity v => v -> Action Postgresql [PersistValue]
toEntityPersistValues' v
v
  let e :: EntityDef
e = Any Postgresql -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any Postgresql
forall (proxy :: * -> *). proxy Postgresql
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 Postgresql IO (AutoKey v, [PersistValue])
-> Action Postgresql (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 Postgresql IO (AutoKey v, [PersistValue])
 -> Action Postgresql (AutoKey v))
-> ReaderT Postgresql IO (AutoKey v, [PersistValue])
-> Action Postgresql (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
-> Bool
-> Utf8
-> ConstructorDef
-> [PersistValue]
-> RenderS Any Any
forall db r.
Bool
-> Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r
insertIntoConstructorTable Bool
True 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)
        case ConstructorDef -> Maybe String
forall str dbType. ConstructorDef' str dbType -> Maybe str
constrAutoKeyName ConstructorDef
constr of
          Maybe String
Nothing -> Utf8 -> [PersistValue] -> Action Postgresql ()
executeRaw' Utf8
query ([PersistValue] -> [PersistValue]
vals' []) Action Postgresql ()
-> ReaderT Postgresql IO (AutoKey v, [PersistValue])
-> ReaderT Postgresql IO (AutoKey v, [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [PersistValue] -> ReaderT Postgresql IO (AutoKey v, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PurePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
pureFromPersistValue []
          Just String
_ -> do
            Maybe [PersistValue]
x <- Utf8
-> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' Utf8
query ([PersistValue] -> [PersistValue]
vals' []) Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Postgresql IO (Maybe [PersistValue]))
-> ReaderT Postgresql IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue]
-> ReaderT Postgresql IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow
            case Maybe [PersistValue]
x of
              Just [PersistValue]
xs -> [PersistValue] -> ReaderT Postgresql IO (AutoKey v, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PurePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
pureFromPersistValue [PersistValue]
xs
              Maybe [PersistValue]
Nothing -> [PersistValue] -> ReaderT Postgresql IO (AutoKey v, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PurePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
pureFromPersistValue []
      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(?)RETURNING(id)"
        PersistValue
rowid <- Utf8
-> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' Utf8
query (Int -> [PersistValue] -> [PersistValue]
forall a. Int -> [a] -> [a]
take Int
1 [PersistValue]
vals) Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue] -> ReaderT Postgresql IO PersistValue)
-> ReaderT Postgresql IO PersistValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue] -> ReaderT Postgresql IO PersistValue
getKey
        let RenderS Utf8
cQuery [PersistValue] -> [PersistValue]
vals' = Bool
-> Bool
-> Utf8
-> ConstructorDef
-> [PersistValue]
-> RenderS Any Any
forall db r.
Bool
-> Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r
insertIntoConstructorTable Bool
False 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 Postgresql ()
executeRaw' Utf8
cQuery ([PersistValue] -> [PersistValue]
vals' [])
        [PersistValue] -> ReaderT Postgresql IO (AutoKey v, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PurePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
pureFromPersistValue [PersistValue
rowid]

insert_' :: (PersistEntity v) => v -> Action Postgresql ()
insert_' :: v -> Action Postgresql ()
insert_' v
v = do
  -- constructor number and the rest of the field values
  [PersistValue]
vals <- v -> Action Postgresql [PersistValue]
forall v. PersistEntity v => v -> Action Postgresql [PersistValue]
toEntityPersistValues' v
v
  let e :: EntityDef
e = Any Postgresql -> v -> EntityDef
forall v db (proxy :: * -> *).
(PersistEntity v, DbDescriptor db) =>
proxy db -> v -> EntityDef
entityDef Any Postgresql
forall (proxy :: * -> *). proxy Postgresql
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
-> Bool
-> Utf8
-> ConstructorDef
-> [PersistValue]
-> RenderS Any Any
forall db r.
Bool
-> Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r
insertIntoConstructorTable Bool
False 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 Postgresql ()
executeRaw' 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(?)RETURNING(id)"
      PersistValue
rowid <- Utf8
-> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' Utf8
query (Int -> [PersistValue] -> [PersistValue]
forall a. Int -> [a] -> [a]
take Int
1 [PersistValue]
vals) Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue] -> ReaderT Postgresql IO PersistValue)
-> ReaderT Postgresql IO PersistValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue] -> ReaderT Postgresql IO PersistValue
getKey
      let RenderS Utf8
cQuery [PersistValue] -> [PersistValue]
vals' = Bool
-> Bool
-> Utf8
-> ConstructorDef
-> [PersistValue]
-> RenderS Any Any
forall db r.
Bool
-> Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r
insertIntoConstructorTable Bool
False 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 Postgresql ()
executeRaw' Utf8
cQuery ([PersistValue] -> [PersistValue]
vals' [])

insertIntoConstructorTable :: Bool -> Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r
insertIntoConstructorTable :: Bool
-> Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r
insertIntoConstructorTable Bool
withRet 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 Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
returning
    ([(String, DbType)]
fields, Utf8
returning) = case ConstructorDef -> Maybe String
forall str dbType. ConstructorDef' str dbType -> Maybe str
constrAutoKeyName ConstructorDef
c of
      Just String
idName -> ([(String, DbType)]
fields', Utf8
returning')
        where
          fields' :: [(String, DbType)]
fields' = if Bool
withId then (String
idName, Any Postgresql -> Int64 -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType Any Postgresql
forall (proxy :: * -> *). proxy Postgresql
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 else ConstructorDef -> [(String, DbType)]
forall str dbType. ConstructorDef' str dbType -> [(str, dbType)]
constrParams ConstructorDef
c
          returning' :: Utf8
returning' = if Bool
withRet then Utf8
" RETURNING(" Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8 -> Utf8
escapeS (String -> Utf8
forall a. IsString a => String -> a
fromString String
idName) Utf8 -> Utf8 -> Utf8
forall a. Semigroup a => a -> a -> a
<> Utf8
")" else Utf8
forall a. Monoid a => a
mempty
      Maybe String
_ -> (ConstructorDef -> [(String, DbType)]
forall str dbType. ConstructorDef' str dbType -> [(str, dbType)]
constrParams ConstructorDef
c, Utf8
forall a. Monoid a => a
mempty)
    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 Postgresql Int64
insertList' :: [a] -> Action Postgresql Int64
insertList' ([a]
l :: [a]) = 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))
  PersistValue
k <- Utf8
-> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' (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 RETURNING(id)") [] Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue] -> ReaderT Postgresql IO PersistValue)
-> ReaderT Postgresql IO PersistValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue] -> ReaderT Postgresql IO PersistValue
getKey
  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 Postgresql -> Int -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType Any Postgresql
forall (proxy :: * -> *). proxy Postgresql
proxy (Int
0 :: Int)), (String
"value", Any Postgresql -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType Any Postgresql
forall (proxy :: * -> *). proxy Postgresql
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 Postgresql ()
      go :: Int -> [a] -> Action Postgresql ()
go Int
n (a
x : [a]
xs) = do
        [PersistValue] -> [PersistValue]
x' <- a -> ReaderT Postgresql IO ([PersistValue] -> [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
a -> m ([PersistValue] -> [PersistValue])
toPersistValues a
x
        Utf8 -> [PersistValue] -> Action Postgresql ()
executeRaw' Utf8
query ([PersistValue] -> Action Postgresql ())
-> [PersistValue] -> Action Postgresql ()
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 Postgresql ()
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs
      go Int
_ [] = () -> Action Postgresql ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Int -> [a] -> Action Postgresql ()
go Int
0 [a]
l
  Int64 -> Action Postgresql Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Action Postgresql Int64)
-> Int64 -> Action Postgresql 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 Postgresql [a]
getList' :: Int64 -> Action Postgresql [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))
  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 value :: (String, DbType)
value = (String
"value", Any Postgresql -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType Any Postgresql
forall (proxy :: * -> *). proxy Postgresql
proxy (a
forall a. HasCallStack => a
undefined :: a))
  let 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 Postgresql (RowStream [PersistValue])
queryRaw' Utf8
query [Int64 -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue Int64
k] Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Postgresql IO (RowStream a))
-> ReaderT Postgresql IO (RowStream a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action Postgresql a)
-> RowStream [PersistValue] -> ReaderT Postgresql IO (RowStream a)
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream (((a, [PersistValue]) -> a)
-> ReaderT Postgresql IO (a, [PersistValue]) -> Action Postgresql 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 Postgresql IO (a, [PersistValue]) -> Action Postgresql a)
-> ([PersistValue] -> ReaderT Postgresql IO (a, [PersistValue]))
-> [PersistValue]
-> Action Postgresql a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> ReaderT Postgresql IO (a, [PersistValue])
forall a (m :: * -> *).
(PersistField a, PersistBackend m) =>
[PersistValue] -> m (a, [PersistValue])
fromPersistValues) ReaderT Postgresql IO (RowStream a)
-> (RowStream a -> Action Postgresql [a]) -> Action Postgresql [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream a -> Action Postgresql [a]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList

--TODO: consider removal
getKey :: RowStream [PersistValue] -> Action Postgresql PersistValue
getKey :: RowStream [PersistValue] -> ReaderT Postgresql IO PersistValue
getKey RowStream [PersistValue]
stream = RowStream [PersistValue]
-> ReaderT Postgresql IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow RowStream [PersistValue]
stream ReaderT Postgresql IO (Maybe [PersistValue])
-> (Maybe [PersistValue] -> ReaderT Postgresql IO PersistValue)
-> ReaderT Postgresql IO PersistValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Just [PersistValue
k]) -> PersistValue -> ReaderT Postgresql IO PersistValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure PersistValue
k

----------

executeRaw' :: Utf8 -> [PersistValue] -> Action Postgresql ()
executeRaw' :: Utf8 -> [PersistValue] -> Action Postgresql ()
executeRaw' Utf8
query [PersistValue]
vals = do
  --  $logDebugS "SQL" $ fromString $ show (fromUtf8 query) ++ " " ++ show vals
  Postgresql Connection
conn <- ReaderT Postgresql IO Postgresql
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let stmt :: Query
stmt = Utf8 -> Query
getStatement Utf8
query
  IO () -> Action Postgresql ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action Postgresql ()) -> IO () -> Action Postgresql ()
forall a b. (a -> b) -> a -> b
$ do
    Int64
_ <- Connection -> Query -> [P] -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
PG.execute Connection
conn Query
stmt ((PersistValue -> P) -> [PersistValue] -> [P]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> P
P [PersistValue]
vals)
    () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

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

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

toEntityPersistValues' :: PersistEntity v => v -> Action Postgresql [PersistValue]
toEntityPersistValues' :: v -> Action Postgresql [PersistValue]
toEntityPersistValues' = (([PersistValue] -> [PersistValue]) -> [PersistValue])
-> ReaderT Postgresql IO ([PersistValue] -> [PersistValue])
-> Action Postgresql [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 Postgresql IO ([PersistValue] -> [PersistValue])
 -> Action Postgresql [PersistValue])
-> (v -> ReaderT Postgresql IO ([PersistValue] -> [PersistValue]))
-> v
-> Action Postgresql [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ReaderT Postgresql IO ([PersistValue] -> [PersistValue])
forall v (m :: * -> *).
(PersistEntity v, PersistBackend m) =>
v -> m ([PersistValue] -> [PersistValue])
toEntityPersistValues

--- MIGRATION

migrate' :: (PersistEntity v) => v -> Migration (Action Postgresql)
migrate' :: v -> StateT NamedMigrations (Action Postgresql) ()
migrate' v
v = do
  MigrationPack Postgresql
migPack <- Action Postgresql (MigrationPack Postgresql)
-> StateT
     NamedMigrations (Action Postgresql) (MigrationPack Postgresql)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Action Postgresql (MigrationPack Postgresql)
forall conn (m :: * -> *).
(SchemaAnalyzer conn, PersistBackend m, Conn m ~ conn) =>
m (MigrationPack conn)
getMigrationPack
  (String -> ReaderT Postgresql IO SingleMigration)
-> (EntityDef -> ReaderT Postgresql IO SingleMigration)
-> (DbType -> ReaderT Postgresql IO SingleMigration)
-> v
-> StateT NamedMigrations (Action Postgresql) ()
forall (m :: * -> *) v.
(PersistBackend m, PersistEntity v) =>
(String -> m SingleMigration)
-> (EntityDef -> m SingleMigration)
-> (DbType -> m SingleMigration)
-> v
-> Migration m
migrateRecursively (MigrationPack Postgresql
-> String -> ReaderT Postgresql IO SingleMigration
forall conn.
SchemaAnalyzer conn =>
MigrationPack conn -> String -> Action conn SingleMigration
migrateSchema MigrationPack Postgresql
migPack) (MigrationPack Postgresql
-> EntityDef -> ReaderT Postgresql IO SingleMigration
forall conn.
(SchemaAnalyzer conn, PersistBackendConn conn) =>
MigrationPack conn -> EntityDef -> Action conn SingleMigration
migrateEntity MigrationPack Postgresql
migPack) (MigrationPack Postgresql
-> DbType -> ReaderT Postgresql IO SingleMigration
forall conn.
(SchemaAnalyzer conn, PersistBackendConn conn) =>
MigrationPack conn -> DbType -> Action conn SingleMigration
migrateList MigrationPack Postgresql
migPack) v
v

migrationPack :: String -> GM.MigrationPack Postgresql
migrationPack :: String -> MigrationPack Postgresql
migrationPack String
currentSchema = MigrationPack Postgresql
m
  where
    m :: MigrationPack Postgresql
m =
      (DbTypePrimitive -> DbTypePrimitive -> Bool)
-> ((Maybe String, Reference) -> (Maybe String, Reference) -> Bool)
-> (UniqueDefInfo -> UniqueDefInfo -> Bool)
-> (String -> String -> Bool)
-> (QualifiedName
    -> [(String, String)] -> Action Postgresql (Bool, [AlterDB]))
-> (QualifiedName
    -> [(String, String)] -> Action Postgresql [(Bool, [AlterDB])])
-> (EntityDef
    -> ConstructorDef -> Action Postgresql (Bool, SingleMigration))
-> (String -> String)
-> String
-> String
-> Int
-> ([UniqueDefInfo] -> [Reference] -> ([String], [AlterTable]))
-> (DbTypePrimitive -> String)
-> (Column -> String)
-> (AlterDB -> SingleMigration)
-> ReferenceActionType
-> ReferenceActionType
-> MigrationPack Postgresql
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
        (String
-> (Maybe String, Reference) -> (Maybe String, Reference) -> Bool
compareRefs String
currentSchema)
        UniqueDefInfo -> UniqueDefInfo -> Bool
compareUniqs
        String -> String -> Bool
compareDefaults
        QualifiedName
-> [(String, String)] -> Action Postgresql (Bool, [AlterDB])
migTriggerOnDelete
        QualifiedName
-> [(String, String)] -> Action Postgresql [(Bool, [AlterDB])]
migTriggerOnUpdate
        (MigrationPack Postgresql
-> EntityDef
-> ConstructorDef
-> Action Postgresql (Bool, SingleMigration)
forall conn.
(SchemaAnalyzer conn, PersistBackendConn conn) =>
MigrationPack conn
-> EntityDef
-> ConstructorDef
-> Action conn (Bool, SingleMigration)
GM.defaultMigConstr MigrationPack Postgresql
m)
        String -> String
escape
        String
"BIGSERIAL PRIMARY KEY UNIQUE"
        String
mainTableId
        Int
defaultPriority
        (\[UniqueDefInfo]
uniques [Reference]
refs -> ([], (UniqueDefInfo -> AlterTable) -> [UniqueDefInfo] -> [AlterTable]
forall a b. (a -> b) -> [a] -> [b]
map UniqueDefInfo -> AlterTable
AddUnique [UniqueDefInfo]
uniques [AlterTable] -> [AlterTable] -> [AlterTable]
forall a. [a] -> [a] -> [a]
++ (Reference -> AlterTable) -> [Reference] -> [AlterTable]
forall a b. (a -> b) -> [a] -> [b]
map Reference -> AlterTable
AddReference [Reference]
refs))
        DbTypePrimitive -> String
showSqlType
        Column -> String
showColumn
        AlterDB -> SingleMigration
showAlterDb
        ReferenceActionType
NoAction
        ReferenceActionType
NoAction

showColumn :: Column -> String
showColumn :: Column -> String
showColumn (Column String
n Bool
nu DbTypePrimitive
t Maybe String
def) =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String -> String
escape String
n,
      String
" ",
      DbTypePrimitive -> String
showSqlType DbTypePrimitive
t,
      String
" ",
      if Bool
nu then String
"NULL" else String
"NOT NULL",
      case Maybe String
def of
        Maybe String
Nothing -> String
""
        Just String
s -> String
" DEFAULT " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
    ]

migTriggerOnDelete :: QualifiedName -> [(String, String)] -> Action Postgresql (Bool, [AlterDB])
migTriggerOnDelete :: QualifiedName
-> [(String, String)] -> Action Postgresql (Bool, [AlterDB])
migTriggerOnDelete QualifiedName
tName [(String, String)]
deletes = do
  let funcName :: QualifiedName
funcName = QualifiedName
tName
      trigName :: QualifiedName
trigName = QualifiedName
tName
  Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
func <- QualifiedName
-> ReaderT
     Postgresql
     IO
     (Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String))
forall conn (m :: * -> *).
(SchemaAnalyzer conn, PersistBackend m, Conn m ~ conn) =>
QualifiedName
-> m (Maybe
        (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String))
analyzeFunction QualifiedName
funcName
  Maybe String
trig <- QualifiedName -> ReaderT Postgresql IO (Maybe String)
forall conn (m :: * -> *).
(SchemaAnalyzer conn, PersistBackend m, Conn m ~ conn) =>
QualifiedName -> m (Maybe String)
analyzeTrigger QualifiedName
trigName
  let funcBody :: String
funcBody = String
"BEGIN " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"RETURN NEW;END;"
      addFunction :: AlterDB
addFunction = String -> AlterDB
CreateOrReplaceFunction (String -> AlterDB) -> String -> AlterDB
forall a b. (a -> b) -> a -> b
$ String
"CREATE OR REPLACE FUNCTION " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualifiedName -> String
withSchema QualifiedName
funcName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"() RETURNS trigger AS $$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
funcBody String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$$ LANGUAGE plpgsql"
      funcMig :: [AlterDB]
funcMig = case Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
func of
        Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
Nothing | [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
deletes -> []
        Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
Nothing -> [AlterDB
addFunction]
        Just (Maybe [DbTypePrimitive]
_, Just (DbOther (OtherTypeDef [Left String
"trigger"])), String
body) ->
          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 -> AlterDB
DropFunction QualifiedName
funcName]
            else
              if String
body String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
funcBody
                then []
                else -- this can happen when an ephemeral field was added or removed.
                  [QualifiedName -> AlterDB
DropFunction QualifiedName
funcName, AlterDB
addFunction]
        Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
_ -> [] -- ignore same name functions which don't return a trigger.
      trigBody :: String
trigBody = String
"EXECUTE PROCEDURE " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualifiedName -> String
withSchema QualifiedName
funcName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"()"
      -- starting from version 11 postgresql returns EXECUTE FUNCTION
      trigBody11 :: String
trigBody11 = String
"EXECUTE FUNCTION " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualifiedName -> String
withSchema QualifiedName
funcName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"()"
      addTrigger :: AlterDB
addTrigger = QualifiedName -> QualifiedName -> String -> AlterDB
AddTriggerOnDelete QualifiedName
trigName QualifiedName
tName String
trigBody
      (Bool
trigExisted, [AlterDB]
trigMig) = case Maybe String
trig 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
body ->
          ( 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
trigName QualifiedName
tName]
              else
                if String
body String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
trigBody Bool -> Bool -> Bool
|| String
body String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
trigBody11
                  then []
                  else -- this can happen when an ephemeral field was added or removed.
                    [QualifiedName -> QualifiedName -> AlterDB
DropTrigger QualifiedName
trigName QualifiedName
tName, AlterDB
addTrigger]
          )
  (Bool, [AlterDB]) -> Action Postgresql (Bool, [AlterDB])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
trigExisted, [AlterDB]
funcMig [AlterDB] -> [AlterDB] -> [AlterDB]
forall a. [a] -> [a] -> [a]
++ [AlterDB]
trigMig)

-- | 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 Postgresql [(Bool, [AlterDB])]
migTriggerOnUpdate :: QualifiedName
-> [(String, String)] -> Action Postgresql [(Bool, [AlterDB])]
migTriggerOnUpdate QualifiedName
tName [(String, String)]
dels = [(String, String)]
-> ((String, String) -> Action Postgresql (Bool, [AlterDB]))
-> Action Postgresql [(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 Postgresql (Bool, [AlterDB]))
 -> Action Postgresql [(Bool, [AlterDB])])
-> ((String, String) -> Action Postgresql (Bool, [AlterDB]))
-> Action Postgresql [(Bool, [AlterDB])]
forall a b. (a -> b) -> a -> b
$ \(String
fieldName, String
del) -> do
  let funcName :: QualifiedName
funcName = (String -> String) -> QualifiedName -> QualifiedName
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (\String
name -> String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: String
fieldName) QualifiedName
tName
  let trigName :: QualifiedName
trigName = (String -> String) -> QualifiedName -> QualifiedName
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (\String
name -> String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
delim Char -> String -> String
forall a. a -> [a] -> [a]
: String
fieldName) QualifiedName
tName
  Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
func <- QualifiedName
-> ReaderT
     Postgresql
     IO
     (Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String))
forall conn (m :: * -> *).
(SchemaAnalyzer conn, PersistBackend m, Conn m ~ conn) =>
QualifiedName
-> m (Maybe
        (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String))
analyzeFunction QualifiedName
funcName
  Maybe String
trig <- QualifiedName -> ReaderT Postgresql IO (Maybe String)
forall conn (m :: * -> *).
(SchemaAnalyzer conn, PersistBackend m, Conn m ~ conn) =>
QualifiedName -> m (Maybe String)
analyzeTrigger QualifiedName
trigName
  let funcBody :: String
funcBody = String
"BEGIN " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
del String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"RETURN NEW;END;"
      addFunction :: AlterDB
addFunction = String -> AlterDB
CreateOrReplaceFunction (String -> AlterDB) -> String -> AlterDB
forall a b. (a -> b) -> a -> b
$ String
"CREATE OR REPLACE FUNCTION " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualifiedName -> String
withSchema QualifiedName
funcName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"() RETURNS trigger AS $$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
funcBody String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$$ LANGUAGE plpgsql"
      funcMig :: [AlterDB]
funcMig = case Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
func of
        Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
Nothing -> [AlterDB
addFunction]
        Just (Maybe [DbTypePrimitive]
_, Just (DbOther (OtherTypeDef [Left String
"trigger"])), String
body) ->
          if String
body String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
funcBody
            then []
            else -- this can happen when an ephemeral field was added or removed.
              [QualifiedName -> AlterDB
DropFunction QualifiedName
funcName, AlterDB
addFunction]
        Maybe (Maybe [DbTypePrimitive], Maybe DbTypePrimitive, String)
_ -> []

      trigBody :: String
trigBody = String
"EXECUTE PROCEDURE " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualifiedName -> String
withSchema QualifiedName
funcName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"()"
      -- starting from version 11 postgresql returns EXECUTE FUNCTION
      trigBody11 :: String
trigBody11 = String
"EXECUTE FUNCTION " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualifiedName -> String
withSchema QualifiedName
funcName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"()"
      addTrigger :: AlterDB
addTrigger = QualifiedName -> QualifiedName -> Maybe String -> String -> AlterDB
AddTriggerOnUpdate QualifiedName
trigName QualifiedName
tName (String -> Maybe String
forall a. a -> Maybe a
Just String
fieldName) String
trigBody
      (Bool
trigExisted, [AlterDB]
trigMig) = case Maybe String
trig of
        Maybe String
Nothing -> (Bool
False, [AlterDB
addTrigger])
        Just String
body ->
          ( Bool
True,
            if String
body String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
trigBody Bool -> Bool -> Bool
|| String
body String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
trigBody11
              then []
              else -- this can happen when an ephemeral field was added or removed.
                [QualifiedName -> QualifiedName -> AlterDB
DropTrigger QualifiedName
trigName QualifiedName
tName, AlterDB
addTrigger]
          )
  (Bool, [AlterDB]) -> Action Postgresql (Bool, [AlterDB])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
trigExisted, [AlterDB]
funcMig [AlterDB] -> [AlterDB] -> [AlterDB]
forall a. [a] -> [a] -> [a]
++ [AlterDB]
trigMig)

analyzeTable' :: QualifiedName -> Action Postgresql (Maybe TableInfo)
analyzeTable' :: QualifiedName -> ReaderT Postgresql IO (Maybe TableInfo)
analyzeTable' QualifiedName
name = do
  Maybe [PersistValue]
table <- Utf8
-> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' Utf8
"SELECT * FROM information_schema.tables WHERE table_schema = coalesce(?, current_schema()) AND table_name = ?" (QualifiedName -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues QualifiedName
name []) Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Postgresql IO (Maybe [PersistValue]))
-> ReaderT Postgresql IO (Maybe [PersistValue])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream [PersistValue]
-> ReaderT Postgresql IO (Maybe [PersistValue])
forall (m :: * -> *) a. MonadIO m => RowStream a -> m (Maybe a)
firstRow
  case Maybe [PersistValue]
table of
    Just [PersistValue]
_ -> do
      let colQuery :: Utf8
colQuery =
            Utf8
"SELECT c.column_name, c.is_nullable, c.udt_name, c.column_default, c.character_maximum_length, c.numeric_precision, c.numeric_scale, c.datetime_precision, c.interval_type, a.attndims AS array_dims, te.typname AS array_elem\
            \  FROM pg_catalog.pg_attribute a\
            \  INNER JOIN pg_catalog.pg_class cl ON cl.oid = a.attrelid\
            \  INNER JOIN pg_catalog.pg_namespace n ON n.oid = cl.relnamespace\
            \  INNER JOIN information_schema.columns c ON c.column_name = a.attname AND c.table_name = cl.relname AND c.table_schema = n.nspname\
            \  INNER JOIN pg_catalog.pg_type t ON t.oid = a.atttypid\
            \  LEFT JOIN pg_catalog.pg_type te ON te.oid = t.typelem\
            \  WHERE c.table_schema = coalesce(?, current_schema()) AND c.table_name=?\
            \  ORDER BY c.ordinal_position"

      [Column]
cols <- Utf8
-> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' Utf8
colQuery (QualifiedName -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues QualifiedName
name []) Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Postgresql IO (RowStream Column))
-> ReaderT Postgresql IO (RowStream Column)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action Postgresql Column)
-> RowStream [PersistValue]
-> ReaderT Postgresql IO (RowStream Column)
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream (Column -> Action Postgresql Column
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Column -> Action Postgresql Column)
-> ([PersistValue] -> Column)
-> [PersistValue]
-> Action Postgresql Column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String, String, Maybe String),
 (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String),
 (Int, Maybe String))
-> Column
getColumn (((String, String, String, Maybe String),
  (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String),
  (Int, Maybe String))
 -> Column)
-> ([PersistValue]
    -> ((String, String, String, Maybe String),
        (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String),
        (Int, Maybe String)))
-> [PersistValue]
-> Column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((String, String, String, Maybe String),
  (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String),
  (Int, Maybe String)),
 [PersistValue])
-> ((String, String, String, Maybe String),
    (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String),
    (Int, Maybe String))
forall a b. (a, b) -> a
fst ((((String, String, String, Maybe String),
   (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String),
   (Int, Maybe String)),
  [PersistValue])
 -> ((String, String, String, Maybe String),
     (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String),
     (Int, Maybe String)))
-> ([PersistValue]
    -> (((String, String, String, Maybe String),
         (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String),
         (Int, Maybe String)),
        [PersistValue]))
-> [PersistValue]
-> ((String, String, String, Maybe String),
    (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String),
    (Int, Maybe String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> (((String, String, String, Maybe String),
     (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String),
     (Int, Maybe String)),
    [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues) ReaderT Postgresql IO (RowStream Column)
-> (RowStream Column -> ReaderT Postgresql IO [Column])
-> ReaderT Postgresql IO [Column]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream Column -> ReaderT Postgresql IO [Column]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
      let constraintQuery :: Utf8
constraintQuery = Utf8
"SELECT u.constraint_name, u.column_name FROM information_schema.table_constraints tc INNER JOIN information_schema.constraint_column_usage u ON tc.constraint_catalog=u.constraint_catalog AND tc.constraint_schema=u.constraint_schema AND tc.constraint_name=u.constraint_name WHERE tc.constraint_type=? AND tc.table_schema=coalesce(?,current_schema()) AND u.table_name=? ORDER BY u.constraint_name, u.column_name"

      [QualifiedName]
uniqConstraints <- Utf8
-> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' Utf8
constraintQuery ((String, QualifiedName) -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues (String
"UNIQUE" :: String, QualifiedName
name) []) Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Postgresql IO (RowStream QualifiedName))
-> ReaderT Postgresql IO (RowStream QualifiedName)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action Postgresql QualifiedName)
-> RowStream [PersistValue]
-> ReaderT Postgresql IO (RowStream QualifiedName)
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream (QualifiedName -> Action Postgresql QualifiedName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QualifiedName -> Action Postgresql QualifiedName)
-> ([PersistValue] -> QualifiedName)
-> [PersistValue]
-> Action Postgresql QualifiedName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedName, [PersistValue]) -> QualifiedName
forall a b. (a, b) -> a
fst ((QualifiedName, [PersistValue]) -> QualifiedName)
-> ([PersistValue] -> (QualifiedName, [PersistValue]))
-> [PersistValue]
-> QualifiedName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> (QualifiedName, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues) ReaderT Postgresql IO (RowStream QualifiedName)
-> (RowStream QualifiedName
    -> ReaderT Postgresql IO [QualifiedName])
-> ReaderT Postgresql IO [QualifiedName]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream QualifiedName -> ReaderT Postgresql IO [QualifiedName]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
      [QualifiedName]
uniqPrimary <- Utf8
-> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' Utf8
constraintQuery ((String, QualifiedName) -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues (String
"PRIMARY KEY" :: String, QualifiedName
name) []) Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Postgresql IO (RowStream QualifiedName))
-> ReaderT Postgresql IO (RowStream QualifiedName)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action Postgresql QualifiedName)
-> RowStream [PersistValue]
-> ReaderT Postgresql IO (RowStream QualifiedName)
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream (QualifiedName -> Action Postgresql QualifiedName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QualifiedName -> Action Postgresql QualifiedName)
-> ([PersistValue] -> QualifiedName)
-> [PersistValue]
-> Action Postgresql QualifiedName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedName, [PersistValue]) -> QualifiedName
forall a b. (a, b) -> a
fst ((QualifiedName, [PersistValue]) -> QualifiedName)
-> ([PersistValue] -> (QualifiedName, [PersistValue]))
-> [PersistValue]
-> QualifiedName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> (QualifiedName, [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues) ReaderT Postgresql IO (RowStream QualifiedName)
-> (RowStream QualifiedName
    -> ReaderT Postgresql IO [QualifiedName])
-> ReaderT Postgresql IO [QualifiedName]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream QualifiedName -> ReaderT Postgresql IO [QualifiedName]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
      -- indexes with system columns like oid are omitted
      let indexQuery :: Utf8
indexQuery =
            Utf8
"WITH indexes as (\
            \SELECT ic.oid, ic.relname,\
            \    ta.attnum, ta.attname, pg_get_indexdef(i.indexrelid, ia.attnum, true) as expr\
            \  FROM pg_catalog.pg_index i\
            \  INNER JOIN pg_catalog.pg_class ic ON ic.oid = i.indexrelid\
            \  INNER JOIN pg_catalog.pg_class tc ON i.indrelid = tc.oid\
            \  INNER JOIN pg_catalog.pg_attribute ia ON ia.attrelid=ic.oid\
            \  LEFT JOIN pg_catalog.pg_attribute ta ON ta.attrelid=tc.oid AND ta.attnum = i.indkey[ia.attnum-1] AND NOT ta.attisdropped\
            \  INNER JOIN pg_namespace sch ON sch.oid = tc.relnamespace\
            \  WHERE sch.nspname = coalesce(?, current_schema())\
            \    AND tc.relname = ?\
            \    AND ic.oid NOT IN (SELECT conindid FROM pg_catalog.pg_constraint)\
            \    AND NOT i.indisprimary\
            \    AND i.indisunique\
            \  ORDER BY ic.relname, ia.attnum)\
            \SELECT i.relname, i.attname, i.expr\
            \  FROM indexes i\
            \  INNER JOIN (SELECT oid FROM indexes\
            \    GROUP BY oid\
            \    HAVING every(attnum > 0 OR attnum IS NULL)) non_system ON i.oid = non_system.oid"
      [(Maybe String, QualifiedName)]
uniqIndexes <- Utf8
-> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' Utf8
indexQuery (QualifiedName -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues QualifiedName
name []) Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT Postgresql IO (RowStream (Maybe String, QualifiedName)))
-> ReaderT Postgresql IO (RowStream (Maybe String, QualifiedName))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue] -> Action Postgresql (Maybe String, QualifiedName))
-> RowStream [PersistValue]
-> ReaderT Postgresql IO (RowStream (Maybe String, QualifiedName))
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream ((Maybe String, QualifiedName)
-> Action Postgresql (Maybe String, QualifiedName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe String, QualifiedName)
 -> Action Postgresql (Maybe String, QualifiedName))
-> ([PersistValue] -> (Maybe String, QualifiedName))
-> [PersistValue]
-> Action Postgresql (Maybe String, QualifiedName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe String, QualifiedName), [PersistValue])
-> (Maybe String, QualifiedName)
forall a b. (a, b) -> a
fst (((Maybe String, QualifiedName), [PersistValue])
 -> (Maybe String, QualifiedName))
-> ([PersistValue]
    -> ((Maybe String, QualifiedName), [PersistValue]))
-> [PersistValue]
-> (Maybe String, QualifiedName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> ((Maybe String, QualifiedName), [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues) ReaderT Postgresql IO (RowStream (Maybe String, QualifiedName))
-> (RowStream (Maybe String, QualifiedName)
    -> ReaderT Postgresql IO [(Maybe String, QualifiedName)])
-> ReaderT Postgresql IO [(Maybe String, QualifiedName)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream (Maybe String, QualifiedName)
-> ReaderT Postgresql IO [(Maybe String, QualifiedName)]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
      let mkUniqs :: UniqueType -> [(Maybe str, field)] -> [UniqueDef' str field]
mkUniqs UniqueType
typ = ([(Maybe str, field)] -> UniqueDef' str field)
-> [[(Maybe str, field)]] -> [UniqueDef' str field]
forall a b. (a -> b) -> [a] -> [b]
map (\[(Maybe str, field)]
us -> Maybe str -> UniqueType -> [field] -> UniqueDef' str field
forall str field.
Maybe str -> UniqueType -> [field] -> UniqueDef' str field
UniqueDef ((Maybe str, field) -> Maybe str
forall a b. (a, b) -> a
fst ((Maybe str, field) -> Maybe str)
-> (Maybe str, field) -> Maybe str
forall a b. (a -> b) -> a -> b
$ [(Maybe str, field)] -> (Maybe str, field)
forall a. [a] -> a
head [(Maybe str, field)]
us) UniqueType
typ (((Maybe str, field) -> field) -> [(Maybe str, field)] -> [field]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe str, field) -> field
forall a b. (a, b) -> b
snd [(Maybe str, field)]
us)) ([[(Maybe str, field)]] -> [UniqueDef' str field])
-> ([(Maybe str, field)] -> [[(Maybe str, field)]])
-> [(Maybe str, field)]
-> [UniqueDef' str field]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe str, field) -> (Maybe str, field) -> Bool)
-> [(Maybe str, field)] -> [[(Maybe str, field)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Maybe str -> Maybe str -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe str -> Maybe str -> Bool)
-> ((Maybe str, field) -> Maybe str)
-> (Maybe str, field)
-> (Maybe str, field)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Maybe str, field) -> Maybe str
forall a b. (a, b) -> a
fst)
          isAutoincremented :: Bool
isAutoincremented = case (Column -> Bool) -> [Column] -> [Column]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Column
c -> Column -> String
colName Column
c String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (QualifiedName -> String) -> [QualifiedName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map QualifiedName -> String
forall a b. (a, b) -> b
snd [QualifiedName]
uniqPrimary) [Column]
cols of
            [Column
c] -> Column -> DbTypePrimitive
colType Column
c DbTypePrimitive -> [DbTypePrimitive] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt32, DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt64] Bool -> Bool -> Bool
&& Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (String
"nextval" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) (Column -> Maybe String
colDefault Column
c)
            [Column]
_ -> Bool
False
      let uniqs :: [UniqueDefInfo]
uniqs =
            UniqueType
-> [(Maybe String, Either String String)] -> [UniqueDefInfo]
forall str field.
Eq str =>
UniqueType -> [(Maybe str, field)] -> [UniqueDef' str field]
mkUniqs UniqueType
UniqueConstraint ((QualifiedName -> (Maybe String, Either String String))
-> [QualifiedName] -> [(Maybe String, Either String String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Either String String)
-> QualifiedName -> (Maybe String, Either String String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second String -> Either String String
forall a b. a -> Either a b
Left) [QualifiedName]
uniqConstraints)
              [UniqueDefInfo] -> [UniqueDefInfo] -> [UniqueDefInfo]
forall a. [a] -> [a] -> [a]
++ UniqueType
-> [(Maybe String, Either String String)] -> [UniqueDefInfo]
forall str field.
Eq str =>
UniqueType -> [(Maybe str, field)] -> [UniqueDef' str field]
mkUniqs UniqueType
UniqueIndex (((Maybe String, QualifiedName)
 -> (Maybe String, Either String String))
-> [(Maybe String, QualifiedName)]
-> [(Maybe String, Either String String)]
forall a b. (a -> b) -> [a] -> [b]
map ((QualifiedName -> Either String String)
-> (Maybe String, QualifiedName)
-> (Maybe String, Either String String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((QualifiedName -> Either String String)
 -> (Maybe String, QualifiedName)
 -> (Maybe String, Either String String))
-> (QualifiedName -> Either String String)
-> (Maybe String, QualifiedName)
-> (Maybe String, Either String String)
forall a b. (a -> b) -> a -> b
$ \(Maybe String
col, String
expr) -> Either String String
-> (String -> Either String String)
-> Maybe String
-> Either String String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String String
forall a b. b -> Either a b
Right String
expr) String -> Either String String
forall a b. a -> Either a b
Left Maybe String
col) [(Maybe String, QualifiedName)]
uniqIndexes)
              [UniqueDefInfo] -> [UniqueDefInfo] -> [UniqueDefInfo]
forall a. [a] -> [a] -> [a]
++ UniqueType
-> [(Maybe String, Either String String)] -> [UniqueDefInfo]
forall str field.
Eq str =>
UniqueType -> [(Maybe str, field)] -> [UniqueDef' str field]
mkUniqs (Bool -> UniqueType
UniquePrimary Bool
isAutoincremented) ((QualifiedName -> (Maybe String, Either String String))
-> [QualifiedName] -> [(Maybe String, Either String String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Either String String)
-> QualifiedName -> (Maybe String, Either String String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second String -> Either String String
forall a b. a -> Either a b
Left) [QualifiedName]
uniqPrimary)
      [(Maybe String, Reference)]
references <- QualifiedName -> Action Postgresql [(Maybe String, Reference)]
analyzeTableReferences QualifiedName
name
      Maybe TableInfo -> ReaderT Postgresql IO (Maybe TableInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TableInfo -> ReaderT Postgresql IO (Maybe TableInfo))
-> Maybe TableInfo -> ReaderT Postgresql 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]
cols [UniqueDefInfo]
uniqs [(Maybe String, Reference)]
references
    Maybe [PersistValue]
Nothing -> Maybe TableInfo -> ReaderT Postgresql IO (Maybe TableInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TableInfo
forall a. Maybe a
Nothing

getColumn :: ((String, String, String, Maybe String), (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String), (Int, Maybe String)) -> Column
getColumn :: ((String, String, String, Maybe String),
 (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String),
 (Int, Maybe String))
-> Column
getColumn ((String
column_name, String
is_nullable, String
udt_name, Maybe String
d), (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String)
modifiers, (Int, Maybe String)
arr_info) = String -> Bool -> DbTypePrimitive -> Maybe String -> Column
Column String
column_name (String
is_nullable String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"YES") DbTypePrimitive
t Maybe String
d
  where
    t :: DbTypePrimitive
t = String
-> (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String)
-> (Int, Maybe String)
-> DbTypePrimitive
readSqlType String
udt_name (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String)
modifiers (Int, Maybe String)
arr_info

analyzeTableReferences :: QualifiedName -> Action Postgresql [(Maybe String, Reference)]
analyzeTableReferences :: QualifiedName -> Action Postgresql [(Maybe String, Reference)]
analyzeTableReferences QualifiedName
tName = do
  let sql :: Utf8
sql =
        Utf8
"SELECT c.conname, sch_parent.nspname, cl_parent.relname, c. confdeltype, c.confupdtype, a_child.attname AS child, a_parent.attname AS parent FROM\
        \  (SELECT r.conrelid, r.confrelid, unnest(r.conkey) AS conkey, unnest(r.confkey) AS confkey, r.conname, r.confupdtype, r.confdeltype\
        \    FROM pg_catalog.pg_constraint r WHERE r.contype = 'f'\
        \  ) AS c\
        \  INNER JOIN pg_attribute a_parent ON a_parent.attnum = c.confkey AND a_parent.attrelid = c.confrelid\
        \  INNER JOIN pg_class cl_parent ON cl_parent.oid = c.confrelid\
        \  INNER JOIN pg_namespace sch_parent ON sch_parent.oid = cl_parent.relnamespace\
        \  INNER JOIN pg_attribute a_child ON a_child.attnum = c.conkey AND a_child.attrelid = c.conrelid\
        \  INNER JOIN pg_class cl_child ON cl_child.oid = c.conrelid\
        \  INNER JOIN pg_namespace sch_child ON sch_child.oid = cl_child.relnamespace\
        \  WHERE sch_child.nspname = coalesce(?, current_schema()) AND cl_child.relname = ?\
        \  ORDER BY c.conname"
  [(String, ((QualifiedName, String, String), (String, String)))]
x <- Utf8
-> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' Utf8
sql (QualifiedName -> [PersistValue] -> [PersistValue]
forall a.
PurePersistField a =>
a -> [PersistValue] -> [PersistValue]
toPurePersistValues QualifiedName
tName []) Action Postgresql (RowStream [PersistValue])
-> (RowStream [PersistValue]
    -> ReaderT
         Postgresql
         IO
         (RowStream
            (String, ((QualifiedName, String, String), (String, String)))))
-> ReaderT
     Postgresql
     IO
     (RowStream
        (String, ((QualifiedName, String, String), (String, String))))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([PersistValue]
 -> Action
      Postgresql
      (String, ((QualifiedName, String, String), (String, String))))
-> RowStream [PersistValue]
-> ReaderT
     Postgresql
     IO
     (RowStream
        (String, ((QualifiedName, String, String), (String, String))))
forall conn a b.
PersistBackendConn conn =>
(a -> Action conn b) -> RowStream a -> Action conn (RowStream b)
mapStream ((String, ((QualifiedName, String, String), (String, String)))
-> Action
     Postgresql
     (String, ((QualifiedName, String, String), (String, String)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String, ((QualifiedName, String, String), (String, String)))
 -> Action
      Postgresql
      (String, ((QualifiedName, String, String), (String, String))))
-> ([PersistValue]
    -> (String, ((QualifiedName, String, String), (String, String))))
-> [PersistValue]
-> Action
     Postgresql
     (String, ((QualifiedName, String, String), (String, String)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, ((QualifiedName, String, String), (String, String))),
 [PersistValue])
-> (String, ((QualifiedName, String, String), (String, String)))
forall a b. (a, b) -> a
fst (((String, ((QualifiedName, String, String), (String, String))),
  [PersistValue])
 -> (String, ((QualifiedName, String, String), (String, String))))
-> ([PersistValue]
    -> ((String, ((QualifiedName, String, String), (String, String))),
        [PersistValue]))
-> [PersistValue]
-> (String, ((QualifiedName, String, String), (String, String)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue]
-> ((String, ((QualifiedName, String, String), (String, String))),
    [PersistValue])
forall a.
PurePersistField a =>
[PersistValue] -> (a, [PersistValue])
fromPurePersistValues) ReaderT
  Postgresql
  IO
  (RowStream
     (String, ((QualifiedName, String, String), (String, String))))
-> (RowStream
      (String, ((QualifiedName, String, String), (String, String)))
    -> ReaderT
         Postgresql
         IO
         [(String, ((QualifiedName, String, String), (String, String)))])
-> ReaderT
     Postgresql
     IO
     [(String, ((QualifiedName, String, String), (String, String)))]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RowStream
  (String, ((QualifiedName, String, String), (String, String)))
-> ReaderT
     Postgresql
     IO
     [(String, ((QualifiedName, String, String), (String, String)))]
forall (m :: * -> *) a. MonadIO m => RowStream a -> m [a]
streamToList
  -- (refName, ((parentTableSchema, parentTable, onDelete, onUpdate), (childColumn, parentColumn)))
  let mkReference :: [(a, ((QualifiedName, String, String), (String, String)))]
-> (Maybe a, Reference)
mkReference [(a, ((QualifiedName, String, String), (String, String)))]
xs = (a -> Maybe a
forall a. a -> Maybe a
Just a
refName, QualifiedName
-> [(String, String)]
-> Maybe ReferenceActionType
-> Maybe ReferenceActionType
-> Reference
Reference QualifiedName
parentTable [(String, String)]
pairs (String -> Maybe ReferenceActionType
mkAction String
onDelete) (String -> Maybe ReferenceActionType
mkAction String
onUpdate))
        where
          pairs :: [(String, String)]
pairs = ((a, ((QualifiedName, String, String), (String, String)))
 -> (String, String))
-> [(a, ((QualifiedName, String, String), (String, String)))]
-> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (((QualifiedName, String, String), (String, String))
-> (String, String)
forall a b. (a, b) -> b
snd (((QualifiedName, String, String), (String, String))
 -> (String, String))
-> ((a, ((QualifiedName, String, String), (String, String)))
    -> ((QualifiedName, String, String), (String, String)))
-> (a, ((QualifiedName, String, String), (String, String)))
-> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, ((QualifiedName, String, String), (String, String)))
-> ((QualifiedName, String, String), (String, String))
forall a b. (a, b) -> b
snd) [(a, ((QualifiedName, String, String), (String, String)))]
xs
          (a
refName, ((QualifiedName
parentTable, String
onDelete, String
onUpdate), (String, String)
_)) = [(a, ((QualifiedName, String, String), (String, String)))]
-> (a, ((QualifiedName, String, String), (String, String)))
forall a. [a] -> a
head [(a, ((QualifiedName, String, String), (String, String)))]
xs
          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
$ case String
c of
            String
"a" -> ReferenceActionType
NoAction
            String
"r" -> ReferenceActionType
Restrict
            String
"c" -> ReferenceActionType
Cascade
            String
"n" -> ReferenceActionType
SetNull
            String
"d" -> ReferenceActionType
SetDefault
            String
_ -> 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
      references :: [(Maybe String, Reference)]
references = ([(String, ((QualifiedName, String, String), (String, String)))]
 -> (Maybe String, Reference))
-> [[(String,
      ((QualifiedName, String, String), (String, String)))]]
-> [(Maybe String, Reference)]
forall a b. (a -> b) -> [a] -> [b]
map [(String, ((QualifiedName, String, String), (String, String)))]
-> (Maybe String, Reference)
forall a.
[(a, ((QualifiedName, String, String), (String, String)))]
-> (Maybe a, Reference)
mkReference ([[(String, ((QualifiedName, String, String), (String, String)))]]
 -> [(Maybe String, Reference)])
-> [[(String,
      ((QualifiedName, String, String), (String, String)))]]
-> [(Maybe String, Reference)]
forall a b. (a -> b) -> a -> b
$ ((String, ((QualifiedName, String, String), (String, String)))
 -> (String, ((QualifiedName, String, String), (String, String)))
 -> Bool)
-> [(String, ((QualifiedName, String, String), (String, String)))]
-> [[(String,
      ((QualifiedName, String, String), (String, String)))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> ((String, ((QualifiedName, String, String), (String, String)))
    -> String)
-> (String, ((QualifiedName, String, String), (String, String)))
-> (String, ((QualifiedName, String, String), (String, String)))
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (String, ((QualifiedName, String, String), (String, String)))
-> String
forall a b. (a, b) -> a
fst) [(String, ((QualifiedName, String, String), (String, String)))]
x
  [(Maybe String, Reference)]
-> Action Postgresql [(Maybe String, Reference)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Maybe String, Reference)]
references

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 QualifiedName
t String
_ TableInfo
_ TableInfo
_ [AlterTable]
alts) = [(Bool, Int, String)] -> SingleMigration
forall a b. b -> Either a b
Right ([(Bool, Int, String)] -> SingleMigration)
-> [(Bool, Int, String)] -> SingleMigration
forall a b. (a -> b) -> a -> b
$ (AlterTable -> [(Bool, Int, String)])
-> [AlterTable] -> [(Bool, Int, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> AlterTable -> [(Bool, Int, String)]
showAlterTable (String -> AlterTable -> [(Bool, Int, String)])
-> String -> AlterTable -> [(Bool, Int, String)]
forall a b. (a -> b) -> a -> b
$ QualifiedName -> String
withSchema QualifiedName
t) [AlterTable]
alts
showAlterDb (DropTrigger QualifiedName
trigName QualifiedName
tName) = [(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]
++ QualifiedName -> String
withSchema QualifiedName
trigName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ON " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualifiedName -> String
withSchema QualifiedName
tName)]
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]
++ QualifiedName -> String
withSchema QualifiedName
trigName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" AFTER DELETE ON " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualifiedName -> String
withSchema QualifiedName
tName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" FOR EACH ROW " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
body)]
showAlterDb (AddTriggerOnUpdate QualifiedName
trigName QualifiedName
tName Maybe String
fName 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]
++ QualifiedName -> String
withSchema QualifiedName
trigName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" AFTER UPDATE OF " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fName' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ON " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualifiedName -> String
withSchema QualifiedName
tName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" FOR EACH ROW " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
body)]
  where
    fName' :: String
fName' = 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
fName
showAlterDb (CreateOrReplaceFunction String
s) = [(Bool, Int, String)] -> SingleMigration
forall a b. b -> Either a b
Right [(Bool
False, Int
functionPriority, String
s)]
showAlterDb (DropFunction QualifiedName
funcName) = [(Bool, Int, String)] -> SingleMigration
forall a b. b -> Either a b
Right [(Bool
False, Int
functionPriority, String
"DROP FUNCTION " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QualifiedName -> String
withSchema QualifiedName
funcName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"()")]
showAlterDb (CreateSchema String
sch Bool
ifNotExists) = [(Bool, Int, String)] -> SingleMigration
forall a b. b -> Either a b
Right [(Bool
False, Int
schemaPriority, String
"CREATE SCHEMA " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ifNotExists' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape String
sch)]
  where
    ifNotExists' :: String
ifNotExists' = if Bool
ifNotExists then String
"IF NOT EXISTS " else String
""

showAlterTable :: String -> AlterTable -> [(Bool, Int, String)]
showAlterTable :: String -> AlterTable -> [(Bool, Int, String)]
showAlterTable String
table (AddColumn Column
col) =
  [ ( Bool
False,
      Int
defaultPriority,
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"ALTER TABLE ",
          String
table,
          String
" ADD COLUMN ",
          Column -> String
showColumn Column
col
        ]
    )
  ]
showAlterTable String
table (DropColumn String
name) =
  [ ( Bool
True,
      Int
defaultPriority,
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"ALTER TABLE ",
          String
table,
          String
" DROP COLUMN ",
          String -> String
escape String
name
        ]
    )
  ]
showAlterTable String
table (AlterColumn Column
col [AlterColumn]
alts) = (AlterColumn -> (Bool, Int, String))
-> [AlterColumn] -> [(Bool, Int, String)]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> AlterColumn -> (Bool, Int, String)
showAlterColumn String
table (String -> AlterColumn -> (Bool, Int, String))
-> String -> AlterColumn -> (Bool, Int, String)
forall a b. (a -> b) -> a -> b
$ Column -> String
colName Column
col) [AlterColumn]
alts
showAlterTable String
table (AddUnique (UniqueDef Maybe String
uName UniqueType
UniqueConstraint [Either String String]
cols)) =
  [ ( Bool
False,
      Int
defaultPriority,
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"ALTER TABLE ",
          String
table,
          String
" ADD",
          String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
" CONSTRAINT " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
escape) Maybe String
uName,
          String
" UNIQUE(",
          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
table (AddUnique (UniqueDef Maybe String
uName UniqueType
UniqueIndex [Either String String]
cols)) =
  [ ( 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 -> String
escape Maybe String
uName,
          String
" ON ",
          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
table (AddUnique (UniqueDef Maybe String
uName (UniquePrimary Bool
_) [Either String String]
cols)) =
  [ ( Bool
False,
      Int
defaultPriority,
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"ALTER TABLE ",
          String
table,
          String
" ADD",
          String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
" CONSTRAINT " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
escape) Maybe String
uName,
          String
" PRIMARY KEY(",
          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
table (DropConstraint String
uName) =
  [ ( Bool
False,
      Int
defaultPriority,
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"ALTER TABLE ",
          String
table,
          String
" DROP CONSTRAINT ",
          String -> String
escape String
uName
        ]
    )
  ]
showAlterTable String
_ (DropIndex String
uName) =
  [ ( Bool
False,
      Int
defaultPriority,
      String
"DROP INDEX " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape String
uName
    )
  ]
showAlterTable String
table (AddReference (Reference QualifiedName
tName [(String, String)]
columns Maybe ReferenceActionType
onDelete Maybe ReferenceActionType
onUpdate)) =
  [ ( Bool
False,
      Int
referencePriority,
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"ALTER TABLE ",
          String
table,
          String
" ADD FOREIGN KEY(",
          String
ourKey,
          String
") REFERENCES ",
          QualifiedName -> String
withSchema QualifiedName
tName,
          String
"(",
          String
foreignKey,
          String
")",
          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
onDelete,
          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
onUpdate
        ]
    )
  ]
  where
    (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)]
columns
    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
showAlterTable String
table (DropReference String
name) =
  [ ( Bool
False,
      Int
defaultPriority,
      String
"ALTER TABLE " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
table String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" DROP CONSTRAINT " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
    )
  ]

showAlterColumn :: String -> String -> AlterColumn -> (Bool, Int, String)
showAlterColumn :: String -> String -> AlterColumn -> (Bool, Int, String)
showAlterColumn String
table String
n (Type DbTypePrimitive
t) =
  ( Bool
False,
    Int
defaultPriority,
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ String
"ALTER TABLE ",
        String
table,
        String
" ALTER COLUMN ",
        String -> String
escape String
n,
        String
" TYPE ",
        DbTypePrimitive -> String
showSqlType DbTypePrimitive
t
      ]
  )
showAlterColumn String
table String
n AlterColumn
IsNull =
  ( Bool
False,
    Int
defaultPriority,
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ String
"ALTER TABLE ",
        String
table,
        String
" ALTER COLUMN ",
        String -> String
escape String
n,
        String
" DROP NOT NULL"
      ]
  )
showAlterColumn String
table String
n AlterColumn
NotNull =
  ( Bool
False,
    Int
defaultPriority,
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ String
"ALTER TABLE ",
        String
table,
        String
" ALTER COLUMN ",
        String -> String
escape String
n,
        String
" SET NOT NULL"
      ]
  )
showAlterColumn String
table String
n (Default String
s) =
  ( Bool
False,
    Int
defaultPriority,
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ String
"ALTER TABLE ",
        String
table,
        String
" ALTER COLUMN ",
        String -> String
escape String
n,
        String
" SET DEFAULT ",
        String
s
      ]
  )
showAlterColumn String
table String
n AlterColumn
NoDefault =
  ( Bool
False,
    Int
defaultPriority,
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ String
"ALTER TABLE ",
        String
table,
        String
" ALTER COLUMN ",
        String -> String
escape String
n,
        String
" DROP DEFAULT"
      ]
  )
showAlterColumn String
table String
n (UpdateValue String
s) =
  ( Bool
False,
    Int
defaultPriority,
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ String
"UPDATE ",
        String
table,
        String
" SET ",
        String -> String
escape String
n,
        String
"=",
        String
s,
        String
" WHERE ",
        String -> String
escape String
n,
        String
" IS NULL"
      ]
  )

-- | udt_name, character_maximum_length, numeric_precision, numeric_scale, datetime_precision, interval_type
readSqlType :: String -> (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String) -> (Int, Maybe String) -> DbTypePrimitive
readSqlType :: String
-> (Maybe Int, Maybe Int, Maybe Int, Maybe Int, Maybe String)
-> (Int, Maybe String)
-> DbTypePrimitive
readSqlType String
typ (Maybe Int
character_maximum_length, Maybe Int
numeric_precision, Maybe Int
numeric_scale, Maybe Int
datetime_precision, Maybe String
_) (Int
array_ndims, Maybe String
array_elem) =
  case String
typ of
    String
"int4" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt32
    String
"int8" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbInt64
    String
"varchar" -> DbTypePrimitive
-> (Int -> DbTypePrimitive) -> Maybe Int -> DbTypePrimitive
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DbTypePrimitive
forall str. DbTypePrimitive' str
DbString (String -> DbTypePrimitive
forall str. str -> DbTypePrimitive' str
dbOther (String -> DbTypePrimitive)
-> (Int -> String) -> Int -> DbTypePrimitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"varchar" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
wrap (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) Maybe Int
character_maximum_length
    String
"numeric" -> String -> DbTypePrimitive
forall str. str -> DbTypePrimitive' str
dbOther (String -> DbTypePrimitive) -> String -> DbTypePrimitive
forall a b. (a -> b) -> a -> b
$ String
"numeric" 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 -> String
wrap Maybe String
attrs
      where
        attrs :: Maybe String
attrs = (Int -> Int -> String) -> Maybe Int -> Maybe Int -> Maybe String
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\Int
a Int
b -> if Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int -> String
forall a. Show a => a -> String
show Int
a else Int -> String
forall a. Show a => a -> String
show Int
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
b) Maybe Int
numeric_precision Maybe Int
numeric_scale
    String
"date" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbDay
    String
"bool" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbBool
    String
"time" -> DbTypePrimitive -> String -> DbTypePrimitive
mkDate DbTypePrimitive
forall str. DbTypePrimitive' str
DbTime String
"time"
    String
"timestamp" -> DbTypePrimitive -> String -> DbTypePrimitive
mkDate DbTypePrimitive
forall str. DbTypePrimitive' str
DbDayTime String
"timestamp"
    String
"timestamptz" -> DbTypePrimitive -> String -> DbTypePrimitive
mkDate DbTypePrimitive
forall str. DbTypePrimitive' str
DbDayTimeZoned String
"timestamptz"
    String
"float4" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbReal
    String
"float8" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbReal
    String
"bytea" -> DbTypePrimitive
forall str. DbTypePrimitive' str
DbBlob
    String
_ | Int
array_ndims Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> String -> DbTypePrimitive
forall str. str -> DbTypePrimitive' str
dbOther (String -> DbTypePrimitive) -> String -> DbTypePrimitive
forall a b. (a -> b) -> a -> b
$ String
arr String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
array_ndims String
"[]")
      where
        arr :: String
arr = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> String
forall a. HasCallStack => String -> a
error String
"readSqlType: array with elem type Nothing") Maybe String
array_elem
    String
a -> String -> DbTypePrimitive
forall str. str -> DbTypePrimitive' str
dbOther String
a
  where
    dbOther :: str -> DbTypePrimitive' str
dbOther str
t = OtherTypeDef' str -> DbTypePrimitive' str
forall str. OtherTypeDef' str -> DbTypePrimitive' str
DbOther (OtherTypeDef' str -> DbTypePrimitive' str)
-> OtherTypeDef' str -> DbTypePrimitive' str
forall a b. (a -> b) -> a -> b
$ [Either str (DbTypePrimitive' str)] -> OtherTypeDef' str
forall str.
[Either str (DbTypePrimitive' str)] -> OtherTypeDef' str
OtherTypeDef [str -> Either str (DbTypePrimitive' str)
forall a b. a -> Either a b
Left str
t]
    wrap :: String -> String
wrap String
x = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    mkDate :: DbTypePrimitive -> String -> DbTypePrimitive
mkDate DbTypePrimitive
t String
name = DbTypePrimitive
-> (Int -> DbTypePrimitive) -> Maybe Int -> DbTypePrimitive
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DbTypePrimitive
t (String -> DbTypePrimitive
forall str. str -> DbTypePrimitive' str
dbOther (String -> DbTypePrimitive)
-> (Int -> String) -> Int -> DbTypePrimitive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
wrap (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) Maybe Int
datetime_precision'
    defDateTimePrec :: Int
defDateTimePrec = Int
6
    datetime_precision' :: Maybe Int
datetime_precision' = Maybe Int
datetime_precision Maybe Int -> (Int -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
p -> if Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
defDateTimePrec then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p

showSqlType :: DbTypePrimitive -> String
showSqlType :: DbTypePrimitive -> String
showSqlType DbTypePrimitive
t = case DbTypePrimitive
t of
  DbTypePrimitive
DbString -> String
"VARCHAR"
  DbTypePrimitive
DbInt32 -> String
"INT4"
  DbTypePrimitive
DbInt64 -> String
"INT8"
  DbTypePrimitive
DbReal -> String
"DOUBLE PRECISION"
  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
"BYTEA"
  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

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
name1 UniqueType
type1 [Either String String]
cols1) (UniqueDef Maybe String
name2 UniqueType
type2 [Either String String]
cols2) = (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= (String -> String -> Bool)
-> Maybe String -> Maybe String -> Maybe Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) Maybe String
name1 Maybe String
name2) Bool -> Bool -> Bool
&& UniqueType
type1 UniqueType -> UniqueType -> Bool
forall a. Eq a => a -> a -> Bool
== UniqueType
type2 Bool -> Bool -> Bool
&& (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

compareRefs :: String -> (Maybe String, Reference) -> (Maybe String, Reference) -> Bool
compareRefs :: String
-> (Maybe String, Reference) -> (Maybe String, Reference) -> Bool
compareRefs String
currentSchema (Maybe String
_, Reference (Maybe String
sch1, String
tbl1) [(String, String)]
pairs1 Maybe ReferenceActionType
onDel1 Maybe ReferenceActionType
onUpd1) (Maybe String
_, Reference (Maybe String
sch2, String
tbl2) [(String, String)]
pairs2 Maybe ReferenceActionType
onDel2 Maybe ReferenceActionType
onUpd2) =
  String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
currentSchema Maybe String
sch1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
currentSchema Maybe String
sch2
    Bool -> Bool -> Bool
&& String -> String
unescape String
tbl1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> String
unescape String
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 -> String
f DbTypePrimitive
type1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== DbTypePrimitive -> String
f DbTypePrimitive
type2
  where
    f :: DbTypePrimitive -> String
f = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (String -> String)
-> (DbTypePrimitive -> String) -> DbTypePrimitive -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DbTypePrimitive -> String
showSqlType

compareDefaults :: String -> String -> Bool
compareDefaults :: String -> String -> Bool
compareDefaults String
def1 String
def2 = String -> Maybe String
forall a. a -> Maybe a
Just String
def2 Maybe String -> [Maybe String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String -> Maybe String
forall a. a -> Maybe a
Just String
def1, String -> Maybe String
stripType String
def1, String -> Maybe String
stripType String
def1 Maybe String -> (String -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe String
stripParens]
  where
    stripType :: String -> Maybe String
stripType = (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
forall a. [a] -> [a]
reverse (Maybe String -> Maybe String)
-> (String -> Maybe String) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"::" (String -> Maybe String)
-> (String -> String) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
    stripParens :: String -> Maybe String
stripParens = String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"(" (String -> Maybe String)
-> (String -> Maybe String) -> String -> Maybe String
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
forall a. [a] -> [a]
reverse (Maybe String -> Maybe String)
-> (String -> Maybe String) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
")" (String -> Maybe String)
-> (String -> String) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse

defaultPriority, schemaPriority, referencePriority, functionPriority, triggerPriority :: Int
defaultPriority :: Int
defaultPriority = Int
1
schemaPriority :: Int
schemaPriority = Int
0
referencePriority :: Int
referencePriority = Int
2
functionPriority :: Int
functionPriority = Int
3
triggerPriority :: Int
triggerPriority = Int
4

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

--- MAIN

-- 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
"\""

getStatement :: Utf8 -> PG.Query
getStatement :: Utf8 -> Query
getStatement Utf8
sql = ByteString -> Query
PG.Query (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ Utf8 -> ByteString
fromUtf8 Utf8
sql

queryRaw' :: Utf8 -> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' :: Utf8
-> [PersistValue] -> Action Postgresql (RowStream [PersistValue])
queryRaw' Utf8
query [PersistValue]
vals = do
  --  $logDebugS "SQL" $ fromString $ show (fromUtf8 query) ++ " " ++ show vals
  Postgresql Connection
conn <- ReaderT Postgresql IO Postgresql
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let open :: IO (IO (Maybe [PersistValue]))
open = do
        ByteString
rawquery <- Connection -> Query -> [P] -> IO ByteString
forall q. ToRow q => Connection -> Query -> q -> IO ByteString
PG.formatQuery Connection
conn (Utf8 -> Query
getStatement Utf8
query) ((PersistValue -> P) -> [PersistValue] -> [P]
forall a b. (a -> b) -> [a] -> [b]
map PersistValue -> P
P [PersistValue]
vals)
        -- Take raw connection
        (Result
ret, IORef Row
rowRef, Row
rowCount, [Maybe ByteString -> Conversion PersistValue]
getters) <- Connection
-> (Connection
    -> IO
         (Result, IORef Row, Row,
          [Maybe ByteString -> Conversion PersistValue]))
-> IO
     (Result, IORef Row, Row,
      [Maybe ByteString -> Conversion PersistValue])
forall a. Connection -> (Connection -> IO a) -> IO a
PG.withConnection Connection
conn ((Connection
  -> IO
       (Result, IORef Row, Row,
        [Maybe ByteString -> Conversion PersistValue]))
 -> IO
      (Result, IORef Row, Row,
       [Maybe ByteString -> Conversion PersistValue]))
-> (Connection
    -> IO
         (Result, IORef Row, Row,
          [Maybe ByteString -> Conversion PersistValue]))
-> IO
     (Result, IORef Row, Row,
      [Maybe ByteString -> Conversion PersistValue])
forall a b. (a -> b) -> a -> b
$ \Connection
rawconn -> do
          -- Execute query
          Maybe Result
mret <- Connection -> ByteString -> IO (Maybe Result)
LibPQ.exec Connection
rawconn ByteString
rawquery
          case Maybe Result
mret of
            Maybe Result
Nothing -> do
              Maybe ByteString
merr <- Connection -> IO (Maybe ByteString)
LibPQ.errorMessage Connection
rawconn
              String
-> IO
     (Result, IORef Row, Row,
      [Maybe ByteString -> Conversion PersistValue])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> IO
      (Result, IORef Row, Row,
       [Maybe ByteString -> Conversion PersistValue]))
-> String
-> IO
     (Result, IORef Row, Row,
      [Maybe ByteString -> Conversion PersistValue])
forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
merr of
                Maybe ByteString
Nothing -> String
"Postgresql.queryRaw': unknown error"
                Just ByteString
e -> String
"Postgresql.queryRaw': " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
unpack ByteString
e
            Just Result
ret -> do
              -- Check result status
              ExecStatus
status <- Result -> IO ExecStatus
LibPQ.resultStatus Result
ret
              case ExecStatus
status of
                ExecStatus
LibPQ.TuplesOk -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                ExecStatus
_ -> do
                  ByteString
msg <- ExecStatus -> IO ByteString
LibPQ.resStatus ExecStatus
status
                  Maybe ByteString
merr <- Connection -> IO (Maybe ByteString)
LibPQ.errorMessage Connection
rawconn
                  String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                    String
"Postgresql.queryRaw': bad result status "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExecStatus -> String
forall a. Show a => a -> String
show ExecStatus
status
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ("
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
msg
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (ByteString -> String) -> Maybe ByteString -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
". Error message: " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
unpack) Maybe ByteString
merr

              -- Get number and type of columns
              Column
cols <- Result -> IO Column
LibPQ.nfields Result
ret
              [Maybe ByteString -> Conversion PersistValue]
getters <- [Column]
-> (Column -> IO (Maybe ByteString -> Conversion PersistValue))
-> IO [Maybe ByteString -> Conversion PersistValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Column
0 .. Column
cols Column -> Column -> Column
forall a. Num a => a -> a -> a
-Column
1] ((Column -> IO (Maybe ByteString -> Conversion PersistValue))
 -> IO [Maybe ByteString -> Conversion PersistValue])
-> (Column -> IO (Maybe ByteString -> Conversion PersistValue))
-> IO [Maybe ByteString -> Conversion PersistValue]
forall a b. (a -> b) -> a -> b
$ \Column
col -> do
                Oid
oid <- Result -> Column -> IO Oid
LibPQ.ftype Result
ret Column
col
                (Maybe ByteString -> Conversion PersistValue)
-> IO (Maybe ByteString -> Conversion PersistValue)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe ByteString -> Conversion PersistValue)
 -> IO (Maybe ByteString -> Conversion PersistValue))
-> (Maybe ByteString -> Conversion PersistValue)
-> IO (Maybe ByteString -> Conversion PersistValue)
forall a b. (a -> b) -> a -> b
$ Oid -> Getter PersistValue
getGetter Oid
oid Getter PersistValue -> Getter PersistValue
forall a b. (a -> b) -> a -> b
$ Result -> Column -> Oid -> Field
PG.Field Result
ret Column
col Oid
oid
              -- Ready to go!
              IORef Row
rowRef <- Row -> IO (IORef Row)
forall a. a -> IO (IORef a)
newIORef (CInt -> Row
LibPQ.Row CInt
0)
              Row
rowCount <- Result -> IO Row
LibPQ.ntuples Result
ret
              (Result, IORef Row, Row,
 [Maybe ByteString -> Conversion PersistValue])
-> IO
     (Result, IORef Row, Row,
      [Maybe ByteString -> Conversion PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result
ret, IORef Row
rowRef, Row
rowCount, [Maybe ByteString -> Conversion PersistValue]
getters)

        IO (Maybe [PersistValue]) -> IO (IO (Maybe [PersistValue]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO (Maybe [PersistValue]) -> IO (IO (Maybe [PersistValue])))
-> IO (Maybe [PersistValue]) -> IO (IO (Maybe [PersistValue]))
forall a b. (a -> b) -> a -> b
$ do
          Row
row <- IORef Row -> (Row -> (Row, Row)) -> IO Row
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Row
rowRef (\Row
r -> (Row
r Row -> Row -> Row
forall a. Num a => a -> a -> a
+ Row
1, Row
r))
          if Row
row Row -> Row -> Bool
forall a. Eq a => a -> a -> Bool
== Row
rowCount
            then Maybe [PersistValue] -> IO (Maybe [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [PersistValue]
forall a. Maybe a
Nothing
            else ([PersistValue] -> Maybe [PersistValue])
-> IO [PersistValue] -> IO (Maybe [PersistValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [PersistValue] -> Maybe [PersistValue]
forall a. a -> Maybe a
Just (IO [PersistValue] -> IO (Maybe [PersistValue]))
-> IO [PersistValue] -> IO (Maybe [PersistValue])
forall a b. (a -> b) -> a -> b
$
              [(Maybe ByteString -> Conversion PersistValue, Column)]
-> ((Maybe ByteString -> Conversion PersistValue, Column)
    -> IO PersistValue)
-> IO [PersistValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Maybe ByteString -> Conversion PersistValue]
-> [Column]
-> [(Maybe ByteString -> Conversion PersistValue, Column)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe ByteString -> Conversion PersistValue]
getters [Column
0 ..]) (((Maybe ByteString -> Conversion PersistValue, Column)
  -> IO PersistValue)
 -> IO [PersistValue])
-> ((Maybe ByteString -> Conversion PersistValue, Column)
    -> IO PersistValue)
-> IO [PersistValue]
forall a b. (a -> b) -> a -> b
$ \(Maybe ByteString -> Conversion PersistValue
getter, Column
col) -> do
                Maybe ByteString
mbs <- Result -> Row -> Column -> IO (Maybe ByteString)
LibPQ.getvalue' Result
ret Row
row Column
col
                case Maybe ByteString
mbs of
                  Maybe ByteString
Nothing -> PersistValue -> IO PersistValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure PersistValue
PersistNull
                  Just ByteString
bs -> do
                    Ok PersistValue
ok <- Conversion PersistValue -> Connection -> IO (Ok PersistValue)
forall a. Conversion a -> Connection -> IO (Ok a)
PGFF.runConversion (Maybe ByteString -> Conversion PersistValue
getter Maybe ByteString
mbs) Connection
conn
                    ByteString
bs ByteString -> IO PersistValue -> IO PersistValue
`seq` case Ok PersistValue
ok of
                      Errors (SomeException
exc : [SomeException]
_) -> SomeException -> IO PersistValue
forall a e. Exception e => e -> a
throw SomeException
exc
                      Errors [] -> String -> IO PersistValue
forall a. HasCallStack => String -> a
error String
"Got an Errors, but no exceptions"
                      Ok PersistValue
v -> PersistValue -> IO PersistValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure PersistValue
v
  RowStream [PersistValue]
-> Action Postgresql (RowStream [PersistValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RowStream [PersistValue]
 -> Action Postgresql (RowStream [PersistValue]))
-> RowStream [PersistValue]
-> Action Postgresql (RowStream [PersistValue])
forall a b. (a -> b) -> a -> b
$ IO (IO (Maybe [PersistValue]))
-> (IO (Maybe [PersistValue]) -> IO ()) -> RowStream [PersistValue]
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO (IO (Maybe [PersistValue]))
open (IO () -> IO (Maybe [PersistValue]) -> IO ()
forall a b. a -> b -> a
const (IO () -> IO (Maybe [PersistValue]) -> IO ())
-> IO () -> IO (Maybe [PersistValue]) -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Avoid orphan instances.
newtype P = P PersistValue

instance PGTF.ToField P where
  toField :: P -> Action
toField (P (PersistString String
t)) = String -> Action
forall a. ToField a => a -> Action
PGTF.toField String
t
  toField (P (PersistText Text
t)) = Text -> Action
forall a. ToField a => a -> Action
PGTF.toField Text
t
  toField (P (PersistByteString ByteString
bs)) = Binary ByteString -> Action
forall a. ToField a => a -> Action
PGTF.toField (ByteString -> Binary ByteString
forall a. a -> Binary a
PG.Binary ByteString
bs)
  toField (P (PersistInt64 Int64
i)) = Int64 -> Action
forall a. ToField a => a -> Action
PGTF.toField Int64
i
  toField (P (PersistDouble Double
d)) = Double -> Action
forall a. ToField a => a -> Action
PGTF.toField Double
d
  toField (P (PersistBool Bool
b)) = Bool -> Action
forall a. ToField a => a -> Action
PGTF.toField Bool
b
  toField (P (PersistDay Day
d)) = Day -> Action
forall a. ToField a => a -> Action
PGTF.toField Day
d
  toField (P (PersistTimeOfDay TimeOfDay
t)) = TimeOfDay -> Action
forall a. ToField a => a -> Action
PGTF.toField TimeOfDay
t
  toField (P (PersistUTCTime UTCTime
t)) = UTCTime -> Action
forall a. ToField a => a -> Action
PGTF.toField UTCTime
t
  toField (P (PersistZonedTime (ZT ZonedTime
t))) = ZonedTime -> Action
forall a. ToField a => a -> Action
PGTF.toField ZonedTime
t
  toField (P PersistValue
PersistNull) = Null -> Action
forall a. ToField a => a -> Action
PGTF.toField Null
PG.Null
  toField (P (PersistCustom Utf8
_ [PersistValue]
_)) = String -> Action
forall a. HasCallStack => String -> a
error String
"toField: unexpected PersistCustom"

type Getter a = PGFF.FieldParser a

convertPV :: PGFF.FromField a => (a -> b) -> Getter b
convertPV :: (a -> b) -> Getter b
convertPV a -> b
f = ((a -> b) -> Conversion a -> Conversion b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Conversion a -> Conversion b)
-> (Maybe ByteString -> Conversion a)
-> Maybe ByteString
-> Conversion b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe ByteString -> Conversion a)
 -> Maybe ByteString -> Conversion b)
-> (Field -> Maybe ByteString -> Conversion a) -> Getter b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Maybe ByteString -> Conversion a
forall a. FromField a => FieldParser a
PGFF.fromField

getGetter :: PG.Oid -> Getter PersistValue
getGetter :: Oid -> Getter PersistValue
getGetter (PG.Oid CUInt
oid) = case CUInt
oid of
  CUInt
16 -> (Bool -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Bool -> PersistValue
PersistBool
  CUInt
17 -> (Binary ByteString -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV (ByteString -> PersistValue
PersistByteString (ByteString -> PersistValue)
-> (Binary ByteString -> ByteString)
-> Binary ByteString
-> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binary ByteString -> ByteString
forall a. Binary a -> a
unBinary)
  CUInt
18 -> (Text -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Text -> PersistValue
PersistText
  CUInt
19 -> (Text -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Text -> PersistValue
PersistText
  CUInt
20 -> (Int64 -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Int64 -> PersistValue
PersistInt64
  CUInt
21 -> (Int64 -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Int64 -> PersistValue
PersistInt64
  CUInt
23 -> (Int64 -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Int64 -> PersistValue
PersistInt64
  CUInt
25 -> (Text -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Text -> PersistValue
PersistText
  CUInt
142 -> (Text -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Text -> PersistValue
PersistText
  CUInt
700 -> (Double -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Double -> PersistValue
PersistDouble
  CUInt
701 -> (Double -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Double -> PersistValue
PersistDouble
  CUInt
702 -> (UTCTime -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV UTCTime -> PersistValue
PersistUTCTime
  CUInt
703 -> (UTCTime -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV UTCTime -> PersistValue
PersistUTCTime
  CUInt
1042 -> (Text -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Text -> PersistValue
PersistText
  CUInt
1043 -> (Text -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Text -> PersistValue
PersistText
  CUInt
1082 -> (Day -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Day -> PersistValue
PersistDay
  CUInt
1083 -> (TimeOfDay -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV TimeOfDay -> PersistValue
PersistTimeOfDay
  CUInt
1114 -> (LocalTime -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV (UTCTime -> PersistValue
PersistUTCTime (UTCTime -> PersistValue)
-> (LocalTime -> UTCTime) -> LocalTime -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
utc)
  CUInt
1184 -> (ZonedTime -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV (ZT -> PersistValue
PersistZonedTime (ZT -> PersistValue)
-> (ZonedTime -> ZT) -> ZonedTime -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> ZT
ZT)
  CUInt
1560 -> (Int64 -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Int64 -> PersistValue
PersistInt64
  CUInt
1562 -> (Int64 -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV Int64 -> PersistValue
PersistInt64
  CUInt
1700 -> (Rational -> PersistValue) -> Getter PersistValue
forall a b. FromField a => (a -> b) -> Getter b
convertPV (Double -> PersistValue
PersistDouble (Double -> PersistValue)
-> (Rational -> Double) -> Rational -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
forall a. Fractional a => Rational -> a
fromRational)
  CUInt
2278 -> \Field
_ Maybe ByteString
_ -> PersistValue -> Conversion PersistValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure PersistValue
PersistNull
  CUInt
_ -> \Field
f Maybe ByteString
dat -> (ByteString -> PersistValue)
-> Conversion ByteString -> Conversion PersistValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> PersistValue
PersistByteString (Conversion ByteString -> Conversion PersistValue)
-> Conversion ByteString -> Conversion PersistValue
forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
dat of
    Maybe ByteString
Nothing -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion ByteString
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
PGFF.returnError String -> Maybe Oid -> String -> String -> String -> ResultError
PGFF.UnexpectedNull Field
f String
""
    Just ByteString
str -> ByteString -> Conversion ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Conversion ByteString)
-> ByteString -> Conversion ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
copy ByteString
str

unBinary :: PG.Binary a -> a
unBinary :: Binary a -> a
unBinary (PG.Binary a
x) = a
x

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

withSchema :: QualifiedName -> String
withSchema :: QualifiedName -> String
withSchema (Maybe String
sch, String
name) = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\String
x -> String -> String
escape String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".") Maybe String
sch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
escape String
name

-- | Put explicit type for expression. It is useful for values which are defaulted to a wrong type.
-- For example, a literal Int from a 64bit machine can be defaulted to a 32bit int by Postgresql.
-- Also a value entered as an external string (geometry, arrays and other complex types have this representation) may need an explicit type.
explicitType :: (Expression Postgresql r a, PersistField a) => a -> Expr Postgresql r a
explicitType :: a -> Expr Postgresql r a
explicitType a
a = a -> String -> Expr Postgresql r a
forall r a.
(Expression Postgresql r a, PersistField a) =>
a -> String -> Expr Postgresql r a
castType a
a String
t
  where
    t :: String
t = case Any Postgresql -> a -> DbType
forall a db (proxy :: * -> *).
(PersistField a, DbDescriptor db) =>
proxy db -> a -> DbType
dbType Any Postgresql
forall (proxy :: * -> *). proxy Postgresql
proxy a
a of
      DbTypePrimitive DbTypePrimitive
t' Bool
_ Maybe String
_ Maybe ParentTableReference
_ -> DbTypePrimitive -> String
showSqlType DbTypePrimitive
t'
      DbType
_ -> String -> String
forall a. HasCallStack => String -> a
error String
"explicitType: type is not primitive"

-- | Casts expression to a type. @castType value \"INT\"@ results in @value::INT@.
castType :: (Expression Postgresql r a, PersistField a) => a -> String -> Expr Postgresql r a
castType :: a -> String -> Expr Postgresql r a
castType a
a String
t = Snippet Postgresql r -> Expr Postgresql r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet Postgresql r -> Expr Postgresql r a)
-> Snippet Postgresql r -> Expr Postgresql r a
forall a b. (a -> b) -> a -> b
$ (RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r
forall db r.
(RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
Snippet ((RenderConfig -> Int -> [RenderS Postgresql r])
 -> Snippet Postgresql r)
-> (RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r
forall a b. (a -> b) -> a -> b
$ \RenderConfig
conf Int
_ -> [RenderS Postgresql r
"(" RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderConfig -> UntypedExpr Postgresql r -> RenderS Postgresql r
forall db r.
SqlDb db =>
RenderConfig -> UntypedExpr db r -> RenderS db r
renderExpr RenderConfig
conf (a -> UntypedExpr Postgresql r
forall db r a. Expression db r a => a -> UntypedExpr db r
toExpr a
a) RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderS Postgresql r
")::" RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> String -> RenderS Postgresql r
forall a. IsString a => String -> a
fromString String
t]

-- | Distinct only on certain fields or expressions. For example, @select $ CondEmpty `distinctOn` (lower EmailField, IpField)@.
distinctOn :: (db ~ Postgresql, HasSelectOptions a db r, HasDistinct a ~ HFalse, Projection' p db r p') => a -> p -> SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a) HTrue
distinctOn :: a
-> p
-> SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a) HTrue
distinctOn a
opts p
p = SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a) HFalse
SelectOptions
  db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
opts' {dbSpecificOptions :: [(String, QueryRaw db r)]
dbSpecificOptions = (String
"DISTINCT_ON", Snippet Postgresql r
clause) (String, Snippet Postgresql r)
-> [(String, Snippet Postgresql r)]
-> [(String, Snippet Postgresql r)]
forall a. a -> [a] -> [a]
: SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a) HFalse
-> [(String, QueryRaw db r)]
forall db r hasLimit hasOffset hasOrder hasDistinct.
SelectOptions db r hasLimit hasOffset hasOrder hasDistinct
-> [(String, QueryRaw db r)]
dbSpecificOptions SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a) HFalse
SelectOptions
  db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
opts'}
  where
    opts' :: SelectOptions
  db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
opts' = a
-> SelectOptions
     db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
forall a db r.
HasSelectOptions a db r =>
a
-> SelectOptions
     db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
getSelectOptions a
opts
    clause :: Snippet Postgresql r
clause = (RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r
forall db r.
(RenderConfig -> Int -> [RenderS db r]) -> Snippet db r
Snippet ((RenderConfig -> Int -> [RenderS Postgresql r])
 -> Snippet Postgresql r)
-> (RenderConfig -> Int -> [RenderS Postgresql r])
-> Snippet Postgresql r
forall a b. (a -> b) -> a -> b
$ \RenderConfig
conf Int
_ -> [[RenderS Postgresql r] -> RenderS Postgresql r
forall s. StringLike s => [s] -> s
commasJoin ([RenderS Postgresql r] -> RenderS Postgresql r)
-> [RenderS Postgresql r] -> RenderS Postgresql r
forall a b. (a -> b) -> a -> b
$ (UntypedExpr Postgresql r -> [RenderS Postgresql r])
-> [UntypedExpr Postgresql r] -> [RenderS Postgresql r]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RenderConfig
-> Int -> UntypedExpr Postgresql r -> [RenderS Postgresql r]
forall db r.
SqlDb db =>
RenderConfig -> Int -> UntypedExpr db r -> [RenderS db r]
renderExprExtended RenderConfig
conf Int
0) ([UntypedExpr Postgresql r] -> [RenderS Postgresql r])
-> [UntypedExpr Postgresql r] -> [RenderS Postgresql r]
forall a b. (a -> b) -> a -> b
$ p -> [UntypedExpr Postgresql r] -> [UntypedExpr Postgresql r]
forall p a db r.
(Projection p a, DbDescriptor db, ProjectionDb p db,
 ProjectionRestriction p r) =>
p -> [UntypedExpr db r] -> [UntypedExpr db r]
projectionExprs p
p []]

preColumns :: HasSelectOptions opts Postgresql r => opts -> RenderS Postgresql r
preColumns :: opts -> RenderS Postgresql r
preColumns opts
opts = RenderS Postgresql r
clause
  where
    clause :: RenderS Postgresql r
clause = String
-> (RenderS Postgresql r -> RenderS Postgresql r)
-> RenderS Postgresql r
apply String
"DISTINCT_ON" (\RenderS Postgresql r
t -> RenderS Postgresql r
"DISTINCT ON (" RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderS Postgresql r
t RenderS Postgresql r
-> RenderS Postgresql r -> RenderS Postgresql r
forall a. Semigroup a => a -> a -> a
<> RenderS Postgresql r
")")
    apply :: String
-> (RenderS Postgresql r -> RenderS Postgresql r)
-> RenderS Postgresql r
apply String
k RenderS Postgresql r -> RenderS Postgresql r
f = case String
-> [(String, Snippet Postgresql r)] -> Maybe (Snippet Postgresql r)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k [(String, Snippet Postgresql r)]
[(String, QueryRaw Postgresql r)]
opts' of
      Maybe (Snippet Postgresql r)
Nothing -> RenderS Postgresql r
forall a. Monoid a => a
mempty
      Just (Snippet RenderConfig -> Int -> [RenderS Postgresql r]
snippet) -> RenderS Postgresql r -> RenderS Postgresql r
f (RenderS Postgresql r -> RenderS Postgresql r)
-> RenderS Postgresql r -> RenderS Postgresql r
forall a b. (a -> b) -> a -> b
$ [RenderS Postgresql r] -> RenderS Postgresql r
forall a. [a] -> a
head ([RenderS Postgresql r] -> RenderS Postgresql r)
-> [RenderS Postgresql r] -> RenderS Postgresql r
forall a b. (a -> b) -> a -> b
$ RenderConfig -> Int -> [RenderS Postgresql r]
snippet RenderConfig
renderConfig Int
0
    opts' :: [(String, QueryRaw Postgresql r)]
opts' = SelectOptions
  Postgresql
  r
  (HasLimit opts)
  (HasOffset opts)
  (HasOrder opts)
  (HasDistinct opts)
-> [(String, QueryRaw Postgresql r)]
forall db r hasLimit hasOffset hasOrder hasDistinct.
SelectOptions db r hasLimit hasOffset hasOrder hasDistinct
-> [(String, QueryRaw db r)]
dbSpecificOptions (SelectOptions
   Postgresql
   r
   (HasLimit opts)
   (HasOffset opts)
   (HasOrder opts)
   (HasDistinct opts)
 -> [(String, QueryRaw Postgresql r)])
-> SelectOptions
     Postgresql
     r
     (HasLimit opts)
     (HasOffset opts)
     (HasOrder opts)
     (HasDistinct opts)
-> [(String, QueryRaw Postgresql r)]
forall a b. (a -> b) -> a -> b
$ opts
-> SelectOptions
     Postgresql
     r
     (HasLimit opts)
     (HasOffset opts)
     (HasOrder opts)
     (HasDistinct opts)
forall a db r.
HasSelectOptions a db r =>
a
-> SelectOptions
     db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
getSelectOptions opts
opts