module Fun.Syntax where

import           Data.Either
import           Data.List
import           Fun.Tree

data SyntaxError = SyntaxError String

mergeSyntax :: [Either [SyntaxError] a] -> ([a] -> b) -> Either [SyntaxError] b
mergeSyntax d c | any isLeft d = Left $ concat $ lefts d
                | otherwise    = Right $ c $ rights d

-- TODO: Overloading only if first element is different

checkFunctionArity :: Block -> Either [SyntaxError] Block
checkFunctionArity (FunctionBlock decl defns) =
  let declArity   = length $ dTypes decl
      defnArities = map (length . pElements . dPattern) defns
      defnFirst   = head defnArities -- can't fail because of parser
      equality    = all (== defnFirst) defnArities
      smaller     = defnFirst < declArity
  in  if equality && smaller
        then Right $ FunctionBlock decl defns
        else Left [SyntaxError msg]
  where msg = "invalid arity in function " ++ (dName decl)

checkEntryExistence :: Tree -> Either [SyntaxError] Tree
checkEntryExistence tree =
  let inProgram bs = filter (\b -> (dName . bDecl) b == "_start") 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 entry (_start) 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 _ _) = 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 >>= checkEntryExistence