awful lot of error handling

app/Main.hs

@@ -4,10 +4,18 @@ import Lox.Interpreter
 import System.IO
 
 run :: String -> IO ()
-run source = print result
+run source = do 
-    where result = eval expr
+    let tokensMaybe = scanTokensFromSource source
-          expr = parse tokens
+    case tokensMaybe of
-          tokens = scanTokensFromSource source
+        Left UnexpectedCharacterError -> putStrLn "Unexpected character"
+        Right tokens -> do
+            let exprMaybe = parse tokens
+            case exprMaybe of
+                Left ExpectedExpressionError -> putStrLn "Expected expression"
+                Left MismatchedParenthesesError -> putStrLn "Mismatched parentheses"
+                Right expr -> do
+                    result <- eval expr
+                    print result
 
 main :: IO ()
 main = putStr ">> " >> hFlush stdout >> getLine >>= run 

src/Lox/Interpreter.hs

@@ -8,8 +8,8 @@ import Control.Monad.State
 
 data InterpreterState = InterpreterState
 
-eval :: Expr -> Object
+eval :: Expr -> IO Object
-eval expr = evalState (interpret expr) InterpreterState
+eval expr = return $ evalState (interpret expr) InterpreterState
 
 interpret :: Expr -> State InterpreterState Object
 interpret (Literal value) = return value

src/Lox/Parser.hs

@@ -1,4 +1,5 @@
 module Lox.Parser (
+    ParserError (..),
     parse
 ) where
 
@@ -9,6 +10,8 @@ import Lox.Expr
 
 data ParserState = ParserState {tokens :: [Token]}
 
+data ParserError = MismatchedParenthesesError | ExpectedExpressionError
+
 -- expression     → equality ;
 -- equality       → comparison ( ( "!=" | "==" ) comparison )* ;
 -- comparison     → term ( ( ">" | ">=" | "<" | "<=" ) term )* ;
@@ -19,63 +22,82 @@ data ParserState = ParserState {tokens :: [Token]}
 -- primary        → NUMBER | STRING | "true" | "false" | "nil"
 --                | "(" expression ")" ;
 
-parse :: [Token] -> Expr
+parse :: [Token] -> Either ParserError Expr
 parse tokens = evalState expression (ParserState {tokens=tokens})
 
-expression :: State ParserState Expr
+expression :: State ParserState (Either ParserError Expr)
 expression = equality
 
-equality :: State ParserState Expr
+equality :: State ParserState (Either ParserError Expr)
 equality = do
-    expr <- comparison
+    exprMaybe <- comparison
-    mergeExpressionMaybe expr <$> matchTail [BANG_EQUAL, EQUAL_EQUAL] comparison
+    case exprMaybe of
+        Left err -> return $ Left err
+        Right expr -> fmap (mergeExpressionMaybe expr) <$> matchTail [BANG_EQUAL, EQUAL_EQUAL] comparison
 
-comparison :: State ParserState Expr
+comparison :: State ParserState (Either ParserError Expr)
 comparison = do
-    expr <- term
+    exprMaybe <- term 
-    mergeExpressionMaybe expr <$> matchTail [GREATER, GREATER_EQUAL, LESS, LESS_EQUAL] term
+    case exprMaybe of
+        Left err -> return $ Left err
+        Right expr -> fmap (mergeExpressionMaybe expr) <$> matchTail [GREATER, GREATER_EQUAL, LESS, LESS_EQUAL] term
 
-term :: State ParserState Expr
+term :: State ParserState (Either ParserError Expr)
 term = do
-    expr <- factor
+    exprMaybe <- factor
-    mergeExpressionMaybe expr <$> matchTail [MINUS, PLUS] factor
+    case exprMaybe of
+        Left err -> return $ Left err
+        Right expr -> fmap (mergeExpressionMaybe expr) <$> matchTail [MINUS, PLUS] factor
 
-factor :: State ParserState Expr
+factor :: State ParserState (Either ParserError Expr)
 factor = do
-    expr <- unary
+    exprMaybe <- unary
-    mergeExpressionMaybe expr <$> matchTail [SLASH, STAR] unary
+    case exprMaybe of
+        Left err -> return $ Left err
+        Right expr -> fmap (mergeExpressionMaybe expr) <$> matchTail [SLASH, STAR] unary
 
