{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Di.Monad
(
MonadDi(ask, local, natSTM)
, log
, flush
, push
, filter
, throw
, onException
,
DiT
, diT
, runDiT
, runDiT'
, hoistDiT
, localDiT
) where
import Control.Applicative (Alternative)
import Control.Concurrent.STM (STM, atomically)
import qualified Control.Monad.Catch as Ex
import Control.Monad.Cont (MonadCont, ContT(ContT))
import Control.Monad.Except (ExceptT(ExceptT), MonadError)
import Control.Monad.Fail (MonadFail)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.IO.Unlift (MonadUnliftIO)
import Control.Monad (MonadPlus)
import Control.Monad.Reader (ReaderT(ReaderT), MonadReader)
import qualified Control.Monad.Reader as Reader
import qualified Control.Monad.RWS.Lazy as RWSL
import qualified Control.Monad.RWS.Strict as RWSS
import Control.Monad.State (MonadState)
import qualified Control.Monad.State.Lazy as SL
import qualified Control.Monad.State.Strict as SS
import Control.Monad.Trans.Class (MonadTrans, lift)
import Control.Monad.Trans.Identity (IdentityT(IdentityT))
import Control.Monad.Trans.Maybe (MaybeT(MaybeT))
import Control.Monad.Writer (MonadWriter)
import qualified Control.Monad.Writer.Lazy as WL
import qualified Control.Monad.Writer.Strict as WS
import Control.Monad.Zip (MonadZip)
import Data.Sequence (Seq)
import qualified Pipes as P
import qualified Pipes.Internal as P
import Prelude hiding (filter, error, log)
import qualified Streaming.Internal as S
#if MIN_VERSION_transformers(0,5,3)
import Control.Monad.Trans.Accum (AccumT(AccumT))
import Control.Monad.Trans.Select (SelectT(SelectT))
#endif
import Di.Core (Di)
import qualified Di.Core as Di
newtype H f g = H (forall x. f x -> g x)
newtype DiT level path msg m a
= DiT (ReaderT (Di level path msg, H STM m) m a)
deriving (forall a b. a -> DiT level path msg m b -> DiT level path msg m a
forall a b.
(a -> b) -> DiT level path msg m a -> DiT level path msg m b
forall level path msg (m :: * -> *) a b.
Functor m =>
a -> DiT level path msg m b -> DiT level path msg m a
forall level path msg (m :: * -> *) a b.
Functor m =>
(a -> b) -> DiT level path msg m a -> DiT level path msg m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> DiT level path msg m b -> DiT level path msg m a
$c<$ :: forall level path msg (m :: * -> *) a b.
Functor m =>
a -> DiT level path msg m b -> DiT level path msg m a
fmap :: forall a b.
(a -> b) -> DiT level path msg m a -> DiT level path msg m b
$cfmap :: forall level path msg (m :: * -> *) a b.
Functor m =>
(a -> b) -> DiT level path msg m a -> DiT level path msg m b
Functor, forall a. a -> DiT level path msg m a
forall a b.
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m a
forall a b.
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m b
forall a b.
DiT level path msg m (a -> b)
-> DiT level path msg m a -> DiT level path msg m b
forall a b c.
(a -> b -> c)
-> DiT level path msg m a
-> DiT level path msg m b
-> DiT level path msg m c
forall {level} {path} {msg} {m :: * -> *}.
Applicative m =>
Functor (DiT level path msg m)
forall level path msg (m :: * -> *) a.
Applicative m =>
a -> DiT level path msg m a
forall level path msg (m :: * -> *) a b.
Applicative m =>
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m a
forall level path msg (m :: * -> *) a b.
Applicative m =>
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m b
forall level path msg (m :: * -> *) a b.
Applicative m =>
DiT level path msg m (a -> b)
-> DiT level path msg m a -> DiT level path msg m b
forall level path msg (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> DiT level path msg m a
-> DiT level path msg m b
-> DiT level path msg 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 a b.
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m a
$c<* :: forall level path msg (m :: * -> *) a b.
Applicative m =>
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m a
*> :: forall a b.
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m b
$c*> :: forall level path msg (m :: * -> *) a b.
Applicative m =>
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m b
liftA2 :: forall a b c.
(a -> b -> c)
-> DiT level path msg m a
-> DiT level path msg m b
-> DiT level path msg m c
$cliftA2 :: forall level path msg (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> DiT level path msg m a
-> DiT level path msg m b
-> DiT level path msg m c
<*> :: forall a b.
DiT level path msg m (a -> b)
-> DiT level path msg m a -> DiT level path msg m b
$c<*> :: forall level path msg (m :: * -> *) a b.
Applicative m =>
DiT level path msg m (a -> b)
-> DiT level path msg m a -> DiT level path msg m b
pure :: forall a. a -> DiT level path msg m a
$cpure :: forall level path msg (m :: * -> *) a.
Applicative m =>
a -> DiT level path msg m a
Applicative, forall a. DiT level path msg m a
forall a. DiT level path msg m a -> DiT level path msg m [a]
forall a.
DiT level path msg m a
-> DiT level path msg m a -> DiT level path msg m a
forall {level} {path} {msg} {m :: * -> *}.
Alternative m =>
Applicative (DiT level path msg m)
forall level path msg (m :: * -> *) a.
Alternative m =>
DiT level path msg m a
forall level path msg (m :: * -> *) a.
Alternative m =>
DiT level path msg m a -> DiT level path msg m [a]
forall level path msg (m :: * -> *) a.
Alternative m =>
DiT level path msg m a
-> DiT level path msg m a -> DiT level path msg 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
many :: forall a. DiT level path msg m a -> DiT level path msg m [a]
$cmany :: forall level path msg (m :: * -> *) a.
Alternative m =>
DiT level path msg m a -> DiT level path msg m [a]
some :: forall a. DiT level path msg m a -> DiT level path msg m [a]
$csome :: forall level path msg (m :: * -> *) a.
Alternative m =>
DiT level path msg m a -> DiT level path msg m [a]
<|> :: forall a.
DiT level path msg m a
-> DiT level path msg m a -> DiT level path msg m a
$c<|> :: forall level path msg (m :: * -> *) a.
Alternative m =>
DiT level path msg m a
-> DiT level path msg m a -> DiT level path msg m a
empty :: forall a. DiT level path msg m a
$cempty :: forall level path msg (m :: * -> *) a.
Alternative m =>
DiT level path msg m a
Alternative, forall a. a -> DiT level path msg m a
forall a b.
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m b
forall a b.
DiT level path msg m a
-> (a -> DiT level path msg m b) -> DiT level path msg m b
forall {level} {path} {msg} {m :: * -> *}.
Monad m =>
Applicative (DiT level path msg m)
forall level path msg (m :: * -> *) a.
Monad m =>
a -> DiT level path msg m a
forall level path msg (m :: * -> *) a b.
Monad m =>
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m b
forall level path msg (m :: * -> *) a b.
Monad m =>
DiT level path msg m a
-> (a -> DiT level path msg m b) -> DiT level path msg 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 :: forall a. a -> DiT level path msg m a
$creturn :: forall level path msg (m :: * -> *) a.
Monad m =>
a -> DiT level path msg m a
>> :: forall a b.
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m b
$c>> :: forall level path msg (m :: * -> *) a b.
Monad m =>
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m b
>>= :: forall a b.
DiT level path msg m a
-> (a -> DiT level path msg m b) -> DiT level path msg m b
$c>>= :: forall level path msg (m :: * -> *) a b.
Monad m =>
DiT level path msg m a
-> (a -> DiT level path msg m b) -> DiT level path msg m b
Monad, forall a. IO a -> DiT level path msg m a
forall {level} {path} {msg} {m :: * -> *}.
MonadIO m =>
Monad (DiT level path msg m)
forall level path msg (m :: * -> *) a.
MonadIO m =>
IO a -> DiT level path msg m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> DiT level path msg m a
$cliftIO :: forall level path msg (m :: * -> *) a.
MonadIO m =>
IO a -> DiT level path msg m a
MonadIO,
forall a. String -> DiT level path msg m a
forall {level} {path} {msg} {m :: * -> *}.
MonadFail m =>
Monad (DiT level path msg m)
forall level path msg (m :: * -> *) a.
MonadFail m =>
String -> DiT level path msg m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> DiT level path msg m a
$cfail :: forall level path msg (m :: * -> *) a.
MonadFail m =>
String -> DiT level path msg m a
MonadFail, forall a. (a -> DiT level path msg m a) -> DiT level path msg m a
forall {level} {path} {msg} {m :: * -> *}.
MonadFix m =>
Monad (DiT level path msg m)
forall level path msg (m :: * -> *) a.
MonadFix m =>
(a -> DiT level path msg m a) -> DiT level path msg m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a. (a -> DiT level path msg m a) -> DiT level path msg m a
$cmfix :: forall level path msg (m :: * -> *) a.
MonadFix m =>
(a -> DiT level path msg m a) -> DiT level path msg m a
MonadFix, forall a b.
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m (a, b)
forall a b.
DiT level path msg m (a, b)
-> (DiT level path msg m a, DiT level path msg m b)
forall a b c.
(a -> b -> c)
-> DiT level path msg m a
-> DiT level path msg m b
-> DiT level path msg m c
forall {level} {path} {msg} {m :: * -> *}.
MonadZip m =>
Monad (DiT level path msg m)
forall level path msg (m :: * -> *) a b.
MonadZip m =>
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m (a, b)
forall level path msg (m :: * -> *) a b.
MonadZip m =>
DiT level path msg m (a, b)
-> (DiT level path msg m a, DiT level path msg m b)
forall level path msg (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c)
-> DiT level path msg m a
-> DiT level path msg m b
-> DiT level path msg m c
forall (m :: * -> *).
Monad m
-> (forall a b. m a -> m b -> m (a, b))
-> (forall a b c. (a -> b -> c) -> m a -> m b -> m c)
-> (forall a b. m (a, b) -> (m a, m b))
-> MonadZip m
munzip :: forall a b.
DiT level path msg m (a, b)
-> (DiT level path msg m a, DiT level path msg m b)
$cmunzip :: forall level path msg (m :: * -> *) a b.
MonadZip m =>
DiT level path msg m (a, b)
-> (DiT level path msg m a, DiT level path msg m b)
mzipWith :: forall a b c.
(a -> b -> c)
-> DiT level path msg m a
-> DiT level path msg m b
-> DiT level path msg m c
$cmzipWith :: forall level path msg (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c)
-> DiT level path msg m a
-> DiT level path msg m b
-> DiT level path msg m c
mzip :: forall a b.
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m (a, b)
$cmzip :: forall level path msg (m :: * -> *) a b.
MonadZip m =>
DiT level path msg m a
-> DiT level path msg m b -> DiT level path msg m (a, b)
MonadZip, forall a. DiT level path msg m a
forall a.
DiT level path msg m a
-> DiT level path msg m a -> DiT level path msg m a
forall {level} {path} {msg} {m :: * -> *}.
MonadPlus m =>
Monad (DiT level path msg m)
forall {level} {path} {msg} {m :: * -> *}.
MonadPlus m =>
Alternative (DiT level path msg m)
forall level path msg (m :: * -> *) a.
MonadPlus m =>
DiT level path msg m a
forall level path msg (m :: * -> *) a.
MonadPlus m =>
DiT level path msg m a
-> DiT level path msg m a -> DiT level path msg m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a.
DiT level path msg m a
-> DiT level path msg m a -> DiT level path msg m a
$cmplus :: forall level path msg (m :: * -> *) a.
MonadPlus m =>
DiT level path msg m a
-> DiT level path msg m a -> DiT level path msg m a
mzero :: forall a. DiT level path msg m a
$cmzero :: forall level path msg (m :: * -> *) a.
MonadPlus m =>
DiT level path msg m a
MonadPlus, forall a b.
((a -> DiT level path msg m b) -> DiT level path msg m a)
-> DiT level path msg m a
forall {level} {path} {msg} {m :: * -> *}.
MonadCont m =>
Monad (DiT level path msg m)
forall level path msg (m :: * -> *) a b.
MonadCont m =>
((a -> DiT level path msg m b) -> DiT level path msg m a)
-> DiT level path msg m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
callCC :: forall a b.
((a -> DiT level path msg m b) -> DiT level path msg m a)
-> DiT level path msg m a
$ccallCC :: forall level path msg (m :: * -> *) a b.
MonadCont m =>
((a -> DiT level path msg m b) -> DiT level path msg m a)
-> DiT level path msg m a
MonadCont,
MonadState s, MonadWriter w, MonadError e, forall b.
((forall a. DiT level path msg m a -> IO a) -> IO b)
-> DiT level path msg m b
forall {level} {path} {msg} {m :: * -> *}.
MonadUnliftIO m =>
MonadIO (DiT level path msg m)
forall level path msg (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. DiT level path msg m a -> IO a) -> IO b)
-> DiT level path msg m b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
withRunInIO :: forall b.
((forall a. DiT level path msg m a -> IO a) -> IO b)
-> DiT level path msg m b
$cwithRunInIO :: forall level path msg (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. DiT level path msg m a -> IO a) -> IO b)
-> DiT level path msg m b
MonadUnliftIO)
diT
:: ((forall x. STM x -> m x) -> Di level path msg -> m a)
-> DiT level path msg m a
diT :: forall (m :: * -> *) level path msg a.
((forall x. STM x -> m x) -> Di level path msg -> m a)
-> DiT level path msg m a
diT (forall x. STM x -> m x) -> Di level path msg -> m a
f = forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\(Di level path msg
di, H forall x. STM x -> m x
nat) -> (forall x. STM x -> m x) -> Di level path msg -> m a
f forall x. STM x -> m x
nat Di level path msg
di))
{-# INLINE diT #-}
instance MonadTrans (DiT level path msg) where
lift :: forall (m :: * -> *) a. Monad m => m a -> DiT level path msg m a
lift = \m a
x -> forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
x)
{-# INLINE lift #-}
runDiT
:: MonadIO m
=> Di level path msg
-> DiT level path msg m a
-> m a
runDiT :: forall (m :: * -> *) level path msg a.
MonadIO m =>
Di level path msg -> DiT level path msg m a -> m a
runDiT = forall (m :: * -> *) level path msg a.
(forall x. STM x -> m x)
-> Di level path msg -> DiT level path msg m a -> m a
runDiT' (\STM x
x -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. STM a -> IO a
atomically STM x
x))
{-# INLINE runDiT #-}
runDiT'
:: (forall x. STM x -> m x)
-> Di level path msg
-> DiT level path msg m a
-> m a
runDiT' :: forall (m :: * -> *) level path msg a.
(forall x. STM x -> m x)
-> Di level path msg -> DiT level path msg m a -> m a
runDiT' forall x. STM x -> m x
h = \Di level path msg
di -> \(DiT (ReaderT (Di level path msg, H STM m) -> m a
f)) -> (Di level path msg, H STM m) -> m a
f (Di level path msg
di, forall (f :: * -> *) (g :: * -> *). (forall x. f x -> g x) -> H f g
H forall x. STM x -> m x
h)
{-# INLINE runDiT' #-}
hoistDiT
:: (forall x. n x -> m x)
-> (forall x. m x -> n x)
-> (DiT level path msg m a -> DiT level path msg n a)
{-# INLINE hoistDiT #-}
hoistDiT :: forall (n :: * -> *) (m :: * -> *) level path msg a.
(forall x. n x -> m x)
-> (forall x. m x -> n x)
-> DiT level path msg m a
-> DiT level path msg n a
hoistDiT forall x. n x -> m x
hgf forall x. m x -> n x
hfg = \(DiT (ReaderT (Di level path msg, H STM m) -> m a
f)) ->
forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\(Di level path msg
di, H forall x. STM x -> n x
hstmg) -> forall x. m x -> n x
hfg ((Di level path msg, H STM m) -> m a
f (Di level path msg
di, forall (f :: * -> *) (g :: * -> *). (forall x. f x -> g x) -> H f g
H (\STM x
stm -> forall x. n x -> m x
hgf (forall x. STM x -> n x
hstmg STM x
stm))))))
localDiT
:: (Di level path msg -> Di level' path' msg')
-> DiT level' path' msg' m a
-> DiT level path msg m a
localDiT :: forall level path msg level' path' msg' (m :: * -> *) a.
(Di level path msg -> Di level' path' msg')
-> DiT level' path' msg' m a -> DiT level path msg m a
localDiT Di level path msg -> Di level' path' msg'
f = \(DiT (ReaderT (Di level' path' msg', H STM m) -> m a
gma)) -> forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\(Di level path msg
di, H STM m
h) -> (Di level' path' msg', H STM m) -> m a
gma (Di level path msg -> Di level' path' msg'
f Di level path msg
di, H STM m
h)))
{-# INLINE localDiT #-}
instance MonadReader r m => MonadReader r (DiT level path msg m) where
ask :: DiT level path msg m r
ask = forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\(Di level path msg, H STM m)
_ -> forall r (m :: * -> *). MonadReader r m => m r
Reader.ask))
{-# INLINE ask #-}
local :: forall a.
(r -> r) -> DiT level path msg m a -> DiT level path msg m a
local r -> r
f = \(DiT (ReaderT (Di level path msg, H STM m) -> m a
gma)) ->
forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\(Di level path msg, H STM m)
di -> forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
Reader.local r -> r
f ((Di level path msg, H STM m) -> m a
gma (Di level path msg, H STM m)
di)))
{-# INLINE local #-}
instance Ex.MonadThrow m => Ex.MonadThrow (DiT level path msg m) where
throwM :: forall e a. Exception e => e -> DiT level path msg m a
throwM e
e = forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\(Di level path msg, H STM m)
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
Ex.throwM e
e))
{-# INLINE throwM #-}
instance Ex.MonadCatch m => Ex.MonadCatch (DiT level path msg m) where
catch :: forall e a.
Exception e =>
DiT level path msg m a
-> (e -> DiT level path msg m a) -> DiT level path msg m a
catch (DiT (ReaderT (Di level path msg, H STM m) -> m a
f)) = \e -> DiT level path msg m a
g -> forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\(Di level path msg, H STM m)
x ->
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
Ex.catch ((Di level path msg, H STM m) -> m a
f (Di level path msg, H STM m)
x) (\e
e -> let DiT (ReaderT (Di level path msg, H STM m) -> m a
h) = e -> DiT level path msg m a
g e
e in (Di level path msg, H STM m) -> m a
h (Di level path msg, H STM m)
x)))
{-# INLINE catch #-}
instance Ex.MonadMask m => Ex.MonadMask (DiT level path msg m) where
mask :: forall b.
((forall a. DiT level path msg m a -> DiT level path msg m a)
-> DiT level path msg m b)
-> DiT level path msg m b
mask (forall a. DiT level path msg m a -> DiT level path msg m a)
-> DiT level path msg m b
f = forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\(Di level path msg, H STM m)
x ->
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
Ex.mask (\forall a. m a -> m a
u ->
case (forall a. DiT level path msg m a -> DiT level path msg m a)
-> DiT level path msg m b
f (\(DiT (ReaderT (Di level path msg, H STM m) -> m a
g)) -> forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (forall a. m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Di level path msg, H STM m) -> m a
g))) of
DiT (ReaderT (Di level path msg, H STM m) -> m b
h) -> (Di level path msg, H STM m) -> m b
h (Di level path msg, H STM m)
x)))
{-# INLINE mask #-}
uninterruptibleMask :: forall b.
((forall a. DiT level path msg m a -> DiT level path msg m a)
-> DiT level path msg m b)
-> DiT level path msg m b
uninterruptibleMask (forall a. DiT level path msg m a -> DiT level path msg m a)
-> DiT level path msg m b
f = forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\(Di level path msg, H STM m)
x ->
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
Ex.uninterruptibleMask (\forall a. m a -> m a
u ->
case (forall a. DiT level path msg m a -> DiT level path msg m a)
-> DiT level path msg m b
f (\(DiT (ReaderT (Di level path msg, H STM m) -> m a
g)) -> forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (forall a. m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Di level path msg, H STM m) -> m a
g))) of
DiT (ReaderT (Di level path msg, H STM m) -> m b
h) -> (Di level path msg, H STM m) -> m b
h (Di level path msg, H STM m)
x)))
{-# INLINE uninterruptibleMask #-}
generalBracket :: forall a b c.
DiT level path msg m a
-> (a -> ExitCase b -> DiT level path msg m c)
-> (a -> DiT level path msg m b)
-> DiT level path msg m (b, c)
generalBracket DiT level path msg m a
acq a -> ExitCase b -> DiT level path msg m c
rel a -> DiT level path msg m b
use = forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\(Di level path msg, H STM m)
x ->
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
Ex.generalBracket
(case DiT level path msg m a
acq of DiT (ReaderT (Di level path msg, H STM m) -> m a
m) -> (Di level path msg, H STM m) -> m a
m (Di level path msg, H STM m)
x)
(\a
res ExitCase b
ec -> case a -> ExitCase b -> DiT level path msg m c
rel a
res ExitCase b
ec of DiT (ReaderT (Di level path msg, H STM m) -> m c
m) -> (Di level path msg, H STM m) -> m c
m (Di level path msg, H STM m)
x)
(\a
res -> case a -> DiT level path msg m b
use a
res of DiT (ReaderT (Di level path msg, H STM m) -> m b
m) -> (Di level path msg, H STM m) -> m b
m (Di level path msg, H STM m)
x)))
{-# INLINABLE generalBracket #-}
class Monad m => MonadDi level path msg m | m -> level path msg where
ask :: m (Di level path msg)
default ask
:: (MonadTrans t, MonadDi level path msg n, m ~ t n)
=> m (Di level path msg)
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall level path msg (m :: * -> *).
MonadDi level path msg m =>
m (Di level path msg)
ask
{-# INLINE ask #-}
local :: (Di level path msg -> Di level path msg) -> m a -> m a
natSTM :: STM a -> m a
default natSTM
:: (MonadTrans t, MonadDi level path msg n, m ~ t n)
=> STM a -> m a
natSTM = \STM a
x -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
STM a -> m a
natSTM STM a
x)
{-# INLINE natSTM #-}
instance Monad m => MonadDi level path msg (DiT level path msg m) where
ask :: DiT level path msg m (Di level path msg)
ask = forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\(Di level path msg
di,H STM m
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Di level path msg
di))
{-# INLINE ask #-}
natSTM :: forall a. STM a -> DiT level path msg m a
natSTM = \STM a
x -> forall level path msg (m :: * -> *) a.
ReaderT (Di level path msg, H STM m) m a -> DiT level path msg m a
DiT (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\(Di level path msg
_, H forall x. STM x -> m x
h) -> forall x. STM x -> m x
h STM a
x))
{-# INLINE natSTM #-}
local :: forall a.
(Di level path msg -> Di level path msg)
-> DiT level path msg m a -> DiT level path msg m a
local Di level path msg -> Di level path msg
f = forall level path msg level' path' msg' (m :: * -> *) a.
(Di level path msg -> Di level' path' msg')
-> DiT level' path' msg' m a -> DiT level path msg m a
localDiT Di level path msg -> Di level path msg
f
{-# INLINE local #-}
instance MonadDi level path msg m
=> MonadDi level path msg (ReaderT r m) where
local :: forall a.
(Di level path msg -> Di level path msg)
-> ReaderT r m a -> ReaderT r m a
local Di level path msg -> Di level path msg
f = \(ReaderT r -> m a
gma) -> forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\r
r -> forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f (r -> m a
gma r
r))
{-# INLINE local #-}
instance MonadDi level path msg m
=> MonadDi level path msg (SS.StateT s m) where
local :: forall a.
(Di level path msg -> Di level path msg)
-> StateT s m a -> StateT s m a
local Di level path msg -> Di level path msg
f = \(SS.StateT s -> m (a, s)
gma) -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
SS.StateT (\s
s -> forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f (s -> m (a, s)
gma s
s))
{-# INLINE local #-}
instance MonadDi level path msg m
=> MonadDi level path msg (SL.StateT s m) where
local :: forall a.
(Di level path msg -> Di level path msg)
-> StateT s m a -> StateT s m a
local Di level path msg -> Di level path msg
f = \(SL.StateT s -> m (a, s)
gma) -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
SL.StateT (\s
s -> forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f (s -> m (a, s)
gma s
s))
{-# INLINE local #-}
instance (Monoid w, MonadDi level path msg m)
=> MonadDi level path msg (WS.WriterT w m) where
local :: forall a.
(Di level path msg -> Di level path msg)
-> WriterT w m a -> WriterT w m a
local Di level path msg -> Di level path msg
f = \(WS.WriterT m (a, w)
ma) -> forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WS.WriterT (forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f m (a, w)
ma)
{-# INLINE local #-}
instance (Monoid w, MonadDi level path msg m)
=> MonadDi level path msg (WL.WriterT w m) where
local :: forall a.
(Di level path msg -> Di level path msg)
-> WriterT w m a -> WriterT w m a
local Di level path msg -> Di level path msg
f = \(WL.WriterT m (a, w)
ma) -> forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WL.WriterT (forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f m (a, w)
ma)
{-# INLINE local #-}
instance MonadDi level path msg m => MonadDi level path msg (MaybeT m) where
local :: forall a.
(Di level path msg -> Di level path msg)
-> MaybeT m a -> MaybeT m a
local Di level path msg -> Di level path msg
f = \(MaybeT m (Maybe a)
ma) -> forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f m (Maybe a)
ma)
{-# INLINE local #-}
instance MonadDi level path msg m => MonadDi level path msg (ExceptT e m) where
local :: forall a.
(Di level path msg -> Di level path msg)
-> ExceptT e m a -> ExceptT e m a
local Di level path msg -> Di level path msg
f = \(ExceptT m (Either e a)
ma) -> forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f m (Either e a)
ma)
{-# INLINE local #-}
instance MonadDi level path msg m => MonadDi level path msg (IdentityT m) where
local :: forall a.
(Di level path msg -> Di level path msg)
-> IdentityT m a -> IdentityT m a
local Di level path msg -> Di level path msg
f = \(IdentityT m a
ma) -> forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f m a
ma)
{-# INLINE local #-}
instance MonadDi level path msg m => MonadDi level path msg (ContT r m) where
local :: forall a.
(Di level path msg -> Di level path msg)
-> ContT r m a -> ContT r m a
local Di level path msg -> Di level path msg
f = \(ContT (a -> m r) -> m r
gma) -> forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (\a -> m r
r -> forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f ((a -> m r) -> m r
gma a -> m r
r))
{-# INLINE local #-}
instance (Monoid w, MonadDi level path msg m)
=> MonadDi level path msg (RWSS.RWST r w s m) where
local :: forall a.
(Di level path msg -> Di level path msg)
-> RWST r w s m a -> RWST r w s m a
local Di level path msg -> Di level path msg
f = \(RWSS.RWST r -> s -> m (a, s, w)
gma) -> forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWSS.RWST (\r
r s
s -> forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f (r -> s -> m (a, s, w)
gma r
r s
s))
{-# INLINE local #-}
instance (Monoid w, MonadDi level path msg m)
=> MonadDi level path msg (RWSL.RWST r w s m) where
local :: forall a.
(Di level path msg -> Di level path msg)
-> RWST r w s m a -> RWST r w s m a
local Di level path msg -> Di level path msg
f = \(RWSL.RWST r -> s -> m (a, s, w)
gma) -> forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWSL.RWST (\r
r s
s -> forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f (r -> s -> m (a, s, w)
gma r
r s
s))
{-# INLINE local #-}
#if MIN_VERSION_transformers(0,5,3)
instance (Monoid w, MonadDi level path msg m)
=> MonadDi level path msg (AccumT w m) where
local :: forall a.
(Di level path msg -> Di level path msg)
-> AccumT w m a -> AccumT w m a
local Di level path msg -> Di level path msg
f = \(AccumT w -> m (a, w)
gma) -> forall w (m :: * -> *) a. (w -> m (a, w)) -> AccumT w m a
AccumT (\w
w -> forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f (w -> m (a, w)
gma w
w))
{-# INLINE local #-}
instance MonadDi level path msg m => MonadDi level path msg (SelectT r m) where
local :: forall a.
(Di level path msg -> Di level path msg)
-> SelectT r m a -> SelectT r m a
local Di level path msg -> Di level path msg
f = \(SelectT (a -> m r) -> m a
gma) -> forall r (m :: * -> *) a. ((a -> m r) -> m a) -> SelectT r m a
SelectT (\a -> m r
r -> forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f ((a -> m r) -> m a
gma a -> m r
r))
{-# INLINE local #-}
#endif
instance MonadDi level path msg m
=> MonadDi level path msg (P.Proxy a' a b' b m) where
{-# INLINABLE local #-}
local :: forall a.
(Di level path msg -> Di level path msg)
-> Proxy a' a b' b m a -> Proxy a' a b' b m a
local Di level path msg -> Di level path msg
f = \case
P.Request a'
a' a -> Proxy a' a b' b m a
fa -> forall a' a b' b (m :: * -> *) r.
a' -> (a -> Proxy a' a b' b m r) -> Proxy a' a b' b m r
P.Request a'
a'(\a
a -> forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f (a -> Proxy a' a b' b m a
fa a
a ))
P.Respond b
b b' -> Proxy a' a b' b m a
fb' -> forall a' a b' b (m :: * -> *) r.
b -> (b' -> Proxy a' a b' b m r) -> Proxy a' a b' b m r
P.Respond b
b (\b'
b' -> forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f (b' -> Proxy a' a b' b m a
fb' b'
b'))
P.Pure a
r -> forall a' a b' b (m :: * -> *) r. r -> Proxy a' a b' b m r
P.Pure a
r
P.M m (Proxy a' a b' b m a)
m -> forall a' a b' b (m :: * -> *) r.
m (Proxy a' a b' b m r) -> Proxy a' a b' b m r
P.M (forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f m (Proxy a' a b' b m a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Proxy a' a b' b m a
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f Proxy a' a b' b m a
r))
instance MonadDi level path msg m => MonadDi level path msg (P.ListT m) where
{-# INLINE local #-}
local :: forall a.
(Di level path msg -> Di level path msg) -> ListT m a -> ListT m a
local Di level path msg -> Di level path msg
f = \(P.Select Producer a m ()
p) -> forall (m :: * -> *) a. Producer a m () -> ListT m a
P.Select (forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
f Producer a m ()
p)
instance (MonadDi level path msg m, Functor f)
=> MonadDi level path msg (S.Stream f m) where
{-# INLINABLE local #-}
local :: forall a.
(Di level path msg -> Di level path msg)
-> Stream f m a -> Stream f m a
local Di level path msg -> Di level path msg
g = \case
S.Step f (Stream f m a)
fs -> forall (f :: * -> *) (m :: * -> *) r.
f (Stream f m r) -> Stream f m r
S.Step (forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Stream f m a)
fs)
S.Effect m (Stream f m a)
ms -> forall (f :: * -> *) (m :: * -> *) r.
m (Stream f m r) -> Stream f m r
S.Effect (forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local Di level path msg -> Di level path msg
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Stream f m a)
ms)
S.Return a
r -> forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
S.Return a
r
log :: MonadDi level path msg m => level -> msg -> m ()
log :: forall level path msg (m :: * -> *).
MonadDi level path msg m =>
level -> msg -> m ()
log level
l = \msg
m -> forall level path msg (m :: * -> *).
MonadDi level path msg m =>
m (Di level path msg)
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Di level path msg
di -> forall (m :: * -> *) level path msg.
Monad m =>
(forall x. STM x -> m x)
-> Di level path msg -> level -> msg -> m ()
Di.log' forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
STM a -> m a
natSTM Di level path msg
di level
l msg
m
{-# INLINE log #-}
flush :: MonadDi level path msg m => m ()
flush :: forall level path msg (m :: * -> *).
MonadDi level path msg m =>
m ()
flush = forall (m :: * -> *) level path msg.
(forall x. STM x -> m x) -> Di level path msg -> m ()
Di.flush' forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
STM a -> m a
natSTM forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall level path msg (m :: * -> *).
MonadDi level path msg m =>
m (Di level path msg)
ask
{-# INLINABLE flush #-}
filter
:: MonadDi level path msg m
=> (level -> Seq path -> msg -> Bool)
-> m a
-> m a
filter :: forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(level -> Seq path -> msg -> Bool) -> m a -> m a
filter level -> Seq path -> msg -> Bool
f = forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local (forall level path msg.
(level -> Seq path -> msg -> Bool)
-> Di level path msg -> Di level path msg
Di.filter level -> Seq path -> msg -> Bool
f)
{-# INLINE filter #-}
push :: MonadDi level path msg m => path -> m a -> m a
push :: forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
path -> m a -> m a
push path
p = forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local (forall path level msg.
path -> Di level path msg -> Di level path msg
Di.push path
p)
{-# INLINE push #-}
onException
:: MonadDi level path msg m
=> (Ex.SomeException -> Maybe (level, Seq path, msg))
-> m a
-> m a
onException :: forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(SomeException -> Maybe (level, Seq path, msg)) -> m a -> m a
onException SomeException -> Maybe (level, Seq path, msg)
f = forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
(Di level path msg -> Di level path msg) -> m a -> m a
local (forall level path msg.
(SomeException -> Maybe (level, Seq path, msg))
-> Di level path msg -> Di level path msg
Di.onException SomeException -> Maybe (level, Seq path, msg)
f)
throw :: (MonadDi level path msg m, Ex.Exception e) => e -> m a
throw :: forall level path msg (m :: * -> *) e a.
(MonadDi level path msg m, Exception e) =>
e -> m a
throw e
e = forall level path msg (m :: * -> *).
MonadDi level path msg m =>
m (Di level path msg)
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Di level path msg
di -> forall (m :: * -> *) e level path msg a.
(Monad m, Exception e) =>
(forall x. STM x -> m x) -> Di level path msg -> e -> m a
Di.throw' forall level path msg (m :: * -> *) a.
MonadDi level path msg m =>
STM a -> m a
natSTM Di level path msg
di e
e
{-# INLINE throw #-}