mirror of
https://github.com/nikita-volkov/hasql.git
synced 2024-12-26 20:12:09 +03:00
CompositionT
This commit is contained in:
parent
f51dcd425a
commit
dfd65582e0
@ -39,6 +39,7 @@ library
|
|||||||
library
|
library
|
||||||
other-modules:
|
other-modules:
|
||||||
HighSQL.Prelude
|
HighSQL.Prelude
|
||||||
|
HighSQL.CompositionT
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
HighSQL
|
HighSQL
|
||||||
HighSQL.Backend
|
HighSQL.Backend
|
||||||
|
40
library/HighSQL/CompositionT.hs
Normal file
40
library/HighSQL/CompositionT.hs
Normal file
@ -0,0 +1,40 @@
|
|||||||
|
module HighSQL.CompositionT where
|
||||||
|
|
||||||
|
import HighSQL.Prelude
|
||||||
|
|
||||||
|
|
||||||
|
-- |
|
||||||
|
-- A monad transformer,
|
||||||
|
-- which serves a purpose of detecting composition of the inner monad.
|
||||||
|
data T m r =
|
||||||
|
T Bool (m r)
|
||||||
|
|
||||||
|
-- |
|
||||||
|
-- Unwrap into a boolean signifying whether the base monad is a composition and
|
||||||
|
-- the base monad itself.
|
||||||
|
run :: T m r -> (Bool, m r)
|
||||||
|
run (T c m) = (c, m)
|
||||||
|
|
||||||
|
instance Monad m => Monad (T m) where
|
||||||
|
return a =
|
||||||
|
T False (return a)
|
||||||
|
(>>=) (T _ m) k =
|
||||||
|
T True (m >>= \a -> case k a of T _ m' -> m')
|
||||||
|
|
||||||
|
instance Functor f => Functor (T f) where
|
||||||
|
fmap f (T c m) = T c (fmap f m)
|
||||||
|
|
||||||
|
instance Applicative f => Applicative (T f) where
|
||||||
|
pure a =
|
||||||
|
T False (pure a)
|
||||||
|
(<*>) (T _ a) (T _ b) =
|
||||||
|
T True (a <*> b)
|
||||||
|
|
||||||
|
instance MonadTrans T where
|
||||||
|
lift m =
|
||||||
|
T False m
|
||||||
|
|
||||||
|
instance MonadIO m => MonadIO (T m) where
|
||||||
|
liftIO io =
|
||||||
|
T False (liftIO io)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user