Cool syntax checks

2 files changed, 31 insertions, 4 deletions

diff --git a/src/Fun/Syntax.hs b/src/Fun/Syntax.hs
index 133b7dc..86e8100 100644
--- a/src/Fun/Syntax.hs
+++ b/src/Fun/Syntax.hs
@@ -1,6 +1,7 @@
 module Fun.Syntax where
 
 import           Data.Either
+import           Data.List
 import           Fun.Tree
 
 data SyntaxError = SyntaxError String
@@ -18,13 +19,39 @@ checkFunctionArity (FunctionBlock decl defns) =
       smaller     = defnFirst < declArity
   in  if equality && smaller
         then Right $ FunctionBlock decl defns
-        else Left $ [SyntaxError $ "invalid arity in function " ++ (dName decl)]
+        else Left [SyntaxError msg]
+  where msg = "invalid arity in function " ++ (dName decl)
+
+checkMainExistence :: Tree -> Either [SyntaxError] Tree
+checkMainExistence tree =
+  let inProgram bs = filter (\b -> (dName . bDecl) b == "main") bs
+      oneInProgram (Program bs) = length (inProgram bs) == 1
+      inTree ps = map oneInProgram ps
+      oneInTree (Tree ps) = length (filter (== True) (inTree ps)) == 1
+  in  if oneInTree tree then Right tree else Left [SyntaxError msg]
+  where msg = "invalid amount of main functions"
+
+checkFunctionPatternDistinguishability :: Block -> Either [SyntaxError] Block
+checkFunctionPatternDistinguishability f =
+  let defns (FunctionBlock _ d) = d
+      patterns = map (pElements . dPattern) $ defns f
+      unique   = (all ((==) 1 . length) . (group . sort))
+  in  if unique $ patterns then Right f else Left [SyntaxError msg]
+ where
+  msg = "pattern not fully distinguishable in function " ++ ((dName . bDecl) f)
+
+checkFunctionPattern :: Block -> Either [SyntaxError] Block
+checkFunctionPattern f = checkFunctionPatternDistinguishability f
+
+checkFunction :: Block -> Either [SyntaxError] Block
+checkFunction f = checkFunctionArity f >>= checkFunctionPattern
 
 checkBlock :: Block -> Either [SyntaxError] Block
-checkBlock b@(FunctionBlock _ _) = checkFunctionArity b
+checkBlock b@(FunctionBlock _ _) = checkFunction b
 
 checkProgram :: Program -> Either [SyntaxError] Program
 checkProgram (Program blocks) = mergeSyntax (map checkBlock blocks) Program
 
 checkTree :: Tree -> Either [SyntaxError] Tree
-checkTree (Tree programs) = mergeSyntax (map checkProgram programs) Tree
+checkTree (Tree programs) =
+  mergeSyntax (map checkProgram programs) Tree >>= checkMainExistence
diff --git a/src/Fun/Tree.hs b/src/Fun/Tree.hs
index 7b21b17..28434cc 100644
--- a/src/Fun/Tree.hs
+++ b/src/Fun/Tree.hs
@@ -43,7 +43,7 @@ data FunctionPattern = FunctionPattern
   deriving Show
 
 data FunctionPatternElement = FunctionPatternParameter String | FunctionPatternString String | FunctionPatternNumber Integer | FunctionPatternWildcard | FunctionPatternSuperWildcard
-  deriving Show
+  deriving (Show, Eq, Ord)
 
 data FunctionBody = FunctionBody
   { bElements :: [FunctionBodyElement]