Hi, I’m new to Haskell. I’m having trouble writing a stateful, fallible function. TL;DR: I have a function f with a return type State S (Either E R), in which I have to call a function g with return type Either E R. I want to “return early” from f when g returns Left _. How do I do that?
Here’s a more detailed breakdown of my problem. I’m trying to write a function that takes an arithmetic expression (represented as a tree) and evaluates it, potentially failing. This function should also update a state, which is a list of binary operations, by appending the operations in the arithmetic expression to the state in the order they are processed. Here are some definitions:
{- Binary operations. -}
data Op = Add | Div deriving (Show)
{- Perform a binary operation. -}
runOp :: Op -> Int -> Int -> Either () Int
runOp Add x y = Right $ x + y
runOp Div x y = if y == 0 then Left () else Right $ x `div` y
{- Arithmetic expressions. -}
data Tree = Leaf Int | Node Op [Tree] deriving (Show)
Here’s the code for eval. A tree with more than 2 branches should be evaluated from left-to-right, so e.g. when eval is called on the tree Add 2 3 (Div 6 3), this should evaluate to 2 + 3 + (6 / 3). As you can see I have no idea how to write this function.
{- Evaluate an arithmetic expression, and return the (possibly)
- failed result. Also update the state by cons'ing operators
- the tree in the order they were processed in. -}
eval :: Tree -> State [Op] (Either () Int)
eval (Leaf x) = do
return $ Right x
eval (Node op xs) = do
state <- get
put $ op:state
case uncons xs of
Nothing -> return $ Left ()
Just (hd, tl) -> do
{- No idea how to write this case. Maybe something like: -}
foldM (\t -> eval t >>= runOp op) (Right $ fmap eval hd) (mapM eval tl)
{- But this doesn't compile! -}
eval :: Tree -> State [Op] (Either () Int)
eval (Leaf x) = do
return $ Right x
eval (Node op xs) = do
state <- get
put $ op:state
case uncons xs of
Nothing -> return $ Left ()
Just (hd, tl) -> do
hd' <- eval hd
let
folder :: Either () Int -> Tree -> State [Op] (Either () Int)
folder x t = do
y <- eval t
return $
do
x' <- x
y' <- y
runOp op x' y'
foldM folder hd' tl
But this doesn’t short-circuit the state update on failure. So the output for the following code:
main :: IO ()
main = do
let t = Node Add [Node Div [Leaf 64, Leaf 8, Leaf 0],
Node Div [Leaf 72, Leaf 9, Leaf 3]]
putStrLn $ show $ runState (eval t) []
is (Left (),[Div,Div,Add]), even though it should be (Left (),[Div,Add]): the second Div node should be skipped because the first Div node evaluates to a failure.
I’m sorry that I don’t have time to re-solve the problem myself, but two on-the-run comments that might help you get unstuck:
It seems like you are adding the state to your log as soon as you inspect a Node, but you might want to do that after you’ve decided that you can actually apply the operation to the evaluated subtrees?
You can always write more functions and do case matching by hand. Instead of trying to force things into foldM-shaped holes or whatever, try writing a separate function that performs the recursion and evaluation of an Op applied to a [Tree]. You’ll probably end up with some mutually-recursive functions, which you can then massage into a more elegant presentation if that ends up being clearer.
I think it’s because eval t is called every time folder is applied by foldM, so all subtrees will be evaluated anyway. You can however check the current result (whether x is a Left) before calling eval t to implement short-circuiting.
Thanks to both @jackdk@lutz! I think the biggest problem was that I wasn’t stacking effects correctly. Here’s the new code:
eval :: Tree -> ExceptT () (State [Op]) Int
eval (Leaf x) =
liftEither $ Right x
eval (Node op ts) = do
lift (do list <- get
put $ op:list)
case uncons ts of
Nothing -> throwError ()
Just (hd, tl) ->
do
hd' <- eval hd
let
folder :: Int -> Tree -> ExceptT () (State [Op]) Int
folder x t = do
y <- eval t
ExceptT . return $ runOp op x y
foldM folder hd' tl
and it works:
main :: IO ()
main = do
let t = Node Add [Node Div [Leaf 64, Leaf 8, Leaf 0],
Node Div [Leaf 72, Leaf 9, Leaf 3]]
let t' = Leaf 8
putStrLn $ show $ runState (runExceptT $ eval t) [] -- (Left (),[Div,Add])
Thanks, that makes sense! I just tried the following coded, and it works:
import Data.List
import Control.Monad
import Control.Monad.State
import Control.Monad.Except
import Control.Monad.Trans.Maybe
{- Binary operators. -}
data Op = Add | Div deriving (Show)
{- Perform a binary operation. -}
runOp :: Op -> Int -> Int -> Maybe Int
runOp Add x y = Just $ x + y
runOp Div x y = if y == 0 then Nothing else Just $ x `div` y
{- Arithmetic expressions. -}
data Tree = Leaf Int | Node Op [Tree] deriving (Show)
{- Evaluate an arithmetic expression, and return the (possibly)
- failed result. Also update the state by cons'ing operators
- the tree in the order they were processed in. -}
eval :: Tree -> MaybeT (State [Op]) Int
eval (Leaf x) =
hoistMaybe $ Just x
eval (Node op ts) = do
lift (do list <- get
put $ op:list)
case uncons ts of
Nothing -> hoistMaybe Nothing
Just (hd, tl) ->
do
hd' <- eval hd
let
folder :: Int -> Tree -> MaybeT (State [Op]) Int
folder x t = do
y <- eval t
MaybeT . return $ runOp op x y
foldM folder hd' tl
main :: IO ()
main = do
let t = Node Add [Node Div [Leaf 64, Leaf 8, Leaf 0],
Node Div [Leaf 72, Leaf 9, Leaf 3]]
let t' = Leaf 8
putStrLn $ show $ runState (runMaybeT $ eval t) []
From what I can see you do not read the state at all, which means you could use WriterT instead. If so I’d generally recommend the CPS version, and/or using a difflist.