Wuah

2 files changed, 41 insertions, 30 deletions

diff --git a/src/Fun/Parser.hs b/src/Fun/Parser.hs
index 1f6be7e..ee2c51e 100644
--- a/src/Fun/Parser.hs
+++ b/src/Fun/Parser.hs
@@ -42,6 +42,18 @@ letters = iter letter
 alphanum :: Parser Char
 alphanum = digit <|> letter
 
+special :: Parser Char
+special = oneOf "+-*/<^>$@#&!?"
+
+-- TODO: Higher-order function?
+linkOr :: [Parser Char] -> Parser Char
+linkOr []       = invalid ' '
+linkOr (x : []) = x
+linkOr (x : xs) = x <|> linkOr xs
+
+oneOf :: [Char] -> Parser Char
+oneOf s = linkOr $ map (\c -> (char <=> (== c))) s
+
 string :: Parser String
 string = literal '"' <-+> iter (char <=> (/= '"')) <+-> literal '"'
 
@@ -51,6 +63,9 @@ literal c = char <=> (== c)
 result :: a -> Parser a
 result a cs = Right (a, cs)
 
+invalid :: a -> Parser a
+invalid a cs = Left $ Just "Invalid"
+
 iter :: Parser Char -> Parser String
 iter m = (iterS m) <=> (/= "")
 
@@ -134,7 +149,7 @@ tree :: Parser Tree
 tree = iterFail program >>> Tree
 
 program :: Parser Program
-program = iterFail block >>> Program
+program = iterS block >>> Program
 
 block :: Parser Block
 block = functionBlock <+-> newline >>> Block
@@ -156,7 +171,7 @@ functionDeclarationWithoutFlags :: Parser FunctionDeclaration
 functionDeclarationWithoutFlags =
   functionName
     <+>  functionDeclarationDelimiter
-    <+>  functionTypeList
+    <+>  functionTypes
     <+-> newline
     >>>  build
   where build ((name, vis), types) = FunctionDeclaration name vis types []
@@ -165,12 +180,10 @@ functionDeclarationWithFlags :: Parser FunctionDeclaration
 functionDeclarationWithFlags =
   functionName
     <+>  functionDeclarationDelimiter
-    <+>  functionTypeList
+    <+>  functionTypes
     <+-> space
     <+-> literal '%'
-    <+-> space
-    <+>  functionFlagList
-    <+-> newline
+    <+>  functionFlags
     >>>  build
  where
   build (((name, vis), types), flags) =
@@ -180,32 +193,28 @@ functionDeclarationDelimiter :: Parser Visibility
 functionDeclarationDelimiter =
   space <-+> literal ':' <-+> visibility <+-> literal ':' <+-> space
 
-functionName :: Parser String -- TODO
-functionName = letter <+> iterS alphanum >>> build where build (a, b) = a : b
+functionName :: Parser String
+functionName = (special <|> letter) <+> iterS (special <|> alphanum) >>> build
+  where build (first, rest) = first : rest
 
-functionTypeList :: Parser [String]
-functionTypeList =
+functionTypes :: Parser [String]
+functionTypes =
   (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 <=> isUpper) <+> iterS alphanum >>> build
+  where build (first, rest) = first : rest
 
-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 <=> (`elem` functionFlags)
+functionFlags :: Parser [FunctionFlag] -- TODO: Fix flags
+functionFlags = iterS (space <-+> letters) <+-> newline >>> build
+  where build list = map read list
 
 functionDefinition :: Parser FunctionDefinition
 functionDefinition =
-  functionPattern <+-> literal ':' <+-> space <+> functionBody >>> build
+  functionPattern <+-> literal ':' <+> functionBody >>> build
   where build (pattern, body) = FunctionDefinition pattern body
 
 functionPattern :: Parser FunctionPattern
@@ -218,17 +227,13 @@ functionPatternElement =
     <|> (number >>> FunctionPatternNumber)
     <|> (string >>> FunctionPatternString)
 
-functionParameter :: Parser String -- TODO
+functionParameter :: Parser String
 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]
+  iterS (space <-+> functionBodyElement) <+-> newline >>> FunctionBody
 
 functionBodyElement :: Parser FunctionBodyElement
 functionBodyElement =
@@ -238,5 +243,5 @@ functionBodyElement =
     <|> (string >>> FunctionBodyString)
     <|> (number >>> FunctionBodyNumber)
 
-statement :: Parser FunctionBodyElement
+statement :: Parser FunctionBodyElement --  TODO
 statement = accept "if" >>> Statement
diff --git a/src/Fun/Tree.hs b/src/Fun/Tree.hs
index d6cdecd..ce6cf6c 100644
--- a/src/Fun/Tree.hs
+++ b/src/Fun/Tree.hs
@@ -17,8 +17,14 @@ data Visibility = PublicVisibility | PrivateVisibility
 data FunctionDeclaration = FunctionDeclaration String
                                                Visibility
                                                [String]
-                                               [String]
+                                               [FunctionFlag]
+  deriving Show
+data FunctionFlag = FunctionInline | FunctionDeprecated | FunctionUnknown
   deriving Show
+instance Read FunctionFlag where
+  readsPrec _ "inline"     = [(FunctionInline, "")]
+  readsPrec _ "deprecated" = [(FunctionDeprecated, "")]
+  readsPrec _ _            = [(FunctionUnknown, "")]
 
 data FunctionDefinition = FunctionDefinition FunctionPattern FunctionBody
   deriving Show