{-# LANGUAGE OverloadedStrings #-}

module Language.SimpleShell.Parser
  ( Parser
  , lexeme
  , lookupVar
  , lookupFun
  , initContext
  , parseTest
  )
where


import Language.SimpleShell.AST.Expr (FunName, VarName)
import Language.SimpleShell.AST.SimpleType (SimpleType, FunSig)

import Control.Monad.Reader (ask, ReaderT, runReaderT)
import Data.Map (Map)
import qualified Data.Map as Map (empty, lookup)
import Data.Text (Text, unpack)
import Data.Void (Void)
import Text.Megaparsec (Parsec)
import qualified Text.Megaparsec as MP (parseTest)
import Text.Megaparsec.Char (space1)
import qualified Text.Megaparsec.Char.Lexer as L
  ( lexeme
  , space
  , skipLineComment
  , skipBlockComment
  )


type Parser = ReaderT Context (Parsec Void Text)

data Context = Context
  { ctxVars :: Map VarName SimpleType
  , ctxFuns :: Map FunName FunSig
  }

initContext :: Context
initContext = Context
  { ctxVars = Map.empty
  , ctxFuns = Map.empty
  }


sc :: Parser ()
sc = L.space
  space1
  (L.skipLineComment "//")
  (L.skipBlockComment "/*" "*/")

lexeme = L.lexeme sc


lookupVar :: VarName -> Parser SimpleType
lookupVar varname = do
  mt <- Map.lookup varname . ctxVars <$> ask
  case mt of
    Just t  -> return t
    Nothing -> fail $ "Undeclared variable $" ++ unpack varname

lookupFun :: FunName -> Parser FunSig
lookupFun fname = do
  msig <- Map.lookup fname . ctxFuns <$> ask
  case msig of
    Just sig -> return sig
    Nothing  -> fail $ "Undefined function " ++ unpack fname


parseTest :: Show a => Parser a -> Text -> IO ()
parseTest p = MP.parseTest (runReaderT p initContext)