{-# LANGUAGE OverloadedStrings #-}

module Language.SimpleShell.Parser.Function
  ( functionP
  , functionP0
  )
where


import Language.SimpleShell.AST.Expr (Expr)
import Language.SimpleShell.AST.Function (Function(..))
import Language.SimpleShell.AST.Name (FunName, VarName)
import Language.SimpleShell.AST.SimpleType (SimpleType, FunSig, Typed)
import Language.SimpleShell.Parser.Common.Lexeme (symbol)
import Language.SimpleShell.Parser.Common.Root (RootParser)
import Language.SimpleShell.Parser.Expr
  ( runExprParser
  , strongTermP
  , strongTermP_
  )
import Language.SimpleShell.Parser.Name (nameP, keyword)
import Language.SimpleShell.Parser.SimpleType (simpleTypeP, forceType)

import Control.Applicative ((<|>))
import Text.Megaparsec (sepBy)


functionPrefixP :: RootParser (SimpleType, FunName, [Typed VarName])
functionPrefixP = do
  keyword "function"
  t' <- simpleTypeP
  fname <- nameP
  params <- symbol "(" *> paramP `sepBy` symbol "," <* symbol ")"
  symbol "="
  return (t', fname, params)

functionP :: RootParser Function
functionP = do
  (t', fname, params) <- functionPrefixP
  let vars = map snd params
  body <- forceType t' (bodyP params) <|> fail "Function return type mismatch."
  return $ Function fname vars body

-- | First-pass function parser.
functionP0 :: RootParser (FunName, FunSig)
functionP0 = do
  (t', fname, params) <- functionPrefixP
  let ts = map fst params
  bodyP_
  return (fname, (t', ts))


paramP :: RootParser (Typed VarName)
paramP = (,) <$> simpleTypeP <*> nameP

bodyP :: [Typed VarName] -> RootParser (Typed Expr)
bodyP params = runExprParser params strongTermP

bodyP_ :: RootParser ()
bodyP_ = runExprParser [] strongTermP_