module Effectful.Colog (
  -- * Effect
  Log,
  LogEff,
  logMsg,
  injectLog,

  -- ** Handlers
  runLogAction,
  runLogWriter,

  -- ** 'LogAction's
  tellLogEff,

  -- *** 'FileSystem' constrained
  byteStringLogEff,
  textLogEff,

  -- * Re-exports
  module Colog.Core.Action,
)
where

import Colog.Core.Action
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.Kind
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Effectful
import Effectful.Dispatch.Static
import Effectful.FileSystem (FileSystem)
import Effectful.FileSystem.IO.ByteString (hPutStr)
import Effectful.Internal.Env (Env, Relinker (..), consEnv, unconsEnv)
import Effectful.Internal.Utils (inlineBracket)
import Effectful.Writer.Static.Shared (Writer, runWriter, tell)
import System.IO (Handle)

-- | Provides the ability to log with an implicit 'LogEff'
type Log :: Type -> Effect
data Log msg m a

type instance DispatchOf (Log msg) = Static NoSideEffects
data instance StaticRep (Log msg) where
  MkLog :: forall localEs msg. !(Env localEs) -> !(LogEff localEs msg) -> StaticRep (Log msg)

-- | 'LogAction' limited to the 'Eff' monad
type LogEff es msg = LogAction (Eff es) msg

unLogEff :: forall es msg. LogEff es msg -> msg -> Env es -> IO ()
unLogEff :: forall (es :: [Effect]) msg.
LogEff es msg -> msg -> Env es -> IO ()
unLogEff LogEff es msg
le = Eff es () -> Env es -> IO ()
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (Eff es () -> Env es -> IO ())
-> (msg -> Eff es ()) -> msg -> Env es -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogEff es msg -> msg -> Eff es ()
forall (m :: Type -> Type) msg. LogAction m msg -> msg -> m ()
unLogAction LogEff es msg
le

relinkLog :: forall msg. Relinker StaticRep (Log msg)
relinkLog :: forall msg. Relinker StaticRep (Log msg)
relinkLog = (HasCallStack =>
 (forall (es :: [Effect]). Env es -> IO (Env es))
 -> StaticRep (Log msg) -> IO (StaticRep (Log msg)))
-> Relinker StaticRep (Log msg)
forall (a :: Effect -> Type) (b :: Effect).
(HasCallStack =>
 (forall (es :: [Effect]). Env es -> IO (Env es))
 -> a b -> IO (a b))
-> Relinker a b
Relinker ((HasCallStack =>
  (forall (es :: [Effect]). Env es -> IO (Env es))
  -> StaticRep (Log msg) -> IO (StaticRep (Log msg)))
 -> Relinker StaticRep (Log msg))
-> (HasCallStack =>
    (forall (es :: [Effect]). Env es -> IO (Env es))
    -> StaticRep (Log msg) -> IO (StaticRep (Log msg)))
-> Relinker StaticRep (Log msg)
forall a b. (a -> b) -> a -> b
$ \forall (es :: [Effect]). Env es -> IO (Env es)
relink (MkLog Env localEs
localEs LogEff localEs msg
act) -> do
  Env localEs
newLocalEs <- Env localEs -> IO (Env localEs)
forall (es :: [Effect]). Env es -> IO (Env es)
relink Env localEs
localEs
  StaticRep (Log msg) -> IO (StaticRep (Log msg))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (StaticRep (Log msg) -> IO (StaticRep (Log msg)))
-> StaticRep (Log msg) -> IO (StaticRep (Log msg))
forall a b. (a -> b) -> a -> b
$ Env localEs -> LogEff localEs msg -> StaticRep (Log msg)
forall (localEs :: [Effect]) msg.
Env localEs -> LogEff localEs msg -> StaticRep (Log msg)
MkLog Env localEs
newLocalEs LogEff localEs msg
act

-- | runs the 'Log' effect using the provided action this is the most general runner
runLogAction :: forall es msg a. LogEff es msg -> Eff (Log msg : es) a -> Eff es a
runLogAction :: forall (es :: [Effect]) msg a.
LogEff es msg -> Eff (Log msg : es) a -> Eff es a
runLogAction LogEff es msg
logAct Eff (Log msg : es) a
act = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
env -> do
  IO (Env (Log msg : es))
