Skip to content

Try removing MonadIO superclass #119

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
MichaelXavier wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Try removing MonadIO superclass #119

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
36 changes: 18 additions & 18 deletions katip/src/Katip/Core.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -811,12 +811,12 @@ closeScribes le = do
-- of the log env that are reverted when the supplied monad
-- completes. 'katipNoLogging', for example, uses this to temporarily
-- pause log outputs.
class MonadIO m => Katip m where
class Katip m where
Copy link
Copy Markdown

@arybczak arybczak Mar 13, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This should really be

Suggested change
class Katip m where
class Monad m => Katip m where

then you won't have to include these Monad constraints below.

Copy link
Copy Markdown
Collaborator Author

@MichaelXavier MichaelXavier Mar 17, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@arybczak is that preferable though? I thought part of the idea of this change was to not require unused constraints. It makes sense to me if an implementation requires Monad that it should demand it but the base class doesn't seem to demand it. Maybe I'm missing something.

Copy link
Copy Markdown

@arybczak arybczak Mar 18, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I thought part of the idea of this change was to not require unused constraints

The problem isn't really unused constraints, it's just that you're forcing MonadIO on downstream users of Katip and MonadIO is huge (in a sense of what you can do with it). Monad on the other hand isn't, so including it as a superclass allows you to omit writing (Katip m, Monad m) in type signatures (which is somewhat annoying) and doesn't give any practical downsides.

Copy link
Copy Markdown

@CharlesEkkel CharlesEkkel Mar 8, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's a little annoying, but if the Katip typeclass doesn't need Monad, why add it? Off the top of my head, it seems theoretically possible that someone might have an applicative context for some kind of weird static logging perhaps? Ultimately I think you're right @MichaelXavier that removing unnecessary constraints is the core of this change, even if practically the Monad constraint honestly covers everything.

I'll just add that it would be wonderful to see this change being finalised if possible - maintaining a bunch of wrapper functions for use with an effects system consistently feels awkward and is a pain point for using katip.

getLogEnv :: m LogEnv
localLogEnv :: (LogEnv -> LogEnv) -> m a -> m a


instance Katip m => Katip (ReaderT s m) where
instance (Katip m, Monad m) => Katip (ReaderT s m) where
getLogEnv = lift getLogEnv
localLogEnv = mapReaderT . localLogEnv

Expand All @@ -828,47 +828,47 @@ instance Katip m => Katip (EitherT s m) where
#endif


instance Katip m => Katip (ExceptT s m) where
instance (Katip m, Monad m) => Katip (ExceptT s m) where
getLogEnv = lift getLogEnv
localLogEnv = mapExceptT . localLogEnv


instance Katip m => Katip (MaybeT m) where
instance (Katip m, Monad m) => Katip (MaybeT m) where
getLogEnv = lift getLogEnv
localLogEnv = mapMaybeT . localLogEnv


instance Katip m => Katip (StateT s m) where
instance (Katip m, Monad m) => Katip (StateT s m) where
getLogEnv = lift getLogEnv
localLogEnv = mapStateT . localLogEnv


instance (Katip m, Monoid w) => Katip (RWST r w s m) where
instance (Katip m, Monoid w, Monad m) => Katip (RWST r w s m) where
getLogEnv = lift getLogEnv
localLogEnv = mapRWST . localLogEnv


instance (Katip m, Monoid w) => Katip (Strict.RWST r w s m) where
instance (Katip m, Monoid w, Monad m) => Katip (Strict.RWST r w s m) where
getLogEnv = lift getLogEnv
localLogEnv = Strict.mapRWST . localLogEnv


instance Katip m => Katip (Strict.StateT s m) where
instance (Katip m, Monad m) => Katip (Strict.StateT s m) where
getLogEnv = lift getLogEnv
localLogEnv = Strict.mapStateT . localLogEnv


