module BNFC.Backend.Haskell.InitState where

import BNFC.Prelude

import Control.Monad.Except

import qualified Data.Map as Map

import BNFC.CF

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

import BNFC.Options.GlobalOptions


haskellInitState :: LBNF -> GlobalOptions -> HaskellBackendOptions -> Except String HaskellBackendState
haskellInitState lbnf globalOpts hsOpts = do
  hsChecks lbnf
  return $
    HaskellSt
      globalOpts
      hsOpts
      (getTokens lbnf)
      (processRules (_lbnfASTRulesAP lbnf))
      (processParserRules (_lbnfParserRules lbnf))
      (processFunctions (_lbnfFunctions  lbnf))
      (sortTokens (_lbnfTokenDefs lbnf))


-- | Checks specific of the Haskell language.
hsChecks :: LBNF -> Except String ()
hsChecks lbnf = do

  when usesLayoutStop $
    -- If a grammar that uses layout has the @layout stop@ pragma,
    -- then it also need to have the @layout@ start one.
    unless usesLayoutStart
      $ throwError $
        "ERROR: the grammar uses the layout stop pragma," ++
        " but no layout start has been specified"

  when (layoutsAreUsed lbnf) $
    -- A grammar that uses layout needs to contain symbols { } ;
    unless
        ( null missingLayoutSymbols )
        $ throwError $ unwords $
          "ERROR: the grammar uses layout, but does not mention symbols"
            : missingLayoutSymbols

  where

    usesLayoutStop  = not $ Map.null (_lbnfLayoutStop lbnf)

    usesLayoutStart = not $ Map.null (_lbnfLayoutStart lbnf)

    layoutSymbols :: [String]
    layoutSymbols =
      if Map.null (_lbnfLayoutStart lbnf) && Map.null (_lbnfLayoutStop lbnf)
      then [";"]
      else [";", "{", "}" ]

    missingLayoutSymbols :: [String]
    missingLayoutSymbols = filter (`notElem` symbols) layoutSymbols

    symbols :: [String]
    symbols = toList . theSymbol <$> Map.keys (_lbnfSymbols lbnf)