module BNFC.Backend.Agda.Options where

import BNFC.Prelude

import Options.Applicative

data AgdaBackendOptions = AgdaOpts
  { AgdaBackendOptions -> Maybe String
nameSpace   :: Maybe String
  , AgdaBackendOptions -> Bool
inDir       :: Bool
  , AgdaBackendOptions -> Bool
functor     :: Bool
  , AgdaBackendOptions -> Bool
generic     :: Bool
  }

agdaOptionsParser :: Parser AgdaBackendOptions
agdaOptionsParser :: Parser AgdaBackendOptions
agdaOptionsParser = Maybe String -> Bool -> Bool -> Bool -> AgdaBackendOptions
AgdaOpts
    (Maybe String -> Bool -> Bool -> Bool -> AgdaBackendOptions)
-> Parser (Maybe String)
-> Parser (Bool -> Bool -> Bool -> AgdaBackendOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe String)
oNameSpace
    Parser (Bool -> Bool -> Bool -> AgdaBackendOptions)
-> Parser Bool -> Parser (Bool -> Bool -> AgdaBackendOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
oInDir
    Parser (Bool -> Bool -> AgdaBackendOptions)
-> Parser Bool -> Parser (Bool -> AgdaBackendOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
oFunctor
    Parser (Bool -> AgdaBackendOptions)
-> Parser Bool -> Parser AgdaBackendOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
oGeneric

  where

    -- name-space option
    oNameSpace :: Parser (Maybe String)
oNameSpace =
      Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String -> Parser (Maybe String))
-> Parser String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$
      Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          ( Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"name-space"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Prepend NAMESPACE to the package/module name"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NAMESPACE")

    -- inDir option
    oInDir :: Parser Bool
oInDir =
      Mod FlagFields Bool -> Parser Bool
switch
          ( Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd'
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Put Haskell code in modules LANG.* instead of LANG* (recommended)" )

    -- functor option
    oFunctor :: Parser Bool
oFunctor =
      Mod FlagFields Bool -> Parser Bool
switch
          ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"functor"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Make the AST a functor and use it to store the position of the nodes" )

    -- generic option
    oGeneric :: Parser Bool
oGeneric =
      Mod FlagFields Bool -> Parser Bool
switch
          ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"generic"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Derive Data, Generic, and Typeable instances for AST types" )


printAgdaOptions :: AgdaBackendOptions -> String
printAgdaOptions :: AgdaBackendOptions -> String
printAgdaOptions AgdaBackendOptions
opts = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
  [ String
nSpace, String
dir, String
funct, String
gen ]

  where

    nSpace :: String
nSpace = case AgdaBackendOptions -> Maybe String
nameSpace AgdaBackendOptions
opts of
      Just String
n  -> String
"-p " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n
      Maybe String
Nothing -> String
""

    dir :: String
dir = if AgdaBackendOptions -> Bool
inDir AgdaBackendOptions
opts then String
"-d" else String
""

    funct :: String
funct = if AgdaBackendOptions -> Bool
functor AgdaBackendOptions
opts then String
"--functor" else String
""

    gen :: String
gen = if AgdaBackendOptions -> Bool
generic AgdaBackendOptions
opts then String
"--generic" else String
""