{-# LANGUAGE OverloadedStrings #-}

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


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

import Control.Monad (void)
import Control.Monad.Reader (ask, local, ReaderT, runReaderT)
import Data.List (nub)
import Data.Map (Map)
import qualified Data.Map as Map (empty, lookup, fromList)
import Data.Text (Text, unpack)
import Data.Tuple (swap)
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
  , symbol
  , 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 :: Parser a -> Parser a
lexeme = L.lexeme sc

symbol :: Text -> Parser ()
symbol = void . L.symbol 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

declareVars :: [Typed VarName] -> Parser a -> Parser a
declareVars decls p = do
  let names = map snd decls
  if length (nub names) == length names   -- TODO: inefficient
  then local (\ctx -> ctx { ctxVars = Map.fromList $ map swap decls }) p
  else fail "Duplicate variable name."


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