module Database.PostgreSQL.Query.Types
       ( -- * Query execution
         HasPostgres(..)
       , MonadPostgres
       , TransactionSafe
       , PgMonadT(..)
       , runPgMonadT
       , launchPG
        -- * Auxiliary types
       , Qp(..)
       , InetText(..)
       , FN(..)
       , textFN
       , MarkedRow(..)
       , mrToBuilder
       , ToMarkedRow(..)
       ) where

import Control.Monad.Cont.Class ( MonadCont )
import Control.Monad.Error.Class ( MonadError )
import Control.Monad.Fix ( MonadFix(..) )
import Control.Monad.HReader
import Control.Monad.Logger
import Control.Monad.Reader
    ( MonadReader(..), ReaderT(..) )
import Control.Monad.State.Class ( MonadState )
import Control.Monad.Trans
import Control.Monad.Trans.Cont
import Control.Monad.Trans.Control
import Control.Monad.Trans.Except
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Writer.Class ( MonadWriter )
import Data.HSet
import Data.Pool
import Data.String
import Data.Typeable
import Database.PostgreSQL.Query.Import
import Database.PostgreSQL.Query.SqlBuilder
import Database.PostgreSQL.Query.TH.SqlExp
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromField
import Database.PostgreSQL.Simple.ToField
import Database.PostgreSQL.Simple.Types
import Instances.TH.Lift ()
import Language.Haskell.TH.Lift ( deriveLift )

#if MIN_VERSION_base(4,8,0)
import Data.Semigroup
#else
import Data.Monoid
import Data.Semigroup
#endif

#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail
#endif

import qualified Blaze.ByteString.Builder.ByteString as BB
import qualified Control.Monad.Trans.State.Lazy as STL
import qualified Control.Monad.Trans.State.Strict as STS
import qualified Control.Monad.Trans.Writer.Lazy as WL
import qualified Control.Monad.Trans.Writer.Strict as WS
import qualified Data.List as L
import qualified Data.Text as T
import qualified Data.Text.Encoding as T

{- $setup
>>> import Database.PostgreSQL.Query.SqlBuilder
>>> import Data.Text ( Text )
>>> c <- connect defaultConnectInfo
-}


-- | Special constructor to perform old-style query interpolation
data Qp = forall row. (ToRow row) => Qp Query row

instance ToSqlBuilder Qp where
  toSqlBuilder :: Qp -> SqlBuilder
toSqlBuilder (Qp Query
q row
row) = (Connection -> LogMasker -> IO SqlBuilderResult) -> SqlBuilder
SqlBuilder ((Connection -> LogMasker -> IO SqlBuilderResult) -> SqlBuilder)
-> (Connection -> LogMasker -> IO SqlBuilderResult) -> SqlBuilder
forall a b. (a -> b) -> a -> b
$ \Connection
con LogMasker
_ ->
    Builder -> SqlBuilderResult
builderResultPure (Builder -> SqlBuilderResult)
-> (ByteString -> Builder) -> ByteString -> SqlBuilderResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BB.fromByteString (ByteString -> SqlBuilderResult)
-> IO ByteString -> IO SqlBuilderResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> row -> IO ByteString
forall q. ToRow q => Connection -> Query -> q -> IO ByteString
formatQuery Connection
con Query
q row
row

-- | type to put and get from db 'inet' and 'cidr' typed postgresql
-- fields. This should be in postgresql-simple in fact.
newtype InetText = InetText
    { InetText -> Text
unInetText :: T.Text
    } deriving ( String -> InetText
(String -> InetText) -> IsString InetText
forall a. (String -> a) -> IsString a
fromString :: String -> InetText
$cfromString :: String -> InetText
IsString, InetText -> InetText -> Bool
(InetText -> InetText -> Bool)
-> (InetText -> InetText -> Bool) -> Eq InetText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InetText -> InetText -> Bool
$c/= :: InetText -> InetText -> Bool
== :: InetText -> InetText -> Bool
$c== :: InetText -> InetText -> Bool
Eq, Eq InetText
Eq InetText
-> (InetText -> InetText -> Ordering)
-> (InetText -> InetText -> Bool)
-> (InetText -> InetText -> Bool)
-> (InetText -> InetText -> Bool)
-> (InetText -> InetText -> Bool)
-> (InetText -> InetText -> InetText)
-> (InetText -> InetText -> InetText)
-> Ord InetText
InetText -> InetText -> Bool
InetText -> InetText -> Ordering
InetText -> InetText -> InetText
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InetText -> InetText -> InetText
$cmin :: InetText -> InetText -> InetText
max :: InetText -> InetText -> InetText
$cmax :: InetText -> InetText -> InetText
>= :: InetText -> InetText -> Bool
$c>= :: InetText -> InetText -> Bool
> :: InetText -> InetText -> Bool
$c> :: InetText -> InetText -> Bool
<= :: InetText -> InetText -> Bool
$c<= :: InetText -> InetText -> Bool
< :: InetText -> InetText -> Bool
$c< :: InetText -> InetText -> Bool
compare :: InetText -> InetText -> Ordering
$ccompare :: InetText -> InetText -> Ordering
$cp1Ord :: Eq InetText
Ord, ReadPrec [InetText]
ReadPrec InetText
Int -> ReadS InetText
ReadS [InetText]
(Int -> ReadS InetText)
-> ReadS [InetText]
-> ReadPrec InetText
-> ReadPrec [InetText]
-> Read InetText
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InetText]
$creadListPrec :: ReadPrec [InetText]
readPrec :: ReadPrec InetText
$creadPrec :: ReadPrec InetText
readList :: ReadS [InetText]
$creadList :: ReadS [InetText]
readsPrec :: Int -> ReadS InetText
$creadsPrec :: Int -> ReadS InetText
Read, Int -> InetText -> ShowS
[InetText] -> ShowS
InetText -> String
(Int -> InetText -> ShowS)
-> (InetText -> String) -> ([InetText] -> ShowS) -> Show InetText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InetText] -> ShowS
$cshowList :: [InetText] -> ShowS
show :: InetText -> String
$cshow :: InetText -> String
showsPrec :: Int -> InetText -> ShowS
$cshowsPrec :: Int -> InetText -> ShowS
Show
               , Typeable, b -> InetText -> InetText
