module Database.PostgreSQL.Query.Types
(
HasPostgres(..)
, MonadPostgres
, TransactionSafe
, PgMonadT(..)
, runPgMonadT
, launchPG
, 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
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
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
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
'.'
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]
:[])
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
toMarkedRow :: a -> MarkedRow
instance ToMarkedRow MarkedRow where
toMarkedRow :: MarkedRow -> MarkedRow
toMarkedRow = MarkedRow -> MarkedRow
forall a. a -> a
id
mrToBuilder :: SqlBuilder
-> 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)
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
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)
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
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
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