Hey folks,
I’d like to kindly ask for comments on this module I wrote. I have been experimenting on how to bring effectful and co-log together in a way that still allows using the combinators that distinguish co-log, and I’ve finally got things working.
I don’t have a whole lot of experience with Haskell though (this is all still for my toy projects), so I’m wondering
- is this a “good” interface? It seems nice to me but I haven’t worked with other logging libraries
- is this a significant enough addition to warrant a package? It’s not a whole lot of code, but it took me a hot minute to get there.
- Are there strictness issues with the State and Writer interpreters?
Next tasks:
- Include comfy functions for logging with Severity and RichMessages
- More specific tests
- See if we can reduce the need for type applications
I also posted the code as a gist in case you prefers that for reading
Here’s the rendered haddock. Ignore the other modules, as I wrote it’s a chaotic toy project for the most part.
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{- |
Description: effectful interface to co-log
License: GPL-3
Provides an 'Effectful' interface to 'Colog' using dynamic dispatching.
It allows adding logging without much ceremony as well as running 'LogAction's
defined through others that are in the environment at that time.
-}
module Colog.Effectful (
-- * Effect
Log,
-- * Actions
log,
getLogAction,
LogActionEff,
-- * Running
runLog,
runLogF,
runLogM,
-- * Pure interpreters
runLogWriterD,
runLogWriterSL,
runLogWriterSS,
runLogStateD,
runLogStateSL,
runLogStateSS,
)
where
import Colog (LogAction (LogAction), choose, divide, logTextStdout, (<&))
import Control.Concurrent.Async (cancel)
import Effectful (
Dispatch (Dynamic),
DispatchOf,
Eff,
Effect,
runEff,
type (:>),
)
import Effectful.Dispatch.Dynamic (
EffectHandler,
interpret,
localSeqLift,
send,
)
import Effectful.Dispatch.Static (SideEffects (WithSideEffects), StaticRep)
import Effectful.Reader.Static qualified as RS
import Effectful.State.Dynamic qualified as SD
import Effectful.State.Static.Local qualified as SSL
import Effectful.State.Static.Shared qualified as SSS
import Effectful.Writer.Dynamic qualified as WD
import Effectful.Writer.Static.Local qualified as WSL
import Effectful.Writer.Static.Shared qualified as WSS
---------
-- Effect
{- | Effect for logging messages of type @msg@.
It means that there is a suitable 'LogAction _ msg' available in the environment.
-}
type Log :: Type -> Effect
data Log msg :: Effect where
Log :: msg -> Log msg effM ()
GetLogAction :: Log msg (Eff es) (LogActionEff es msg)
type instance DispatchOf (Log _) = 'Dynamic
----------
-- Actions
-- | An adaptation of 'LogAction' for @effectful@
type LogActionEff :: [Effect] -> Type -> Type
type LogActionEff es msg = LogAction (Eff es) msg
{- | Log a message of type 'msg' using the handler in the environment.
This will log "hi" to standard out
@
runEff
. runLog logTextStdout
$ log @Text "hi"
@
Note that for plain text types, type applications are necessary because there could be
different handlers for e.g. String and Text
-}
log ::
forall msg es.
(Log msg :> es) =>
msg ->
Eff es ()
log = send . Log
{- | Retrieve the logger for 'msg' from the environment.
This is mostly useful to define dependent 'LogActionEff's, for example
>>> mkLogWeirdEither ::
>>> forall es.
>>> (Log Text :> es, Log Char :> es) =>
>>> Eff es (LogActionEff es (Bool, Bool, [Int]))
>>> mkLogWeirdEither = do
>>> logText <- getLogAction @Text
>>> let boolToChar b = if b then 'y' else 'n'
>>> logBool <- (boolToChar >$<) <$> getLogAction @Char
>>> let toEither (True, bool, _) = Left bool
>>> toEither (False, _, list) = Right list
>>> pure $ choose toEither logBool (show >$< logText)
>>>
>>> doIt :: ((), Seq Text)
>>> doIt =
>>> runPureEff
>>> . WSL.runWriter @(Seq Text)
>>> . runLogWriterSL @Seq @Text
>>> . runLogM @Char ((show >$<) <$> getLogAction @Text)
>>> . runLogM mkLogWeirdEither
>>> $ do
>>> log (True, False, [3, 4 :: Int])
>>> log @Text "foo"
>>> log '?'
>>> log (False, True, [8, 9 :: Int])
>>>
>>> doIt
((),fromList ["'n'","foo","'?'","[8,9]"])
-}
getLogAction ::
forall msg es.
(Log msg :> es) =>
Eff es (LogActionEff es msg)
getLogAction =
send GetLogAction
-- | Run the effectful computation using the given 'LogActionEff' to log 'msg's
runLog ::
forall msg es a.
LogActionEff es msg ->
Eff (Log msg : es) a ->
Eff es a
runLog = runLogM . pure
{- | Run the effectful computation using the given action as a handler to log 'msg's
@runLogF = runLog . LogAction@
-}
runLogF ::
forall msg es a.
(msg -> Eff es ()) ->
Eff (Log msg : es) a ->
Eff es a
runLogF = runLog . LogAction
{- | Run the effectful computation using the result of the given action as a handler to log 'msg's.
This allows additional effects to be used when /constructing/ the 'LogActionEff'.
(Note that effects are always possible when processing 'msg's.)
This is necessary when a handler is defined in terms of other handlers. In that case, you can
retrieve and combine the base handlers.
See 'getLogAction' for an example.
-}
runLogM ::
forall msg es a.
Eff es (LogActionEff es msg) ->
Eff (Log msg : es) a ->
Eff es a
runLogM mkLogAction task = do
LogAction doLog <- mkLogAction
let handler :: EffectHandler (Log msg) es
handler localEnv = \case
Log msg ->
doLog msg
GetLogAction -> do
localSeqLift localEnv \lift ->
pure $ LogAction (lift . doLog)
interpret handler task
---
-- Specific interpreters
{- | Log using 'Effectful.Writer.Dynamic.Writer'.
Because of performance, you probably don't want to use this with regular lists ('[]').
'Data.Sequence.Seq' should be fine.
-}
runLogWriterD ::
forall s msg es a.
(Applicative s, WD.Writer (s msg) :> es) =>
Eff (Log msg : es) a ->
Eff es a
runLogWriterD =
runLogF $ WD.tell . pure @s
{- | Log using 'Effectful.Writer.Static.Local.Writer'.
Because of performance, you probably don't want to use this with regular lists ('[]').
'Data.Sequence.Seq' should be fine.
-}
runLogWriterSL ::
forall s msg es a.
(Monoid (s msg), Applicative s, WSL.Writer (s msg) :> es) =>
Eff (Log msg : es) a ->
Eff es a
runLogWriterSL =
runLogF $ WSL.tell . pure @s
{- | Log using 'Effectful.Writer.Static.Shared.Writer'.
Because of performance, you probably don't want to use this with regular lists ('[]').
'Data.Sequence.Seq' should be fine.
-}
runLogWriterSS ::
forall s msg es a.
(Monoid (s msg), Applicative s, WSS.Writer (s msg) :> es) =>
Eff (Log msg : es) a ->
Eff es a
runLogWriterSS =
runLogF $ WSS.tell . pure @s
-- | Log using 'Effectful.State.Dynamic.State' over a Semigroup.
runLogStateD ::
forall s msg es a.
(Applicative s, Semigroup (s msg), SD.State (s msg) :> es) =>
Eff (Log msg : es) a ->
Eff es a
runLogStateD =
runLogF $ \msg -> SD.modify (<> pure @s msg)
-- | Log using 'Effectful.State.Static.Local.State' over a Semigroup.
runLogStateSL ::
forall s msg es a.
(Monoid (s msg), Applicative s, SSL.State (s msg) :> es) =>
Eff (Log msg : es) a ->
Eff es a
runLogStateSL =
runLogF $ \msg -> SSL.modify (<> pure @s msg)
-- | Log using 'Effectful.State.Static.Shared.State' over a Semigroup.
runLogStateSS ::
forall s msg es a.
(Monoid (s msg), Applicative s, SSS.State (s msg) :> es) =>
Eff (Log msg : es) a ->
Eff es a
runLogStateSS =
runLogF $ \msg -> SSS.modify (<> pure @s msg)
module Fairtalk.CologTest where
import Colog (LogAction (LogAction), choose, divide, (<&))
import Effectful (Eff, runEff, runPureEff, (:>))
import qualified Effectful.Writer.Static.Local as WSL
import Fairtalk.Colog
import Test.Hspec
logCharAsText ::
(Log Text :> es) =>
LogActionEff es Char
logCharAsText = LogAction \msg -> do
logText <- getLogAction @Text
(show >$< logText) <& msg
logTuple ::
(Log Text :> es) =>
(Log Char :> es) =>
Eff es (LogActionEff es (Char, Text))
logTuple =
divide id <$> getLogAction <*> getLogAction
coolStuff :: ((), Seq Text)
coolStuff =
runPureEff
. WSL.runWriter @(Seq Text)
. runLogWriterSL @Seq @Text
. runLog logCharAsText
. runLogM logTuple
$ do
log @Text "hello"
log ('z', "Foo" :: Text)
runLogM @[Int]
( do
textLogger <- getLogAction @Text
pure (show >$< textLogger)
)
do
log [1, 2, 3 :: Int]
runLogM @[Int] ((show >$<) <$> getLogAction @Text) $
log [6, 7, 8 :: Int]
log 'x'
mkLogWeirdEither ::
forall es.
(Log Text :> es, Log Char :> es) =>
Eff es (LogActionEff es (Bool, Bool, [Int]))
mkLogWeirdEither = do
logText <- getLogAction @Text
let boolToChar b = if b then 'y' else 'n'
logBool <- (boolToChar >$<) <$> getLogAction @Char
let toEither (True, bool, _) = Left bool
toEither (False, _, list) = Right list
pure $ choose toEither logBool (show >$< logText)
doIt :: ((), Seq Text)
doIt =
runPureEff
. WSL.runWriter @(Seq Text)
. runLogWriterSL @Seq @Text
. runLogM @Char ((show >$<) <$> getLogAction @Text)
. runLogM mkLogWeirdEither
$ do
log (True, False, [3 :: Int, 4])
log @Text "foo"
log '?'
log (False, True, [8 :: Int, 9])
spec_runLogM :: Spec
spec_runLogM = do
it "allows using more effects (coolStuff)" do
coolStuff `shouldBe` ((), fromList ["hello", show 'z', "Foo", "[1,2,3]", "[6,7,8]", show 'x'])
it "does this other thing also (doIt)" do
doIt `shouldBe` ((), fromList [show 'n', "foo", show '?', show [8, 9 :: Int]])
