haskell - 这个 YesodAuth 实例有什么问题？

Question

我刚刚从当前的 yesod 脚手架迁移到最新的 yesod-1.6.0、yesod-auth-1.6.2。

instance YesodAuth App where
    type AuthId App = UserId

    -- ....

    authenticate creds = runDB $ do
        x <- getBy $ UniqueUser $ credsIdent creds
        case x of
            Just (Entity uid _) -> return $ Authenticated uid
            Nothing -> return $ UserError InvalidUsernamePass

在迁移之前，此代码运行良好。但出现以下错误后。

.../src/Foundation.hs:212:26: error:
    • Could not deduce: m ~ HandlerFor site8
      from the context: (MonadHandler m, HandlerSite m ~ App)
        bound by the type signature for:
                   authenticate :: forall (m :: * -> *).
                                   (MonadHandler m, HandlerSite m ~ App) =>
                                   Creds App -> m (AuthenticationResult App)
        at src/Foundation.hs:212:5-16
      ‘m’ is a rigid type variable bound by
        the type signature for:
          authenticate :: forall (m :: * -> *).
                          (MonadHandler m, HandlerSite m ~ App) =>
                          Creds App -> m (AuthenticationResult App)
        at src/Foundation.hs:212:5-16
      Expected type: m (AuthenticationResult App)
        Actual type: HandlerFor site8 (AuthenticationResult App)
    • In the expression:
        runDB
          $ do x <- getBy $ UniqueUser $ credsIdent creds
               case x of
                 Just (Entity uid _) -> return $ Authenticated uid
                 Nothing -> return $ UserError InvalidUsernamePass
      In an equation for ‘authenticate’:
          authenticate creds
            = runDB
                $ do x <- getBy $ UniqueUser $ credsIdent creds
                     case x of
                       Just (Entity uid _) -> return $ Authenticated uid
                       Nothing -> return $ UserError InvalidUsernamePass
      In the instance declaration for ‘YesodAuth App’
    • Relevant bindings include
        authenticate :: Creds App -> m (AuthenticationResult App)
          (bound at src/Foundation.hs:212:5)
    |
212 |     authenticate creds = runDB $ do
    |                          ^^^^^^^^^^...

我不知道为什么它无法通过类型检查。 runDB 在与 yesod-auth 无关的地方运行良好。

编辑:我提取了似乎相关的代码。

class (MonadResource m, MonadLogger m) => MonadHandler m where
    type HandlerSite m
    type SubHandlerSite m
    liftHandler :: HandlerFor (HandlerSite m) a -> m a
    liftSubHandler :: SubHandlerFor (SubHandlerSite m) (HandlerSite m) a -> m a

instance MonadHandler (HandlerFor site) where
    type HandlerSite (HandlerFor site) = site
    type SubHandlerSite (HandlerFor site) = site
    liftHandler = id
    {-# INLINE liftHandler #-}
    liftSubHandler (SubHandlerFor f) = HandlerFor f
    {-# INLINE liftSubHandler #-}

newtype HandlerFor site a = HandlerFor
    { unHandlerFor :: HandlerData site site -> IO a
    }
    deriving Functor

instance MonadHandler (HandlerFor site) where
    type HandlerSite (HandlerFor site) = site
    type SubHandlerSite (HandlerFor site) = site
    liftHandler = id
    {-# INLINE liftHandler #-}
    liftSubHandler (SubHandlerFor f) = HandlerFor f
    {-# INLINE liftSubHandler #-}

有了上面的定义，我想知道下面的定义无法通过类型检查的原因。

problem :: (MonadHandler m, HandlerSite m ~ App) => m ()
problem = (undefined :: HandlerFor App ())

    • Could not deduce: m ~ HandlerFor App
      from the context: (MonadHandler m, HandlerSite m ~ App)
        bound by the type signature for:
                   problem :: forall (m :: * -> *).
                          (MonadHandler m, HandlerSite m ~ App) =>
                          m ()
        at /intero/intero1940cny-TEMP.hs:210:1-52
      ‘m’ is a rigid type variable bound by
        the type signature for:
          problem :: forall (m :: * -> *).
                 (MonadHandler m, HandlerSite m ~ App) =>
                 m ()
        at /intero/intero1940cny-TEMP.hs:210:1-52
      Expected type: m ()
        Actual type: HandlerFor App ()
    • In the expression: (undefined :: HandlerFor App ())
      In an equation for ‘problem’: problem = (undefined :: HandlerFor App ())
    • Relevant bindings include
        problem :: m ()
          (bound at /intero/intero1940cny-TEMP.hs:211:1)

Answer 1

将 liftHandler . 放在每个 runDB 之前。