module Effectful.Zoo.Log.Static
  ( Log,
    runLog,
    runLogToHandle,
    runLogToStdout,
    runLogToStderr,
    withLog,
    log,
    local,
  ) where

import Data.Kind
import Data.Text.IO qualified as T
import Effectful
import Effectful.Dispatch.Static
import Effectful.Zoo.Core
import Effectful.Zoo.Log.Data.Logger
import Effectful.Zoo.Log.Data.Severity
import GHC.Stack qualified as GHC
import HaskellWorks.Prelude
import System.IO qualified as IO

data Log (i :: Type) :: Effect

type instance DispatchOf (Log i) = Static NoSideEffects

newtype instance StaticRep (Log i) = Log (Logger i)

runLog :: ()
  => r <: IOE
  => HasCallStack
  => UnliftStrategy
  -> (CallStack -> Severity -> i -> Eff r ())
  -> Eff (Log i : r) a
  -> Eff r a
runLog :: forall (r :: [Effect]) i a.
(r <: IOE, HasCallStack) =>
UnliftStrategy
-> (CallStack -> Severity -> i -> Eff r ())
-> Eff (Log i : r) a
-> Eff r a
runLog UnliftStrategy
strategy CallStack -> Severity -> i -> Eff r ()
run Eff (Log i : r) a
f = do
  Logger i
s <- UnliftStrategy
-> (CallStack -> Severity -> i -> Eff r ()) -> Eff r (Logger i)
forall (r :: [Effect]) i.
(r <: IOE) =>
UnliftStrategy
-> (CallStack -> Severity -> i -> Eff r ()) -> Eff r (Logger i)
mkLogger UnliftStrategy
strategy CallStack -> Severity -> i -> Eff r ()
run
  StaticRep (Log i) -> Eff (Log i : r) a -> Eff r a
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects,
 MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep (Logger i -> StaticRep (Log i)
forall i. Logger i -> StaticRep (Log i)
Log Logger i
s) Eff (Log i : r) a
f

runLogToHandle :: ()
  => HasCallStack
  => Handle
  -> (Severity -> a -> Text)
  -> Eff (Log a : r) a
  -> Eff r a
runLogToHandle :: forall a (r :: [Effect]).
HasCallStack =>
Handle -> (Severity -> a -> Text) -> Eff (Log a : r) a -> Eff r a
runLogToHandle Handle
h Severity -> a -> Text
f =
  StaticRep (Log a) -> Eff (Log a : r) a -> Eff r a
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects,
 MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep (StaticRep (Log a) -> Eff (Log a : r) a -> Eff r a)
-> StaticRep (Log a) -> Eff (Log a : r) a -> Eff r a
forall a b. (a -> b) -> a -> b
$ Logger a -> StaticRep (Log a)
forall i. Logger i -> StaticRep (Log i)
Log (Logger a -> StaticRep (Log a)) -> Logger a -> StaticRep (Log a)
forall a b. (a -> b) -> a -> b
$ (CallStack -> Severity -> a -> IO ()) -> Logger a
forall i. (CallStack -> Severity -> i -> IO ()) -> Logger i
Logger ((CallStack -> Severity -> a -> IO ()) -> Logger a)
-> (CallStack -> Severity -> a -> IO ()) -> Logger a
forall a b. (a -> b) -> a -> b
$ \CallStack
_ Severity
severity a
i ->
    Handle -> Text -> IO ()
