如何使 `co-log` 的 `withLog` 与 `Scotty` 一起工作？

Question

我已经在 Reddit 上询问过，但想向更广泛的圈子寻求帮助。

这是一个存储库，其中包含您可以运行用于最小测试用例的代码：https://github.com/cideM/co_log_issue

如果你运行 stack build 你会得到：

    • Could not deduce (HasLog
                          (AppEnv App) Message (Scotty.ActionT TL.Text m))

我不知道怎么写这个实例。

我正在尝试比较 co-log 和 Katip。我有一个 Scotty 路由处理程序（更准确地说，它是处理程序的包装器），在该处理程序内部，我想修改我的应用程序环境中的日志操作。这里的用例是添加到记录器的上下文中，以便所有后续的日志操作都自动添加一个字符串或类似的前缀。

这是处理程序的相关部分：

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"
    ...

withLog 函数会导致错误：

• 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) ()

这是有道理的，因为 withLog 之后 do 块中的所有内容都是 Scotty.ActionT TL.Text m()，我无法在同一范围内提升它。我有一个类似的 issue with katip.

由于 GHC 错误，我无法派生实例：

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

即使没有那个错误，我也不确定它是否可以导出。我试图只处理转储的派生实例（即使生成的代码没有编译）但我最终无法让它工作：

deriving instance HasLog (AppEnv App) Message (Scotty.ActionT TL.Text App)

给我

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

哪个不见了

No instance for (HasLog
                     (AppEnv App)
                     Message
                     (ExceptT
                        (Scotty.ActionError TL.Text)
                        (ReaderT Scotty.ActionEnv (StateT Scotty.ScottyResponse App))))

而且我无法推导

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

我没主意了。

Answer 1

你想做的事情可能是不可能的，至少在目前的假设下是这样，但我很乐意被证明是错误的。

简介

让我们先说这个错误：

Could not deduce (HasLog (AppEnv App) Message (ActionT e m))

应该让我们暂停一下，因为它说我们在 ActionT e App 运营，但只有 LogAction App Message。 LogAction m msg 是 msg -> m () 的包装器，所以为了写 getLogAction 和 setLogAction 我们需要一个 iso:

get :: (msg -> m ()) -> (msg -> ActionT e m ()) -- fmap lift
set :: (msg -> ActionT e m ()) -> (msg -> m ()) -- ?

我们是怎么陷入这种困境的？

来自 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

它与 m 和 env 紧密耦合，其中 m 是我们操作的 monad。你有：

newtype App a = App {unApp :: AppEnv App -> IO a}
  deriving (MonadReader (AppEnv App)) via ReaderT (AppEnv App) IO

紧耦合 App 和 AppEnv App。到目前为止，一切都很好。在 scotty 中，我们有 ActionT e m 实现：

(MonadReader r m, ScottyError e) => MonadReader r (ActionT e m)

这基本上提升了 m 中的操作。 ActionT 有点假装它有一个 env，而实际上将所有事情委托给 m。但是，哦，这与上面的两个观察结果不太相符，这就是令人不安的错误出现的原因。我们希望有一个专门用于 ActionT 的 env（和 LogAction），但它只用于基本 monad 并且不能“升级”它，因为它已融入 App.

我们能做什么？

instance (Monad m) => HasLog (AppEnv m) Message (ActionT e m) where
  getLogAction = liftLogAction . logAction
  setLogAction newact env = _ -- ?

setLogAction是纯的，我们需要构造只有msg -> ActionT e m ()的msg -> m ()。我很确定这是不可能的:(

我们还能做什么？

本着如果它很愚蠢但有效的精神...

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 }

没有测试。

我们还能做什么？

肯定不是这个:

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

如何使 `co-log` 的 `withLog` 与 `Scotty` 一起工作？

How to make `co-log`'s `withLog` work with `Scotty`?

haskell

deriving

scotty

简介

我们是怎么陷入这种困境的？

我们能做什么？

我们还能做什么？

我们还能做什么？