NonEmpty InetText -> InetText
InetText -> InetText -> InetText
(InetText -> InetText -> InetText)
-> (NonEmpty InetText -> InetText)
-> (forall b. Integral b => b -> InetText -> InetText)
-> Semigroup InetText
forall b. Integral b => b -> InetText -> InetText
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> InetText -> InetText
$cstimes :: forall b. Integral b => b -> InetText -> InetText
sconcat :: NonEmpty InetText -> InetText
$csconcat :: NonEmpty InetText -> InetText
<> :: InetText -> InetText -> InetText
$c<> :: InetText -> InetText -> InetText
Semigroup, Semigroup InetText
InetText
Semigroup InetText
-> InetText
-> (InetText -> InetText -> InetText)
-> ([InetText] -> InetText)
-> Monoid InetText
[InetText] -> InetText
InetText -> InetText -> InetText
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [InetText] -> InetText
$cmconcat :: [InetText] -> InetText
mappend :: InetText -> InetText -> InetText
$cmappend :: InetText -> InetText -> InetText
mempty :: InetText
$cmempty :: InetText
$cp1Monoid :: Semigroup InetText
Monoid, InetText -> Action
(InetText -> Action) -> ToField InetText
forall a. (a -> Action) -> ToField a
toField :: InetText -> Action
$ctoField :: InetText -> Action
ToField )


instance FromField InetText where
    fromField :: FieldParser InetText
fromField Field
fld Maybe ByteString
Nothing = (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion InetText
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed
                            Field
fld String
"can not convert Null to InetText"
    fromField Field
fld (Just ByteString
bs) = do
        ByteString
n <- Field -> Conversion ByteString
typename Field
fld
        case ByteString
n of
            ByteString
"inet" -> Conversion InetText
result
            ByteString
"cidr" -> Conversion InetText
result
            ByteString
_ -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion InetText
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError
                 String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
fld
                 String
"could not convert to InetText"
      where
        result :: Conversion InetText
result = InetText -> Conversion InetText
forall (m :: * -> *) a. Monad m => a -> m a
return (InetText -> Conversion InetText)
-> InetText -> Conversion InetText
forall a b. (a -> b) -> a -> b
$ Text -> InetText
InetText
                 (Text -> InetText) -> Text -> InetText
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
bs



{- | Dot-separated field name. Each element in nested list will be
properly quoted and separated by dot. It also have instance of
'ToSqlBuilder' and 'IsString` so you can:

>>> let a = "hello" :: FN
>>> a
FN ["hello"]

>>> let b = "user.name" :: FN
>>> b
FN ["user","name"]

>>> let n = "u.name" :: FN
>>> runSqlBuilder c $ toSqlBuilder n
"\"u\".\"name\""

>>> ("user" <> "name") :: FN
FN ["user","name"]

>>> let a = "name" :: FN
>>> let b = "email" :: FN
>>> runSqlBuilder c [sqlExp|^{"u" <> a} = 'name', ^{"e" <> b} = 'email'|]
"\"u\".\"name\" = 'name', \"e\".\"email\" = 'email'"

-}

newtype FN = FN [Text]
    deriving (Eq FN
Eq FN
-> (FN -> FN -> Ordering)
-> (FN -> FN -> Bool)
-> (FN -> FN -> Bool)
-> (FN -> FN -> Bool)
-> (FN -> FN -> Bool)
-> (FN -> FN -> FN)
-> (FN -> FN -> FN)
-> Ord FN
FN -> FN -> Bool
FN -> FN -> Ordering
FN -> FN -> FN
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FN -> FN -> FN
$cmin :: FN -> FN -> FN
max :: FN -> FN -> FN
$cmax :: FN -> FN -> FN
>= :: FN -> FN -> Bool
$c>= :: FN -> FN -> Bool
> :: FN -> FN -> Bool
$c> :: FN -> FN -> Bool
<= :: FN -> FN -> Bool
$c<= :: FN -> FN -> Bool
< :: FN -> FN -> Bool
$c< :: FN -> FN -> Bool
compare :: FN -> FN -> Ordering
$ccompare :: FN -> FN -> Ordering
$cp1Ord :: Eq FN
Ord, FN -> FN -> Bool
(FN -> FN -> Bool) -> (FN -> FN -> Bool) -> Eq FN
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FN -> FN -> Bool
$c/= :: FN -> FN -> Bool
== :: FN -> FN -> Bool
$c== :: FN -> FN -> Bool
Eq, Int -> FN -> ShowS
[FN] -> ShowS
FN -> String
(Int -> FN -> ShowS)
-> (FN -> String) -> ([FN] -> ShowS) -> Show FN
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FN] -> ShowS
$cshowList :: [FN] -> ShowS
show :: FN -> String
$cshow :: FN -> String
showsPrec :: Int -> FN -> ShowS
$cshowsPrec :: Int -> FN -> ShowS
Show, b -> FN -> FN
NonEmpty FN -> FN
FN -> FN -> FN
(FN -> FN -> FN)
-> (NonEmpty FN -> FN)
-> (forall b. Integral b => b -> FN -> FN)
-> Semigroup FN
forall b. Integral b => b -> FN -> FN
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> FN -> FN
$cstimes :: forall b. Integral b => b -> FN -> FN
sconcat :: NonEmpty FN -> FN
$csconcat :: NonEmpty FN -> FN
<> :: FN -> FN -> FN
$c<> :: FN -> FN -> FN
Semigroup, Semigroup FN
FN
Semigroup FN -> FN -> (FN -> FN -> FN) -> ([FN] -> FN) -> Monoid FN
[FN] -> FN
FN -> FN -> FN
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [FN] -> FN
$cmconcat :: [FN] -> FN
mappend :: FN -> FN -> FN
$cmappend :: FN -> FN -> FN
mempty :: FN
$cmempty :: FN
$cp1Monoid :: Semigroup FN
Monoid, Typeable, (forall x. FN -> Rep FN x)
-> (forall x. Rep FN x -> FN) -> Generic FN
forall x. Rep FN x -> FN
forall x. FN -> Rep FN x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FN x -> FN
$cfrom :: forall x. FN -> Rep FN x
Generic)

$(deriveLift ''FN)

instance ToSqlBuilder FN where
    toSqlBuilder :: FN -> SqlBuilder
toSqlBuilder (FN [Text]
tt) =
        [SqlBuilder] -> SqlBuilder
forall a. Monoid a => [a] -> a
mconcat
        ([SqlBuilder] -> SqlBuilder) -> [SqlBuilder] -> SqlBuilder
forall a b. (a -> b) -> a -> b
$ SqlBuilder -> [SqlBuilder] -> [SqlBuilder]
forall a. a -> [a] -> [a]
L.intersperse SqlBuilder
"."
        ([SqlBuilder] -> [SqlBuilder]) -> [SqlBuilder] -> [SqlBuilder]
forall a b. (a -> b) -> a -> b
$ (Text -> SqlBuilder) -> [Text] -> [SqlBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier -> SqlBuilder
forall a. ToSqlBuilder a => a -> SqlBuilder
toSqlBuilder (Identifier -> SqlBuilder)
-> (Text -> Identifier) -> Text -> SqlBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Identifier
Identifier) [Text]
tt

