aboutsummaryrefslogtreecommitdiff
path: root/src/Fun/Parser.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Fun/Parser.hs')
-rw-r--r--src/Fun/Parser.hs152
1 files changed, 101 insertions, 51 deletions
diff --git a/src/Fun/Parser.hs b/src/Fun/Parser.hs
index f3f5201..1f6be7e 100644
--- a/src/Fun/Parser.hs
+++ b/src/Fun/Parser.hs
@@ -3,11 +3,12 @@ module Fun.Parser where
import Data.Char
import Fun.Tree
-type Parser a = String -> Maybe (a, String)
+type Context = Maybe String
+type Parser a = String -> Either Context (a, String)
char :: Parser Char
-char [] = Nothing
-char (x : xs) = Just (x, xs)
+char [] = Left Nothing
+char (x : xs) = Right (x, xs)
digit :: Parser Char
digit = char <=> isDigit
@@ -41,11 +42,14 @@ letters = iter letter
alphanum :: Parser Char
alphanum = digit <|> letter
+string :: Parser String
+string = literal '"' <-+> iter (char <=> (/= '"')) <+-> literal '"'
+
literal :: Char -> Parser Char
literal c = char <=> (== c)
result :: a -> Parser a
-result a cs = Just (a, cs)
+result a cs = Right (a, cs)
iter :: Parser Char -> Parser String
iter m = (iterS m) <=> (/= "")
@@ -53,6 +57,9 @@ iter m = (iterS m) <=> (/= "")
iterS :: Parser a -> Parser [a]
iterS m = m <+> iterS m >>> (\(x, y) -> x : y) <|> result []
+iterFail :: Parser a -> Parser [a]
+iterFail m = m <+> iterFail m >>> (\(x, y) -> x : y)
+
token :: Parser a -> Parser a
token = (<+-> iterS space)
@@ -68,77 +75,78 @@ accept w = token ((iter notSpace) <=> (== w))
infix 7 <=>
(<=>) :: Parser a -> (a -> Bool) -> Parser a
(parser <=> predicate) input = case parser input of
- Nothing -> Nothing
- Just (a, rest) -> if (predicate a) then Just (a, rest) else Nothing
-
+ Left a -> Left a
+ Right (a, rest) -> if (predicate a)
+ then Right (a, rest)
+ else Left $ Just (head . lines $ input)
-- Combine two parser together pairing their results up in a tuple
infixl 6 <+>
(<+>) :: Parser a -> Parser b -> Parser (a, b)
(parserA <+> parserB) input = case parserA input of
- Nothing -> Nothing
- Just (resultA, remainder) -> case parserB remainder of
- Nothing -> Nothing
- Just (resultB, cs) -> Just ((resultA, resultB), cs)
+ Left a -> Left a
+ Right (resultA, remainder) -> case parserB remainder of
+ Left a -> Left a
+ Right (resultB, cs) -> Right ((resultA, resultB), cs)
-- Sequence operator that discards the second result
infixl 6 <+->
(<+->) :: Parser a -> Parser b -> Parser a
(parserA <+-> parserB) input = case parserA input of
- Nothing -> Nothing
- Just (resultA, remainder) -> case parserB remainder of
- Nothing -> Nothing
- Just (_, cs) -> Just (resultA, cs)
+ Left a -> Left a
+ Right (resultA, remainder) -> case parserB remainder of
+ Left a -> Left a
+ Right (_, cs) -> Right (resultA, cs)
-- Sequence operator that discards the first result
infixl 6 <-+>
(<-+>) :: Parser a -> Parser b -> Parser b
(parserA <-+> parserB) input = case parserA input of
- Nothing -> Nothing
- Just (resultA, remainder) -> case parserB remainder of
- Nothing -> Nothing
- Just (resultB, cs) -> Just (resultB, cs)
+ Left a -> Left a
+ Right (resultA, remainder) -> case parserB remainder of
+ Left a -> Left a
+ Right (resultB, cs) -> Right (resultB, cs)
-- Transform a parsers result
infixl 5 >>>
(>>>) :: Parser a -> (a -> b) -> Parser b
(parser >>> transformer) input = case parser input of
- Nothing -> Nothing
- Just (resultA, remainder) -> Just ((transformer resultA), remainder)
+ Left a -> Left a
+ Right (resultA, remainder) -> Right ((transformer resultA), remainder)
-- Extract a parsers result
infix 4 +>
(+>) :: Parser a -> (a -> Parser b) -> Parser b
(parser +> function) input = case parser input of
- Nothing -> Nothing
- Just (a, cs) -> function a cs
+ Left a -> Left a
+ Right (a, cs) -> function a cs
-- Combine two parsers using a 'or' type operation
infixl 3 <|>
(<|>) :: Parser a -> Parser a -> Parser a
(parserA <|> parserB) input = case parserA input of
- Nothing -> parserB input
- result -> result
+ Left _ -> parserB input
+ result -> result
----
tree :: Parser Tree
-tree = iterS program >>> Tree
+tree = iterFail program >>> Tree
program :: Parser Program
-program = iterS block >>> Program
+program = iterFail block >>> Program
block :: Parser Block
block = functionBlock <+-> newline >>> Block
-visibility :: Parser Char
-visibility = literal '+' <|> literal '-'
+visibility :: Parser Visibility
+visibility =
+ (literal '+' >>> const PublicVisibility)
+ <|> (literal '-' >>> const PrivateVisibility)
functionBlock :: Parser FunctionBlock
-functionBlock =
- functionDeclaration
- <+> iterS functionDefinition
- >>> (\(a, b) -> FunctionBlock a b)
+functionBlock = functionDeclaration <+> iterS functionDefinition >>> build
+ where build (decl, defn) = FunctionBlock decl defn
functionDeclaration :: Parser FunctionDeclaration
functionDeclaration =
@@ -148,9 +156,10 @@ functionDeclarationWithoutFlags :: Parser FunctionDeclaration
functionDeclarationWithoutFlags =
functionName
<+> functionDeclarationDelimiter
- <+> iterS functionType
+ <+> functionTypeList
<+-> newline
- >>> (\((a, b), c) -> FunctionDeclarationWithoutFlags a b c)
+ >>> build
+ where build ((name, vis), types) = FunctionDeclaration name vis types []
functionDeclarationWithFlags :: Parser FunctionDeclaration
functionDeclarationWithFlags =
@@ -160,33 +169,74 @@ functionDeclarationWithFlags =
<+-> space
<+-> literal '%'
<+-> space
- <+> iterS functionFlag
+ <+> functionFlagList
<+-> newline
- >>> (\(((a, b), c), d) -> FunctionDeclarationWithFlags a b c d)
+ >>> build
+ where
+ build (((name, vis), types), flags) =
+ FunctionDeclaration name vis types flags
-functionDeclarationDelimiter :: Parser Char
+functionDeclarationDelimiter :: Parser Visibility
functionDeclarationDelimiter =
space <-+> literal ':' <-+> visibility <+-> literal ':' <+-> space
-functionName :: Parser String
-functionName = letter <+> iterS alphanum >>> (\(a, b) -> a : b)
+functionName :: Parser String -- TODO
+functionName = letter <+> iterS alphanum >>> build where build (a, b) = a : b
functionTypeList :: Parser [String]
functionTypeList =
- iterS ((functionType <+-> space <+-> literal ':' <+-> space) <|> functionType)
+ (iterS (functionType <+-> space <+-> literal ':' <+-> space))
+ <+> functionType
+ >>> build
+ where build (a, b) = a ++ [b]
+
+functionType :: Parser String -- TODO
+functionType = letter <+> iterS alphanum >>> build where build (a, b) = a : b
-functionType :: Parser String
-functionType = letter <+> iterS alphanum >>> (\(a, b) -> a : b)
+functionFlagList :: Parser [String]
+functionFlagList = (iterS (functionFlag <+-> space)) <+> functionFlag >>> build
+ where build (a, b) = a ++ [b]
+
+functionFlags :: [String]
+functionFlags = ["inline", "deprecated"]
functionFlag :: Parser String
-functionFlag = letters
+functionFlag = letters <=> (`elem` functionFlags)
functionDefinition :: Parser FunctionDefinition
functionDefinition =
- letters
- <+-> space
- <+-> literal ':'
- <+-> space
- <+> letters
- <+-> newline
- >>> (\(a, b) -> FunctionDefinition a b)
+ functionPattern <+-> literal ':' <+-> space <+> functionBody >>> build
+ where build (pattern, body) = FunctionDefinition pattern body
+
+functionPattern :: Parser FunctionPattern
+functionPattern = iterS (functionPatternElement <+-> space) >>> FunctionPattern
+
+functionPatternElement :: Parser FunctionPatternElement
+functionPatternElement =
+ (functionParameter >>> FunctionPatternParameter)
+ <|> (literal '_' >>> const Wildcard)
+ <|> (number >>> FunctionPatternNumber)
+ <|> (string >>> FunctionPatternString)
+
+functionParameter :: Parser String -- TODO
+functionParameter = letter <+> iterS alphanum >>> build
+ where build (a, b) = a : b
+
+functionBody :: Parser FunctionBody
+functionBody =
+ (iterS (functionBodyElement <+-> space))
+ <+> (functionBodyElement <+-> newline)
+ >>> build
+ >>> FunctionBody
+ where build (a, b) = a ++ [b]
+
+functionBodyElement :: Parser FunctionBodyElement
+functionBodyElement =
+ statement
+ <|> (functionName >>> FunctionBodyIdentifier)
+ <|> (functionParameter >>> FunctionBodyIdentifier)
+ <|> (string >>> FunctionBodyString)
+ <|> (number >>> FunctionBodyNumber)
+
+statement :: Parser FunctionBodyElement
+statement = accept "if" >>> Statement