module Fun.Tree where

import           Fun.Typer

data Visibility = PublicVisibility | PrivateVisibility
  deriving Show
-- TODO: Actually enforce danger-* in syntax-check
data FunctionFlag = FunctionInline | FunctionDeprecated | FunctionDangerVoid | FunctionDangerAsm | FunctionUnknown
  deriving Show
instance Read FunctionFlag where
  readsPrec _ "inline"      = [(FunctionInline, "")]
  readsPrec _ "deprecated"  = [(FunctionDeprecated, "")]
  readsPrec _ "danger-void" = [(FunctionDangerVoid, "")]
  readsPrec _ "danger-asm"  = [(FunctionDangerAsm, "")]
  readsPrec _ _             = [(FunctionUnknown, "")]

data Tree = Tree [Program]
  deriving Show

data Program = Program [Block]
  deriving Show

data Block = FunctionBlock
  { bDecl  :: FunctionDeclaration
  , bDefns :: [FunctionDefinition]
  } -- | DataBlock .. TODO
  deriving Show

type FunctionSignature = [Type]

data FunctionDeclaration = FunctionDeclaration
  { dName       :: String
  , dVisibility :: Visibility
  , dTypes      :: FunctionSignature
  , dFlags      :: [FunctionFlag]
  }
  deriving Show

data FunctionDefinition = FunctionDefinition
  { dPattern :: FunctionPattern
  , dBody    :: FunctionBody
  }
  deriving Show

data FunctionPattern = FunctionPattern
  { pElements :: [FunctionPatternElement]
  }
  deriving Show

data FunctionPatternElement = FunctionPatternParameter String | FunctionPatternString String | FunctionPatternNumber Integer | FunctionPatternWildcard
  deriving (Show, Eq, Ord)

data FunctionBody = FunctionBodyCall { cName :: String, cArgs :: [FunctionArgument] } | FunctionBodyInfixCall { iName :: String, iArgs :: [FunctionArgument] } | FunctionBodyValue FunctionArgument | FunctionBodySub FunctionBody
  deriving Show

data FunctionArgument = FunctionName String | FunctionInfixName String | FunctionParameter String | FunctionString String | FunctionNumber Integer
  deriving Show

----

-- TODO: This can be optimized
-- TODO: Respect visibility
getFunction :: Tree -> String -> FunctionSignature -> Maybe Block
getFunction (Tree ps) f sig =
  let fromProgram (Program bs) =
        filter (\b -> (dName . bDecl) b == f && (dTypes . bDecl) b == sig) bs
      fromTree = filter (\b -> length b == 1) (map fromProgram ps)
  in  case fromTree of
        [[f]] -> Just f
        _     -> Nothing