-> (Env (Log msg : es) -> IO ())
-> (Env (Log msg : es) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
inlineBracket
    (EffectRep (DispatchOf (Log msg)) (Log msg)
-> Relinker (EffectRep (DispatchOf (Log msg))) (Log msg)
-> Env es
-> IO (Env (Log msg : es))
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
consEnv (Env es -> LogEff es msg -> StaticRep (Log msg)
forall (localEs :: [Effect]) msg.
Env localEs -> LogEff localEs msg -> StaticRep (Log msg)
MkLog Env es
env LogEff es msg
logAct) Relinker (EffectRep (DispatchOf (Log msg))) (Log msg)
Relinker StaticRep (Log msg)
forall msg. Relinker StaticRep (Log msg)
relinkLog Env es
env)
    Env (Log msg : es) -> IO ()
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
Env (e : es) -> IO ()
unconsEnv
    (\Env (Log msg : es)
es -> Eff (Log msg : es) a -> Env (Log msg : es) -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff (Log msg : es) a
act Env (Log msg : es)
es)

-- | runs the 'Log' effect using 'tellLogEff' and then handles the 'Writer' effect
runLogWriter :: forall es msg a. (Monoid msg) => Eff (Log msg : es) a -> Eff es (a, msg)
runLogWriter :: forall (es :: [Effect]) msg a.
Monoid msg =>
Eff (Log msg : es) a -> Eff es (a, msg)
runLogWriter = Eff (Writer msg : es) a -> Eff es (a, msg)
forall w (es :: [Effect]) a.
(HasCallStack, Monoid w) =>
Eff (Writer w : es) a -> Eff es (a, w)
runWriter (Eff (Writer msg : es) a -> Eff es (a, msg))
-> (Eff (Log msg : es) a -> Eff (Writer msg : es) a)
-> Eff (Log msg : es) a
-> Eff es (a, msg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogEff (Writer msg : es) msg
-> Eff (Log msg : Writer msg : es) a -> Eff (Writer msg : es) a
forall (es :: [Effect]) msg a.
LogEff es msg -> Eff (Log msg : es) a -> Eff es a
runLogAction LogEff (Writer msg : es) msg
forall (es :: [Effect]) msg.
(Writer msg :> es, Monoid msg) =>
LogEff es msg
tellLogEff (Eff (Log msg : Writer msg : es) a -> Eff (Writer msg : es) a)
-> (Eff (Log msg : es) a -> Eff (Log msg : Writer msg : es) a)
-> Eff (Log msg : es) a
-> Eff (Writer msg : es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (Log msg : es) a -> Eff (Log msg : Writer msg : es) a
forall (subEs :: [Effect]) (es :: [Effect]) a.
Subset subEs es =>
Eff subEs a -> Eff es a
inject

-- | logs a message using the implicit 'LogEff'
logMsg :: forall msg es. (Log msg :> es) => msg -> Eff es ()
logMsg :: forall msg (es :: [Effect]). (Log msg :> es) => msg -> Eff es ()
logMsg msg
message = do
  MkLog Env localEs
env LogEff localEs msg
act <- Eff es (StaticRep (Log msg))
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(HasCallStack, DispatchOf e ~ 'Static sideEffects, e :> es) =>
Eff es (StaticRep e)
getStaticRep
  IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> IO () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ LogEff localEs msg -> msg -> Env localEs -> IO ()
forall (es :: [Effect]) msg.
LogEff es msg -> msg -> Env es -> IO ()
unLogEff LogEff localEs msg
act msg
message Env localEs
env

-- untested

-- | converts a 'LogEff' into another compatible 'LogEff'
injectLog :: forall (xs :: [Effect]) (es :: [Effect]) a. (Subset xs es) => LogEff xs a -> LogEff es a
injectLog :: forall (xs :: [Effect]) (es :: [Effect]) a.
Subset xs es =>
LogEff xs a -> LogEff es a
injectLog = (forall x. Eff xs x -> Eff es x)
-> LogAction (Eff xs) a -> LogAction (Eff es) a
forall (m :: Type -> Type) (n :: Type -> Type) a.
(forall x. m x -> n x) -> LogAction m a -> LogAction n a
hoistLogAction Eff xs x -> Eff es x
forall (subEs :: [Effect]) (es :: [Effect]) a.
Subset subEs es =>
Eff subEs a -> Eff es a
forall x. Eff xs x -> Eff es x
inject

-- | 'LogEff' that delegates to a static shared 'Writer' effect
tellLogEff :: forall es msg. (Writer msg :> es, Monoid msg) => LogEff es msg
tellLogEff :: forall (es :: [Effect]) msg.
(Writer msg :> es, Monoid msg) =>
LogEff es msg
tellLogEff = (msg -> Eff es ()) -> LogAction (Eff es) msg
forall (m :: Type -> Type) msg. (msg -> m ()) -> LogAction m msg
LogAction msg -> Eff es ()
forall w (es :: [Effect]).
(HasCallStack, Writer w :> es, Monoid w) =>
w -> Eff es ()
tell

-- untested

-- | 'LogEff' that writes 'Text' to a 'Handle'
textLogEff :: forall es. (FileSystem :> es) => Handle -> LogEff es Text
textLogEff :: forall (es :: [Effect]).
(FileSystem :> es) =>
Handle -> LogEff es Text
textLogEff Handle
hdl = (Text -> Eff es ()) -> LogAction (Eff es) Text
forall (m :: Type -> Type) msg. (msg -> m ()) -> LogAction m msg
LogAction ((Text -> Eff es ()) -> LogAction (Eff es) Text)
-> (Text -> Eff es ()) -> LogAction (Eff es) Text
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> Eff es ()
forall (es :: [Effect]).
(FileSystem :> es) =>
Handle -> ByteString -> Eff es ()
hPutStr Handle
hdl (ByteString -> Eff es ())
-> (Text -> ByteString) -> Text -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- untested

-- | 'LogEff' that writes 'ByteString' to a 'Handle'
byteStringLogEff :: forall es. (FileSystem :> es) => Handle -> LogEff es ByteString
byteStringLogEff :: forall (es :: [Effect]).
(FileSystem :> es) =>
Handle -> LogEff es ByteString
byteStringLogEff Handle
hdl = (ByteString -> Eff es ()) -> LogAction (Eff es) ByteString
forall (m :: Type -> Type) msg. (msg -> m ()) -> LogAction m msg
LogAction ((ByteString -> Eff es ()) -> LogAction (Eff es) ByteString)
-> (ByteString -> Eff es ()) -> LogAction (Eff es) ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> Eff es ()
forall (es :: [Effect]).
(FileSystem :> es) =>
Handle -> ByteString -> Eff es ()
hPutStr Handle
hdl