instance (Katip m, Monoid s) => Katip (WriterT s m) where
instance (Katip m, Monoid s, Monad m) => Katip (WriterT s m) where
getLogEnv = lift getLogEnv
localLogEnv = mapWriterT . localLogEnv


instance (Katip m, Monoid s) => Katip (Strict.WriterT s m) where
instance (Katip m, Monoid s, Monad m) => Katip (Strict.WriterT s m) where
getLogEnv = lift getLogEnv
localLogEnv = Strict.mapWriterT . localLogEnv


instance (Katip m) => Katip (ResourceT m) where
instance (Katip m, Monad m) => Katip (ResourceT m) where
getLogEnv = lift getLogEnv
localLogEnv = transResourceT . localLogEnv

Expand Down Expand Up @@ -937,7 +937,7 @@ katipNoLogging = localLogEnv (\le -> set logEnvScribes mempty le)
-- | Log with everything, including a source code location. This is
-- very low level and you typically can use 'logT' in its place.
logItem
:: (A.Applicative m, LogItem a, Katip m)
:: (A.Applicative m, LogItem a, Katip m, MonadIO m)
Copy link
Copy Markdown

@turion turion Apr 12, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why still require Applicative m? Shouldn't that be implied by MonadIO?

=> a
-> Namespace
-> Maybe Loc
Expand All @@ -963,7 +963,7 @@ logItem a ns loc sev msg = do
-- functions use.
-- It can be useful when implementing centralised logging services.
logKatipItem
:: (A.Applicative m, LogItem a, Katip m)
:: (A.Applicative m, LogItem a, Katip m, MonadIO m)
=> Item a
-> m ()
logKatipItem item = do
Expand All @@ -988,7 +988,7 @@ tryWriteTBQueue q a = do
-------------------------------------------------------------------------------
-- | Log with full context, but without any code location.
logF
:: (Applicative m, LogItem a, Katip m)
:: (Applicative m, LogItem a, Katip m, MonadIO m)
=> a
-- ^ Contextual payload for the log
-> Namespace
Expand All @@ -1008,7 +1008,7 @@ logF a ns sev msg = logItem a ns Nothing sev msg
--
-- >>>> logException () mempty ErrorS (error "foo")
logException
:: (Katip m, LogItem a, MonadCatch m, Applicative m)
:: (Katip m, LogItem a, MonadCatch m, Applicative m, MonadIO m)
=> a -- ^ Log context
-> Namespace -- ^ Namespace
-> Severity -- ^ Severity
Expand All @@ -1023,7 +1023,7 @@ logException a ns sev action = action `catchAny` \e -> f e >> throwM e
-------------------------------------------------------------------------------
-- | Log a message without any payload/context or code location.
logMsg
:: (Applicative m, Katip m)
:: (Applicative m, Katip m, MonadIO m)
=> Namespace
-> Severity
-> LogStr
Expand Down Expand Up @@ -1121,9 +1121,9 @@ logT = [| \ a ns sev msg -> logItem a ns (Just $(getLocTH)) sev msg |]
--
-- @logLoc obj mempty InfoS "Hello world"@
#if MIN_VERSION_base(4, 8, 0)
logLoc :: (Applicative m, LogItem a, Katip m, HasCallStack)
logLoc :: (Applicative m, LogItem a, Katip m, HasCallStack, MonadIO m)
#else
logLoc :: (Applicative m, LogItem a, Katip m)
logLoc :: (Applicative m, LogItem a, Katip m, MonadIO m)
#endif
=> a
-> Namespace
Expand Down
36 changes: 18 additions & 18 deletions katip/src/Katip/Monadic.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -151,100 +151,100 @@ class Katip m => KatipContext m where
-- supplied monad. Used in 'katipAddNamespace'
localKatipNamespace :: (Namespace -> Namespace) -> m a -> m a

