{-# 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 (Parser, symbol, declareVars)
import Language.SimpleShell.Parser.Expr (strongTermP, strongTermP_)
import Language.SimpleShell.Parser.Name (nameP, keyword)
import Language.SimpleShell.Parser.SimpleType (simpleTypeP, forceType)

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


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

functionP :: Parser 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 :: Parser (FunName, FunSig)
functionP0 = do
  (t', fname, params) <- functionPrefixP
  let ts = map fst params
  bodyP_
  return (fname, (t', ts))


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

bodyP :: [Typed VarName] -> Parser (Typed Expr)
bodyP params = declareVars params strongTermP

bodyP_ :: Parser ()
bodyP_ = strongTermP_