module BNFC.Options where

import BNFC.Prelude

import BNFC.Options.Commands
import BNFC.Options.GlobalOptions
import BNFC.Options.InfoOptions

import Options.Applicative
import Options.Applicative.Help.Pretty (vcat, text)

import System.Environment (getArgs)


data Options = Options
  { Options -> GlobalOptions
globalOptions :: GlobalOptions
  , Options -> Command
command       :: Command
  }

programOptions :: Parser Options
programOptions :: Parser Options
programOptions = GlobalOptions -> Command -> Options
Options (GlobalOptions -> Command -> Options)
-> Parser GlobalOptions -> Parser (Command -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GlobalOptions
globalOptionsParser Parser (Command -> Options) -> Parser Command -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
commandsParser

getOptInput :: Options -> FilePath
getOptInput :: Options -> FilePath
getOptInput = GlobalOptions -> FilePath
optInput (GlobalOptions -> FilePath)
-> (Options -> GlobalOptions) -> Options -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> GlobalOptions
globalOptions

-- * Option parsing and handling

options :: IO Options
options :: IO Options
options = [FilePath] -> IO Options
options' ([FilePath] -> IO Options) -> IO [FilePath] -> IO Options
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [FilePath]
getArgs

options' :: [String] -> IO Options
options' :: [FilePath] -> IO Options
options' [FilePath]
args =
  [FilePath] -> ParserInfo Options -> IO Options
forall a. [FilePath] -> ParserInfo a -> IO a
execParser' [FilePath]
args (ParserInfo Options -> IO Options)
-> ParserInfo Options -> IO Options
forall a b. (a -> b) -> a -> b
$
    Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser
  ((((Options -> Options) -> Options -> Options)
    -> (Options -> Options) -> Options -> Options)
   -> ((Options -> Options) -> Options -> Options)
   -> (Options -> Options)
   -> Options
   -> Options)
forall a. Parser (a -> a)
helper Parser
  ((((Options -> Options) -> Options -> Options)
    -> (Options -> Options) -> Options -> Options)
   -> ((Options -> Options) -> Options -> Options)
   -> (Options -> Options)
   -> Options
   -> Options)
-> Parser
     (((Options -> Options) -> Options -> Options)
      -> (Options -> Options) -> Options -> Options)
-> Parser
     (((Options -> Options) -> Options -> Options)
      -> (Options -> Options) -> Options -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (((Options -> Options) -> Options -> Options)
   -> (Options -> Options) -> Options -> Options)
forall a. Parser (a -> a)
versionOption Parser
  (((Options -> Options) -> Options -> Options)
   -> (Options -> Options) -> Options -> Options)
-> Parser ((Options -> Options) -> Options -> Options)
-> Parser ((Options -> Options) -> Options -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ((Options -> Options) -> Options -> Options)
forall a. Parser (a -> a)
numericVersionOption Parser ((Options -> Options) -> Options -> Options)
-> Parser (Options -> Options) -> Parser (Options -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Options -> Options)
forall a. Parser (a -> a)
licenseOption Parser (Options -> Options) -> Parser Options -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Options
programOptions)
         (FilePath -> InfoMod Options
forall a. FilePath -> InfoMod a
header FilePath
"The BNF Converter"
          InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod Options
forall a. Maybe Doc -> InfoMod a
footerDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
foot))
  where
    foot :: Doc
foot = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (FilePath -> Doc) -> [FilePath] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Doc
text ([FilePath] -> [Doc]) -> [FilePath] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [ FilePath
""
        ]
      ]

type Target = Maybe FilePath

-- * Patch to optparse-applicative

-- | Like 'execParser', but parse given argument list rather than those from 'getArgs'.
execParser' :: [String] -> ParserInfo a -> IO a
execParser' :: [FilePath] -> ParserInfo a -> IO a
execParser' = ParserPrefs -> [FilePath] -> ParserInfo a -> IO a
forall a. ParserPrefs -> [FilePath] -> ParserInfo a -> IO a
customExecParser' ParserPrefs
defaultPrefs

-- | Run a program description with custom preferences.
customExecParser' :: ParserPrefs -> [String] -> ParserInfo a -> IO a
customExecParser' :: ParserPrefs -> [FilePath] -> ParserInfo a -> IO a
customExecParser' ParserPrefs
pprefs [FilePath]
args ParserInfo a
pinfo =
  ParserResult a -> IO a
forall a. ParserResult a -> IO a
handleParseResult (ParserResult a -> IO a) -> ParserResult a -> IO a
forall a b. (a -> b) -> a -> b
$ ParserPrefs -> ParserInfo a -> [FilePath] -> ParserResult a
forall a.
ParserPrefs -> ParserInfo a -> [FilePath] -> ParserResult a
execParserPure ParserPrefs
pprefs ParserInfo a
pinfo [FilePath]
args