-unary :: State ParserState Expr
+unary :: State ParserState (Either ParserError Expr)
 unary = do
     maybeOperator <- matchToken [BANG, MINUS]
     case maybeOperator of
         Nothing -> primary
-        Just op -> Unary op <$> unary
+        Just op -> do
+            exprMaybe <- unary
+            case exprMaybe of
+                Left err -> return $ Left err
+                Right expr -> return $ Right $ Unary op expr
 
-primary :: State ParserState Expr
+primary :: State ParserState (Either ParserError Expr)
 primary = do
     token <- advance
     case tokenType token of
-        FALSE -> return $ Literal $ BoolObject False
+        FALSE -> return $ Right $ Literal $ BoolObject False
-        TRUE -> return $ Literal $ BoolObject True
+        TRUE -> return $ Right $ Literal $ BoolObject True
-        NIL -> return $ Literal NullObject
+        NIL -> return $ Right $ Literal NullObject
-        NUMBER -> return $ Literal $ tokenObject token
+        NUMBER -> return $ Right $ Literal $ tokenObject token
-        STRING -> return $ Literal $ tokenObject token
+        STRING -> return $ Right $ Literal $ tokenObject token
         LEFT_PAREN -> do
-            expr <- expression
+            exprMaybe <- expression
-            consume RIGHT_PAREN "Expected '(' after ')'"
+            case exprMaybe of
-            return $ Grouping expr
+                Left err -> return $ Left err
-        _ -> error "Expected expression"
+                Right expr -> do 
+                    consume RIGHT_PAREN MismatchedParenthesesError
+                    return $ Right $ Grouping expr
+        _ -> return $ Left ExpectedExpressionError
 
-matchTail :: [TokenType] -> State ParserState Expr -> State ParserState (Maybe (Token, Expr))
+matchTail :: [TokenType] -> State ParserState (Either ParserError Expr) -> State ParserState (Either ParserError (Maybe (Token, Expr)))
 matchTail tokenTypes f = do
     maybeOperator <- matchToken tokenTypes
     case maybeOperator of
-        Nothing -> return Nothing
+        Nothing -> return $ Right Nothing
         Just op -> do
-            expr <- comparison
+            exprMaybe <- comparison
-            rest <- matchTail tokenTypes f
+            restMaybe <- matchTail tokenTypes f
-            return $ Just (op, mergeExpressionMaybe expr rest)
+            case (exprMaybe, restMaybe) of
+                (Left err, _) -> return $ Left err
+                (_, Left err) -> return $ Left err
+                (Right expr, Right rest) -> return $ Right $ Just (op, mergeExpressionMaybe expr rest)
+
 mergeExpressionMaybe :: Expr -> Maybe (Token, Expr) -> Expr
 mergeExpressionMaybe expr Nothing = expr
 mergeExpressionMaybe left (Just (op, right)) = Binary left op right
@@ -91,10 +113,10 @@ check t = do
     atEnd <- isAtEnd
     if atEnd then return False else (== t) . tokenType <$> peek
 
-consume :: TokenType -> String -> State ParserState Token
+consume :: TokenType -> ParserError -> State ParserState (Either ParserError Token)
-consume t msg = do
+consume t err = do
     isOk <- check t
-    if isOk then advance else error msg
+    if isOk then Right <$> advance else return $ Left err
 
 advance :: State ParserState Token
 advance = state (\s@ParserState {tokens=(t:ts)} -> (t, s {tokens = ts}))

src/Lox/Scanner.hs

@@ -2,6 +2,7 @@ module Lox.Scanner (
     TokenType (..),
     Object (..),
     Token (..),
+    ScannerError (..),
     scanTokensFromSource
 ) where
 
