module DiPolysemy
( Di(..)
, runDiToIOReader
, runDiToIO
, runDiNoop
, log
, flush
, local
, fetch
, push
, attr_
, attr
, debug
, info
, notice
, warning
, error
, alert
, critical
, emergency
, debug_
, info_
, notice_
, warning_
, error_
, alert_
, critical_
, emergency_ ) where
import Data.Functor
import qualified Df1 as D
import qualified Di.Core as DC
import qualified Di.Df1 as Df1
import Polysemy
import qualified Polysemy.Reader as P
import Prelude hiding ( error, log )
data Di level path msg m a where
Log :: level -> msg -> Di level path msg m ()
Flush :: Di level path msg m ()
Local :: (DC.Di level path msg -> DC.Di level path msg) -> m a -> Di level path msg m a
Fetch :: Di level path msg m (Maybe (DC.Di level path msg))
makeSem ''Di
runDiToIOReader :: forall r a level msg. Members '[Embed IO, P.Reader (DC.Di level Df1.Path msg)] r
=> Sem (Di level Df1.Path msg ': r) a
-> Sem r a
runDiToIOReader :: Sem (Di level Path msg : r) a -> Sem r a
runDiToIOReader = (forall x (m :: * -> *).
Di level Path msg m x -> Tactical (Di level Path msg) m r x)
-> Sem (Di level Path msg : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall x (m :: * -> *). e m x -> Tactical e m r x)
-> Sem (e : r) a -> Sem r a
interpretH ((forall x (m :: * -> *).
Di level Path msg m x -> Tactical (Di level Path msg) m r x)
-> Sem (Di level Path msg : r) a -> Sem r a)
-> (forall x (m :: * -> *).
Di level Path msg m x -> Tactical (Di level Path msg) m r x)
-> Sem (Di level Path msg : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
Log level msg -> do
Di level Path msg
di <- forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader (Di level Path msg)) r =>
Sem r (Di level Path msg)
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
P.ask @(DC.Di level Df1.Path msg)
(forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IO a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed @IO (IO () -> Sem (WithTactics (Di level Path msg) f m r) ())
-> IO () -> Sem (WithTactics (Di level Path msg) f m r) ()
forall a b. (a -> b) -> a -> b
$ Di level Path msg -> level -> msg -> IO ()
forall (m :: * -> *) level path msg.
MonadIO m =>
Di level path msg -> level -> msg -> m ()
DC.log Di level Path msg
di level
level msg
msg) Sem (WithTactics (Di level Path msg) f m r) ()
-> (() -> Sem (WithTactics (Di level Path msg) f m r) (f ()))
-> Sem (WithTactics (Di level Path msg) f m r) (f ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= () -> Sem (WithTactics (Di level Path msg) f m r) (f ())
forall a (e :: (* -> *) -> * -> *) (m :: * -> *)
(r :: [(* -> *) -> * -> *]).
a -> Tactical e m r a
pureT
Flush -> do
Di level Path msg
di <- forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader (Di level Path msg)) r =>
Sem r (Di level Path msg)
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
P.ask @(DC.Di level Df1.Path msg)
(forall (r :: [(* -> *) -> * -> *]) a.
Member (Embed IO) r =>
IO a -> Sem r a
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Embed m) r =>
m a -> Sem r a
embed @IO (IO () -> Sem (WithTactics (Di level Path msg) f m r) ())
-> IO () -> Sem (WithTactics (Di level Path msg) f m r) ()
forall a b. (a -> b) -> a -> b
$ Di level Path msg -> IO ()
forall (m :: * -> *) level path msg.
MonadIO m =>
Di level path msg -> m ()
DC.flush Di level Path msg
di) Sem (WithTactics (Di level Path msg) f m r) ()
-> (() -> Sem (WithTactics (Di level Path msg) f m r) (f ()))
-> Sem (WithTactics (Di level Path msg) f m r) (f ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= () -> Sem (WithTactics (Di level Path msg) f m r) (f ())
forall a (e :: (* -> *) -> * -> *) (m :: * -> *)
(r :: [(* -> *) -> * -> *]).
a -> Tactical e m r a
pureT
Local f m -> do
Sem r (f x)
m' <- Sem (Di level Path msg : r) (f x) -> Sem r (f x)
forall (r :: [(* -> *) -> * -> *]) a level msg.
Members '[Embed IO, Reader (Di level Path msg)] r =>
Sem (Di level Path msg : r) a -> Sem r a
runDiToIOReader (Sem (Di level Path msg : r) (f x) -> Sem r (f x))
-> Sem
(WithTactics (Di level Path msg) f m r)
(Sem (Di level Path msg : r) (f x))
-> Sem (WithTactics (Di level Path msg) f m r) (Sem r (f x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m x
-> Sem
(WithTactics (Di level Path msg) f m r)
(Sem (Di level Path msg : r) (f x))
forall (m :: * -> *) a (e :: (* -> *) -> * -> *) (f :: * -> *)
(r :: [(* -> *) -> * -> *]).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT m x
m
Sem r (f x) -> Sem (WithTactics (Di level Path msg) f m r) (f x)
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise (Sem r (f x) -> Sem (WithTactics (Di level Path msg) f m r) (f x))
-> Sem r (f x) -> Sem (WithTactics (Di level Path msg) f m r) (f x)
forall a b. (a -> b) -> a -> b
$ (Di level Path msg -> Di level Path msg)
-> Sem r (f x) -> Sem r (f x)
forall i (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Reader i) r =>
(i -> i) -> Sem r a -> Sem r a
P.local @(DC.Di level Df1.Path msg) Di level Path msg -> Di level Path msg
f Sem r (f x)
m'
Fetch -> do
Maybe (Di level Path msg)
di <- Di level Path msg -> Maybe (Di level Path msg)
forall a. a -> Maybe a
Just (Di level Path msg -> Maybe (Di level Path msg))
-> Sem (WithTactics (Di level Path msg) f m r) (Di level Path msg)
-> Sem
(WithTactics (Di level Path msg) f m r) (Maybe (Di level Path msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader (Di level Path msg)) r =>
Sem r (Di level Path msg)
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Reader i) r =>
Sem r i
P.ask @(DC.Di level Df1.Path msg)
Maybe (Di level Path msg)
-> Tactical (Di level Path msg) m r (Maybe (Di level Path msg))
forall a (e :: (* -> *) -> * -> *) (m :: * -> *)
(r :: [(* -> *) -> * -> *]).
a -> Tactical e m r a
pureT Maybe (Di level Path msg)
di
runDiToIO :: forall r level msg a. Member (Embed IO) r
=> DC.Di level Df1.Path msg
-> Sem (Di level Df1.Path msg ': r) a
-> Sem r a
runDiToIO :: Di level Path msg -> Sem (Di level Path msg : r) a -> Sem r a
runDiToIO di :: Di level Path msg
di = Di level Path msg
-> Sem (Reader (Di level Path msg) : r) a -> Sem r a
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
P.runReader Di level Path msg
di (Sem (Reader (Di level Path msg) : r) a -> Sem r a)
-> (Sem (Di level Path msg : r) a
-> Sem (Reader (Di level Path msg) : r) a)
-> Sem (Di level Path msg : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Di level Path msg : Reader (Di level Path msg) : r) a
-> Sem (Reader (Di level Path msg) : r) a
forall (r :: [(* -> *) -> * -> *]) a level msg.
Members '[Embed IO, Reader (Di level Path msg)] r =>
Sem (Di level Path msg : r) a -> Sem r a
runDiToIOReader (Sem (Di level Path msg : Reader (Di level Path msg) : r) a
-> Sem (Reader (Di level Path msg) : r) a)
-> (Sem (Di level Path msg : r) a
-> Sem (Di level Path msg : Reader (Di level Path msg) : r) a)
-> Sem (Di level Path msg : r) a
-> Sem (Reader (Di level Path msg) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Di level Path msg : r) a
-> Sem (Di level Path msg : Reader (Di level Path msg) : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder
runDiNoop :: forall r level msg a. Sem (Di level Df1.Path msg ': r) a -> Sem r a
runDiNoop :: Sem (Di level Path msg : r) a -> Sem r a
runDiNoop = (forall x (m :: * -> *).
Di level Path msg m x -> Tactical (Di level Path msg) m r x)
-> Sem (Di level Path msg : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall x (m :: * -> *). e m x -> Tactical e m r x)
-> Sem (e : r) a -> Sem r a
interpretH \case
Log _level _msg -> () -> Tactical (Di level Path msg) m r ()
forall a (e :: (* -> *) -> * -> *) (m :: * -> *)
(r :: [(* -> *) -> * -> *]).
a -> Tactical e m r a
pureT ()
Flush -> () -> Tactical (Di level Path msg) m r ()
forall a (e :: (* -> *) -> * -> *) (m :: * -> *)
(r :: [(* -> *) -> * -> *]).
a -> Tactical e m r a
pureT ()
Local _f m -> Sem (Di level Path msg : r) (f x) -> Sem r (f x)
forall (r :: [(* -> *) -> * -> *]) level msg a.
Sem (Di level Path msg : r) a -> Sem r a
runDiNoop (Sem (Di level Path msg : r) (f x) -> Sem r (f x))
-> Sem
(Tactics f m (Di level Path msg : r) : r)
(Sem (Di level Path msg : r) (f x))
-> Sem (Tactics f m (Di level Path msg : r) : r) (Sem r (f x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m x
-> Sem
(Tactics f m (Di level Path msg : r) : r)
(Sem (Di level Path msg : r) (f x))
forall (m :: * -> *) a (e :: (* -> *) -> * -> *) (f :: * -> *)
(r :: [(* -> *) -> * -> *]).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT m x
m Sem (Tactics f m (Di level Path msg : r) : r) (Sem r (f x))
-> (Sem r (f x)
-> Sem (Tactics f m (Di level Path msg : r) : r) (f x))
-> Sem (Tactics f m (Di level Path msg : r) : r) (f x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Sem r (f x) -> Sem (Tactics f m (Di level Path msg : r) : r) (f x)
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise
Fetch -> Maybe (Di level Path msg)
-> Tactical (Di level Path msg) m r (Maybe (Di level Path msg))
forall a (e :: (* -> *) -> * -> *) (m :: * -> *)
(r :: [(* -> *) -> * -> *]).
a -> Tactical e m r a
pureT Maybe (Di level Path msg)
forall a. Maybe a
Nothing
push :: forall level msg r a. Member (Di level Df1.Path msg) r => Df1.Segment -> Sem r a -> Sem r a
push :: Segment -> Sem r a -> Sem r a
push s :: Segment
s = (Di level Path msg -> Di level Path msg) -> Sem r a -> Sem r a
forall level path msg (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Di level path msg) r =>
(Di level path msg -> Di level path msg) -> Sem r a -> Sem r a
local @level @Df1.Path @msg (Segment -> Di level Path msg -> Di level Path msg
forall level msg. Segment -> Di level Path msg -> Di level Path msg
Df1.push Segment
s)
attr_ :: forall level msg r a. Member (Di level Df1.Path msg) r => Df1.Key -> Df1.Value -> Sem r a -> Sem r a
attr_ :: Key -> Value -> Sem r a -> Sem r a
attr_ k :: Key
k v :: Value
v = (Di level Path msg -> Di level Path msg) -> Sem r a -> Sem r a
forall level path msg (r :: [(* -> *) -> * -> *]) a.
MemberWithError (Di level path msg) r =>
(Di level path msg -> Di level path msg) -> Sem r a -> Sem r a
local @level @Df1.Path @msg (Key -> Value -> Di level Path msg -> Di level Path msg
forall level msg.
Key -> Value -> Di level Path msg -> Di level Path msg
Df1.attr_ Key
k Value
v)
attr :: forall value level msg r a. (Df1.ToValue value, Member (Di level Df1.Path msg) r) => Df1.Key -> value -> Sem r a -> Sem r a
attr :: Key -> value -> Sem r a -> Sem r a
attr k :: Key
k v :: value
v = Key -> Value -> Sem r a -> Sem r a
forall level msg (r :: [(* -> *) -> * -> *]) a.
Member (Di level Path msg) r =>
Key -> Value -> Sem r a -> Sem r a
attr_ @level @msg Key
k (value -> Value
forall a. ToValue a => a -> Value
Df1.value value
v)
debug :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()
debug :: msg -> Sem r ()
debug = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Debug (Message -> Sem r ()) -> (msg -> Message) -> msg -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. msg -> Message
forall a. ToMessage a => a -> Message
Df1.message
info :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()
info :: msg -> Sem r ()
info = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Info (Message -> Sem r ()) -> (msg -> Message) -> msg -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. msg -> Message
forall a. ToMessage a => a -> Message
Df1.message
notice :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()
notice :: msg -> Sem r ()
notice = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Notice (Message -> Sem r ()) -> (msg -> Message) -> msg -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. msg -> Message
forall a. ToMessage a => a -> Message
Df1.message
warning :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()
warning :: msg -> Sem r ()
warning = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Warning (Message -> Sem r ()) -> (msg -> Message) -> msg -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. msg -> Message
forall a. ToMessage a => a -> Message
Df1.message
error :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()
error :: msg -> Sem r ()
error = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Error (Message -> Sem r ()) -> (msg -> Message) -> msg -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. msg -> Message
forall a. ToMessage a => a -> Message
Df1.message
alert :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()
alert :: msg -> Sem r ()
alert = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Alert (Message -> Sem r ()) -> (msg -> Message) -> msg -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. msg -> Message
forall a. ToMessage a => a -> Message
Df1.message
critical :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()
critical :: msg -> Sem r ()
critical = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Critical (Message -> Sem r ()) -> (msg -> Message) -> msg -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. msg -> Message
forall a. ToMessage a => a -> Message
Df1.message
emergency :: forall msg path r. (Df1.ToMessage msg, Member (Di Df1.Level path Df1.Message) r) => msg -> Sem r ()
emergency :: msg -> Sem r ()
emergency = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Emergency (Message -> Sem r ()) -> (msg -> Message) -> msg -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. msg -> Message
forall a. ToMessage a => a -> Message
Df1.message
debug_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()
debug_ :: Message -> Sem r ()
debug_ = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Debug
info_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()
info_ :: Message -> Sem r ()
info_ = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Info
notice_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()
notice_ :: Message -> Sem r ()
notice_ = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Notice
warning_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()
warning_ :: Message -> Sem r ()
warning_ = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Warning
error_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()
error_ :: Message -> Sem r ()
error_ = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Error
alert_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()
alert_ :: Message -> Sem r ()
alert_ = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Alert
critical_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()
critical_ :: Message -> Sem r ()
critical_ = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Critical
emergency_ :: forall path r. Member (Di Df1.Level path Df1.Message) r => Df1.Message -> Sem r ()
emergency_ :: Message -> Sem r ()
emergency_ = Level -> Message -> Sem r ()
forall level path msg (r :: [(* -> *) -> * -> *]).
MemberWithError (Di level path msg) r =>
level -> msg -> Sem r ()
log @Df1.Level @path Level
D.Emergency