Add more explicit error handling for mismatched groupings

demos/LevelOrderTraversal.tri

@@ -57,7 +57,12 @@ levelOrderToString = (\s : toLineString (levelOrderTraversal s))
 flatten = foldl (\acc x : lconcat acc x) ""
 flatLOT = (\s : lconcat (t 10 t) (flatten (levelOrderToString s)))
 
-exampleOne = flatLOT [("1") [("2") [("4") t t] t] [("3") [("5") t t] [("6") t t]]]
+exampleOne = flatLOT [("1")
-exampleTwo = flatLOT [("1") [("2") [("4") [("8") t t] [("9") t t]] [("6") [("10") t t] [("12") t t]]] [("3") [("5") [("11") t t] t] [("7") t t]]]
+                       [("2") [("4") t t] t]
+                       [("3") [("5") t t] [("6") t t]]]
 
-exampleOne
+exampleTwo = flatLOT [[("1")
+                       [("2") [("4") [("8") t t] [("9") t t]] [("6") [("10") t t] [("12") t t]]]
+                       [("3") [("5") [("11") t t] t] [("7") t t]]]
+
+exampleTwo

src/Parser.hs

@@ -12,7 +12,8 @@ import Text.Megaparsec.Error (ParseErrorBundle, errorBundlePretty)
 import qualified Data.Set as Set
 
 data PState = PState
-  { depth :: Int
+  { parenDepth  :: Int
+  , bracketDepth :: Int
   } deriving (Show)
 
 type ParserM = StateT PState (Parsec Void [LToken])
@@ -24,24 +25,37 @@ satisfyM f = do
   return token
 
 updateDepth :: LToken -> PState -> PState
-updateDepth LOpenParen  st = st { depth = depth st + 1 }
+updateDepth LOpenParen st = st { parenDepth = parenDepth st + 1 }
-updateDepth LCloseParen st = st { depth = max 0 (depth st - 1) }
+updateDepth LCloseParen st
-updateDepth _           st = st
+  | parenDepth st > 0 = st { parenDepth = parenDepth st - 1 }
+  | otherwise         = errorWithoutStackTrace "Unmatched closing parentheses"
+updateDepth LOpenBracket st = st { bracketDepth = bracketDepth st + 1 }
+updateDepth LCloseBracket st
+  | bracketDepth st > 0 = st { bracketDepth = bracketDepth st - 1 }
+  | otherwise           = errorWithoutStackTrace "Unmatched closing bracket"
+updateDepth _ st = st
 
 topLevelNewline :: ParserM ()
 topLevelNewline = do
   st <- get
-  if depth st == 0
+  if parenDepth st == 0 && bracketDepth st == 0
     then void (satisfyM (== LNewline))
-    else fail "Top-level exit in paren context"
+    else fail "Top-level exit in nested context (paren or bracket)"
 
 parseProgram :: [LToken] -> Either (ParseErrorBundle [LToken] Void) [TricuAST]
 parseProgram tokens =
-  runParser (evalStateT parseProgramM (PState 0)) "" tokens
+  runParser (evalStateT (parseProgramM <* finalizeDepth <* eof) (PState 0 0)) "" tokens
 
 parseSingleExpr :: [LToken] -> Either (ParseErrorBundle [LToken] Void) TricuAST
 parseSingleExpr tokens =
-  runParser (evalStateT (scnParserM *> parseExpressionM <* eofM) (PState 0)) "" tokens
+  runParser (evalStateT (scnParserM *> parseExpressionM <* finalizeDepth <* eof) (PState 0 0)) "" tokens
+
+finalizeDepth :: ParserM ()
+finalizeDepth = do
+  st <- get
+  case (parenDepth st, bracketDepth st) of
+    (0, 0) -> pure ()
+    (p, b) -> fail $ "Unmatched tokens: " ++ show (p, b)
 
 parseTricu :: String -> [TricuAST]
 parseTricu input =
@@ -49,7 +63,7 @@ parseTricu input =
     [] -> []
     toks ->
       case parseProgram toks of
-        Left err   -> error (handleParseError err)
+        Left err   -> errorWithoutStackTrace (handleParseError err)
         Right asts -> asts
 
 parseSingle :: String -> TricuAST
@@ -58,7 +72,7 @@ parseSingle input =
     [] -> SEmpty
     toks ->
       case parseSingleExpr toks of
-        Left err -> error (handleParseError err)
+        Left err -> errorWithoutStackTrace (handleParseError err)
         Right ast -> ast
 
 parseProgramM :: ParserM [TricuAST]
@@ -75,12 +89,13 @@ scnParserM :: ParserM ()
 scnParserM = skipMany $ do
   t  <- lookAhead anySingle
   st <- get
-  if | depth st > 0 && case t of
+  if | (parenDepth st > 0 || bracketDepth st > 0) && case t of
          LNewline -> True
          _        -> False -> void $ satisfyM $ \case
            LNewline -> True
            _        -> False
-     | otherwise -> fail "In paren context or no space token" <|> empty
+     | otherwise -> fail "In nested context or no space token" <|> empty
+
 
 eofM :: ParserM ()
 eofM = lift eof
@@ -214,7 +229,10 @@ parseLiteralM = choice
 parseListLiteralM :: ParserM TricuAST
 parseListLiteralM = do
   _        <- satisfyM (== LOpenBracket)
-  elements <- many parseListItemM
+  elements <- many $ do
+    scnParserM
+    parseListItemM
+  scnParserM
   _        <- satisfyM (== LCloseBracket)
   pure (SList elements)
 
@@ -268,24 +286,23 @@ parseStrLiteralM = do
 
 getIdentifier :: LToken -> String
 getIdentifier (LIdentifier name) = name
-getIdentifier _                  = error "Expected identifier"
+getIdentifier _                  = errorWithoutStackTrace "Expected identifier"
 
 handleParseError :: ParseErrorBundle [LToken] Void -> String
 handleParseError bundle =
-  let errors        = bundleErrors bundle
+  let errors = bundleErrors bundle
-      errorList     = Data.List.NonEmpty.toList errors
+      formattedErrors = map formatError (Data.List.NonEmpty.toList errors)
-      formattedErrs = map showError errorList
+  in unlines ("Parse error(s) encountered:" : formattedErrors)
-  in unlines ("Parse error(s) encountered:" : formattedErrs)
-
-showError :: ParseError [LToken] Void -> String
-showError (TrivialError offset (Just (Tokens tokenStream)) expected) =
-  "Parse error at offset " ++ show offset
-    ++ ": unexpected token " ++ show tokenStream
-    ++ ", expected one of " ++ show (Set.toList expected)
-showError (FancyError offset fancy) =
-  "Parse error at offset " ++ show offset ++ ":\n "
-    ++ unlines (map show (Set.toList fancy))
-showError (TrivialError offset Nothing expected) =
-  "Parse error at offset " ++ show offset
-    ++ ": expected one of " ++ show (Set.toList expected)
 
+formatError :: ParseError [LToken] Void -> String
+formatError (TrivialError offset unexpected expected) =
+  let unexpectedMsg = case unexpected of
+        Just x  -> "unexpected token " ++ show x
+        Nothing -> "unexpected end of input"
+      expectedMsg = if null expected
+        then ""
+        else "expected " ++ show (Set.toList expected)
+  in "Parse error at offset " ++ show offset ++ ": " ++ unexpectedMsg ++
+     if null expectedMsg then "" else " " ++ expectedMsg
+formatError (FancyError offset _) =
+  "Parse error at offset " ++ show offset ++ ": unexpected FancyError"