instance IsString FN where
    fromString :: String -> FN
fromString String
s =
        [Text] -> FN
FN
        ([Text] -> FN) -> [Text] -> FN
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack
        ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
".")
        ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Char -> Char -> Bool) -> String -> [String]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy Char -> Char -> Bool
f String
s
      where
        f :: Char -> Char -> Bool
f Char
a Char
b = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
b Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'

{- | Single field to 'FN'

>>> textFN "hello"
FN ["hello"]

>>> textFN "user.name"
FN ["user.name"]

Note that it does not split string to parts by point like instance of
`IsString` does

-}

textFN :: Text -> FN
textFN :: Text -> FN
textFN = [Text] -> FN
FN ([Text] -> FN) -> (Text -> [Text]) -> Text -> FN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[])

{- | Marked row is list of pairs of field name and some sql
expression. Used to generate queries like:

@
name = 'name' AND size = 10 AND length = 20
@

or

@
UPDATE tbl SET name = 'name', size = 10, lenght = 20
@

-}

newtype MarkedRow = MR
    { MarkedRow -> [(FN, SqlBuilder)]
unMR :: [(FN, SqlBuilder)]
    } deriving (b -> MarkedRow -> MarkedRow
NonEmpty MarkedRow -> MarkedRow
MarkedRow -> MarkedRow -> MarkedRow
(MarkedRow -> MarkedRow -> MarkedRow)
-> (NonEmpty MarkedRow -> MarkedRow)
-> (forall b. Integral b => b -> MarkedRow -> MarkedRow)
-> Semigroup MarkedRow
forall b. Integral b => b -> MarkedRow -> MarkedRow
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> MarkedRow -> MarkedRow
$cstimes :: forall b. Integral b => b -> MarkedRow -> MarkedRow
sconcat :: NonEmpty MarkedRow -> MarkedRow
$csconcat :: NonEmpty MarkedRow -> MarkedRow
<> :: MarkedRow -> MarkedRow -> MarkedRow
$c<> :: MarkedRow -> MarkedRow -> MarkedRow
Semigroup, Semigroup MarkedRow
MarkedRow
Semigroup MarkedRow
-> MarkedRow
-> (MarkedRow -> MarkedRow -> MarkedRow)
-> ([MarkedRow] -> MarkedRow)
-> Monoid MarkedRow
[MarkedRow] -> MarkedRow
MarkedRow -> MarkedRow -> MarkedRow
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [MarkedRow] -> MarkedRow
$cmconcat :: [MarkedRow] -> MarkedRow
mappend :: MarkedRow -> MarkedRow -> MarkedRow
$cmappend :: MarkedRow -> MarkedRow -> MarkedRow
mempty :: MarkedRow
$cmempty :: MarkedRow
$cp1Monoid :: Semigroup MarkedRow
Monoid, Typeable, (forall x. MarkedRow -> Rep MarkedRow x)
-> (forall x. Rep MarkedRow x -> MarkedRow) -> Generic MarkedRow
forall x. Rep MarkedRow x -> MarkedRow
forall x. MarkedRow -> Rep MarkedRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MarkedRow x -> MarkedRow
$cfrom :: forall x. MarkedRow -> Rep MarkedRow x
Generic)

class ToMarkedRow a where
    -- | generate list of pairs (field name, field value)
    toMarkedRow :: a -> MarkedRow

instance ToMarkedRow MarkedRow where
    toMarkedRow :: MarkedRow -> MarkedRow
toMarkedRow = MarkedRow -> MarkedRow
forall a. a -> a
id

{- | Turns marked row to query intercalating it with other builder

>>> runSqlBuilder c $ mrToBuilder "AND" $ MR [("name", mkValue "petr"), ("email", mkValue "foo@bar.com")]
" \"name\" = 'petr' AND \"email\" = 'foo@bar.com' "

-}

mrToBuilder :: SqlBuilder        -- ^ Builder to intercalate with
            -> MarkedRow
            -> SqlBuilder
mrToBuilder :: SqlBuilder -> MarkedRow -> SqlBuilder
mrToBuilder SqlBuilder
b (MR [(FN, SqlBuilder)]
l) = [SqlBuilder] -> SqlBuilder
forall a. Monoid a => [a] -> a
mconcat
                       ([SqlBuilder] -> SqlBuilder) -> [SqlBuilder] -> SqlBuilder
forall a b. (a -> b) -> a -> b
$ SqlBuilder -> [SqlBuilder] -> [SqlBuilder]
forall a. a -> [a] -> [a]
L.intersperse SqlBuilder
b
                       ([SqlBuilder] -> [SqlBuilder]) -> [SqlBuilder] -> [SqlBuilder]
forall a b. (a -> b) -> a -> b
$ ((FN, SqlBuilder) -> SqlBuilder)
-> [(FN, SqlBuilder)] -> [SqlBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (FN, SqlBuilder) -> SqlBuilder
forall a a.
(ToSqlBuilder a, ToSqlBuilder a) =>
(a, a) -> SqlBuilder
tobld [(FN, SqlBuilder)]
l
  where
    tobld :: (a, a) -> SqlBuilder
tobld (a
f, a
val) = [sqlExp| ^{f} = ^{val} |]

type MonadPostgres m = (HasPostgres m, MonadLogger m)

-- | Instances of this typeclass can acquire connection and pass it to
-- computation. It can be reader of pool of connections or just reader of
-- connection

class (MonadBase IO m) => HasPostgres m where
    withPGConnection :: (Connection -> m a) -> m a

instance (HasPostgres m) => HasPostgres (ExceptT e m) where
    withPGConnection :: (Connection -> ExceptT e m a) -> ExceptT e m a
withPGConnection Connection -> ExceptT e m a
action = do
        m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> m (Either e a) -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$ (Connection -> m (Either e a)) -> m (Either e a)
forall (m :: * -> *) a. HasPostgres m => (Connection -> m a) -> m a
withPGConnection ((Connection -> m (Either e a)) -> m (Either e a))
-> (Connection -> m (Either e a)) -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ \Connection
con -> do
            ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e m a -> m (Either e a))
