module BNFC.Backend.Haskell.Options where

import BNFC.Prelude

import Data.List (intercalate)

import Options.Applicative

data HaskellBackendOptions = HaskellOpts
  { nameSpace   :: Maybe String
  , inDir       :: Bool
  , tokenText   :: TokenText
  , functor     :: Bool
  , generic     :: Bool
  , xml         :: Bool
  , xmlt        :: Bool
  , gadt        :: Bool
  }

haskellOptionsParser :: Parser HaskellBackendOptions
haskellOptionsParser = HaskellOpts
    <$> oNameSpace
    <*> oInDir
    <*> oTokenText
    <*> oFunctor
    <*> oGeneric
    <*> oXml
    <*> oXmlt
    <*> oGadt

  where

    -- name-space option
    oNameSpace =
      optional $
      strOption
          ( short 'p'
          <> long "name-space"
          <> help "Prepend NAMESPACE to the package/module name"
          <> metavar "NAMESPACE")

    -- inDir option
    oInDir =
      switch
          ( short 'd'
         <> help "Put Haskell code in modules LANG.* instead of LANG* (recommended)" )

    -- tokenText option
    oTokenText =
      option tokenTextReader
          ( long "token-text"
         <> value StringToken
         <> showDefaultWith showTokenText
         <> metavar "TYPE"
         <> help ("How to represent token content in the Haskell backend ("
          ++ intercalate ", " (map showTokenText [minBound..maxBound]) ++ ")"))

    -- functor option
    oFunctor =
      switch
          ( long "functor"
         <> help "Make the AST a functor and use it to store the position of the nodes" )

    -- generic option
    oGeneric =
      switch
          ( long "generic"
         <> help "Derive Data, Generic, and Typeable instances for AST types" )

    -- xml option
    oXml =
      switch
          ( long "xml"
         <> help "Also generate a DTD and an XML printer" )

    -- xmlt option
    oXmlt =
      switch
          ( long "xmlt"
         <> help "DTD and an XML printer, another encoding" )

    -- gadt option
    oGadt =
      switch
          ( long "gadt"
         <> help "Output Haskell code which uses GADTs" )

tokenTextReader :: ReadM TokenText
tokenTextReader = maybeReader $ \case
  "string"     -> Just StringToken
  "text"       -> Just TextToken
  _            -> Nothing

showTokenText :: TokenText -> String
showTokenText = \case
  StringToken     -> "string"
  TextToken       -> "text"

-- | How to represent token content in the Haskell backend?

data TokenText
  = StringToken      -- ^ Represent strings as @String@.
  | TextToken        -- ^ Represent strings as @Data.Text@.
  deriving (Bounded , Enum, Eq, Ord, Show)

isStringToken :: TokenText -> Bool
isStringToken = \case
  StringToken -> True
  TextToken   -> False

isTextToken :: TokenText -> Bool
isTextToken = \case
  StringToken -> False
  TextToken   -> True

printHaskellOptions :: HaskellBackendOptions -> String
printHaskellOptions opts = unwords $ filter (not . null)
  [ nSpace, dir, tt, funct, gen, xml', xmlt', gadt' ]

  where

    nSpace = case nameSpace opts of
      Just n -> "-p " ++ n
      Nothing -> ""

    dir = if inDir opts then "-d" else ""

    tt = case tokenText opts of
      StringToken -> ""
      TextToken -> "--token-text text"

    funct = if functor opts then "--functor" else ""

    gen = if generic opts then "--generic" else ""

    xml' = if xml opts then "--xml" else ""

    xmlt' = if xml opts then "--xmlt" else ""

    gadt' = if gadt opts then "--gadt" else ""