@@ -44,21 +45,24 @@ data Token = Token {
 
 data ScannerState = ScannerState {source :: String, current :: String, lineNumber :: Int}
 
+data ScannerError = UnexpectedCharacterError
+
 emptyScannerState :: String -> ScannerState
 emptyScannerState source = 
     ScannerState {source=source, current="", lineNumber=1}
 
-scanTokensFromSource :: String -> [Token]
+scanTokensFromSource :: String -> Either ScannerError [Token]
 scanTokensFromSource source = evalState scanTokens (emptyScannerState source)
 
-scanTokens :: State ScannerState [Token]
+scanTokens :: State ScannerState (Either ScannerError [Token])
 scanTokens = do
     atEnd <- isAtEnd
-    if atEnd then return <$> addToken EOF else do
+    if atEnd then return . return <$> addToken EOF else do
         maybeToken <- scanToken
         case maybeToken of
-            Nothing -> scanTokens
+            Right Nothing -> scanTokens
-            Just t -> (t :) <$> scanTokens
+            Right (Just t) -> fmap (fmap (t :)) scanTokens
+            Left err -> return $ Left err
 
 isAtEnd :: State ScannerState Bool
 isAtEnd = gets scannerIsAtEnd
@@ -66,32 +70,34 @@ isAtEnd = gets scannerIsAtEnd
 scannerIsAtEnd :: ScannerState -> Bool
 scannerIsAtEnd ScannerState {source=source} = null source
 
-scanToken :: State ScannerState (Maybe Token)
+scanToken :: State ScannerState (Either ScannerError (Maybe Token))
 scanToken = do
     resetCurrent
     c <- advance
+    let ok = Right . Just
+    let nothing = Right Nothing
     case c of
-        '(' -> Just <$> addToken LEFT_PAREN
+        '(' -> ok <$> addToken LEFT_PAREN
-        ')' -> Just <$> addToken RIGHT_PAREN
+        ')' -> ok <$> addToken RIGHT_PAREN
-        '{' -> Just <$> addToken LEFT_BRACE
+        '{' -> ok <$> addToken LEFT_BRACE
-        '}' -> Just <$> addToken RIGHT_BRACE
+        '}' -> ok <$> addToken RIGHT_BRACE
-        ',' -> Just <$> addToken COMMA
+        ',' -> ok <$> addToken COMMA
-        '.' -> Just <$> addToken DOT
+        '.' -> ok <$> addToken DOT
-        '-' -> Just <$> addToken MINUS
+        '-' -> ok <$> addToken MINUS
-        '+' -> Just <$> addToken PLUS
+        '+' -> ok <$> addToken PLUS
-        ';' -> Just <$> addToken SEMICOLON
+        ';' -> ok <$> addToken SEMICOLON
-        '*' -> Just <$> addToken STAR
+        '*' -> ok <$> addToken STAR
-        '!' -> Just <$> ifM (match '=') (addToken BANG_EQUAL) (addToken BANG)
+        '!' -> ok <$> ifM (match '=') (addToken BANG_EQUAL) (addToken BANG)
-        '=' -> Just <$> ifM (match '=') (addToken EQUAL_EQUAL) (addToken EQUAL)
+        '=' -> ok <$> ifM (match '=') (addToken EQUAL_EQUAL) (addToken EQUAL)
-        '<' -> Just <$> ifM (match '=') (addToken LESS_EQUAL) (addToken LESS)
+        '<' -> ok <$> ifM (match '=') (addToken LESS_EQUAL) (addToken LESS)
-        '>' -> Just <$> ifM (match '=') (addToken GREATER_EQUAL) (addToken GREATER)
+        '>' -> ok <$> ifM (match '=') (addToken GREATER_EQUAL) (addToken GREATER)
-        '/' -> ifM (match '/') (advanceLine >> return Nothing) (Just <$> addToken SLASH)
+        '/' -> ifM (match '/') (advanceLine >> return nothing) (ok <$> addToken SLASH)
-        '"' -> Just <$> scanString
+        '"' -> ok <$> scanString
-        ' ' -> return Nothing
+        ' ' -> return nothing
-        '\r' -> return Nothing
+        '\r' -> return nothing
-        '\t' -> return Nothing
+        '\t' -> return nothing
-        '\n' -> return Nothing
+        '\n' -> return nothing
-        c -> if isDigit c then Just <$> scanNumber else if isAlpha c then Just <$> scanIdentifier else error "Unexpected character"
+        c -> if isDigit c then ok <$> scanNumber else if isAlpha c then ok <$> scanIdentifier else return $ Left UnexpectedCharacterError
 
 scanString :: State ScannerState Token
 scanString = do