0.2.0

Includes better error handling, additional tests, parsing and lexing
fixes to match the desired behavior defined by the new tests, and a very
basic REPL implementation.

src/Parser.hs

@@ -1,10 +1,15 @@
 module Parser where
 
 import Lexer
-import Research
+import Research hiding (toList)
+
+import Control.Exception (throw)
+import Data.List.NonEmpty (toList)
+import qualified Data.Set as Set
+import Data.Void
 import Text.Megaparsec
 import Text.Megaparsec.Char
-import Data.Void
+import Text.Megaparsec.Error (errorBundlePretty, ParseErrorBundle)
 
 type Parser = Parsec Void [LToken]
 data SaplingAST
@@ -19,10 +24,15 @@ data SaplingAST
   | TFork SaplingAST SaplingAST
   deriving (Show, Eq, Ord)
 
-parseSapling :: String -> SaplingAST
-parseSapling "" = error "Empty input provided to parseSapling"
-parseSapling input = case runParser parseExpression "" (lexSapling input) of
-  Left err -> error "Failed to parse input"
+parseSapling :: String -> [SaplingAST]
+parseSapling input =
+  let nonEmptyLines = filter (not . null) (lines input)
+  in map parseSingle nonEmptyLines
+
+parseSingle :: String -> SaplingAST
+parseSingle "" = error "Empty input provided to parseSingle"
+parseSingle input = case runParser parseExpression "" (lexSapling input) of
+  Left  err -> error $ handleParseError err
   Right ast -> ast
 
 scnParser :: Parser ()
@@ -48,7 +58,7 @@ parseFunction = do
 parseApplication :: Parser SaplingAST
 parseApplication = do
   func <- parseAtomicBase
-  args <- many parseAtomic
+  args <- many parseAtomicApplication
   case func of
     TLeaf | not (null args) && all isTreeTerm args -> fail "Defer to Tree Calculus"
     _ -> return (SApp func args)
@@ -66,7 +76,7 @@ parseAtomicBase = choice
   ]
 
 parseTreeLeaf :: Parser SaplingAST
-parseTreeLeaf = satisfy isKeywordT *> pure TLeaf
+parseTreeLeaf = satisfy isKeywordT *> notFollowedBy (satisfy (== LAssign)) *> pure TLeaf
 
 getIdentifier :: LToken -> String
 getIdentifier (LIdentifier name) = name
@@ -86,7 +96,7 @@ parseTreeTerm = do
 parseTreeLeafOrParenthesized :: Parser SaplingAST
 parseTreeLeafOrParenthesized = choice
   [ between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseTreeTerm
-  , satisfy isKeywordT *> pure TLeaf
+  , parseTreeLeaf
   ]
 
 foldTree :: [SaplingAST] -> SaplingAST
@@ -103,6 +113,22 @@ parseAtomic = choice
   , between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseExpression
   ]
 
+parseAtomicApplication :: Parser SaplingAST
+parseAtomicApplication = do
+  token <- anySingle
+  case token of
+    LAssign -> fail
+      "Unexpected `=` character in application context. \
+      \ This is usually caused by an incomplete definition such as: \
+      \ `function a b =`"
+    LIdentifier name -> return (SVar name)
+    LKeywordT -> return TLeaf
+    LIntegerLiteral value -> return (SInt value)
+    LStringLiteral value -> return (SStr value)
+    LOpenBracket -> parseListLiteral
+    LOpenParen -> between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseExpression
+    _ -> fail "Invalid token while parsing attempted function application"
+
 parseLiteral :: Parser SaplingAST
 parseLiteral = choice
   [ parseIntLiteral
@@ -125,21 +151,21 @@ parseListLiteral = do
 
 parseListItem :: Parser SaplingAST
 parseListItem = choice
-  [ parseGroupedItem  -- Handle expressions inside parentheses
-  , parseListLiteral  -- Allow nested lists
-  , parseSingleItem   -- Handle single tokens like `t` or identifiers
+  [ parseGroupedItem
+  , parseListLiteral
+  , parseSingleItem
   ]
 
 parseGroupedItem :: Parser SaplingAST
 parseGroupedItem = do
-  satisfy (== LOpenParen) 
+  satisfy (== LOpenParen)
   inner <- parseExpression
   satisfy (== LCloseParen)
   return inner
 
 parseSingleItem :: Parser SaplingAST
 parseSingleItem = do
-  token <- satisfy isListItem 
+  token <- satisfy isListItem
   case token of
     LIdentifier name -> return (SVar name)
     LKeywordT        -> return TLeaf
@@ -151,9 +177,11 @@ isListItem LKeywordT = True
 isListItem _ = False
 
 parseVar :: Parser SaplingAST
-parseVar = do 
+parseVar = do
   LIdentifier name <- satisfy isIdentifier
-  return (SVar name)
+  if (name == "t" || name == "__result")
+    then fail $ "Reserved keyword: " ++ name ++ " cannot be assigned."
+    else return (SVar name)
 
 parseIntLiteral :: Parser SaplingAST
 parseIntLiteral = do
@@ -165,11 +193,6 @@ parseStrLiteral = do
   LStringLiteral value <- satisfy isStringLiteral
   return (SStr value)
 
-parseMulti :: String -> [SaplingAST]
-parseMulti input =
-  let nonEmptyLines = filter (not . null) (lines input) 
-  in map parseSapling nonEmptyLines
-
 -- Boolean Helpers
 isKeywordT       (LKeywordT)         = True
 isKeywordT                        _  = False
@@ -183,5 +206,27 @@ isIntegerLiteral                  _  = False
 isStringLiteral  (LStringLiteral  _) = True
 isStringLiteral                   _  = False
 
-isNewline        (LNewline)          = True
+isLiteral        (LIntegerLiteral _) = True
+isLiteral        (LStringLiteral  _) = True
+isLiteral                         _  = False
+
+esNewline        (LNewline)          = True
 isNewline                         _  = False
+
+-- Error Handling
+handleParseError :: ParseErrorBundle [LToken] Void -> String
+handleParseError bundle =
+  let errors = bundleErrors bundle
+      errorList = toList errors
+      formattedErrors = map showError errorList
+  in unlines ("Parse error(s) encountered:" : formattedErrors)
+
+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)