Fixed parsing to end

1 files changed, 43 insertions, 35 deletions

diff --git a/src/Fun/Parser.hs b/src/Fun/Parser.hs
index 8042caa..15c5cd0 100644
--- a/src/Fun/Parser.hs
+++ b/src/Fun/Parser.hs
@@ -3,10 +3,12 @@ module Fun.Parser where
 import           Fun.Tree
 
 data Trace = StringTrace String | OrTrace [Trace] [Trace]
+  deriving (Eq, Show)
 data State = State
   { trace :: [Trace]
   , line  :: Maybe String
   }
+  deriving (Eq, Show)
 type Parser a = String -> Either State (a, String)
 
 ----
@@ -22,26 +24,30 @@ upperAlpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥ
 isDigit :: Char -> Bool
 isDigit c = elem c "0123456789"
 
+isAlpha :: Char -> Bool
+isAlpha c = elem c $ lowerAlpha ++ upperAlpha
+
 isLower :: Char -> Bool
 isLower c = elem c lowerAlpha
 
 isUpper :: Char -> Bool
 isUpper c = elem c upperAlpha
 
-isAlpha :: Char -> Bool
-isAlpha c = elem c $ lowerAlpha ++ upperAlpha
-
 ----
 
 char :: Parser Char
 char []       = Left $ State [StringTrace "char"] Nothing
 char (x : xs) = Right (x, xs)
 
+endOfFile :: Parser Char
+endOfFile [] = Right ('\00', [])
+endOfFile _  = Left $ State [StringTrace "end of file"] Nothing
+
 digit :: Parser Char
 digit = char <=> isDigit <?> "digit"
 
 digits :: Parser String
-digits = iter digit <?> "digits"
+digits = oneOrMore digit <?> "digits"
 
 number :: Parser Integer
 number =
@@ -55,17 +61,17 @@ number =
 space :: Parser Char
 space = char <=> (== ' ') <?> "space"
 
-newline :: Parser Char
-newline = char <=> (== '\n') <?> "newline"
-
 notSpace :: Parser Char
 notSpace = char <=> (/= ' ') <?> "non-space"
 
+newline :: Parser Char
+newline = char <=> (== '\n') <?> "newline"
+
 letter :: Parser Char
 letter = char <=> isAlpha <?> "letter"
 
 letters :: Parser String
-letters = iter letter <?> "letters"
+letters = oneOrMore letter <?> "letters"
 
 alphanum :: Parser Char
 alphanum = digit <|> letter <?> "letter or digit"
@@ -86,28 +92,23 @@ literal c = char <=> (== c) <?> "char (" ++ [c] ++ ")"
 result :: a -> Parser a
 result a cs = Right (a, cs)
 
-invalid :: a -> Parser a
-invalid a cs = Left $ State [StringTrace "<unknown>"] $ Just "Invalid"
-
-iter :: Parser Char -> Parser String
-iter m = (iterS m) <=> (/= "") <?> "multiple chars"
+oneOrMore :: Parser Char -> Parser String
+oneOrMore m = (iter m) <=> (/= "") <?> "one or more chars"
 
-iterS :: Parser a -> Parser [a]
-iterS m = m <+> iterS m >>> (\(x, y) -> x : y) <|> result [] <?> "multiple"
+iter :: Parser a -> Parser [a]
+iter m = m <+> iter m >>> (\(x, y) -> x : y) <|> result [] <?> "multiple"
 
-iterFail :: Parser a -> Parser [a]
-iterFail m = m <+> iterFail m >>> (\(x, y) -> x : y)
+-- TODO: Improve this for better error reporting
+iterFull :: Parser a -> Parser [a]
+iterFull m = m <+> iterFull m >>> (\(x, y) -> x : y) <|> iterFull'
+iterFull' "" = Right ([], "")
+iterFull' _  = Left $ State [StringTrace "<something>"] $ Nothing
 
 token :: Parser a -> Parser a
