时间戳

首页 > 解决方案 > 如何使`co-log`的`withLog`与`Scotty`一起工作？

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

问题描述

我已经在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) ()

这是有道理的，因为do之后块中的所有内容withLog都是Scotty.ActionT TL.Text m()并且我无法在同一范围内提升它。我有一个类似的问题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

我没主意了。

标签： haskellderivingscotty

解决方案

至少在目前的假设下，您尝试做的事情可能是不可能的，但我很高兴被证明是错误的。

介绍

让我们首先说这个错误：

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. 但是，哦，这与上面的两个观察结果不太兼容，这就是令人不安的错误出现的原因。我们希望有一个env（和 LogAction）专门用于ActionT但仅用于基本 monad 并且不能“升级”它，因为它已融入 App。

我们能做什么？

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

setLogActionmsg -> m ()是纯的，我们只需要构造msg -> ActionT e 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

推荐阅读