-> ExceptT e m a -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ Connection -> ExceptT e m a
action Connection
con
    {-# INLINABLE withPGConnection #-}

instance (HasPostgres m) => HasPostgres (IdentityT m) where
    withPGConnection :: (Connection -> IdentityT m a) -> IdentityT m a
withPGConnection Connection -> IdentityT m a
action = do
        m a -> IdentityT m a
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> IdentityT m a) -> m a -> IdentityT m a
forall a b. (a -> b) -> a -> b
$ (Connection -> m a) -> m a
forall (m :: * -> *) a. HasPostgres m => (Connection -> m a) -> m a
withPGConnection ((Connection -> m a) -> m a) -> (Connection -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Connection
con -> do
            IdentityT m a -> m a
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT (IdentityT m a -> m a) -> IdentityT m a -> m a
forall a b. (a -> b) -> a -> b
$ Connection -> IdentityT m a
action Connection
con
    {-# INLINABLE withPGConnection #-}

instance (HasPostgres m) => HasPostgres (MaybeT m) where
    withPGConnection :: (Connection -> MaybeT m a) -> MaybeT m a
withPGConnection Connection -> MaybeT m a
action = do
        m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ (Connection -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a. HasPostgres m => (Connection -> m a) -> m a
withPGConnection ((Connection -> m (Maybe a)) -> m (Maybe a))
-> (Connection -> m (Maybe a)) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Connection
con -> do
            MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m a -> m (Maybe a)) -> MaybeT m a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Connection -> MaybeT m a
action Connection
con
    {-# INLINABLE withPGConnection #-}

instance (HasPostgres m) => HasPostgres (ReaderT r m) where
    withPGConnection :: (Connection -> ReaderT r m a) -> ReaderT r m a
withPGConnection Connection -> ReaderT r m a
action = do
        (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \r
r -> (Connection -> m a) -> m a
forall (m :: * -> *) a. HasPostgres m => (Connection -> m a) -> m a
withPGConnection ((Connection -> m a) -> m a) -> (Connection -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Connection
con ->
            ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Connection -> ReaderT r m a
action Connection
con) r
r
    {-# INLINABLE withPGConnection #-}

instance (HasPostgres m) => HasPostgres (STL.StateT s m) where
    withPGConnection :: (Connection -> StateT s m a) -> StateT s m a
withPGConnection Connection -> StateT s m a
action = do
        (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
STL.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> (Connection -> m (a, s)) -> m (a, s)
forall (m :: * -> *) a. HasPostgres m => (Connection -> m a) -> m a
withPGConnection ((Connection -> m (a, s)) -> m (a, s))
-> (Connection -> m (a, s)) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ \Connection
con ->
            StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
STL.runStateT (Connection -> StateT s m a
action Connection
con) s
s
    {-# INLINABLE withPGConnection #-}

instance (HasPostgres m) => HasPostgres (STS.StateT s m) where
    withPGConnection :: (Connection -> StateT s m a) -> StateT s m a
withPGConnection Connection -> StateT s m a
action = do
        (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
STS.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> (Connection -> m (a, s)) -> m (a, s)
forall (m :: * -> *) a. HasPostgres m => (Connection -> m a) -> m a
withPGConnection ((Connection -> m (a, s)) -> m (a, s))
-> (Connection -> m (a, s)) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ \Connection
con ->
            StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
STS.runStateT (Connection -> StateT s m a
action Connection
con) s
s
    {-# INLINABLE withPGConnection #-}

instance (HasPostgres m) => HasPostgres (ContT r m) where
    withPGConnection :: (Connection -> ContT r m a) -> ContT r m a
withPGConnection Connection -> ContT r m a
action = do
        ((a -> m r) -> m r) -> ContT r m a
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((a -> m r) -> m r) -> ContT r m a)
-> ((a -> m r) -> m r) -> ContT r m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
r -> (Connection -> m r) -> m r
forall (m :: * -> *) a. HasPostgres m => (Connection -> m a) -> m a
withPGConnection ((Connection -> m r) -> m r) -> (Connection -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \Connection
con ->
            ContT r m a -> (a -> m r) -> m r
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
runContT (Connection -> ContT r m a
action Connection
con) a -> m r
r
    {-# INLINABLE withPGConnection #-}

instance (HasPostgres m, Monoid w) => HasPostgres (WL.WriterT w m) where
    withPGConnection :: (Connection -> WriterT w m a) -> WriterT w m a
withPGConnection Connection -> WriterT w m a
action = do
        m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WL.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$ (Connection -> m (a, w)) -> m (a, w)
forall (m :: * -> *) a. HasPostgres m => (Connection -> m a) -> m a
withPGConnection ((Connection -> m (a, w)) -> m (a, w))
-> (Connection -> m (a, w)) -> m (a, w)
forall a b. (a -> b) -> a -> b
$ \Connection
con ->
            WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WL.runWriterT (Connection -> WriterT w m a
action Connection
con)
    {-# INLINABLE withPGConnection #-}

instance (HasPostgres m, Monoid w) => HasPostgres (WS.WriterT w m) where
    withPGConnection :: (Connection -> WriterT w m a) -> WriterT w m a
withPGConnection Connection -> WriterT w m a
action = do
        m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WS.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$ (Connection -> m (a, w)) -> m (a, w)
forall (m :: * -> *) a. HasPostgres m => (Connection -> m a) -> m a
withPGConnection ((Connection -> m (a, w)) -> m (a, w))
-> (Connection -> m (a, w)) -> m (a, w)
forall a b. (a -> b) -> a -> b
$ \Connection
con ->
            WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WS.runWriterT (Connection -> WriterT w m a
action Connection
con)
    {-# INLINABLE withPGConnection #-}

instance (MonadBase IO m, MonadBaseControl IO m, HGettable els (Pool Connection))
         => HasPostgres (HReaderT els m) where
    withPGConnection :: (Connection -> HReaderT els m a) -> HReaderT els m a
withPGConnection Connection -> HReaderT els m a
action = do
        Pool Connection
pool <- HReaderT els m (Pool Connection)
forall (m :: * -> *) e.
(MonadHReader m, HGettable (MHRElements m) e) =>
m e
hask
        Pool Connection
-> (Connection -> HReaderT els m a) -> HReaderT els m a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Pool a -> (a -> m b) -> m b
withResource Pool Connection
pool Connection -> HReaderT els m a
action

-- | Empty typeclass signing monad in which transaction is
-- safe. i.e. `PgMonadT` have this instance, but some other monad giving
-- connection from e.g. connection pool is not.
class TransactionSafe (m :: * -> *)

instance (TransactionSafe m) => TransactionSafe (ExceptT e m)
instance (TransactionSafe m) => TransactionSafe (IdentityT m)
instance (TransactionSafe m) => TransactionSafe (MaybeT m)
instance (TransactionSafe m) => TransactionSafe (ReaderT r m)
instance (TransactionSafe m) => TransactionSafe (STL.StateT s m)
instance (TransactionSafe m) => TransactionSafe (STS.StateT s m)
instance (TransactionSafe m) => TransactionSafe (ContT r m)
instance (TransactionSafe m, Monoid w) => TransactionSafe (WL.WriterT w m)
instance (TransactionSafe m, Monoid w) => TransactionSafe (WS.WriterT w m)


-- | Reader of connection. Has instance of 'HasPostgres'. So if you have a
-- connection you can run queries in this monad using 'runPgMonadT'. Or you
-- can use this transformer to run sequence of queries using same
-- connection with 'launchPG'.
newtype PgMonadT m a = PgMonadT
    { PgMonadT m a -> ReaderT Connection m a
unPgMonadT :: ReaderT Connection m a
    } deriving ( a -> PgMonadT m b -> PgMonadT m a
(a -> b) -> PgMonadT m a -> PgMonadT m b
(forall a b. (a -> b) -> PgMonadT m a -> PgMonadT m b)
-> (forall a b. a -> PgMonadT m b -> PgMonadT m a)
-> Functor (PgMonadT m)
forall a b. a -> PgMonadT m b -> PgMonadT m a
forall a b. (a -> b) -> PgMonadT m a -> PgMonadT m b
forall (m :: * -> *) a b.
Functor m =>
a -> PgMonadT m b -> PgMonadT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> PgMonadT m a -> PgMonadT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PgMonadT m b -> PgMonadT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> PgMonadT m b -> PgMonadT m a
fmap :: (a -> b) -> PgMonadT m a -> PgMonadT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> PgMonadT m a -> PgMonadT m b
Functor, Functor (PgMonadT m)
a -> PgMonadT m a
Functor (PgMonadT m)
-> (forall a. a -> PgMonadT m a)
-> (forall a b.
    PgMonadT m (a -> b) -> PgMonadT m a -> PgMonadT m b)
-> (forall a b c.
    (a -> b -> c) -> PgMonadT m a -> PgMonadT m b -> PgMonadT m c)
-> (forall a b. PgMonadT m a -> PgMonadT m b -> PgMonadT m b)
-> (forall a b. PgMonadT m a -> PgMonadT m b -> PgMonadT m a)
-> Applicative (PgMonadT m)
PgMonadT m a -> PgMonadT m b -> PgMonadT m b
PgMonadT m a -> PgMonadT m b -> PgMonadT m a
PgMonadT m (a -> b) -> PgMonadT m a -> PgMonadT m b
(a -> b -> c) -> PgMonadT m a -> PgMonadT m b -> PgMonadT m c
forall a. a -> PgMonadT m a
forall a b. PgMonadT m a -> PgMonadT m b -> PgMonadT m a
forall a b. PgMonadT m a -> PgMonadT m b -> PgMonadT m b
forall a b. PgMonadT m (a -> b) -> PgMonadT m a -> PgMonadT m b
forall a b c.
(a -> b -> c) -> PgMonadT m a -> PgMonadT m b -> PgMonadT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (PgMonadT m)
forall (m :: * -> *) a. Applicative m => a -> PgMonadT m a
forall (m :: * -> *) a b.
Applicative m =>
PgMonadT m a -> PgMonadT m b -> PgMonadT m a
forall (m :: * -> *) a b.
Applicative m =>
PgMonadT m a -> PgMonadT m b -> PgMonadT m b
forall (m :: * -> *) a b.
Applicative m =>
PgMonadT m (a -> b) -> PgMonadT m a -> PgMonadT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> PgMonadT m a -> PgMonadT m b -> PgMonadT m c
<* :: PgMonadT m a -> PgMonadT m b -> PgMonadT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
PgMonadT m a -> PgMonadT m b -> PgMonadT m a
*> :: PgMonadT m a -> PgMonadT m b -> PgMonadT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
PgMonadT m a -> PgMonadT m b -> PgMonadT m b
liftA2 :: (a -> b -> c) -> PgMonadT m a -> PgMonadT m b -> PgMonadT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> PgMonadT m a -> PgMonadT m b -> PgMonadT m c
<*> :: PgMonadT m (a -> b) -> PgMonadT m a -> PgMonadT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
PgMonadT m (a -> b) -> PgMonadT m a -> PgMonadT m b
pure :: a -> PgMonadT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> PgMonadT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (PgMonadT m)
Applicative, Applicative (PgMonadT m)
a -> PgMonadT m a
Applicative (PgMonadT m)
-> (forall a b.
    PgMonadT m a -> (a -> PgMonadT m b) -> PgMonadT m b)
-> (forall a b. PgMonadT m a -> PgMonadT m b -> PgMonadT m b)
-> (forall a. a -> PgMonadT m a)
-> Monad (PgMonadT m)
PgMonadT m a -> (a -> PgMonadT m b) -> PgMonadT m b
PgMonadT m a -> PgMonadT m b -> PgMonadT m b
forall a. a -> PgMonadT m a
forall a b. PgMonadT m a -> PgMonadT m b -> PgMonadT m b
forall a b. PgMonadT m a -> (a -> PgMonadT m b) -> PgMonadT m b
forall (m :: * -> *). Monad m => Applicative (PgMonadT m)
forall (m :: * -> *) a. Monad m => a -> PgMonadT m a
forall (m :: * -> *) a b.
Monad m =>
PgMonadT m a -> PgMonadT m b -> PgMonadT m b
forall (m :: * -> *) a b.
Monad m =>
PgMonadT m a -> (a -> PgMonadT m b) -> PgMonadT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> PgMonadT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> PgMonadT m a
>> :: PgMonadT m a -> PgMonadT m b -> PgMonadT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
PgMonadT m a -> PgMonadT m b -> PgMonadT m b
>>= :: PgMonadT m a -> (a -> PgMonadT m b) -> PgMonadT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
PgMonadT m a -> (a -> PgMonadT m b) -> PgMonadT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (PgMonadT m)
Monad , MonadWriter w
               , MonadState s, MonadError e, m a -> PgMonadT m a
(forall (m :: * -> *) a. Monad m => m a -> PgMonadT m a)
-> MonadTrans PgMonadT
forall (m :: * -> *) a. Monad m => m a -> PgMonadT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> PgMonadT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> PgMonadT m a
MonadTrans
               , Applicative (PgMonadT m)
PgMonadT m a
Applicative (PgMonadT m)
-> (forall a. PgMonadT m a)
-> (forall a. PgMonadT m a -> PgMonadT m a -> PgMonadT m a)
-> (forall a. PgMonadT m a -> PgMonadT m [a])
-> (forall a. PgMonadT m a -> PgMonadT m [a])
-> Alternative (PgMonadT m)
PgMonadT m a -> PgMonadT m a -> PgMonadT m a
PgMonadT m a -> PgMonadT m [a]
PgMonadT m a -> PgMonadT m [a]
forall a. PgMonadT m a
forall a. PgMonadT m a -> PgMonadT m [a]
forall a. PgMonadT m a -> PgMonadT m a -> PgMonadT m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (m :: * -> *). Alternative m => Applicative (PgMonadT m)
forall (m :: * -> *) a. Alternative m => PgMonadT m a
forall (m :: * -> *) a.
Alternative m =>
PgMonadT m a -> PgMonadT m [a]
forall (m :: * -> *) a.
Alternative m =>
PgMonadT m a -> PgMonadT m a -> PgMonadT m a
many :: PgMonadT m a -> PgMonadT m [a]
$cmany :: forall (m :: * -> *) a.
Alternative m =>
PgMonadT m a -> PgMonadT m [a]
some :: PgMonadT m a -> PgMonadT m [a]
$csome :: forall (m :: * -> *) a.
Alternative m =>
PgMonadT m a -> PgMonadT m [a]
<|> :: PgMonadT m a -> PgMonadT m a -> PgMonadT m a
$c<|> :: forall (m :: * -> *) a.
Alternative m =>
PgMonadT m a -> PgMonadT m a -> PgMonadT m a
empty :: PgMonadT m a
$cempty :: forall (m :: * -> *) a. Alternative m => PgMonadT m a
$cp1Alternative :: forall (m :: * -> *). Alternative m => Applicative (PgMonadT m)
Alternative, Monad (PgMonadT m)
Monad (PgMonadT m)
-> (forall a. (a -> PgMonadT m a) -> PgMonadT m a)
-> MonadFix (PgMonadT m)
(a -> PgMonadT m a) -> PgMonadT m a
forall a. (a -> PgMonadT m a) -> PgMonadT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall (m :: * -> *). MonadFix m => Monad (PgMonadT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> PgMonadT m a) -> PgMonadT m a
mfix :: (a -> PgMonadT m a) -> PgMonadT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> PgMonadT m a) -> PgMonadT m a
$cp1MonadFix :: forall (m :: * -> *). MonadFix m => Monad (PgMonadT m)
MonadFix, Monad (PgMonadT m)
Alternative (PgMonadT m)
PgMonadT m a
Alternative (PgMonadT m)
-> Monad (PgMonadT m)
-> (forall a. PgMonadT m a)
-> (forall a. PgMonadT m a -> PgMonadT m a -> PgMonadT m a)
-> MonadPlus (PgMonadT m)
PgMonadT m a -> PgMonadT m a -> PgMonadT m a
forall a. PgMonadT m a
forall a. PgMonadT m a -> PgMonadT m a -> PgMonadT m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall (m :: * -> *). MonadPlus m => Monad (PgMonadT m)
forall (m :: * -> *). MonadPlus m => Alternative (PgMonadT m)
forall (m :: * -> *) a. MonadPlus m => PgMonadT m a
forall (m :: * -> *) a.
MonadPlus m =>
PgMonadT m a -> PgMonadT m a -> PgMonadT m a
mplus :: PgMonadT m a -> PgMonadT m a -> PgMonadT m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
PgMonadT m a -> PgMonadT m a -> PgMonadT m a
mzero :: PgMonadT m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => PgMonadT m a
$cp2MonadPlus :: forall (m :: * -> *). MonadPlus m => Monad (PgMonadT m)
$cp1MonadPlus :: forall (m :: * -> *). MonadPlus m => Alternative (PgMonadT m)
MonadPlus, Monad (PgMonadT m)
Monad (PgMonadT m)
-> (forall a. IO a -> PgMonadT m a) -> MonadIO (PgMonadT m)
IO a -> PgMonadT m a
forall a. IO a -> PgMonadT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (PgMonadT m)
forall (m :: * -> *) a. MonadIO m => IO a -> PgMonadT m a
liftIO :: IO a -> PgMonadT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> PgMonadT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (PgMonadT m)
MonadIO
               , Monad (PgMonadT m)
Monad (PgMonadT m)
-> (forall a b.
    ((a -> PgMonadT m b) -> PgMonadT m a) -> PgMonadT m a)
-> MonadCont (PgMonadT m)
((a -> PgMonadT m b) -> PgMonadT m a) -> PgMonadT m a
forall a b. ((a -> PgMonadT m b) -> PgMonadT m a) -> PgMonadT m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
forall (m :: * -> *). MonadCont m => Monad (PgMonadT m)
forall (m :: * -> *) a b.
MonadCont m =>
((a -> PgMonadT m b) -> PgMonadT m a) -> PgMonadT m a
callCC :: ((a -> PgMonadT m b) -> PgMonadT m a) -> PgMonadT m a
$ccallCC :: forall (m :: * -> *) a b.
MonadCont m =>
((a -> PgMonadT m b) -> PgMonadT m a) -> PgMonadT m a
$cp1MonadCont :: forall (m :: * -> *). MonadCont m => Monad (PgMonadT m)
MonadCont, Monad (PgMonadT m)
e -> PgMonadT m a
Monad (PgMonadT m)
-> (forall e a. Exception e => e -> PgMonadT m a)
-> MonadThrow (PgMonadT m)
forall e a. Exception e => e -> PgMonadT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (PgMonadT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> PgMonadT m a
throwM :: e -> PgMonadT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> PgMonadT m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (PgMonadT m)
MonadThrow, MonadThrow (PgMonadT m)
MonadThrow (PgMonadT m)
-> (forall e a.
    Exception e =>
    PgMonadT m a -> (e -> PgMonadT m a) -> PgMonadT m a)
-> MonadCatch (PgMonadT m)
PgMonadT m a -> (e -> PgMonadT m a) -> PgMonadT m a
forall e a.
Exception e =>
PgMonadT m a -> (e -> PgMonadT m a) -> PgMonadT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (PgMonadT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
PgMonadT m a -> (e -> PgMonadT m a) -> PgMonadT m a
catch :: PgMonadT m a -> (e -> PgMonadT m a) -> PgMonadT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
PgMonadT m a -> (e -> PgMonadT m a) -> PgMonadT m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (PgMonadT m)
MonadCatch, MonadCatch (PgMonadT m)
MonadCatch (PgMonadT m)
-> (forall b.
    ((forall a. PgMonadT m a -> PgMonadT m a) -> PgMonadT m b)
    -> PgMonadT m b)
-> (forall b.
    ((forall a. PgMonadT m a -> PgMonadT m a) -> PgMonadT m b)
    -> PgMonadT m b)
-> (forall a b c.
    PgMonadT m a
    -> (a -> ExitCase b -> PgMonadT m c)
    -> (a -> PgMonadT m b)
    -> PgMonadT m (b, c))
-> MonadMask (PgMonadT m)
PgMonadT m a
-> (a -> ExitCase b -> PgMonadT m c)
-> (a -> PgMonadT m b)
-> PgMonadT m (b, c)
((forall a. PgMonadT m a -> PgMonadT m a) -> PgMonadT m b)
-> PgMonadT m b
((forall a. PgMonadT m a -> PgMonadT m a) -> PgMonadT m b)
-> PgMonadT m b
forall b.
((forall a. PgMonadT m a -> PgMonadT m a) -> PgMonadT m b)
-> PgMonadT m b
forall a b c.
PgMonadT m a
-> (a -> ExitCase b -> PgMonadT m c)
-> (a -> PgMonadT m b)
-> PgMonadT m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: * -> *). MonadMask m => MonadCatch (PgMonadT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. PgMonadT m a -> PgMonadT m a) -> PgMonadT m b)
-> PgMonadT m b
forall (m :: * -> *) a b c.
MonadMask m =>
PgMonadT m a
-> (a -> ExitCase b -> PgMonadT m c)
-> (a -> PgMonadT m b)
-> PgMonadT m (b, c)
generalBracket :: PgMonadT m a
-> (a -> ExitCase b -> PgMonadT m c)
-> (a -> PgMonadT m b)
-> PgMonadT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
PgMonadT m a
-> (a -> ExitCase b -> PgMonadT m c)
-> (a -> PgMonadT m b)
-> PgMonadT m (b, c)
uninterruptibleMask :: ((forall a. PgMonadT m a -> PgMonadT m a) -> PgMonadT m b)
-> PgMonadT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. PgMonadT m a -> PgMonadT m a) -> PgMonadT m b)
-> PgMonadT m b
mask :: ((forall a. PgMonadT m a -> PgMonadT m a) -> PgMonadT m b)
-> PgMonadT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. PgMonadT m a -> PgMonadT m a) -> PgMonadT m b)
-> PgMonadT m b
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (PgMonadT m)
MonadMask
               , MonadBase b, Monad (PgMonadT m)
Monad (PgMonadT m)
-> (forall msg.
    ToLogStr msg =>
    Loc -> Text -> LogLevel -> msg -> PgMonadT m ())
-> MonadLogger (PgMonadT m)
Loc -> Text -> LogLevel -> msg -> PgMonadT m ()
forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> PgMonadT m ()
forall (m :: * -> *).
Monad m
-> (forall msg.
    ToLogStr msg =>
    Loc -> Text -> LogLevel -> msg -> m ())
-> MonadLogger m
forall (m :: * -> *). MonadLogger m => Monad (PgMonadT m)
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> PgMonadT m ()
monadLoggerLog :: Loc -> Text -> LogLevel -> msg -> PgMonadT m ()
$cmonadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> PgMonadT m ()
$cp1MonadLogger :: forall (m :: * -> *). MonadLogger m => Monad (PgMonadT m)
MonadLogger, Monad (PgMonadT m)
Monad (PgMonadT m)
-> (forall a. String -> PgMonadT m a) -> MonadFail (PgMonadT m)
String -> PgMonadT m a
forall a. String -> PgMonadT m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (PgMonadT m)
forall (m :: * -> *) a. MonadFail m => String -> PgMonadT m a
fail :: String -> PgMonadT m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> PgMonadT m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (PgMonadT m)
MonadFail )

#if MIN_VERSION_monad_control(1,0,0)
instance (MonadBaseControl b m) => MonadBaseControl b (PgMonadT m) where
    type StM (PgMonadT m) a = StM (ReaderT Connection m) a
    liftBaseWith :: (RunInBase (PgMonadT m) b -> b a) -> PgMonadT m a
liftBaseWith RunInBase (PgMonadT m) b -> b a
action = ReaderT Connection m a -> PgMonadT m a
forall (m :: * -> *) a. ReaderT Connection m a -> PgMonadT m a
PgMonadT (ReaderT Connection m a -> PgMonadT m a)
-> ReaderT Connection m a -> PgMonadT m a
forall a b. (a -> b) -> a -> b
$ do
        (RunInBase (ReaderT Connection m) b -> b a)
-> ReaderT Connection m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase (ReaderT Connection m) b -> b a)
 -> ReaderT Connection m a)
-> (RunInBase (ReaderT Connection m) b -> b a)
-> ReaderT Connection m a
forall a b. (a -> b) -> a -> b
$ \RunInBase (ReaderT Connection m) b
runInBase -> RunInBase (PgMonadT m) b -> b a
action (ReaderT Connection m a -> b (StM m a)
RunInBase (ReaderT Connection m) b
runInBase (ReaderT Connection m a -> b (StM m a))
-> (PgMonadT m a -> ReaderT Connection m a)
-> PgMonadT m a
-> b (StM m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgMonadT m a -> ReaderT Connection m a
forall (m :: * -> *) a. PgMonadT m a -> ReaderT Connection m a
unPgMonadT)
    restoreM :: StM (PgMonadT m) a -> PgMonadT m a
restoreM StM (PgMonadT m) a
st = ReaderT Connection m a -> PgMonadT m a
forall (m :: * -> *) a. ReaderT Connection m a -> PgMonadT m a
PgMonadT (ReaderT Connection m a -> PgMonadT m a)
-> ReaderT Connection m a -> PgMonadT m a
forall a b. (a -> b) -> a -> b
$ StM (ReaderT Connection m) a -> ReaderT Connection m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM (ReaderT Connection m) a
StM (PgMonadT m) a
st
    {-# INLINABLE liftBaseWith #-}
    {-# INLINABLE restoreM #-}

instance MonadTransControl PgMonadT where
    type StT PgMonadT a = StT (ReaderT Connection) a
    liftWith :: (Run PgMonadT -> m a) -> PgMonadT m a
liftWith Run PgMonadT -> m a
action = ReaderT Connection m a -> PgMonadT m a
forall (m :: * -> *) a. ReaderT Connection m a -> PgMonadT m a
PgMonadT (ReaderT Connection m a -> PgMonadT m a)
-> ReaderT Connection m a -> PgMonadT m a
forall a b. (a -> b) -> a -> b
$ do
        (Run (ReaderT Connection) -> m a) -> ReaderT Connection m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run (ReaderT Connection) -> m a) -> ReaderT Connection m a)
-> (Run (ReaderT Connection) -> m a) -> ReaderT Connection m a
forall a b. (a -> b) -> a -> b
$ \Run (ReaderT Connection)
runTrans -> Run PgMonadT -> m a
action (ReaderT Connection n b -> n b
Run (ReaderT Connection)
runTrans (ReaderT Connection n b -> n b)
-> (PgMonadT n b -> ReaderT Connection n b) -> PgMonadT n b -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgMonadT n b -> ReaderT Connection n b
forall (m :: * -> *) a. PgMonadT m a -> ReaderT Connection m a
unPgMonadT)
    restoreT :: m (StT PgMonadT a) -> PgMonadT m a
restoreT m (StT PgMonadT a)
st = ReaderT Connection m a -> PgMonadT m a
forall (m :: * -> *) a. ReaderT Connection m a -> PgMonadT m a
PgMonadT (ReaderT Connection m a -> PgMonadT m a)
-> ReaderT Connection m a -> PgMonadT m a
forall a b. (a -> b) -> a -> b
$ m (StT (ReaderT Connection) a) -> ReaderT Connection m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT m (StT (ReaderT Connection) a)
m (StT PgMonadT a)
st
    {-# INLINABLE liftWith #-}
    {-# INLINABLE restoreT #-}
#else
instance (MonadBaseControl b m) => MonadBaseControl b (PgMonadT m) where
    newtype StM (PgMonadT m) a
        = PgMTM (StM (ReaderT Connection m) a)
    liftBaseWith action = PgMonadT $ do
        liftBaseWith $ \runInBase -> do
            action ((PgMTM `liftM`) . runInBase . unPgMonadT)
    restoreM (PgMTM st) = PgMonadT $ restoreM st
    {-# INLINABLE liftBaseWith #-}
    {-# INLINABLE restoreM #-}

instance MonadTransControl PgMonadT where
    newtype StT PgMonadT a
        = PgMTT
          { unPgMTT :: StT (ReaderT Connection) a
          }
    liftWith action = PgMonadT $ do
        liftWith $ \runTrans -> do -- ReaderT Connection n a -> n (StT (ReaderT Connection n) a)
            action ((PgMTT `liftM`) . runTrans . unPgMonadT)
    restoreT st = PgMonadT $ restoreT $ unPgMTT `liftM` st
    {-# INLINABLE liftWith #-}
    {-# INLINABLE restoreT #-}
#endif

instance (MonadReader r m) => MonadReader r (PgMonadT m) where
    ask :: PgMonadT m r
ask = m r -> PgMonadT m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
    local :: (r -> r) -> PgMonadT m a -> PgMonadT m a
local r -> r
md PgMonadT m a
ac = do
        Connection
con <- ReaderT Connection m Connection -> PgMonadT m Connection
forall (m :: * -> *) a. ReaderT Connection m a -> PgMonadT m a
PgMonadT ReaderT Connection m Connection
forall r (m :: * -> *). MonadReader r m => m r
ask
        m a -> PgMonadT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> PgMonadT m a) -> m a -> PgMonadT m a
forall a b. (a -> b) -> a -> b
$ do
            (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
md (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Connection -> (HasCallStack => PgMonadT m a) -> m a
forall (m :: * -> *) a.
HasCallStack =>
Connection -> (HasCallStack => PgMonadT m a) -> m a
runPgMonadT Connection
con PgMonadT m a
HasCallStack => PgMonadT m a
ac
    reader :: (r -> a) -> PgMonadT m a
reader = m a -> PgMonadT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> PgMonadT m a)
-> ((r -> a) -> m a) -> (r -> a) -> PgMonadT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader
    {-# INLINABLE ask #-}
    {-# INLINABLE local #-}
    {-# INLINABLE reader #-}

instance (MonadHReader m) => MonadHReader (PgMonadT m) where
  type MHRElements (PgMonadT m) = MHRElements m
  askHSet :: PgMonadT m (HSet (MHRElements (PgMonadT m)))
askHSet = ReaderT Connection m (HSet (MHRElements m))
-> PgMonadT m (HSet (MHRElements m))
forall (m :: * -> *) a. ReaderT Connection m a -> PgMonadT m a
PgMonadT ReaderT Connection m (HSet (MHRElements m))
forall (m :: * -> *). MonadHReader m => m (HSet (MHRElements m))
askHSet
  {-# INLINEABLE askHSet #-}
  hlocal :: (HSet (MHRElements (PgMonadT m))
 -> HSet (MHRElements (PgMonadT m)))
-> PgMonadT m a -> PgMonadT m a
hlocal HSet (MHRElements (PgMonadT m)) -> HSet (MHRElements (PgMonadT m))
f (PgMonadT ReaderT Connection m a
ma) = ReaderT Connection m a -> PgMonadT m a
forall (m :: * -> *) a. ReaderT Connection m a -> PgMonadT m a
PgMonadT (ReaderT Connection m a -> PgMonadT m a)
-> ReaderT Connection m a -> PgMonadT m a
forall a b. (a -> b) -> a -> b
$ (HSet (MHRElements (ReaderT Connection m))
 -> HSet (MHRElements (ReaderT Connection m)))
-> ReaderT Connection m a -> ReaderT Connection m a
forall (m :: * -> *) a.
MonadHReader m =>
(HSet (MHRElements m) -> HSet (MHRElements m)) -> m a -> m a
hlocal HSet (MHRElements (ReaderT Connection m))
-> HSet (MHRElements (ReaderT Connection m))
HSet (MHRElements (PgMonadT m)) -> HSet (MHRElements (PgMonadT m))
f ReaderT Connection m a
ma

instance (MonadBase IO m) => HasPostgres (PgMonadT m) where
    withPGConnection :: (Connection -> PgMonadT m a) -> PgMonadT m a
withPGConnection Connection -> PgMonadT m a
action = do
        Connection
con <- ReaderT Connection m Connection -> PgMonadT m Connection
forall (m :: * -> *) a. ReaderT Connection m a -> PgMonadT m a
PgMonadT ReaderT Connection m Connection
forall r (m :: * -> *). MonadReader r m => m r
ask
        Connection -> PgMonadT m a
action Connection
con
    {-# INLINABLE withPGConnection #-}

instance TransactionSafe (PgMonadT m)


runPgMonadT
  :: HasCallStack
  => Connection
  -> (HasCallStack => PgMonadT m a)
  -> m a
runPgMonadT :: Connection -> (HasCallStack => PgMonadT m a) -> m a
runPgMonadT Connection
con (PgMonadT action) = ReaderT Connection m a -> Connection -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Connection m a
action Connection
con

{- | If your monad have instance of 'HasPostgres' you maybe dont need this
function, unless your instance use 'withPGPool' which acquires connection
from pool for each query. If you want to run sequence of queries using same
connection you need this function

-}

launchPG
  :: (HasPostgres m, HasCallStack)
  => (HasCallStack => PgMonadT m a)
  -> m a
launchPG :: (HasCallStack => PgMonadT m a) -> m a
launchPG HasCallStack => PgMonadT m a
act = (Connection -> m a) -> m a
forall (m :: * -> *) a. HasPostgres m => (Connection -> m a) -> m a
withPGConnection ((Connection -> m a) -> m a) -> (Connection -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Connection
con -> do
    Connection -> (HasCallStack => PgMonadT m a) -> m a
forall (m :: * -> *) a.
HasCallStack =>
Connection -> (HasCallStack => PgMonadT m a) -> m a
runPgMonadT Connection
con HasCallStack => PgMonadT m a
act