module Fun.Generator where

import           Fun.Tree
import           Fun.Typer

-- TODO: 'Merge' syntax for danger-asm: _merge (_asm ..) main (_asm ..)

data GenerateError = GenerateError String

-- TODO: There's something about a lifted ++ as alternative here I think
concatEither :: Either GenerateError [String] -> Either GenerateError String
concatEither (Left  err ) = Left err
concatEither (Right strs) = Right $ concat strs

generatePattern :: Tree -> FunctionPattern -> Either GenerateError String
generatePattern t (FunctionPattern []) = Right ""
generatePattern t _                    = Left $ GenerateError "not implemented"

generateInternalAsmArgs :: [FunctionArgument] -> [Either GenerateError String]
generateInternalAsmArgs [FunctionString x] = [Right x]
generateInternalAsmArgs ((FunctionString x) : xs) =
  [Right x] ++ [Right "\n"] ++ (generateInternalAsmArgs xs)
generateInternalAsmArgs _ = [Left $ GenerateError "invalid _asm arguments"]

generateFunctionCall :: Tree -> FunctionBody -> Either GenerateError String
generateFunctionCall t (FunctionBodyCall "_asm" args) =
  concatEither $ sequence $ generateInternalAsmArgs args
generateFunctionCall t (FunctionBodyCall name args) =
  Left $ GenerateError "not implemented"

generateBody :: Tree -> FunctionBody -> Either GenerateError String
generateBody t c@(FunctionBodyCall _ _) = generateFunctionCall t c
generateBody t (FunctionBodyInfixCall name args) =
  Left $ GenerateError "infix function call not implemented"
generateBody t (FunctionBodyValue value) =
  Left $ GenerateError "value not implemented"
generateBody t (FunctionBodySub sub) = generateBody t sub

generateDefinition :: Tree -> FunctionDefinition -> Either GenerateError String
generateDefinition t (FunctionDefinition pattern body) =
  concatEither $ sequence $ [generatePattern t pattern, generateBody t body]

generateFunction :: Tree -> Block -> Either GenerateError String
generateFunction t (FunctionBlock decl defns) =
  let defn = concatEither $ sequence $ map (\d -> generateDefinition t d) defns
  in  case defn of
        Left  _ -> defn
        Right d -> Right $ (dName decl) ++ ":\n" ++ d

-- TODO: Generate all used functions directly instead
generateAsm :: Tree -> Either GenerateError String
-- generateAsm (Tree t) = Right $ show t
generateAsm t = case getFunction t "_start" [InternalType "_void"] of
  Nothing -> Left $ GenerateError "invalid/missing _start function"
  Just f  -> generateFunction t f