instance (KatipContext m, Katip (IdentityT m)) => KatipContext (IdentityT m) where
instance (KatipContext m, Katip (IdentityT m), Monad m) => KatipContext (IdentityT m) where
getKatipContext = lift getKatipContext
localKatipContext = mapIdentityT . localKatipContext
getKatipNamespace = lift getKatipNamespace
localKatipNamespace = mapIdentityT . localKatipNamespace


instance (KatipContext m, Katip (MaybeT m)) => KatipContext (MaybeT m) where
instance (KatipContext m, Katip (MaybeT m), Monad m) => KatipContext (MaybeT m) where
getKatipContext = lift getKatipContext
localKatipContext = mapMaybeT . localKatipContext
getKatipNamespace = lift getKatipNamespace
localKatipNamespace = mapMaybeT . localKatipNamespace


#if !MIN_VERSION_either(4, 5, 0)
instance (KatipContext m, Katip (EitherT e m)) => KatipContext (EitherT e m) where
instance (KatipContext m, Katip (EitherT e m), Monad m) => KatipContext (EitherT e m) where
getKatipContext = lift getKatipContext
localKatipContext = mapEitherT . localKatipContext
getKatipNamespace = lift getKatipNamespace
localKatipNamespace = mapEitherT . localKatipNamespace
#endif


instance (KatipContext m, Katip (ReaderT r m)) => KatipContext (ReaderT r m) where
instance (KatipContext m, Katip (ReaderT r m), Monad m) => KatipContext (ReaderT r m) where
getKatipContext = lift getKatipContext
localKatipContext = mapReaderT . localKatipContext
getKatipNamespace = lift getKatipNamespace
localKatipNamespace = mapReaderT . localKatipNamespace


instance (KatipContext m, Katip (ResourceT m)) => KatipContext (ResourceT m) where
instance (KatipContext m, Katip (ResourceT m), Monad m) => KatipContext (ResourceT m) where
getKatipContext = lift getKatipContext
localKatipContext = transResourceT . localKatipContext
getKatipNamespace = lift getKatipNamespace
localKatipNamespace = transResourceT . localKatipNamespace


instance (KatipContext m, Katip (Strict.StateT s m)) => KatipContext (Strict.StateT s m) where
instance (KatipContext m, Katip (Strict.StateT s m), Monad m) => KatipContext (Strict.StateT s m) where
getKatipContext = lift getKatipContext
localKatipContext = Strict.mapStateT . localKatipContext
getKatipNamespace = lift getKatipNamespace
localKatipNamespace = Strict.mapStateT . localKatipNamespace


instance (KatipContext m, Katip (StateT s m)) => KatipContext (StateT s m) where
instance (KatipContext m, Katip (StateT s m), Monad m) => KatipContext (StateT s m) where
getKatipContext = lift getKatipContext
localKatipContext = mapStateT . localKatipContext
getKatipNamespace = lift getKatipNamespace
localKatipNamespace = mapStateT . localKatipNamespace


instance (KatipContext m, Katip (ExceptT e m)) => KatipContext (ExceptT e m) where
instance (KatipContext m, Katip (ExceptT e m), Monad m) => KatipContext (ExceptT e m) where
getKatipContext = lift getKatipContext
localKatipContext = mapExceptT . localKatipContext
getKatipNamespace = lift getKatipNamespace
localKatipNamespace = mapExceptT . localKatipNamespace


instance (Monoid w, KatipContext m, Katip (Strict.WriterT w m)) => KatipContext (Strict.WriterT w m) where
instance (Monoid w, KatipContext m, Katip (Strict.WriterT w m), Monad m) => KatipContext (Strict.WriterT w m) where
getKatipContext = lift getKatipContext
localKatipContext = Strict.mapWriterT . localKatipContext
getKatipNamespace = lift getKatipNamespace
localKatipNamespace = Strict.mapWriterT . localKatipNamespace