T.hPutStrLn Handle
h (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Severity -> a -> Text
f Severity
severity a
i

runLogToStdout :: ()
  => HasCallStack
  => (Severity -> a -> Text)
  -> Eff (Log a : r) a
  -> Eff r a
runLogToStdout :: forall a (r :: [Effect]).
HasCallStack =>
(Severity -> a -> Text) -> Eff (Log a : r) a -> Eff r a
runLogToStdout =
  Handle -> (Severity -> a -> Text) -> Eff (Log a : r) a -> Eff r a
forall a (r :: [Effect]).
HasCallStack =>
Handle -> (Severity -> a -> Text) -> Eff (Log a : r) a -> Eff r a
runLogToHandle Handle
IO.stdout

runLogToStderr :: ()
  => HasCallStack
  => (Severity -> a -> Text)
  -> Eff (Log a : r) a
  -> Eff r a
runLogToStderr :: forall a (r :: [Effect]).
HasCallStack =>
(Severity -> a -> Text) -> Eff (Log a : r) a -> Eff r a
runLogToStderr =
  Handle -> (Severity -> a -> Text) -> Eff (Log a : r) a -> Eff r a
forall a (r :: [Effect]).
HasCallStack =>
Handle -> (Severity -> a -> Text) -> Eff (Log a : r) a -> Eff r a
runLogToHandle Handle
IO.stderr

withDataLogSerialiser :: ()
  => HasCallStack
  => (Logger i -> Logger o)
  -> Eff (Log o : r) a
  -> Eff (Log i : r) a
withDataLogSerialiser :: forall i o (r :: [Effect]) a.
HasCallStack =>
(Logger i -> Logger o) -> Eff (Log o : r) a -> Eff (Log i : r) a
withDataLogSerialiser Logger i -> Logger o
f Eff (Log o : r) a
m = do
  Logger i
logger <- Eff (Log i : r) (Logger i)
forall (r :: [Effect]) i.
(HasCallStack, r <: Log i) =>
Eff r (Logger i)
getDataLogger
  let Logger i
_ = Logger i
logger
  Eff r a -> Eff (Log i : r) a
forall (es :: [Effect]) a (e :: Effect). Eff es a -> Eff (e : es) a
raise (Eff r a -> Eff (Log i : r) a) -> Eff r a -> Eff (Log i : r) a
forall a b. (a -> b) -> a -> b
$ StaticRep (Log o) -> Eff (Log o : r) a -> Eff r a
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects,
 MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep (Logger o -> StaticRep (Log o)
forall i. Logger i -> StaticRep (Log i)
Log (Logger i -> Logger o
f Logger i
logger)) Eff (Log o : r) a
m

withLog :: ()
  => HasCallStack
  => (o -> i)
  -> Eff (Log o : r) a
  -> Eff (Log i : r) a
withLog :: forall o i (r :: [Effect]) a.
HasCallStack =>
(o -> i) -> Eff (Log o : r) a -> Eff (Log i : r) a
withLog =
  (Logger i -> Logger o) -> Eff (Log o : r) a -> Eff (Log i : r) a
forall i o (r :: [Effect]) a.
HasCallStack =>
(Logger i -> Logger o) -> Eff (Log o : r) a -> Eff (Log i : r) a
withDataLogSerialiser ((Logger i -> Logger o) -> Eff (Log o : r) a -> Eff (Log i : r) a)
-> ((o -> i) -> Logger i -> Logger o)
-> (o -> i)
-> Eff (Log o : r) a
-> Eff (Log i : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (o -> i) -> Logger i -> Logger o
forall a' a. (a' -> a) -> Logger a -> Logger a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap

getDataLogger :: ()
  => HasCallStack
  => r <: Log i
  => Eff r (Logger i)
getDataLogger :: forall (r :: [Effect]) i.
(HasCallStack, r <: Log i) =>
Eff r (Logger i)
getDataLogger = do
  Log Logger i
i <- Eff r (StaticRep (Log i))
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(HasCallStack, DispatchOf e ~ 'Static sideEffects, e :> es) =>
Eff es (StaticRep e)
getStaticRep
  Logger i -> Eff r (Logger i)
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Logger i
i

log :: ()
  => HasCallStack
  => r <: Log i
  => r <: IOE
  => Severity
  -> i
  -> Eff r ()
log :: forall (r :: [Effect]) i.
(HasCallStack, r <: Log i, r <: IOE) =>
Severity -> i -> Eff r ()
log Severity
severity i
i =
  (HasCallStack => Eff r ()) -> Eff r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack do
    Logger i
dataLogger <- Eff r (Logger i)
forall (r :: [Effect]) i.
(HasCallStack, r <: Log i) =>
Eff r (Logger i)
getDataLogger
    IO () -> Eff r ()
forall a. IO a -> Eff r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff r ()) -> IO () -> Eff r ()
forall a b. (a -> b) -> a -> b
$ Logger i
dataLogger.run CallStack
HasCallStack => CallStack
GHC.callStack Severity
severity i
i

local :: ()
  => HasCallStack
  => r <: Log i
  => (i -> i)
  -> Eff r a
  -> Eff r a
local :: forall (r :: [Effect]) i a.
(HasCallStack, r <: Log i) =>
(i -> i) -> Eff r a -> Eff r a
local i -> i
f =
  (StaticRep (Log i) -> StaticRep (Log i)) -> Eff r a -> Eff r a
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects, e :> es) =>
(StaticRep e -> StaticRep e) -> Eff es a -> Eff es a
localStaticRep ((StaticRep (Log i) -> StaticRep (Log i)) -> Eff r a -> Eff r a)
-> (StaticRep (Log i) -> StaticRep (Log i)) -> Eff r a -> Eff r a
forall a b. (a -> b) -> a -> b
$ \(Log Logger i
s) -> Logger i -> StaticRep (Log i)
forall i. Logger i -> StaticRep (Log i)
Log ((i -> i) -> Logger i -> Logger i
forall a' a. (a' -> a) -> Logger a -> Logger a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap i -> i
f Logger i
s)