组合StateT和ExceptT单片变压器

Question

我有以下小程序:

{-# LANGUAGE FlexibleContexts #-} 
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad.State.Strict
import Control.Monad.Except
import qualified Data.Text as T
import qualified Data.Text.Read as T
import qualified Data.Text.IO as T
main :: IO ()
main = do
_ <- execStateT loop 0
return ()
loop :: StateT Int IO ()
loop = do
liftIO $ putStrLn "Enter a Number"
line <- liftIO $ T.getLine
let ts = T.words line
checkFoo ts
loop
checkFoo ::  (MonadState Int m, MonadIO m) => [T.Text] -> m()
checkFoo strs = liftIO (runExceptT
(check1 strs >>= checkNum >>= doFoo)) >>= result
where
doFoo n = liftIO $ putStrLn $ "Your number: " <> show n
check1 :: [a] -> ExceptT T.Text IO a
check1 ts =
if length ts == 1
then return $ head ts
else throwError "1 number please"
checkNum :: T.Text ->  ExceptT T.Text IO Int
checkNum t = case T.decimal t of
Left _ -> throwError "input isn't a number"
Right (d, _) -> return $ d
result :: (MonadState Int m, MonadIO m) => Either T.Text () -> m ()
result (Left e) = liftIO $ T.putStrLn e
result (Right _) = return ()

现在我想在函数checkFoo的子函数doFoo中访问状态单子的值。如:

doFoo n =
old <- lift get
let s = old + n
liftIO $ putStrLn $ "The sum of your numbers: " <> show s
lift $ put s
pure ()

我得到以下错误:

Main.hs:26:35: error:
• Could not deduce (MonadState a0 IO) arising from a use of ‘doFoo’
from the context: (MonadState Int m, MonadIO m)
bound by the type signature for:
checkFoo :: forall (m :: * -> *).
(MonadState Int m, MonadIO m) =>
[T.Text] -> m ()
at Main.hs:24:1-60
The type variable ‘a0’ is ambiguous
• In the second argument of ‘(>>=)’, namely ‘doFoo’
In the first argument of ‘runExceptT’, namely
‘(check1 strs >>= checkNum >>= doFoo)’
In the first argument of ‘liftIO’, namely
‘(runExceptT (check1 strs >>= checkNum >>= doFoo))’
|
26 |     (check1 strs >>= checkNum >>= doFoo)) >>= result

为什么不工作?有什么必要的改变使其工作?

Answer 1

问题是当你写表达式:

check1 strs >>= checkNum >>= doFoo

这要求这些操作中的每一个都是同一个单子的操作。前两个的单子是:

ExceptT T.Text IO

表示doFoo的类型签名:

doFoo :: Int -> ExceptT T.Text IO ()

但随后您尝试在修订的doFoo定义中解除put和get操作。错误消息告诉您这些操作不被无状态单子ExceptT T.Text IO所支持。

最不具破坏性的修复可能是修改check1和checkNum的类型签名，将它们泛化到任何MonadIO m上:

check1 :: (MonadIO m) => [a] -> ExceptT T.Text m a
checkNum :: (MonadIO m) => T.Text ->  ExceptT T.Text m Int

则checkFoo可以写成如下，其中runExcept前面没有liftIO。我还在get和put之前删除了lift。它们不是必需的，因为get和put会自动将自己提升到最近的包含StateT的变压器。

checkFoo ::  (MonadState Int m, MonadIO m) => [T.Text] -> m ()
checkFoo strs = runExceptT (check1 strs >>= checkNum >>= doFoo) >>= result
where
-- doFoo :: (MonadState Int m, MonadIO m) => Int -> m ()
doFoo n = do
old <- get
let s = old + n
liftIO $ putStrLn $ "The sum of your numbers: " <> show s
put s
pure ()

此版本在monadExceptT T.Text m中运行check1 strs >>= checkNum >>= doFoo管道，其中m与checkFoo类型签名中出现的monad(MonadState Int m, MonadIO m) => m相同。对于同一个单子m，结果再次传递给result :: (MonadIO m) => Either T.Text () -> m ()。在您的代码中，checkFoo是在m ~ StateT Int IO处调用的，它满足MonadState Int m和MonadIO m的约束，所以类型检查器一切正常。

修改后的完整示例:

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad.State.Strict
import Control.Monad.Except
import qualified Data.Text as T
import qualified Data.Text.Read as T
import qualified Data.Text.IO as T
main :: IO ()
main = do
_ <- execStateT loop 0
return ()
loop :: StateT Int IO ()
loop = do
liftIO $ putStrLn "Enter a Number"
line <- liftIO $ T.getLine
let ts = T.words line
checkFoo ts
loop
checkFoo ::  (MonadState Int m, MonadIO m) => [T.Text] -> m ()
checkFoo strs = runExceptT (check1 strs >>= checkNum >>= doFoo) >>= result
where
-- doFoo :: (MonadState Int m, MonadIO m) => Int -> m ()
doFoo n = do
old <- get
let s = old + n
liftIO $ putStrLn $ "The sum of your numbers: " <> show s
put s
pure ()
check1 :: (MonadIO m) => [a] -> ExceptT T.Text m a
check1 ts =
if length ts == 1
then return $ head ts
else throwError "1 number please"
checkNum :: (MonadIO m) => T.Text ->  ExceptT T.Text m Int
checkNum t = case T.decimal t of
Left _ -> throwError "input isn't a number"
Right (d, _) -> return $ d
result :: (MonadState Int m, MonadIO m) => Either T.Text () -> m ()
result (Left e) = liftIO $ T.putStrLn e
result (Right _) = return ()

Answer 2

这里的问题是check1和checkNum的类型注释。他们没有提到State Int单子。它们应该是:

check1 :: [a] -> ExceptT T.Text (StateT Int IO) a
checkNum :: T.Text ->  ExceptT T.Text (StateT Int IO) Int

那么checkFoo的代码应该是:

checkFoo strs = (runExceptT
(check1 strs >>= checkNum >>= doFoo)) >>= result