Combining StateT and ExceptT monad tranformers-CodePudding

I have the following little working program:

{-# 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 ()

Now I would like to access the value of the State Monad in the subfunction doFoo of my function checkFoo. eg:

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

I get the following error:

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

Why is this not working? What are the necessary changes to make this working?

CodePudding user response：

The problem here are the type annotations for check1 and checkNum. They don't mention the State Int monad. They should be:

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

Then the code for checkFoo should be:

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

CodePudding user response：

The problem is that when you write the expression:

check1 strs >>= checkNum >>= doFoo

this requires that each of these operations is an action is the same monad. The monad for the first two is:

ExceptT T.Text IO

which implies a type signature for doFoo:

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

but then you try to lift put and get operations in your revised doFoo definition. The error message is telling you that these operations aren't supported by the stateless monad ExceptT T.Text IO.

The least disruptive fix is probably to modify the type signatures for check1 and checkNum to generalize them over any MonadIO m:

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

Then, checkFoo can be written as follows, without the liftIO before runExcept. I've also removed the lift before get and put. They aren't necessary, as get and put automatically lift themselves to the closest containing StateT transformer.

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

This version runs the pipeline check1 strs >>= checkNum >>= doFoo in the monad ExceptT T.Text m where m is the same monad (MonadState Int m, MonadIO m) => m that appears in checkFoo's type signature. The result is passed to result :: (MonadIO m) => Either T.Text () -> m () again for that same monad m. In your code, checkFoo is called at m ~ StateT Int IO, which satisfies the constraints MonadState Int m and MonadIO m, so all is well with the type checker.

The full revised example:

{-# 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 ()