haskellmonad-transformers

How can I refactor from error to an ExceptT?


I'm trying to refactor a piece of code to use a monad.

import Data.Map (Map)
import qualified Data.Map as Map
data Order = LeftToRight | RightToLeft
  deriving Show

ordering :: [String] -> Map String Order
ordering ls = Map.fromList pairs -- TODO: refactor to a monad
  where
  pairs = map parseOrder ls
  parseOrder s =
    case words s of
      [v, o] -> (v, o')
        where
          o' = case o of
            "l2r" -> LeftToRight
            "r2l" -> RightToLeft
            _     -> error $ "parse error in ordering:" ++ s
      _ -> error $ "parse error in ordering: " ++ s

I am trying to wrap the errors inside of an ExceptT, but I can't figure out how to yank out the code from the where clause into the right lifted format. Here is what I've tried:

import Data.Map (Map)
import qualified Data.Map as Map

import qualified System.Exit as Exit
import Control.Monad.Trans.Except
import Control.Monad.IO.Class (liftIO)

die :: String -> ExceptT () IO a
die msg = liftIO $ Exit.die ("\ESC[31mERROR: \ESC[0m" ++ msg)

data Order = LeftToRight | RightToLeft
  deriving Show

ordering' :: [String] -> ExceptT () IO (Map String Order)
ordering' ls = return (Map.fromList pairs)
  where
  pairs = map parseOrder ls
  parseOrder s =
    case words s of
      [v, o] -> (v, o')
        where
          o' = case o of
            "l2r" -> LeftToRight
            "r2l" -> RightToLeft
            _     -> die $ "parse error in ordering:" ++ s
      _ -> die $ "parse error in ordering: " ++ s


main :: IO ()
main = do
  let x = ["a l2r", "b r2l", "b c r2l"]
  p <- runExceptT $ ordering' x
  putStrLn (show p)

This gives the error

eg.hs:30:37: error: [GHC-83865]
    • Couldn't match type ‘ExceptT () IO Order’ with ‘Order’
      Expected: [(String, Order)]
        Actual: [(String, ExceptT () IO Order)]
    • In the first argument of ‘Map.fromList’, namely ‘pairs’
      In the first argument of ‘return’, namely ‘(Map.fromList pairs)’
      In the expression: return (Map.fromList pairs)
   |
30 | ordering' ls = return (Map.fromList pairs)
   |                                     ^^^^^

What is going on here? Isn't it the case that return wraps the Map String Order in the monad of the correct type, or do I need to lift something?

If possible, I would prefer to keep a similar structure of the where definitions, since this coding pattern is used many different places in the code base I'm working with.


Solution

  • This is essentially cafce25's solution. You need to "sequence" out both the list and the tuple. Since a tuple isn't Traversable, you have to write your own function.

    import Control.Monad (liftM2)
    
    ordering' :: [String] -> ExceptT () IO (Map String Order)
    ordering' ls = pairs >>= (\p -> return (Map.fromList p))
      where
      pairs = sequence $ map parseOrder ls
      parseOrder s = do
        case words s of
          [v, o] -> ts2 (return v, o')
            where
              ts2 = uncurry $ liftM2 (,)
              o' = case o of
                "l2r" -> return LeftToRight
                "r2l" -> return RightToLeft
                _     -> die $ "parse error in ordering:" ++ s
          _ -> die $ "parse error in ordering: " ++ s