1 files changed, 153 insertions, 0 deletions
diff --git a/src/Fun/Grammar.hs b/src/Fun/Grammar.hs
new file mode 100644
index 0000000..2b46418
--- /dev/null
+++ b/src/Fun/Grammar.hs
@@ -0,0 +1,153 @@
+module Fun.Grammar where
+
+import           Fun.Parser
+import           Fun.Tree
+
+tree :: Parser Tree
+tree = iterFull program >>> Tree
+
+program :: Parser Program
+program = iterFull block >>> Program <?> "program"
+
+block :: Parser Block
+block =
+  functionBlock
+    <+-> newline
+    >>>  Block
+    <|>  functionBlock
+    <+-> endOfFile
+    >>>  Block
+    <?>  "block"
+
+visibility :: Parser Visibility
+visibility =
+  (literal '+' >>> const PublicVisibility)
+    <|> (literal '-' >>> const PrivateVisibility)
+    <?> "visibility"
+
+functionBlock :: Parser FunctionBlock
+functionBlock = functionDeclaration <+> iter functionDefinition >>> build
+  where build (decl, defn) = FunctionBlock decl defn
+
+functionDeclaration :: Parser FunctionDeclaration
+functionDeclaration =
+  functionDeclarationWithoutFlags
+    <|> functionDeclarationWithFlags
+    <?> "function declaration"
+
+functionDeclarationWithoutFlags :: Parser FunctionDeclaration
+functionDeclarationWithoutFlags =
+  functionName
+    <+>  functionDeclarationDelimiter
+    <+>  functionTypes
+    <+-> newline
+    >>>  build
+    <?>  "function declaration without flags"
+  where build ((name, vis), types) = FunctionDeclaration name vis types []
+
+functionDeclarationWithFlags :: Parser FunctionDeclaration
+functionDeclarationWithFlags =
+  functionName
+    <+>  functionDeclarationDelimiter
+    <+>  functionTypes
+    <+-> space
+    <+-> functionFlagDelimiter
+    <+>  functionFlagList
+    >>>  build
+    <?>  "function declaration with flags"
+ where
+  build (((name, vis), types), flags) =
+    FunctionDeclaration name vis types flags
+
+functionDeclarationDelimiter :: Parser Visibility
+functionDeclarationDelimiter =
+  space
+    <-+> literal ':'
+    <-+> visibility
+    <+-> literal ':'
+    <+-> space
+    <?>  "function declaration delimiter"
+
+functionName :: Parser String
+functionName =
+  (special <|> letter)
+    <+> iter (special <|> alphanum)
+    >>> build
+    <?> "function name"
+  where build (first, rest) = first : rest
+
+functionTypes :: Parser [String]
+functionTypes =
+  iter (functionType <+-> space <+-> functionTypeDelimiter <+-> space)
+    <+> functionType
+    >>> build
+    <?> "function types"
+  where build (a, b) = a ++ [b]
+
+functionType :: Parser String
+functionType =
+  (letter <=> isUpper) <+> oneOrMore alphanum >>> build <?> "function type"
+  where build (first, rest) = first : rest
+
+functionTypeDelimiter :: Parser Char
+functionTypeDelimiter = literal ':' <?> "function type delimiter"
+
+functionFlagList :: Parser [FunctionFlag]
+functionFlagList =
+  (iter (space <-+> functionFlag)) <+-> newline >>> build <?> "function flags"
+  where build list = map read list
+
+functionFlagDelimiter :: Parser Char
+functionFlagDelimiter = literal '%' <?> "function flag delimiter"
+
+functionFlags :: [String]
+functionFlags = ["inline", "deprecated"]
+
+functionFlag :: Parser String
+functionFlag = letters <=> (`elem` functionFlags) <?> "function flag"
+
+functionDefinition :: Parser FunctionDefinition
+functionDefinition =
+  (functionPattern <+-> literal ':')
+    <+> functionBody
+    >>> build
+    <?> "function definition"
+  where build (pattern, body) = FunctionDefinition pattern body
+
+functionPattern :: Parser FunctionPattern
+functionPattern =
+  iter (functionPatternElement <+-> space)
+    >>> FunctionPattern
+    <?> "function pattern"
+
+functionPatternElement :: Parser FunctionPatternElement
+functionPatternElement =
+  (functionParameter >>> FunctionPatternParameter)
+    <|> (literal '_' >>> const FunctionPatternWildcard)
+    <|> (number >>> FunctionPatternNumber)
+    <|> (string >>> FunctionPatternString)
+    <?> "function pattern element"
+
+functionParameter :: Parser String
+functionParameter =
+  letters <|> (letter <+> oneOrMore alphanum) >>> build <?> "function parameter"
+  where build (a, b) = a : b
+
+functionBody :: Parser FunctionBody
+functionBody =
+  iter (space <-+> functionBodyElement)
+    <+-> newline
+    >>>  FunctionBody
+    <?>  "function body"
+
+functionBodyElement :: Parser FunctionBodyElement
+functionBodyElement =
+  statement
+    <|> (functionName >>> FunctionBodyIdentifier)
+    <|> (functionParameter >>> FunctionBodyIdentifier)
+    <|> (string >>> FunctionBodyString)
+    <|> (number >>> FunctionBodyNumber)
+    <?> "function body element"
+
+statement :: Parser FunctionBodyElement --  TODO
+statement = accept "if" >>> Statement