instance (Monoid w, KatipContext m, Katip (WriterT w m)) => KatipContext (WriterT w m) where
instance (Monoid w, KatipContext m, Katip (WriterT w m), Monad m) => KatipContext (WriterT w m) where
getKatipContext = lift getKatipContext
localKatipContext = mapWriterT . localKatipContext
getKatipNamespace = lift getKatipNamespace
localKatipNamespace = mapWriterT . localKatipNamespace


instance (Monoid w, KatipContext m, Katip (Strict.RWST r w s m)) => KatipContext (Strict.RWST r w s m) where
instance (Monoid w, KatipContext m, Katip (Strict.RWST r w s m), Monad m) => KatipContext (Strict.RWST r w s m) where
getKatipContext = lift getKatipContext
localKatipContext = Strict.mapRWST . localKatipContext
getKatipNamespace = lift getKatipNamespace
localKatipNamespace = Strict.mapRWST . localKatipNamespace


instance (Monoid w, KatipContext m, Katip (RWST r w s m)) => KatipContext (RWST r w s m) where
instance (Monoid w, KatipContext m, Katip (RWST r w s m), Monad m) => KatipContext (RWST r w s m) where
getKatipContext = lift getKatipContext
localKatipContext = mapRWST . localKatipContext
getKatipNamespace = lift getKatipNamespace
localKatipNamespace = mapRWST . localKatipNamespace


deriving instance (Monad m, KatipContext m) => KatipContext (KatipT m)
deriving instance (MonadIO m, KatipContext m) => KatipContext (KatipT m)

-------------------------------------------------------------------------------
-- | Log with everything, including a source code location. This is
-- very low level and you typically can use 'logTM' in its
-- place. Automatically supplies payload and namespace.
logItemM
:: (Applicative m, KatipContext m, HasCallStack)
:: (Applicative m, KatipContext m, HasCallStack, MonadIO m)
=> Maybe Loc
-> Severity
-> LogStr
Expand All @@ -259,7 +259,7 @@ logItemM loc sev msg = do
-- | Log with full context, but without any code
-- location. Automatically supplies payload and namespace.
logFM
:: (Applicative m, KatipContext m)
:: (Applicative m, KatipContext m, MonadIO m)
=> Severity
-- ^ Severity of the message
-> LogStr
Expand Down Expand Up @@ -295,7 +295,7 @@ logTM = [| logItemM (Just $(getLocTH)) |]
-- `logTM` for maximum compatibility.
--
-- @logLocM InfoS "Hello world"@
logLocM :: (Applicative m, KatipContext m, HasCallStack)
logLocM :: (Applicative m, KatipContext m, HasCallStack, MonadIO m)
=> Severity
-> LogStr
-> m ()
Expand All @@ -308,7 +308,7 @@ logLocM = logItemM getLoc
--
-- >>>> error "foo" `logExceptionM` ErrorS
logExceptionM
:: (KatipContext m, MonadCatch m, Applicative m)
:: (KatipContext m, MonadCatch m, Applicative m, MonadIO m)
=> m a -- ^ Main action to run
-> Severity -- ^ Severity
-> m a
Expand Down Expand Up @@ -511,7 +511,7 @@ instance MonadIO m => KatipContext (NoLoggingT m) where

-- | Convenience function for when you have to integrate with a third
-- party API that takes a generic logging function as an argument.
askLoggerIO :: (Applicative m, KatipContext m) => m (Severity -> LogStr -> IO ())
askLoggerIO :: (Applicative m, KatipContext m, MonadIO m) => m (Severity -> LogStr -> IO ())
Copy link
Copy Markdown

@arybczak arybczak Mar 18, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't think this requires MonadIO, right? You return an IO function, but the constraint doesn't seem needed to do that.

It looks similar to https://hackage.haskell.org/package/log-base-0.12.0.1/docs/Log-Monad.html#v:getLoggerIO.

askLoggerIO = do
ctx <- getKatipContext
ns <- getKatipNamespace
Expand Down