module BNFC.Backend.Agda.InitState where

import BNFC.Prelude

import Control.Monad.Except

import BNFC.CF

import BNFC.Backend.Agda.Options
import BNFC.Backend.Agda.State
import BNFC.Backend.Agda.Utilities.ReservedWords
import BNFC.Backend.Haskell.InitState
import BNFC.Backend.Haskell.Utilities.InitState

import BNFC.Options.GlobalOptions

import           Data.Bifunctor (second)
import qualified Data.Map as Map

agdaInitState :: LBNF -> GlobalOptions -> AgdaBackendOptions -> Except String AgdaBackendState
agdaInitState lbnf globalOpts agdaOpts = do
  let hsAstRules    = processRules $ _lbnfASTRulesAP lbnf
      agdaAstRules  = processASTRulesAgda fNames hsAstRules
      fNames        = toList <$> Map.keys (_lbnfFunctions lbnf)
      hsFunctions   = processFunctions $ _lbnfFunctions  lbnf
      agdaFunctions = processFunctionsAgda hsFunctions
      tokens        = sortTokens $ _lbnfTokenDefs lbnf
  hsChecks lbnf
  return $
    AgdaSt
      globalOpts
      agdaOpts
      (getTokens lbnf)
      hsAstRules
      agdaAstRules
      (processParserRules (_lbnfParserRules lbnf))
      hsFunctions
      agdaFunctions
      tokens


processASTRulesAgda :: [String]
                    -> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
                    -> [(Type, [(Label, [Type])])]
processASTRulesAgda fNames rules =
  avoidResWordsASTRulesAgda $ filterRules fNames $ toAgdaRules <$> rules

-- Remove category precedence and ARHS from AST rules
toAgdaRules :: (Type, [(Label, ([Type], (Integer, ARHS)))])
            -> (Type, [(Label, [Type])])
toAgdaRules (r,l) = (r, second fst <$> l)

filterRules :: [String]
            -> [(Type, [(Label, [Type])])]
            -> [(Type, [(Label, [Type])])]
filterRules fNames rules =
  filter
  (\(_,l) -> not (null l))
  (Data.Bifunctor.second (filterLabelsAgdaAST fNames) <$> rules)

-- | Filter @Label@s that will be printed in the Agda AST datatypes.

filterLabelsAgdaAST :: [String]
                    -> [(Label, [Type])]
                    -> [(Label, [Type])]
filterLabelsAgdaAST fNames =
  filter (\(l,_) -> isALabel l && notElem (printLabelName l) fNames)