module Language.SimpleShell.Parser.Module
  ( moduleP0
  , modulePF
  )
where


import Language.SimpleShell.AST.Module (Module(..), ModuleElement(..))
import Language.SimpleShell.AST.Name (FunName, ProcedureName)
import Language.SimpleShell.AST.SimpleType (FunSig, ProcedureSig)
import Language.SimpleShell.Parser.Common.Root (RootParser)
import Language.SimpleShell.Parser.Function (functionP0, functionP)

import Control.Monad (void)
import Control.Monad.Reader (ReaderT, runReaderT, withReaderT)
import Control.Monad.State (StateT, execStateT, gets, modify)
import Control.Monad.Trans.Class (lift)
import Data.Map (Map)
import qualified Data.Map as Map (empty, lookup, insert)
import Data.Text (unpack)
import Text.Megaparsec (many)


type ModuleParser0 = StateT ModuleContext RootParser
type ModuleParser = ReaderT ModuleContext RootParser

moduleP0 :: RootParser ModuleContext
moduleP0 = execStateT moduleMP0 initModuleContext

modulePF :: ModuleContext -> RootParser Module
modulePF = runReaderT moduleMP


data ModuleContext
  = ModuleContext
      { ctxFuns       :: Map FunName       FunSig
      , ctxProcedures :: Map ProcedureName ProcedureSig
      }
  deriving (Show)

initModuleContext :: ModuleContext
initModuleContext = ModuleContext Map.empty Map.empty


addFun :: FunName -> FunSig -> ModuleParser0 ()
addFun fname sig = do
  funs <- gets ctxFuns
  case Map.lookup fname funs of
    Just _  -> fail $ "Function `" ++ unpack fname ++ "` already defined."
    Nothing -> modify (\ctx -> ctx { ctxFuns = Map.insert fname sig funs })


moduleMP0 :: ModuleParser0 ()
moduleMP0 = void $ many (lift functionP0 >>= uncurry addFun)


moduleMP :: ModuleParser Module
moduleMP = Module <$> many elementP
  where
    elementP :: ModuleParser ModuleElement
    elementP = FunctionElement <$> withReaderT ctxFuns functionP