-token = (<+-> iterS space)
+token = (<+-> space)
 
--- A parser that will accept a given alpha string
-acceptWord :: String -> Parser String
-acceptWord w = token (letters <=> (== w))
-
--- A parser that will accept a given string
 accept :: String -> Parser String
-accept w = token ((iter notSpace) <=> (== w))
+accept w = token ((oneOrMore notSpace) <=> (== w))
 
 -- Given a parser and a predicate return the parser only if it satisfies the predicate
 infix 7 <=>
@@ -181,13 +182,20 @@ infix 0 <?>
 ----
 
 tree :: Parser Tree
-tree = iterFail program >>> Tree
+tree = iterFull program >>> Tree
 
 program :: Parser Program
-program = iterFail block >>> Program <?> "program"
+program = iterFull block >>> Program <?> "program"
 
 block :: Parser Block
-block = functionBlock <+-> newline >>> Block <?> "block"
+block =
+  functionBlock
+    <+-> newline
+    >>>  Block
+    <|>  functionBlock
+    <+-> endOfFile
+    >>>  Block
+    <?>  "block"
 
 visibility :: Parser Visibility
 visibility =
@@ -196,7 +204,7 @@ visibility =
     <?> "visibility"
 
 functionBlock :: Parser FunctionBlock
-functionBlock = functionDeclaration <+> iterS functionDefinition >>> build
+functionBlock = functionDeclaration <+> iter functionDefinition >>> build
   where build (decl, defn) = FunctionBlock decl defn
 
 functionDeclaration :: Parser FunctionDeclaration
@@ -241,14 +249,14 @@ functionDeclarationDelimiter =
 functionName :: Parser String
 functionName =
   (special <|> letter)
-    <+> iterS (special <|> alphanum)
+    <+> iter (special <|> alphanum)
     >>> build
     <?> "function name"
   where build (first, rest) = first : rest
 
 functionTypes :: Parser [String]
 functionTypes =
-  iterS (functionType <+-> space <+-> functionTypeDelimiter <+-> space)
+  iter (functionType <+-> space <+-> functionTypeDelimiter <+-> space)
     <+> functionType
     >>> build
     <?> "function types"
@@ -256,7 +264,7 @@ functionTypes =
 
 functionType :: Parser String
 functionType =
-  (letter <=> isUpper) <+> iter alphanum >>> build <?> "function type"
+  (letter <=> isUpper) <+> oneOrMore alphanum >>> build <?> "function type"
   where build (first, rest) = first : rest
 
 functionTypeDelimiter :: Parser Char
@@ -264,7 +272,7 @@ functionTypeDelimiter = literal ':' <?> "function type delimiter"
 
 functionFlagList :: Parser [FunctionFlag]
 functionFlagList =
-  (iterS (space <-+> functionFlag)) <+-> newline >>> build <?> "function flags"
+  (iter (space <-+> functionFlag)) <+-> newline >>> build <?> "function flags"
   where build list = map read list
 
 functionFlagDelimiter :: Parser Char
@@ -286,7 +294,7 @@ functionDefinition =
 
 functionPattern :: Parser FunctionPattern
 functionPattern =
-  iterS (functionPatternElement <+-> space)
+  iter (functionPatternElement <+-> space)
     >>> FunctionPattern
     <?> "function pattern"
 
@@ -300,12 +308,12 @@ functionPatternElement =
 
 functionParameter :: Parser String
 functionParameter =
-  letters <|> (letter <+> iter alphanum) >>> build <?> "function parameter"
+  letters <|> (letter <+> oneOrMore alphanum) >>> build <?> "function parameter"
   where build (a, b) = a : b
 
 functionBody :: Parser FunctionBody
 functionBody =
-  iterS (space <-+> functionBodyElement)
+  iter (space <-+> functionBodyElement)
     <+-> newline
     >>>  FunctionBody
     <?>  "function body"