{-# LANGUAGE
DataKinds
, DefaultSignatures
, DeriveFunctor
, FlexibleContexts
, FlexibleInstances
, FunctionalDependencies
, GADTs
, PolyKinds
, MultiParamTypeClasses
, QuantifiedConstraints
, RankNTypes
, TypeApplications
, TypeFamilies
, UndecidableInstances
#-}
module Squeal.PostgreSQL.Session.Monad
(
MonadPQ (..)
, manipulateParams
, manipulateParams_
, manipulate
, manipulate_
, runQueryParams
, runQuery
, executePrepared
, executePrepared_
, traversePrepared
, forPrepared
, traversePrepared_
, forPrepared_
, preparedFor
) where
import Control.Category (Category (..))
import Control.Monad
import Control.Monad.Morph
import Data.Foldable
import Data.Profunctor.Traversing
import Data.Traversable
import Prelude hiding (id, (.))
import Squeal.PostgreSQL.Manipulation
import Squeal.PostgreSQL.Session.Decode
import Squeal.PostgreSQL.Session.Encode
import Squeal.PostgreSQL.Session.Result
import Squeal.PostgreSQL.Session.Statement
import Squeal.PostgreSQL.Query
import Control.Monad.Trans.Cont
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import qualified Control.Monad.Trans.State.Lazy as Lazy
import qualified Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.Writer.Lazy as Lazy
import qualified Control.Monad.Trans.Writer.Strict as Strict
import qualified Control.Monad.Trans.RWS.Lazy as Lazy
import qualified Control.Monad.Trans.RWS.Strict as Strict
class Monad pq => MonadPQ db pq | pq -> db where
executeParams
:: Statement db x y
-> x
-> pq (Result y)
default executeParams
:: (MonadTrans t, MonadPQ db m, pq ~ t m)
=> Statement db x y
-> x
-> pq (Result y)
executeParams Statement db x y
statement x
params = m (Result y) -> t m (Result y)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Result y) -> t m (Result y)) -> m (Result y) -> t m (Result y)
forall a b. (a -> b) -> a -> b
$ Statement db x y -> x -> m (Result y)
forall (db :: SchemasType) (pq :: * -> *) x y.
MonadPQ db pq =>
Statement db x y -> x -> pq (Result y)
executeParams Statement db x y
statement x
params
executeParams_
:: Statement db x ()
-> x
-> pq ()
executeParams_ Statement db x ()
statement x
params = pq (Result ()) -> pq ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (pq (Result ()) -> pq ()) -> pq (Result ()) -> pq ()
forall a b. (a -> b) -> a -> b
$ Statement db x () -> x -> pq (Result ())
forall (db :: SchemasType) (pq :: * -> *) x y.
MonadPQ db pq =>
Statement db x y -> x -> pq (Result y)
executeParams Statement db x ()
statement x
params
execute
:: Statement db () y
-> pq (Result y)
execute Statement db () y
statement = Statement db () y -> () -> pq (Result y)
forall (db :: SchemasType) (pq :: * -> *) x y.
MonadPQ db pq =>
Statement db x y -> x -> pq (Result y)
executeParams Statement db () y
statement ()
execute_
:: Statement db () ()
-> pq ()
execute_ = pq (Result ()) -> pq ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (pq (Result ()) -> pq ())
-> (Statement db () () -> pq (Result ()))
-> Statement db () ()
-> pq ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Statement db () () -> pq (Result ())
forall (db :: SchemasType) (pq :: * -> *) y.
MonadPQ db pq =>
Statement db () y -> pq (Result y)
execute
prepare
:: Statement db x y
-> pq (Prepared pq x (Result y))
default prepare
:: (MonadTrans t, MonadPQ db m, pq ~ t m)
=> Statement db x y
-> pq (Prepared pq x (Result y))
prepare Statement db x y
statement = do
Prepared m x (Result y)
prepared <- m (Prepared m x (Result y)) -> t m (Prepared m x (Result y))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Prepared m x (Result y)) -> t m (Prepared m x (Result y)))
-> m (Prepared m x (Result y)) -> t m (Prepared m x (Result y))
forall a b. (a -> b) -> a -> b
$ Statement db x y -> m (Prepared m x (Result y))
forall (db :: SchemasType) (pq :: * -> *) x y.
MonadPQ db pq =>
Statement db x y -> pq (Prepared pq x (Result y))
prepare Statement db x y
statement
Prepared (t m) x (Result y) -> pq (Prepared (t m) x (Result y))
forall (m :: * -> *) a. Monad m => a -> m a
return (Prepared (t m) x (Result y) -> pq (Prepared (t m) x (Result y)))
-> Prepared (t m) x (Result y) -> pq (Prepared (t m) x (Result y))
forall a b. (a -> b) -> a -> b
$ (x -> t m (Result y)) -> t m () -> Prepared (t m) x (Result y)
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
(m (Result y) -> t m (Result y)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Result y) -> t m (Result y))
-> (x -> m (Result y)) -> x -> t m (Result y)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Prepared m x (Result y) -> x -> m (Result y)
forall (m :: * -> *) x y. Prepared m x y -> x -> m y
runPrepared Prepared m x (Result y)
prepared)
(m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Prepared m x (Result y) -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m x (Result y)
prepared))
prepare_
:: Statement db x ()
-> pq (Prepared pq x ())
prepare_ = (Prepared pq x (Result ()) -> Prepared pq x ())
-> pq (Prepared pq x (Result ())) -> pq (Prepared pq x ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prepared pq x (Result ()) -> Prepared pq x ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (pq (Prepared pq x (Result ())) -> pq (Prepared pq x ()))
-> (Statement db x () -> pq (Prepared pq x (Result ())))
-> Statement db x ()
-> pq (Prepared pq x ())
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Statement db x () -> pq (Prepared pq x (Result ()))
forall (db :: SchemasType) (pq :: * -> *) x y.
MonadPQ db pq =>
Statement db x y -> pq (Prepared pq x (Result y))
prepare
preparedFor
:: MonadPQ db pq
=> (Prepared pq a (Result b) -> Prepared pq s t)
-> Statement db a b
-> s -> pq t
preparedFor :: (Prepared pq a (Result b) -> Prepared pq s t)
-> Statement db a b -> s -> pq t
preparedFor Prepared pq a (Result b) -> Prepared pq s t
optic Statement db a b
statement s
x' = do
Prepared pq a (Result b)
prepared <- Statement db a b -> pq (Prepared pq a (Result b))
forall (db :: SchemasType) (pq :: * -> *) x y.
MonadPQ db pq =>
Statement db x y -> pq (Prepared pq x (Result y))
prepare Statement db a b
statement
t
y' <- Prepared pq s t -> s -> pq t
forall (m :: * -> *) x y. Prepared m x y -> x -> m y
runPrepared (Prepared pq a (Result b) -> Prepared pq s t
optic Prepared pq a (Result b)
prepared) s
x'
Prepared pq a (Result b) -> pq ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared pq a (Result b)
prepared
t -> pq t
forall (m :: * -> *) a. Monad m => a -> m a
return t
y'
executePrepared
:: (MonadPQ db pq, Traversable list)
=> Statement db x y
-> list x
-> pq (list (Result y))
executePrepared :: Statement db x y -> list x -> pq (list (Result y))
executePrepared = (Prepared pq x (Result y)
-> Prepared pq (list x) (list (Result y)))
-> Statement db x y -> list x -> pq (list (Result y))
forall (db :: SchemasType) (pq :: * -> *) a b s t.
MonadPQ db pq =>
(Prepared pq a (Result b) -> Prepared pq s t)
-> Statement db a b -> s -> pq t
preparedFor Prepared pq x (Result y) -> Prepared pq (list x) (list (Result y))
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse'
executePrepared_
:: (MonadPQ db pq, Foldable list)
=> Statement db x ()
-> list x
-> pq ()
executePrepared_ :: Statement db x () -> list x -> pq ()
executePrepared_ = (Prepared pq x (Result ()) -> Prepared pq (list x) ())
-> Statement db x () -> list x -> pq ()
forall (db :: SchemasType) (pq :: * -> *) a b s t.
MonadPQ db pq =>
(Prepared pq a (Result b) -> Prepared pq s t)
-> Statement db a b -> s -> pq t
preparedFor ((forall (f :: * -> *).
Applicative f =>
(x -> f (Result ())) -> list x -> f ())
-> Prepared pq x (Result ()) -> Prepared pq (list x) ()
forall (p :: * -> * -> *) a b s t.
Traversing p =>
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> p a b -> p s t
wander forall (f :: * -> *).
Applicative f =>
(x -> f (Result ())) -> list x -> f ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_)
manipulateParams ::
( MonadPQ db pq
, GenericParams db params x xs
, GenericRow row y ys
) => Manipulation '[] db params row
-> x -> pq (Result y)
manipulateParams :: Manipulation '[] db params row -> x -> pq (Result y)
manipulateParams = Statement db x y -> x -> pq (Result y)
forall (db :: SchemasType) (pq :: * -> *) x y.
MonadPQ db pq =>
Statement db x y -> x -> pq (Result y)
executeParams (Statement db x y -> x -> pq (Result y))
-> (Manipulation '[] db params row -> Statement db x y)
-> Manipulation '[] db params row
-> x
-> pq (Result y)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Manipulation '[] db params row -> Statement db x y
forall (db :: SchemasType) (params :: [NullType]) x (xs :: [*])
(row :: RowType) y (ys :: RecordCode).
(GenericParams db params x xs, GenericRow row y ys) =>
Manipulation '[] db params row -> Statement db x y
manipulation
manipulateParams_ ::
( MonadPQ db pq
, GenericParams db params x xs
) => Manipulation '[] db params '[]
-> x -> pq ()
manipulateParams_ :: Manipulation '[] db params '[] -> x -> pq ()
manipulateParams_ = Statement db x () -> x -> pq ()
forall (db :: SchemasType) (pq :: * -> *) x.
MonadPQ db pq =>
Statement db x () -> x -> pq ()
executeParams_ (Statement db x () -> x -> pq ())
-> (Manipulation '[] db params '[] -> Statement db x ())
-> Manipulation '[] db params '[]
-> x
-> pq ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Manipulation '[] db params '[] -> Statement db x ()
forall (db :: SchemasType) (params :: [NullType]) x (xs :: [*])
(row :: RowType) y (ys :: RecordCode).
(GenericParams db params x xs, GenericRow row y ys) =>
Manipulation '[] db params row -> Statement db x y
manipulation
manipulate
:: (MonadPQ db pq, GenericRow row y ys)
=> Manipulation '[] db '[] row
-> pq (Result y)
manipulate :: Manipulation '[] db '[] row -> pq (Result y)
manipulate = Statement db () y -> pq (Result y)
forall (db :: SchemasType) (pq :: * -> *) y.
MonadPQ db pq =>
Statement db () y -> pq (Result y)
execute (Statement db () y -> pq (Result y))
-> (Manipulation '[] db '[] row -> Statement db () y)
-> Manipulation '[] db '[] row
-> pq (Result y)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Manipulation '[] db '[] row -> Statement db () y
forall (db :: SchemasType) (params :: [NullType]) x (xs :: [*])
(row :: RowType) y (ys :: RecordCode).
(GenericParams db params x xs, GenericRow row y ys) =>
Manipulation '[] db params row -> Statement db x y
manipulation
manipulate_
:: MonadPQ db pq
=> Manipulation '[] db '[] '[]
-> pq ()
manipulate_ :: Manipulation '[] db '[] '[] -> pq ()
manipulate_ = Statement db () () -> pq ()
forall (db :: SchemasType) (pq :: * -> *).
MonadPQ db pq =>
Statement db () () -> pq ()
execute_ (Statement db () () -> pq ())
-> (Manipulation '[] db '[] '[] -> Statement db () ())
-> Manipulation '[] db '[] '[]
-> pq ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Manipulation '[] db '[] '[] -> Statement db () ()
forall (db :: SchemasType) (params :: [NullType]) x (xs :: [*])
(row :: RowType) y (ys :: RecordCode).
(GenericParams db params x xs, GenericRow row y ys) =>
Manipulation '[] db params row -> Statement db x y
manipulation
runQueryParams ::
( MonadPQ db pq
, GenericParams db params x xs
, GenericRow row y ys
) => Query '[] '[] db params row
-> x -> pq (Result y)
runQueryParams :: Query '[] '[] db params row -> x -> pq (Result y)
runQueryParams = Statement db x y -> x -> pq (Result y)
forall (db :: SchemasType) (pq :: * -> *) x y.
MonadPQ db pq =>
Statement db x y -> x -> pq (Result y)
executeParams (Statement db x y -> x -> pq (Result y))
-> (Query '[] '[] db params row -> Statement db x y)
-> Query '[] '[] db params row
-> x
-> pq (Result y)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Query '[] '[] db params row -> Statement db x y
forall (db :: SchemasType) (params :: [NullType]) x (xs :: [*])
(row :: RowType) y (ys :: RecordCode).
(GenericParams db params x xs, GenericRow row y ys) =>
Query '[] '[] db params row -> Statement db x y
query
runQuery
:: (MonadPQ db pq, GenericRow row y ys)
=> Query '[] '[] db '[] row
-> pq (Result y)
runQuery :: Query '[] '[] db '[] row -> pq (Result y)
runQuery = Statement db () y -> pq (Result y)
forall (db :: SchemasType) (pq :: * -> *) y.
MonadPQ db pq =>
Statement db () y -> pq (Result y)
execute (Statement db () y -> pq (Result y))
-> (Query '[] '[] db '[] row -> Statement db () y)
-> Query '[] '[] db '[] row
-> pq (Result y)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Query '[] '[] db '[] row -> Statement db () y
forall (db :: SchemasType) (params :: [NullType]) x (xs :: [*])
(row :: RowType) y (ys :: RecordCode).
(GenericParams db params x xs, GenericRow row y ys) =>
Query '[] '[] db params row -> Statement db x y
query
traversePrepared
:: ( MonadPQ db pq
, GenericParams db params x xs
, GenericRow row y ys
, Traversable list )
=> Manipulation '[] db params row
-> list x -> pq (list (Result y))
traversePrepared :: Manipulation '[] db params row -> list x -> pq (list (Result y))
traversePrepared = Statement db x y -> list x -> pq (list (Result y))
forall (db :: SchemasType) (pq :: * -> *) (list :: * -> *) x y.
(MonadPQ db pq, Traversable list) =>
Statement db x y -> list x -> pq (list (Result y))
executePrepared (Statement db x y -> list x -> pq (list (Result y)))
-> (Manipulation '[] db params row -> Statement db x y)
-> Manipulation '[] db params row
-> list x
-> pq (list (Result y))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Manipulation '[] db params row -> Statement db x y
forall (db :: SchemasType) (params :: [NullType]) x (xs :: [*])
(row :: RowType) y (ys :: RecordCode).
(GenericParams db params x xs, GenericRow row y ys) =>
Manipulation '[] db params row -> Statement db x y
manipulation
forPrepared
:: ( MonadPQ db pq
, GenericParams db params x xs
, GenericRow row y ys
, Traversable list )
=> list x
-> Manipulation '[] db params row
-> pq (list (Result y))
forPrepared :: list x -> Manipulation '[] db params row -> pq (list (Result y))
forPrepared = (Manipulation '[] db params row -> list x -> pq (list (Result y)))
-> list x -> Manipulation '[] db params row -> pq (list (Result y))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Manipulation '[] db params row -> list x -> pq (list (Result y))
forall (db :: SchemasType) (pq :: * -> *) (params :: [NullType]) x
(xs :: [*]) (row :: RowType) y (ys :: RecordCode) (list :: * -> *).
(MonadPQ db pq, GenericParams db params x xs, GenericRow row y ys,
Traversable list) =>
Manipulation '[] db params row -> list x -> pq (list (Result y))
traversePrepared
traversePrepared_
:: ( MonadPQ db pq
, GenericParams db params x xs
, Foldable list )
=> Manipulation '[] db params '[]
-> list x -> pq ()
traversePrepared_ :: Manipulation '[] db params '[] -> list x -> pq ()
traversePrepared_ = Statement db x () -> list x -> pq ()
forall (db :: SchemasType) (pq :: * -> *) (list :: * -> *) x.
(MonadPQ db pq, Foldable list) =>
Statement db x () -> list x -> pq ()
executePrepared_ (Statement db x () -> list x -> pq ())
-> (Manipulation '[] db params '[] -> Statement db x ())
-> Manipulation '[] db params '[]
-> list x
-> pq ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Manipulation '[] db params '[] -> Statement db x ()
forall (db :: SchemasType) (params :: [NullType]) x (xs :: [*])
(row :: RowType) y (ys :: RecordCode).
(GenericParams db params x xs, GenericRow row y ys) =>
Manipulation '[] db params row -> Statement db x y
manipulation
forPrepared_
:: ( MonadPQ db pq
, GenericParams db params x xs
, Foldable list )
=> list x
-> Manipulation '[] db params '[]
-> pq ()
forPrepared_ :: list x -> Manipulation '[] db params '[] -> pq ()
forPrepared_ = (Manipulation '[] db params '[] -> list x -> pq ())
-> list x -> Manipulation '[] db params '[] -> pq ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Manipulation '[] db params '[] -> list x -> pq ()
forall (db :: SchemasType) (pq :: * -> *) (params :: [NullType]) x
(xs :: [*]) (list :: * -> *).
(MonadPQ db pq, GenericParams db params x xs, Foldable list) =>
Manipulation '[] db params '[] -> list x -> pq ()
traversePrepared_
instance MonadPQ db m => MonadPQ db (IdentityT m)
instance MonadPQ db m => MonadPQ db (ReaderT r m)
instance MonadPQ db m => MonadPQ db (Strict.StateT s m)
instance MonadPQ db m => MonadPQ db (Lazy.StateT s m)
instance (Monoid w, MonadPQ db m) => MonadPQ db (Strict.WriterT w m)
instance (Monoid w, MonadPQ db m) => MonadPQ db (Lazy.WriterT w m)
instance MonadPQ db m => MonadPQ db (MaybeT m)
instance MonadPQ db m => MonadPQ db (ExceptT e m)
instance (Monoid w, MonadPQ db m) => MonadPQ db (Strict.RWST r w s m)
instance (Monoid w, MonadPQ db m) => MonadPQ db (Lazy.RWST r w s m)
instance MonadPQ db m => MonadPQ db (ContT r m)