I already asked on Reddit but wanted to ask a wider circle for help.
Here's a repository with code that you can run for a minimal test case: https://github.com/cideM/co_log_issue
If you run stack build you'll get:
• Could not deduce (HasLog
(AppEnv App) Message (Scotty.ActionT TL.Text m))
and I don't know how to write this instance.
I'm trying to compare co-log and Katip. I have a Scotty route handler (more precisely it's a wrapper for a handler) and inside of that handler I want to modify the log action in my app environment. The use case here would be to add to the context of the logger so that all subsequent log actions are automatically prepended with a string, or something like that.
Here's the relevant part of the handler:
withSession ::
( WithLog (AppEnv App) Message m,
MonadIO m
) =>
SQLite.Connection ->
(Session -> Scotty.ActionT TL.Text m ()) ->
Scotty.ActionT TL.Text m () ->
Scotty.ActionT TL.Text m ()
withSession dbConn handler defaultAction =
withLog (cmap (\(msg :: Message) -> msg {msgText = "foo"})) $ do
log I "Hi"
sessionCookie <- Scotty.getCookie "lions-session"
...
The withLog function causes an error though:
• Occurs check: cannot construct the infinite type:
m ~ Scotty.ActionT TL.Text m
Expected type: Scotty.ActionT TL.Text m ()
Actual type: Scotty.ActionT TL.Text (Scotty.ActionT TL.Text m) ()
which makes sense, since everything in the do block after withLog is Scotty.ActionT TL.Text m() and I can't lift that in the same scope. I had a similar issue with katip.
I can't derive the instance due to a GHC bug which gives me:
The exact Name ‘f’ is not in scope
Probable cause: you used a unique Template Haskell name (NameU),
perhaps via newName, but did not bind it
If that's it, then -ddump-splices might be useful
even without that bug I'm not sure if it can be derived though. I tried to just work with the dumped derived instances (even if the resulting code didn't compile) but I couldn't make it work in the end:
deriving instance HasLog (AppEnv App) Message (Scotty.ActionT TL.Text App)
gives me
instance HasLog (AppEnv App) Message (Scotty.ActionT TL.Text App) where
getLogAction
= coerce
@(AppEnv App -> LogAction (ExceptT (Scotty.ActionError TL.Text) (ReaderT Scotty.ActionEnv (StateT Scotty.ScottyResponse App))) Message)
@(AppEnv App -> LogAction (Scotty.ActionT TL.Text App) Message)
(getLogAction
@(AppEnv App) @Message
@(ExceptT (Scotty.ActionError TL.Text) (ReaderT Scotty.ActionEnv (StateT Scotty.ScottyResponse App)))) ::
AppEnv App -> LogAction (Scotty.ActionT TL.Text App.App) Message
which is missing
No instance for (HasLog
(AppEnv App)
Message
(ExceptT
(Scotty.ActionError TL.Text)
(ReaderT Scotty.ActionEnv (StateT Scotty.ScottyResponse App))))
and that I can't derive
deriving instance HasLog (AppEnv App) Message (ExceptT (Scotty.ActionError TL.Text) (ReaderT Scotty.ActionEnv (StateT Scotty.ScottyResponse App)))
Can't make a derived instance of
‘HasLog
(AppEnv App)
Message
(ExceptT
(Scotty.ActionError TL.Text)
(ReaderT Scotty.ActionEnv (StateT Scotty.ScottyResponse App)))’
(even with cunning GeneralizedNewtypeDeriving):
cannot eta-reduce the representation type enough
I'm out of ideas.
What you're trying to do may be impossible, at least with the current assumptions, but I would be happy to be proven wrong.
Lets start by saying that this error:
Could not deduce (HasLog (AppEnv App) Message (ActionT e m))
should give us pause because it says we are operating in ActionT e App but only have LogAction App Message. LogAction m msg is a wrapper around msg -> m (), so in order to write getLogAction and setLogAction for this instance we require an iso:
get :: (msg -> m ()) -> (msg -> ActionT e m ()) -- fmap lift
set :: (msg -> ActionT e m ()) -> (msg -> m ()) -- ?
From Colog.Monad:
type WithLog env msg m = (MonadReader env m, HasLog env msg m, HasCallStack)
withLog :: WithLog env msg m => (LogAction m msg -> LogAction m msg) -> m a -> m a
which tightly couples m and env where m is the monad we operate in. You have:
newtype App a = App {unApp :: AppEnv App -> IO a}
deriving (MonadReader (AppEnv App)) via ReaderT (AppEnv App) IO
which tightly couples App and AppEnv App. So far so good. In scotty we have ActionT e m which implements:
(MonadReader r m, ScottyError e) => MonadReader r (ActionT e m)
that basically lifts operations in m. ActionT is sort of pretending it has an env while really delegating everything to m. But uh oh, that is not quite compatible with the two observations above and this is how the troubling error arises. We would like to have an env (and LogAction) specifically for ActionT but only have it for the base monad and cannot "upgrade" it because it's baked into App.
instance (Monad m) => HasLog (AppEnv m) Message (ActionT e m) where
getLogAction = liftLogAction . logAction
setLogAction newact env = _ -- ?
setLogAction is pure and we need to construct msg -> m () having only msg -> ActionT e m (). I'm pretty sure this is not possible :(
In the spirit of if it's stupid but works...
data AppEnv = AppEnv
{ appLogAction :: LogAction App Message
, actLogAction :: LogAction (ActionT TL.Text App) Message
}
instance HasLog AppEnv Message App where
getLogAction = appLogAction
setLogAction newact env = env { appLogAction = newact }
instance HasLog AppEnv Message (ActionT TL.Text App) where
getLogAction = actLogAction
setLogAction newact env = env { actLogAction = newact }
Did not test.
Surely not this:
instance (Monad m) => HasLog (AppEnv m) Message (ActionT TL.Text m) where
getLogAction = liftLogAction . logAction
setLogAction newact = id -- who needs the co in colog anyway?
veryUnsafeWithLog
:: ( MonadTrans t
, MonadBaseControl b (t b)
, WithLog env msg b
, MonadReader env (t b))
=> (LogAction (t b) msg -> LogAction (t b) msg) -> (t b) a -> (t b) a
veryUnsafeWithLog f act = do
LogAction newlog <- asks (f . liftLogAction . getLogAction)
x <- liftBaseWith $ \rib -> do
pure $ LogAction $ \msg -> void $ rib (newlog msg) -- discards state!
local (setLogAction x) act
allegedlySafeUselessWithLog
:: ( StM (t b) a ~ StM b a -- not satisfied for ActionT
, MonadTrans t
, MonadBaseControl b (t b)
, WithLog env msg b
, MonadReader env (t b))
=> (LogAction (t b) msg -> LogAction (t b) msg) -> (t b) a -> (t b) a
allegedlySafeUselessWithLog = veryUnsafeWithLog