module GF.Infra.Option
    (
     -- ** Command line options
     -- *** Option types
     Options,
     Flags(..),
     Mode(..), Phase(..), Verbosity(..),
     OutputFormat(..),
     SISRFormat(..), Optimization(..), CFGTransform(..), HaskellOption(..),
     Dump(..), Pass(..), Recomp(..),
     outputFormatsExpl,
     -- *** Option parsing
     parseOptions, parseModuleOptions, fixRelativeLibPaths,
     -- *** Option pretty-printing
     optionsGFO,
     optionsPGF,
     -- *** Option manipulation
     addOptions, concatOptions, noOptions,
     modifyFlags,
     helpMessage,
     -- *** Checking specific options
     flag, cfgTransform, haskellOption, readOutputFormat,
     isLexicalCat, isLiteralCat, renameEncoding, getEncoding, defaultEncoding,
     -- *** Setting specific options
     setOptimization, setCFGTransform,
     -- *** Convenience methods for checking options
     verbAtLeast, dump
    ) where

import Control.Monad
import Data.Char (toLower, isDigit)
import Data.List
import Data.Maybe
import GF.Infra.Ident
import GF.Infra.GetOpt
import GF.Grammar.Predef
--import System.Console.GetOpt
import System.FilePath
--import System.IO

import GF.Data.Operations(Err,ErrorMonad(..),liftErr)

import Data.Set (Set)
import qualified Data.Set as Set

import PGF.Internal(Literal(..))
import qualified Control.Monad.Fail as Fail

usageHeader :: String
usageHeader :: String
usageHeader = [String] -> String
unlines
 [String
"Usage: gf [OPTIONS] [FILE [...]]",
  String
"",
  String
"How each FILE is handled depends on the file name suffix:",
  String
"",
  String
".gf Normal or old GF source, will be compiled.",
  String
".gfo Compiled GF source, will be loaded as is.",
  String
".gfe Example-based GF source, will be converted to .gf and compiled.",
  String
".ebnf Extended BNF format, will be converted to .gf and compiled.",
  String
".cf Context-free (BNF) format, will be converted to .gf and compiled.",
  String
"",
  String
"If multiple FILES are given, they must be normal GF source, .gfo or .gfe files.",
  String
"For the other input formats, only one file can be given.",
  String
"",
  String
"Command-line options:"]


helpMessage :: String
helpMessage :: String
helpMessage = String -> [OptDescr (Err Options)] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
usageHeader [OptDescr (Err Options)]
optDescr


-- FIXME: do we really want multi-line errors?
errors :: ErrorMonad err => [String] -> err a
errors :: [String] -> err a
errors = String -> err a
forall (m :: * -> *) a. ErrorMonad m => String -> m a
raise (String -> err a) -> ([String] -> String) -> [String] -> err a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines

-- Types

data Mode = ModeVersion | ModeHelp
          | ModeInteractive | ModeRun
          | ModeInteractive2 | ModeRun2
          | ModeCompiler
          | ModeServer {-port::-}Int
  deriving (Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show,Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq,Eq Mode
Eq Mode
-> (Mode -> Mode -> Ordering)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Mode)
-> (Mode -> Mode -> Mode)
-> Ord Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmax :: Mode -> Mode -> Mode
>= :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c< :: Mode -> Mode -> Bool
compare :: Mode -> Mode -> Ordering
$ccompare :: Mode -> Mode -> Ordering
$cp1Ord :: Eq Mode
Ord)

data Verbosity = Quiet | Normal | Verbose | Debug
  deriving (Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
(Int -> Verbosity -> ShowS)
-> (Verbosity -> String)
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verbosity] -> ShowS
$cshowList :: [Verbosity] -> ShowS
show :: Verbosity -> String
$cshow :: Verbosity -> String
showsPrec :: Int -> Verbosity -> ShowS
$cshowsPrec :: Int -> Verbosity -> ShowS
Show,Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq,Eq Verbosity
Eq Verbosity
-> (Verbosity -> Verbosity -> Ordering)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Verbosity)
-> (Verbosity -> Verbosity -> Verbosity)
-> Ord Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmax :: Verbosity -> Verbosity -> Verbosity
>= :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c< :: Verbosity -> Verbosity -> Bool
compare :: Verbosity -> Verbosity -> Ordering
$ccompare :: Verbosity -> Verbosity -> Ordering
$cp1Ord :: Eq Verbosity
Ord,Int -> Verbosity
Verbosity -> Int
Verbosity -> [Verbosity]
Verbosity -> Verbosity
Verbosity -> Verbosity -> [Verbosity]
Verbosity -> Verbosity -> Verbosity -> [Verbosity]
(Verbosity -> Verbosity)
-> (Verbosity -> Verbosity)
-> (Int -> Verbosity)
-> (Verbosity -> Int)
-> (Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> Verbosity -> [Verbosity])
-> Enum Verbosity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
$cenumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
enumFromTo :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromTo :: Verbosity -> Verbosity -> [Verbosity]
enumFromThen :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromThen :: Verbosity -> Verbosity -> [Verbosity]
enumFrom :: Verbosity -> [Verbosity]
$cenumFrom :: Verbosity -> [Verbosity]
fromEnum :: Verbosity -> Int
$cfromEnum :: Verbosity -> Int
toEnum :: Int -> Verbosity
$ctoEnum :: Int -> Verbosity
pred :: Verbosity -> Verbosity
$cpred :: Verbosity -> Verbosity
succ :: Verbosity -> Verbosity
$csucc :: Verbosity -> Verbosity
Enum,Verbosity
Verbosity -> Verbosity -> Bounded Verbosity
forall a. a -> a -> Bounded a
maxBound :: Verbosity
$cmaxBound :: Verbosity
minBound :: Verbosity
$cminBound :: Verbosity
Bounded)

data Phase = Preproc | Convert | Compile | Link
  deriving (Int -> Phase -> ShowS
[Phase] -> ShowS
Phase -> String
(Int -> Phase -> ShowS)
-> (Phase -> String) -> ([Phase] -> ShowS) -> Show Phase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Phase] -> ShowS
$cshowList :: [Phase] -> ShowS
show :: Phase -> String
$cshow :: Phase -> String
showsPrec :: Int -> Phase -> ShowS
$cshowsPrec :: Int -> Phase -> ShowS
Show,Phase -> Phase -> Bool
(Phase -> Phase -> Bool) -> (Phase -> Phase -> Bool) -> Eq Phase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Phase -> Phase -> Bool
$c/= :: Phase -> Phase -> Bool
== :: Phase -> Phase -> Bool
$c== :: Phase -> Phase -> Bool
Eq,Eq Phase
Eq Phase
-> (Phase -> Phase -> Ordering)
-> (Phase -> Phase -> Bool)
-> (Phase -> Phase -> Bool)
-> (Phase -> Phase -> Bool)
-> (Phase -> Phase -> Bool)
-> (Phase -> Phase -> Phase)
-> (Phase -> Phase -> Phase)
-> Ord Phase
Phase -> Phase -> Bool
Phase -> Phase -> Ordering
Phase -> Phase -> Phase
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Phase -> Phase -> Phase
$cmin :: Phase -> Phase -> Phase
max :: Phase -> Phase -> Phase
$cmax :: Phase -> Phase -> Phase
>= :: Phase -> Phase -> Bool
$c>= :: Phase -> Phase -> Bool
> :: Phase -> Phase -> Bool
$c> :: Phase -> Phase -> Bool
<= :: Phase -> Phase -> Bool
$c<= :: Phase -> Phase -> Bool
< :: Phase -> Phase -> Bool
$c< :: Phase -> Phase -> Bool
compare :: Phase -> Phase -> Ordering
$ccompare :: Phase -> Phase -> Ordering
$cp1Ord :: Eq Phase
Ord)

data OutputFormat = FmtPGFPretty
                  | FmtCanonicalGF
                  | FmtCanonicalJson
                  | FmtJavaScript
                  | FmtJSON
                  | FmtPython
                  | FmtHaskell
                  | FmtJava
                  | FmtProlog
                  | FmtBNF
                  | FmtEBNF
                  | FmtRegular
                  | FmtNoLR
                  | FmtSRGS_XML
                  | FmtSRGS_XML_NonRec
                  | FmtSRGS_ABNF
                  | FmtSRGS_ABNF_NonRec
                  | FmtJSGF
                  | FmtGSL
                  | FmtVoiceXML
                  | FmtSLF
                  | FmtRegExp
                  | FmtFA
  deriving (OutputFormat -> OutputFormat -> Bool
(OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool) -> Eq OutputFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputFormat -> OutputFormat -> Bool
$c/= :: OutputFormat -> OutputFormat -> Bool
== :: OutputFormat -> OutputFormat -> Bool
$c== :: OutputFormat -> OutputFormat -> Bool
Eq,Eq OutputFormat
Eq OutputFormat
-> (OutputFormat -> OutputFormat -> Ordering)
-> (OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> OutputFormat)
-> (OutputFormat -> OutputFormat -> OutputFormat)
-> Ord OutputFormat
OutputFormat -> OutputFormat -> Bool
OutputFormat -> OutputFormat -> Ordering
OutputFormat -> OutputFormat -> OutputFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OutputFormat -> OutputFormat -> OutputFormat
$cmin :: OutputFormat -> OutputFormat -> OutputFormat
max :: OutputFormat -> OutputFormat -> OutputFormat
$cmax :: OutputFormat -> OutputFormat -> OutputFormat
>= :: OutputFormat -> OutputFormat -> Bool
$c>= :: OutputFormat -> OutputFormat -> Bool
> :: OutputFormat -> OutputFormat -> Bool
$c> :: OutputFormat -> OutputFormat -> Bool
<= :: OutputFormat -> OutputFormat -> Bool
$c<= :: OutputFormat -> OutputFormat -> Bool
< :: OutputFormat -> OutputFormat -> Bool
$c< :: OutputFormat -> OutputFormat -> Bool
compare :: OutputFormat -> OutputFormat -> Ordering
$ccompare :: OutputFormat -> OutputFormat -> Ordering
$cp1Ord :: Eq OutputFormat
Ord)

data SISRFormat =
    -- | SISR Working draft 1 April 2003
    --   <http://www.w3.org/TR/2003/WD-semantic-interpretation-20030401/>
    SISR_WD20030401
  | SISR_1_0
 deriving (Int -> SISRFormat -> ShowS
[SISRFormat] -> ShowS
SISRFormat -> String
(Int -> SISRFormat -> ShowS)
-> (SISRFormat -> String)
-> ([SISRFormat] -> ShowS)
-> Show SISRFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SISRFormat] -> ShowS
$cshowList :: [SISRFormat] -> ShowS
show :: SISRFormat -> String
$cshow :: SISRFormat -> String
showsPrec :: Int -> SISRFormat -> ShowS
$cshowsPrec :: Int -> SISRFormat -> ShowS
Show,SISRFormat -> SISRFormat -> Bool
(SISRFormat -> SISRFormat -> Bool)
-> (SISRFormat -> SISRFormat -> Bool) -> Eq SISRFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SISRFormat -> SISRFormat -> Bool
$c/= :: SISRFormat -> SISRFormat -> Bool
== :: SISRFormat -> SISRFormat -> Bool
$c== :: SISRFormat -> SISRFormat -> Bool
Eq,Eq SISRFormat
Eq SISRFormat
-> (SISRFormat -> SISRFormat -> Ordering)
-> (SISRFormat -> SISRFormat -> Bool)
-> (SISRFormat -> SISRFormat -> Bool)
-> (SISRFormat -> SISRFormat -> Bool)
-> (SISRFormat -> SISRFormat -> Bool)
-> (SISRFormat -> SISRFormat -> SISRFormat)
-> (SISRFormat -> SISRFormat -> SISRFormat)
-> Ord SISRFormat
SISRFormat -> SISRFormat -> Bool
SISRFormat -> SISRFormat -> Ordering
SISRFormat -> SISRFormat -> SISRFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SISRFormat -> SISRFormat -> SISRFormat
$cmin :: SISRFormat -> SISRFormat -> SISRFormat
max :: SISRFormat -> SISRFormat -> SISRFormat
$cmax :: SISRFormat -> SISRFormat -> SISRFormat
>= :: SISRFormat -> SISRFormat -> Bool
$c>= :: SISRFormat -> SISRFormat -> Bool
> :: SISRFormat -> SISRFormat -> Bool
$c> :: SISRFormat -> SISRFormat -> Bool
<= :: SISRFormat -> SISRFormat -> Bool
$c<= :: SISRFormat -> SISRFormat -> Bool
< :: SISRFormat -> SISRFormat -> Bool
$c< :: SISRFormat -> SISRFormat -> Bool
compare :: SISRFormat -> SISRFormat -> Ordering
$ccompare :: SISRFormat -> SISRFormat -> Ordering
$cp1Ord :: Eq SISRFormat
Ord)

data Optimization = OptStem | OptCSE | OptExpand | OptParametrize
  deriving (Int -> Optimization -> ShowS
[Optimization] -> ShowS
Optimization -> String
(Int -> Optimization -> ShowS)
-> (Optimization -> String)
-> ([Optimization] -> ShowS)
-> Show Optimization
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Optimization] -> ShowS
$cshowList :: [Optimization] -> ShowS
show :: Optimization -> String
$cshow :: Optimization -> String
showsPrec :: Int -> Optimization -> ShowS
$cshowsPrec :: Int -> Optimization -> ShowS
Show,Optimization -> Optimization -> Bool
(Optimization -> Optimization -> Bool)
-> (Optimization -> Optimization -> Bool) -> Eq Optimization
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Optimization -> Optimization -> Bool
$c/= :: Optimization -> Optimization -> Bool
== :: Optimization -> Optimization -> Bool
$c== :: Optimization -> Optimization -> Bool
Eq,Eq Optimization
Eq Optimization
-> (Optimization -> Optimization -> Ordering)
-> (Optimization -> Optimization -> Bool)
-> (Optimization -> Optimization -> Bool)
-> (Optimization -> Optimization -> Bool)
-> (Optimization -> Optimization -> Bool)
-> (Optimization -> Optimization -> Optimization)
-> (Optimization -> Optimization -> Optimization)
-> Ord Optimization
Optimization -> Optimization -> Bool
Optimization -> Optimization -> Ordering
Optimization -> Optimization -> Optimization
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Optimization -> Optimization -> Optimization
$cmin :: Optimization -> Optimization -> Optimization
max :: Optimization -> Optimization -> Optimization
$cmax :: Optimization -> Optimization -> Optimization
>= :: Optimization -> Optimization -> Bool
$c>= :: Optimization -> Optimization -> Bool
> :: Optimization -> Optimization -> Bool
$c> :: Optimization -> Optimization -> Bool
<= :: Optimization -> Optimization -> Bool
$c<= :: Optimization -> Optimization -> Bool
< :: Optimization -> Optimization -> Bool
$c< :: Optimization -> Optimization -> Bool
compare :: Optimization -> Optimization -> Ordering
$ccompare :: Optimization -> Optimization -> Ordering
$cp1Ord :: Eq Optimization
Ord)

data CFGTransform = CFGNoLR
                  | CFGRegular
                  | CFGTopDownFilter
                  | CFGBottomUpFilter
                  | CFGStartCatOnly
                  | CFGMergeIdentical
                  | CFGRemoveCycles
  deriving (Int -> CFGTransform -> ShowS
[CFGTransform] -> ShowS
CFGTransform -> String
(Int -> CFGTransform -> ShowS)
-> (CFGTransform -> String)
-> ([CFGTransform] -> ShowS)
-> Show CFGTransform
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CFGTransform] -> ShowS
$cshowList :: [CFGTransform] -> ShowS
show :: CFGTransform -> String
$cshow :: CFGTransform -> String
showsPrec :: Int -> CFGTransform -> ShowS
$cshowsPrec :: Int -> CFGTransform -> ShowS
Show,CFGTransform -> CFGTransform -> Bool
(CFGTransform -> CFGTransform -> Bool)
-> (CFGTransform -> CFGTransform -> Bool) -> Eq CFGTransform
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CFGTransform -> CFGTransform -> Bool
$c/= :: CFGTransform -> CFGTransform -> Bool
== :: CFGTransform -> CFGTransform -> Bool
$c== :: CFGTransform -> CFGTransform -> Bool
Eq,Eq CFGTransform
Eq CFGTransform
-> (CFGTransform -> CFGTransform -> Ordering)
-> (CFGTransform -> CFGTransform -> Bool)
-> (CFGTransform -> CFGTransform -> Bool)
-> (CFGTransform -> CFGTransform -> Bool)
-> (CFGTransform -> CFGTransform -> Bool)
-> (CFGTransform -> CFGTransform -> CFGTransform)
-> (CFGTransform -> CFGTransform -> CFGTransform)
-> Ord CFGTransform
CFGTransform -> CFGTransform -> Bool
CFGTransform -> CFGTransform -> Ordering
CFGTransform -> CFGTransform -> CFGTransform
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CFGTransform -> CFGTransform -> CFGTransform
$cmin :: CFGTransform -> CFGTransform -> CFGTransform
max :: CFGTransform -> CFGTransform -> CFGTransform
$cmax :: CFGTransform -> CFGTransform -> CFGTransform
>= :: CFGTransform -> CFGTransform -> Bool
$c>= :: CFGTransform -> CFGTransform -> Bool
> :: CFGTransform -> CFGTransform -> Bool
$c> :: CFGTransform -> CFGTransform -> Bool
<= :: CFGTransform -> CFGTransform -> Bool
$c<= :: CFGTransform -> CFGTransform -> Bool
< :: CFGTransform -> CFGTransform -> Bool
$c< :: CFGTransform -> CFGTransform -> Bool
compare :: CFGTransform -> CFGTransform -> Ordering
$ccompare :: CFGTransform -> CFGTransform -> Ordering
$cp1Ord :: Eq CFGTransform
Ord)

data HaskellOption = HaskellNoPrefix
                   | HaskellGADT
                   | HaskellLexical
                   | HaskellConcrete
                   | HaskellVariants
                   | HaskellData
                   | HaskellPGF2
  deriving (Int -> HaskellOption -> ShowS
[HaskellOption] -> ShowS
HaskellOption -> String
(Int -> HaskellOption -> ShowS)
-> (HaskellOption -> String)
-> ([HaskellOption] -> ShowS)
-> Show HaskellOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HaskellOption] -> ShowS
$cshowList :: [HaskellOption] -> ShowS
show :: HaskellOption -> String
$cshow :: HaskellOption -> String
showsPrec :: Int -> HaskellOption -> ShowS
$cshowsPrec :: Int -> HaskellOption -> ShowS
Show,HaskellOption -> HaskellOption -> Bool
(HaskellOption -> HaskellOption -> Bool)
-> (HaskellOption -> HaskellOption -> Bool) -> Eq HaskellOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HaskellOption -> HaskellOption -> Bool
$c/= :: HaskellOption -> HaskellOption -> Bool
== :: HaskellOption -> HaskellOption -> Bool
$c== :: HaskellOption -> HaskellOption -> Bool
Eq,Eq HaskellOption
Eq HaskellOption
-> (HaskellOption -> HaskellOption -> Ordering)
-> (HaskellOption -> HaskellOption -> Bool)
-> (HaskellOption -> HaskellOption -> Bool)
-> (HaskellOption -> HaskellOption -> Bool)
-> (HaskellOption -> HaskellOption -> Bool)
-> (HaskellOption -> HaskellOption -> HaskellOption)
-> (HaskellOption -> HaskellOption -> HaskellOption)
-> Ord HaskellOption
HaskellOption -> HaskellOption -> Bool
HaskellOption -> HaskellOption -> Ordering
HaskellOption -> HaskellOption -> HaskellOption
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HaskellOption -> HaskellOption -> HaskellOption
$cmin :: HaskellOption -> HaskellOption -> HaskellOption
max :: HaskellOption -> HaskellOption -> HaskellOption
$cmax :: HaskellOption -> HaskellOption -> HaskellOption
>= :: HaskellOption -> HaskellOption -> Bool
$c>= :: HaskellOption -> HaskellOption -> Bool
> :: HaskellOption -> HaskellOption -> Bool
$c> :: HaskellOption -> HaskellOption -> Bool
<= :: HaskellOption -> HaskellOption -> Bool
$c<= :: HaskellOption -> HaskellOption -> Bool
< :: HaskellOption -> HaskellOption -> Bool
$c< :: HaskellOption -> HaskellOption -> Bool
compare :: HaskellOption -> HaskellOption -> Ordering
$ccompare :: HaskellOption -> HaskellOption -> Ordering
$cp1Ord :: Eq HaskellOption
Ord)

data Warning = WarnMissingLincat
  deriving (Int -> Warning -> ShowS
[Warning] -> ShowS
Warning -> String
(Int -> Warning -> ShowS)
-> (Warning -> String) -> ([Warning] -> ShowS) -> Show Warning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Warning] -> ShowS
$cshowList :: [Warning] -> ShowS
show :: Warning -> String
$cshow :: Warning -> String
showsPrec :: Int -> Warning -> ShowS
$cshowsPrec :: Int -> Warning -> ShowS
Show,Warning -> Warning -> Bool
(Warning -> Warning -> Bool)
-> (Warning -> Warning -> Bool) -> Eq Warning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Warning -> Warning -> Bool
$c/= :: Warning -> Warning -> Bool
== :: Warning -> Warning -> Bool
$c== :: Warning -> Warning -> Bool
Eq,Eq Warning
Eq Warning
-> (Warning -> Warning -> Ordering)
-> (Warning -> Warning -> Bool)
-> (Warning -> Warning -> Bool)
-> (Warning -> Warning -> Bool)
-> (Warning -> Warning -> Bool)
-> (Warning -> Warning -> Warning)
-> (Warning -> Warning -> Warning)
-> Ord Warning
Warning -> Warning -> Bool
Warning -> Warning -> Ordering
Warning -> Warning -> Warning
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Warning -> Warning -> Warning
$cmin :: Warning -> Warning -> Warning
max :: Warning -> Warning -> Warning
$cmax :: Warning -> Warning -> Warning
>= :: Warning -> Warning -> Bool
$c>= :: Warning -> Warning -> Bool
> :: Warning -> Warning -> Bool
$c> :: Warning -> Warning -> Bool
<= :: Warning -> Warning -> Bool
$c<= :: Warning -> Warning -> Bool
< :: Warning -> Warning -> Bool
$c< :: Warning -> Warning -> Bool
compare :: Warning -> Warning -> Ordering
$ccompare :: Warning -> Warning -> Ordering
$cp1Ord :: Eq Warning
Ord)

newtype Dump = Dump Pass deriving (Int -> Dump -> ShowS
[Dump] -> ShowS
Dump -> String
(Int -> Dump -> ShowS)
-> (Dump -> String) -> ([Dump] -> ShowS) -> Show Dump
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dump] -> ShowS
$cshowList :: [Dump] -> ShowS
show :: Dump -> String
$cshow :: Dump -> String
showsPrec :: Int -> Dump -> ShowS
$cshowsPrec :: Int -> Dump -> ShowS
Show,Dump -> Dump -> Bool
(Dump -> Dump -> Bool) -> (Dump -> Dump -> Bool) -> Eq Dump
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dump -> Dump -> Bool
$c/= :: Dump -> Dump -> Bool
== :: Dump -> Dump -> Bool
$c== :: Dump -> Dump -> Bool
Eq,Eq Dump
Eq Dump
-> (Dump -> Dump -> Ordering)
-> (Dump -> Dump -> Bool)
-> (Dump -> Dump -> Bool)
-> (Dump -> Dump -> Bool)
-> (Dump -> Dump -> Bool)
-> (Dump -> Dump -> Dump)
-> (Dump -> Dump -> Dump)
-> Ord Dump
Dump -> Dump -> Bool
Dump -> Dump -> Ordering
Dump -> Dump -> Dump
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Dump -> Dump -> Dump
$cmin :: Dump -> Dump -> Dump
max :: Dump -> Dump -> Dump
$cmax :: Dump -> Dump -> Dump
>= :: Dump -> Dump -> Bool
$c>= :: Dump -> Dump -> Bool
> :: Dump -> Dump -> Bool
$c> :: Dump -> Dump -> Bool
<= :: Dump -> Dump -> Bool
$c<= :: Dump -> Dump -> Bool
< :: Dump -> Dump -> Bool
$c< :: Dump -> Dump -> Bool
compare :: Dump -> Dump -> Ordering
$ccompare :: Dump -> Dump -> Ordering
$cp1Ord :: Eq Dump
Ord)
data Pass = Source | Rebuild | Extend | Rename | TypeCheck | Refresh | Optimize | Canon
  deriving (Int -> Pass -> ShowS
[Pass] -> ShowS
Pass -> String
(Int -> Pass -> ShowS)
-> (Pass -> String) -> ([Pass] -> ShowS) -> Show Pass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pass] -> ShowS
$cshowList :: [Pass] -> ShowS
show :: Pass -> String
$cshow :: Pass -> String
showsPrec :: Int -> Pass -> ShowS
$cshowsPrec :: Int -> Pass -> ShowS
Show,Pass -> Pass -> Bool
(Pass -> Pass -> Bool) -> (Pass -> Pass -> Bool) -> Eq Pass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pass -> Pass -> Bool
$c/= :: Pass -> Pass -> Bool
== :: Pass -> Pass -> Bool
$c== :: Pass -> Pass -> Bool
Eq,Eq Pass
Eq Pass
-> (Pass -> Pass -> Ordering)
-> (Pass -> Pass -> Bool)
-> (Pass -> Pass -> Bool)
-> (Pass -> Pass -> Bool)
-> (Pass -> Pass -> Bool)
-> (Pass -> Pass -> Pass)
-> (Pass -> Pass -> Pass)
-> Ord Pass
Pass -> Pass -> Bool
Pass -> Pass -> Ordering
Pass -> Pass -> Pass
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pass -> Pass -> Pass
$cmin :: Pass -> Pass -> Pass
max :: Pass -> Pass -> Pass
$cmax :: Pass -> Pass -> Pass
>= :: Pass -> Pass -> Bool
$c>= :: Pass -> Pass -> Bool
> :: Pass -> Pass -> Bool
$c> :: Pass -> Pass -> Bool
<= :: Pass -> Pass -> Bool
$c<= :: Pass -> Pass -> Bool
< :: Pass -> Pass -> Bool
$c< :: Pass -> Pass -> Bool
compare :: Pass -> Pass -> Ordering
$ccompare :: Pass -> Pass -> Ordering
$cp1Ord :: Eq Pass
Ord)

data Recomp = AlwaysRecomp | RecompIfNewer | NeverRecomp
  deriving (Int -> Recomp -> ShowS
[Recomp] -> ShowS
Recomp -> String
(Int -> Recomp -> ShowS)
-> (Recomp -> String) -> ([Recomp] -> ShowS) -> Show Recomp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Recomp] -> ShowS
$cshowList :: [Recomp] -> ShowS
show :: Recomp -> String
$cshow :: Recomp -> String
showsPrec :: Int -> Recomp -> ShowS
$cshowsPrec :: Int -> Recomp -> ShowS
Show,Recomp -> Recomp -> Bool
(Recomp -> Recomp -> Bool)
-> (Recomp -> Recomp -> Bool) -> Eq Recomp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Recomp -> Recomp -> Bool
$c/= :: Recomp -> Recomp -> Bool
== :: Recomp -> Recomp -> Bool
$c== :: Recomp -> Recomp -> Bool
Eq,Eq Recomp
Eq Recomp
-> (Recomp -> Recomp -> Ordering)
-> (Recomp -> Recomp -> Bool)
-> (Recomp -> Recomp -> Bool)
-> (Recomp -> Recomp -> Bool)
-> (Recomp -> Recomp -> Bool)
-> (Recomp -> Recomp -> Recomp)
-> (Recomp -> Recomp -> Recomp)
-> Ord Recomp
Recomp -> Recomp -> Bool
Recomp -> Recomp -> Ordering
Recomp -> Recomp -> Recomp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Recomp -> Recomp -> Recomp
$cmin :: Recomp -> Recomp -> Recomp
max :: Recomp -> Recomp -> Recomp
$cmax :: Recomp -> Recomp -> Recomp
>= :: Recomp -> Recomp -> Bool
$c>= :: Recomp -> Recomp -> Bool
> :: Recomp -> Recomp -> Bool
$c> :: Recomp -> Recomp -> Bool
<= :: Recomp -> Recomp -> Bool
$c<= :: Recomp -> Recomp -> Bool
< :: Recomp -> Recomp -> Bool
$c< :: Recomp -> Recomp -> Bool
compare :: Recomp -> Recomp -> Ordering
$ccompare :: Recomp -> Recomp -> Ordering
$cp1Ord :: Eq Recomp
Ord)

data Flags = Flags {
      Flags -> Mode
optMode            :: Mode,
      Flags -> Phase
optStopAfterPhase  :: Phase,
      Flags -> Verbosity
optVerbosity       :: Verbosity,
      Flags -> Bool
optShowCPUTime     :: Bool,
      Flags -> [OutputFormat]
optOutputFormats   :: [OutputFormat],
      Flags -> Maybe SISRFormat
optSISR            :: Maybe SISRFormat,
      Flags -> Set HaskellOption
optHaskellOptions  :: Set HaskellOption,
      Flags -> Set String
optLexicalCats     :: Set String,
      Flags -> Set Ident
optLiteralCats     :: Set Ident,
      Flags -> Maybe String
optGFODir          :: Maybe FilePath,
      Flags -> Maybe String
optOutputDir       :: Maybe FilePath,
      Flags -> Maybe [String]
optGFLibPath       :: Maybe [FilePath],
      Flags -> Maybe String
optDocumentRoot    :: Maybe FilePath, -- For --server mode
      Flags -> Recomp
optRecomp          :: Recomp,
      Flags -> Maybe String
optProbsFile       :: Maybe FilePath,
      Flags -> Bool
optRetainResource  :: Bool,
      Flags -> Maybe String
optName            :: Maybe String,
      Flags -> [String]
optPreprocessors   :: [String],
      Flags -> Maybe String
optEncoding        :: Maybe String,
      Flags -> Bool
optPMCFG           :: Bool,
      Flags -> Set Optimization
optOptimizations   :: Set Optimization,
      Flags -> Bool
optOptimizePGF     :: Bool,
      Flags -> Bool
optSplitPGF        :: Bool,
      Flags -> Set CFGTransform
optCFGTransforms   :: Set CFGTransform,
      Flags -> [String]
optLibraryPath     :: [FilePath],
      Flags -> Maybe String
optStartCat        :: Maybe String,
      Flags -> Maybe String
optSpeechLanguage  :: Maybe String,
      Flags -> Maybe String
optLexer           :: Maybe String,
      Flags -> Maybe String
optUnlexer         :: Maybe String,
      Flags -> [Warning]
optWarnings        :: [Warning],
      Flags -> [Dump]
optDump            :: [Dump],
      Flags -> Bool
optTagsOnly        :: Bool,
      Flags -> Maybe Double
optHeuristicFactor :: Maybe Double,
      Flags -> Bool
optCaseSensitive   :: Bool,
      Flags -> Bool
optPlusAsBind      :: Bool,
      Flags -> Maybe (Maybe Int)
optJobs            :: Maybe (Maybe Int),
      Flags -> Bool
optTrace           :: Bool
    }
  deriving (Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> String
(Int -> Flags -> ShowS)
-> (Flags -> String) -> ([Flags] -> ShowS) -> Show Flags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flags] -> ShowS
$cshowList :: [Flags] -> ShowS
show :: Flags -> String
$cshow :: Flags -> String
showsPrec :: Int -> Flags -> ShowS
$cshowsPrec :: Int -> Flags -> ShowS
Show)

newtype Options = Options (Flags -> Flags)

instance Show Options where
    show :: Options -> String
show (Options Flags -> Flags
o) = Flags -> String
forall a. Show a => a -> String
show (Flags -> Flags
o Flags
defaultFlags)

-- Option parsing

parseOptions :: ErrorMonad err =>
                [String]                   -- ^ list of string arguments
             -> err (Options, [FilePath])
parseOptions :: [String] -> err (Options, [String])
parseOptions [String]
args
  | Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs) = [String] -> err (Options, [String])
forall (err :: * -> *) a. ErrorMonad err => [String] -> err a
errors [String]
errs
  | Bool
otherwise       = do Options
opts <- [Options] -> Options
concatOptions ([Options] -> Options) -> err [Options] -> err Options
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Err [Options] -> err [Options]
forall (m :: * -> *) a. ErrorMonad m => Err a -> m a
liftErr ([Err Options] -> Err [Options]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Err Options]
optss)
                         (Options, [String]) -> err (Options, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Options
opts, [String]
files)
  where
    ([Err Options]
optss, [String]
files, [String]
errs) = ArgOrder (Err Options)
-> [OptDescr (Err Options)]
-> [String]
-> ([Err Options], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder (Err Options)
forall a. ArgOrder a
RequireOrder [OptDescr (Err Options)]
optDescr [String]
args

parseModuleOptions :: ErrorMonad err =>
                      [String]                   -- ^ list of string arguments
                   -> err Options
parseModuleOptions :: [String] -> err Options
parseModuleOptions [String]
args = do
  (Options
opts,[String]
nonopts) <- [String] -> err (Options, [String])
forall (err :: * -> *).
ErrorMonad err =>
[String] -> err (Options, [String])
parseOptions [String]
args
  if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
nonopts
    then Options -> err Options
forall (m :: * -> *) a. Monad m => a -> m a
return Options
opts
    else [String] -> err Options
forall (err :: * -> *) a. ErrorMonad err => [String] -> err a
errors ([String] -> err Options) -> [String] -> err Options
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"Non-option among module options: " String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
nonopts

fixRelativeLibPaths :: String -> [String] -> Options -> Options
fixRelativeLibPaths String
curr_dir [String]
lib_dirs (Options Flags -> Flags
o) = (Flags -> Flags) -> Options
Options (Flags -> Flags
fixPathFlags (Flags -> Flags) -> (Flags -> Flags) -> Flags -> Flags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flags -> Flags
o)
  where
    fixPathFlags :: Flags -> Flags
fixPathFlags f :: Flags
f@(Flags{optLibraryPath :: Flags -> [String]
optLibraryPath=[String]
path}) = Flags
f{optLibraryPath :: [String]
optLibraryPath=(String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\String
dir -> [String
parent String -> ShowS
</> String
dir
                                                                                      | String
parent <- String
curr_dir String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
lib_dirs]) [String]
path}

-- Showing options

-- | Pretty-print the options that are preserved in .gfo files.
optionsGFO :: Options -> [(String,Literal)]
optionsGFO :: Options -> [(String, Literal)]
optionsGFO Options
opts = Options -> [(String, Literal)]
optionsPGF Options
opts
      [(String, Literal)] -> [(String, Literal)] -> [(String, Literal)]
forall a. [a] -> [a] -> [a]
++ [(String
"coding", String -> Literal
LStr (Options -> String
getEncoding Options
opts))]

-- | Pretty-print the options that are preserved in .pgf files.
optionsPGF :: Options -> [(String,Literal)]
optionsPGF :: Options -> [(String, Literal)]
optionsPGF Options
opts =
         [(String, Literal)]
-> (String -> [(String, Literal)])
-> Maybe String
-> [(String, Literal)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
x -> [(String
"language",String -> Literal
LStr String
x)]) ((Flags -> Maybe String) -> Options -> Maybe String
forall a. (Flags -> a) -> Options -> a
flag Flags -> Maybe String
optSpeechLanguage Options
opts)
      [(String, Literal)] -> [(String, Literal)] -> [(String, Literal)]
forall a. [a] -> [a] -> [a]
++ [(String, Literal)]
-> (String -> [(String, Literal)])
-> Maybe String
-> [(String, Literal)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
x -> [(String
"startcat",String -> Literal
LStr String
x)]) ((Flags -> Maybe String) -> Options -> Maybe String
forall a. (Flags -> a) -> Options -> a
flag Flags -> Maybe String
optStartCat Options
opts)
      [(String, Literal)] -> [(String, Literal)] -> [(String, Literal)]
forall a. [a] -> [a] -> [a]
++ [(String, Literal)]
-> (Double -> [(String, Literal)])
-> Maybe Double
-> [(String, Literal)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Double
x -> [(String
"heuristic_search_factor",Double -> Literal
LFlt Double
x)]) ((Flags -> Maybe Double) -> Options -> Maybe Double
forall a. (Flags -> a) -> Options -> a
flag Flags -> Maybe Double
optHeuristicFactor Options
opts)
      [(String, Literal)] -> [(String, Literal)] -> [(String, Literal)]
forall a. [a] -> [a] -> [a]
++ (if (Flags -> Bool) -> Options -> Bool
forall a. (Flags -> a) -> Options -> a
flag Flags -> Bool
optCaseSensitive Options
opts then [] else [(String
"case_sensitive",String -> Literal
LStr String
"off")])

-- Option manipulation

flag :: (Flags -> a) -> Options -> a
flag :: (Flags -> a) -> Options -> a
flag Flags -> a
f (Options Flags -> Flags
o) = Flags -> a
f (Flags -> Flags
o Flags
defaultFlags)

addOptions :: Options -> Options -> Options
addOptions :: Options -> Options -> Options
addOptions (Options Flags -> Flags
o1) (Options Flags -> Flags
o2) = (Flags -> Flags) -> Options
Options (Flags -> Flags
o2 (Flags -> Flags) -> (Flags -> Flags) -> Flags -> Flags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flags -> Flags
o1)

noOptions :: Options
noOptions :: Options
noOptions = (Flags -> Flags) -> Options
Options Flags -> Flags
forall a. a -> a
id

concatOptions :: [Options] -> Options
concatOptions :: [Options] -> Options
concatOptions = (Options -> Options -> Options) -> Options -> [Options] -> Options
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Options -> Options -> Options
addOptions Options
noOptions

modifyFlags :: (Flags -> Flags) -> Options
modifyFlags :: (Flags -> Flags) -> Options
modifyFlags = (Flags -> Flags) -> Options
Options

getEncoding :: Options -> String
getEncoding :: Options -> String
getEncoding = ShowS
renameEncoding ShowS -> (Options -> String) -> Options -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
defaultEncoding ShowS
forall a. a -> a
id (Maybe String -> String)
-> (Options -> Maybe String) -> Options -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Flags -> Maybe String) -> Options -> Maybe String
forall a. (Flags -> a) -> Options -> a
flag Flags -> Maybe String
optEncoding
defaultEncoding :: String
defaultEncoding = String
"UTF-8"

-- Default options

defaultFlags :: Flags
defaultFlags :: Flags
defaultFlags = Flags :: Mode
-> Phase
-> Verbosity
-> Bool
-> [OutputFormat]
-> Maybe SISRFormat
-> Set HaskellOption
-> Set String
-> Set Ident
-> Maybe String
-> Maybe String
-> Maybe [String]
-> Maybe String
-> Recomp
-> Maybe String
-> Bool
-> Maybe String
-> [String]
-> Maybe String
-> Bool
-> Set Optimization
-> Bool
-> Bool
-> Set CFGTransform
-> [String]
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> [Warning]
-> [Dump]
-> Bool
-> Maybe Double
-> Bool
-> Bool
-> Maybe (Maybe Int)
-> Bool
-> Flags
Flags {
      optMode :: Mode
optMode            = Mode
ModeInteractive,
      optStopAfterPhase :: Phase
optStopAfterPhase  = Phase
Compile,
      optVerbosity :: Verbosity
optVerbosity       = Verbosity
Normal,
      optShowCPUTime :: Bool
optShowCPUTime     = Bool
False,
      optOutputFormats :: [OutputFormat]
optOutputFormats   = [],
      optSISR :: Maybe SISRFormat
optSISR            = Maybe SISRFormat
forall a. Maybe a
Nothing,
      optHaskellOptions :: Set HaskellOption
optHaskellOptions  = Set HaskellOption
forall a. Set a
Set.empty,
      optLiteralCats :: Set Ident
optLiteralCats     = [Ident] -> Set Ident
forall a. Ord a => [a] -> Set a
Set.fromList [Ident
cString,Ident
cInt,Ident
cFloat,Ident
cVar],
      optLexicalCats :: Set String
optLexicalCats     = Set String
forall a. Set a
Set.empty,
      optGFODir :: Maybe String
optGFODir          = Maybe String
forall a. Maybe a
Nothing,
      optOutputDir :: Maybe String
optOutputDir       = Maybe String
forall a. Maybe a
Nothing,
      optGFLibPath :: Maybe [String]
optGFLibPath       = Maybe [String]
forall a. Maybe a
Nothing,
      optDocumentRoot :: Maybe String
optDocumentRoot    = Maybe String
forall a. Maybe a
Nothing,
      optRecomp :: Recomp
optRecomp          = Recomp
RecompIfNewer,
      optProbsFile :: Maybe String
optProbsFile       = Maybe String
forall a. Maybe a
Nothing,
      optRetainResource :: Bool
optRetainResource  = Bool
False,

      optName :: Maybe String
optName            = Maybe String
forall a. Maybe a
Nothing,
      optPreprocessors :: [String]
optPreprocessors   = [],
      optEncoding :: Maybe String
optEncoding        = Maybe String
forall a. Maybe a
Nothing,
      optPMCFG :: Bool
optPMCFG           = Bool
True,
      optOptimizations :: Set Optimization
optOptimizations   = [Optimization] -> Set Optimization
forall a. Ord a => [a] -> Set a
Set.fromList [Optimization
OptStem,Optimization
OptCSE,Optimization
OptExpand,Optimization
OptParametrize],
      optOptimizePGF :: Bool
optOptimizePGF     = Bool
False,
      optSplitPGF :: Bool
optSplitPGF        = Bool
False,
      optCFGTransforms :: Set CFGTransform
optCFGTransforms   = [CFGTransform] -> Set CFGTransform
forall a. Ord a => [a] -> Set a
Set.fromList [CFGTransform
CFGRemoveCycles, CFGTransform
CFGBottomUpFilter,
                                         CFGTransform
CFGTopDownFilter, CFGTransform
CFGMergeIdentical],
      optLibraryPath :: [String]
optLibraryPath     = [],
      optStartCat :: Maybe String
optStartCat        = Maybe String
forall a. Maybe a
Nothing,
      optSpeechLanguage :: Maybe String
optSpeechLanguage  = Maybe String
forall a. Maybe a
Nothing,
      optLexer :: Maybe String
optLexer           = Maybe String
forall a. Maybe a
Nothing,
      optUnlexer :: Maybe String
optUnlexer         = Maybe String
forall a. Maybe a
Nothing,
      optWarnings :: [Warning]
optWarnings        = [],
      optDump :: [Dump]
optDump            = [],
      optTagsOnly :: Bool
optTagsOnly        = Bool
False,
      optHeuristicFactor :: Maybe Double
optHeuristicFactor = Maybe Double
forall a. Maybe a
Nothing,
      optCaseSensitive :: Bool
optCaseSensitive   = Bool
True,
      optPlusAsBind :: Bool
optPlusAsBind      = Bool
False,
      optJobs :: Maybe (Maybe Int)
optJobs            = Maybe (Maybe Int)
forall a. Maybe a
Nothing,
      optTrace :: Bool
optTrace           = Bool
False
    }

-- | Option descriptions
{-# NOINLINE optDescr #-}
optDescr :: [OptDescr (Err Options)]
optDescr :: [OptDescr (Err Options)]
optDescr =
    [
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'?',Char
'h'] [String
"help"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Mode -> Err Options
mode Mode
ModeHelp)) String
"Show help message.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'V'] [String
"version"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Mode -> Err Options
mode Mode
ModeVersion)) String
"Display GF version number.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'v'] [String
"verbose"] ((Maybe String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg Maybe String -> Err Options
verbosity String
"N") String
"Set verbosity (default 1). -v alone is the same as -v 2.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'q',Char
's'] [String
"quiet"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Maybe String -> Err Options
verbosity (String -> Maybe String
forall a. a -> Maybe a
Just String
"0"))) String
"Quiet, same as -v 0.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"batch"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Mode -> Err Options
mode Mode
ModeCompiler)) String
"Run in batch compiler mode.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'j'] [String
"jobs"] ((Maybe String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg Maybe String -> Err Options
jobs String
"N") String
"Compile N modules in parallel with -batch (default 1).",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"interactive"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Mode -> Err Options
mode Mode
ModeInteractive)) String
"Run in interactive mode (default).",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"run"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Mode -> Err Options
mode Mode
ModeRun)) String
"Run in interactive mode, showing output only (no other messages).",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"cshell"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Mode -> Err Options
mode Mode
ModeInteractive2)) String
"Start the C run-time shell.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"crun"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Mode -> Err Options
mode Mode
ModeRun2)) String
"Start the C run-time shell, showing output only (no other messages).",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"server"] ((Maybe String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg Maybe String -> Err Options
modeServer String
"port") (String -> OptDescr (Err Options))
-> String -> OptDescr (Err Options)
forall a b. (a -> b) -> a -> b
$
       String
"Run in HTTP server mode on given port (default "String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
defaultPortString -> ShowS
forall a. [a] -> [a] -> [a]
++String
").",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"document-root"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
gfDocuRoot String
"DIR")
           String
"Overrides the default document root for --server mode.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"tags"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg ((Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o{optMode :: Mode
optMode = Mode
ModeCompiler, optTagsOnly :: Bool
optTagsOnly = Bool
True})) String
"Build TAGS file and exit.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'E'] [] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Phase -> Err Options
phase Phase
Preproc)) String
"Stop after preprocessing (with --preproc).",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'C'] [] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Phase -> Err Options
phase Phase
Convert)) String
"Stop after conversion to .gf.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'c'] [] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Phase -> Err Options
phase Phase
Compile)) String
"Stop after compiling to .gfo (default) .",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"make"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg ((Options -> Options -> Options)
-> Err Options -> Err Options -> Err Options
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Options -> Options -> Options
addOptions (Mode -> Err Options
mode Mode
ModeCompiler) (Phase -> Err Options
phase Phase
Link))) String
"Build .pgf file and other output files and exit.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"cpu"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Bool -> Err Options
cpu Bool
True)) String
"Show compilation CPU time statistics.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"no-cpu"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Bool -> Err Options
cpu Bool
False)) String
"Don't show compilation CPU time statistics (default).",
--   Option ['t'] ["trace"] (NoArg (trace True)) "Trace computations",
--   Option [] ["no-trace"] (NoArg (trace False)) "Don't trace computations",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"gfo-dir"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
gfoDir String
"DIR") String
"Directory to put .gfo files in (default = '.').",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'f'] [String
"output-format"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
outFmt String
"FMT")
        ([String] -> String
unlines [String
"Output format. FMT can be one of:",
                  String
"Canonical GF grammar: canonical_gf, canonical_json, (and haskell with option --haskell=concrete)",
                  String
"Multiple concrete: pgf (default), json, js, pgf_pretty, prolog, python, ...", -- gar,
                  String
"Single concrete only: bnf, ebnf, fa, gsl, jsgf, regexp, slf, srgs_xml, srgs_abnf, vxml, ....", -- cf, lbnf,
                  String
"Abstract only: haskell, ..."]), -- prolog_abs,
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"sisr"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
sisrFmt String
"FMT")
        ([String] -> String
unlines [String
"Include SISR tags in generated speech recognition grammars.",
                  String
"FMT can be one of: old, 1.0"]),
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"haskell"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
hsOption String
"OPTION")
            (String
"Turn on an optional feature when generating Haskell data types. OPTION = "
             String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" | " (((String, HaskellOption) -> String)
-> [(String, HaskellOption)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, HaskellOption) -> String
forall a b. (a, b) -> a
fst [(String, HaskellOption)]
haskellOptionNames))),
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"lexical"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
lexicalCat String
"CAT[,CAT[...]]")
            String
"Treat CAT as a lexical category.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"literal"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
literalCat String
"CAT[,CAT[...]]")
            String
"Treat CAT as a literal category.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'D'] [String
"output-dir"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
outDir String
"DIR")
           String
"Save output files (other than .gfo files) in DIR.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"gf-lib-path"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
gfLibPath String
"DIR")
           String
"Overrides the value of GF_LIB_PATH.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"src",String
"force-recomp"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Recomp -> Err Options
recomp Recomp
AlwaysRecomp))
                 String
"Always recompile from source.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"recomp-if-newer"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Recomp -> Err Options
recomp Recomp
RecompIfNewer))
                 String
"(default) Recompile from source if the source is newer than the .gfo file.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"gfo",String
"no-recomp"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Recomp -> Err Options
recomp Recomp
NeverRecomp))
                 String
"Never recompile from source, if there is already .gfo file.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"retain"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg ((Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optRetainResource :: Bool
optRetainResource = Bool
True })) String
"Retain opers.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"probs"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
probsFile String
"file.probs") String
"Read probabilities from file.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'n'] [String
"name"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
name String
"NAME")
           ([String] -> String
unlines [String
"Use NAME as the name of the output. This is used in the output file names, ",
                     String
"with suffixes depending on the formats, and, when relevant, ",
                     String
"internally in the output."]),
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'i'] [] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
addLibDir String
"DIR") String
"Add DIR to the library search path.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"path"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
setLibPath String
"DIR:DIR:...") String
"Set the library search path.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"preproc"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
preproc String
"CMD")
                 ([String] -> String
unlines [String
"Use CMD to preprocess input files.",
                           String
"Multiple preprocessors can be used by giving this option multiple times."]),
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"coding"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
coding String
"ENCODING")
                (String
"Character encoding of the source grammar, ENCODING = utf8, latin1, cp1251, ..."),
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"startcat"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
startcat String
"CAT") String
"Grammar start category.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"language"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
language String
"LANG") String
"Set the speech language flag to LANG in the generated grammar.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"lexer"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
lexer String
"LEXER") String
"Use lexer LEXER.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"unlexer"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
unlexer String
"UNLEXER") String
"Use unlexer UNLEXER.",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"pmcfg"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Bool -> Err Options
pmcfg Bool
True)) String
"Generate PMCFG (default).",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"no-pmcfg"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Bool -> Err Options
pmcfg Bool
False)) String
"Don't generate PMCFG (useful for libraries).",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"optimize"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
optimize String
"OPT")
                String
"Select an optimization package. OPT = all | values | parametrize | none",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"optimize-pgf"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Bool -> Err Options
optimize_pgf Bool
True))
                String
"Enable or disable global grammar optimization. This could significantly reduce the size of the final PGF file",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"split-pgf"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg (Bool -> Err Options
splitPGF Bool
True))
                String
"Split the PGF into one file per language. This allows the runtime to load only individual languages",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"cfg"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Err Options
cfgTransform String
"TRANS") String
"Enable or disable specific CFG transformations. TRANS = merge, no-merge, bottomup, no-bottomup, ...",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"heuristic_search_factor"] ((String -> Err Options) -> String -> ArgDescr (Err Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg ((Double -> Flags -> Flags) -> String -> Err Options
forall t. Read t => (t -> Flags -> Flags) -> String -> Err Options
readDouble (\Double
d Flags
o -> Flags
o { optHeuristicFactor :: Maybe Double
optHeuristicFactor = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
d })) String
"FACTOR") String
"Set the heuristic search factor for statistical parsing",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"case_sensitive"] ((Bool -> Err Options) -> Bool -> ArgDescr (Err Options)
forall (m :: * -> *) a.
MonadFail m =>
(Bool -> m a) -> Bool -> ArgDescr (m a)
onOff (\Bool
v -> (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o{optCaseSensitive :: Bool
optCaseSensitive=Bool
v}) Bool
True) String
"Set the parser in case-sensitive/insensitive mode [sensitive by default]",
     String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"plus-as-bind"] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg ((Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o{optPlusAsBind :: Bool
optPlusAsBind=Bool
True})) String
"Uses of (+) with runtime variables automatically generate BIND (experimental feature).",
     String -> Pass -> OptDescr (Err Options)
dumpOption String
"source" Pass
Source,
     String -> Pass -> OptDescr (Err Options)
dumpOption String
"rebuild" Pass
Rebuild,
     String -> Pass -> OptDescr (Err Options)
dumpOption String
"extend" Pass
Extend,
     String -> Pass -> OptDescr (Err Options)
dumpOption String
"rename" Pass
Rename,
     String -> Pass -> OptDescr (Err Options)
dumpOption String
"tc" Pass
TypeCheck,
     String -> Pass -> OptDescr (Err Options)
dumpOption String
"refresh" Pass
Refresh,
     String -> Pass -> OptDescr (Err Options)
dumpOption String
"opt" Pass
Optimize,
     String -> Pass -> OptDescr (Err Options)
dumpOption String
"canon" Pass
Canon
    ]
 where phase :: Phase -> Err Options
phase       Phase
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optStopAfterPhase :: Phase
optStopAfterPhase = Phase
x }
       mode :: Mode -> Err Options
mode        Mode
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optMode :: Mode
optMode = Mode
x }
       defaultPort :: Int
defaultPort   = Int
41296
       modeServer :: Maybe String -> Err Options
modeServer    = Err Options
-> (String -> Err Options) -> Maybe String -> Err Options
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Err Options
ms Int
defaultPort) String -> Err Options
readPort
         where
           ms :: Int -> Err Options
ms = Mode -> Err Options
mode (Mode -> Err Options) -> (Int -> Mode) -> Int -> Err Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Mode
ModeServer
           readPort :: String -> Err Options
readPort String
p = Err Options -> (Int -> Err Options) -> Maybe Int -> Err Options
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Err Options
forall a. Err a
err Int -> Err Options
ms (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
p)
                 where err :: Err a
err = String -> Err a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Err a) -> String -> Err a
forall a b. (a -> b) -> a -> b
$ String
"Bad server port: "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
p

       jobs :: Maybe String -> Err Options
jobs          = Err Options
-> (String -> Err Options) -> Maybe String -> Err Options
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Int -> Err Options
setjobs Maybe Int
forall a. Maybe a
Nothing) String -> Err Options
number
           where
             number :: String -> Err Options
number String
s = Err Options -> (Int -> Err Options) -> Maybe Int -> Err Options
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Err Options
forall a. Err a
err (Maybe Int -> Err Options
setjobs (Maybe Int -> Err Options)
-> (Int -> Maybe Int) -> Int -> Err Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just) (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
s)
               where err :: Err a
err = String -> Err a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Err a) -> String -> Err a
forall a b. (a -> b) -> a -> b
$ String
"Bad number of jobs: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
             setjobs :: Maybe Int -> Err Options
setjobs Maybe Int
j = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \ Flags
o -> Flags
o { optJobs :: Maybe (Maybe Int)
optJobs = Maybe Int -> Maybe (Maybe Int)
forall a. a -> Maybe a
Just Maybe Int
j }

       verbosity :: Maybe String -> Err Options
verbosity Maybe String
mv  = case Maybe String
mv of
                           Maybe String
Nothing -> (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optVerbosity :: Verbosity
optVerbosity = Verbosity
Verbose }
                           Just String
v  -> case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
v Maybe Int -> (Int -> Maybe Verbosity) -> Maybe Verbosity
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Maybe Verbosity
forall a. (Bounded a, Enum a, Ord a) => Int -> Maybe a
toEnumBounded of
                                        Just Verbosity
i  -> (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optVerbosity :: Verbosity
optVerbosity = Verbosity
i }
                                        Maybe Verbosity
Nothing -> String -> Err Options
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Err Options) -> String -> Err Options
forall a b. (a -> b) -> a -> b
$ String
"Bad verbosity: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v
       cpu :: Bool -> Err Options
cpu         Bool
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optShowCPUTime :: Bool
optShowCPUTime = Bool
x }
--     trace       x = set $ \o -> o { optTrace = x }
       gfoDir :: String -> Err Options
gfoDir      String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optGFODir :: Maybe String
optGFODir = String -> Maybe String
forall a. a -> Maybe a
Just String
x }
       outFmt :: String -> Err Options
outFmt      String
x = String -> Err OutputFormat
forall (m :: * -> *). MonadFail m => String -> m OutputFormat
readOutputFormat String
x Err OutputFormat -> (OutputFormat -> Err Options) -> Err Options
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \OutputFormat
f ->
                         (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optOutputFormats :: [OutputFormat]
optOutputFormats = Flags -> [OutputFormat]
optOutputFormats Flags
o [OutputFormat] -> [OutputFormat] -> [OutputFormat]
forall a. [a] -> [a] -> [a]
++ [OutputFormat
f] }
       sisrFmt :: String -> Err Options
sisrFmt     String
x = case String
x of
                         String
"old" -> (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optSISR :: Maybe SISRFormat
optSISR = SISRFormat -> Maybe SISRFormat
forall a. a -> Maybe a
Just SISRFormat
SISR_WD20030401 }
                         String
"1.0" -> (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optSISR :: Maybe SISRFormat
optSISR = SISRFormat -> Maybe SISRFormat
forall a. a -> Maybe a
Just SISRFormat
SISR_1_0 }
                         String
_     -> String -> Err Options
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Err Options) -> String -> Err Options
forall a b. (a -> b) -> a -> b
$ String
"Unknown SISR format: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
x
       hsOption :: String -> Err Options
hsOption    String
x = case String -> [(String, HaskellOption)] -> Maybe HaskellOption
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
x [(String, HaskellOption)]
haskellOptionNames of
                         Just HaskellOption
p  -> (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optHaskellOptions :: Set HaskellOption
optHaskellOptions = HaskellOption -> Set HaskellOption -> Set HaskellOption
forall a. Ord a => a -> Set a -> Set a
Set.insert HaskellOption
p (Flags -> Set HaskellOption
optHaskellOptions Flags
o) }
                         Maybe HaskellOption
Nothing -> String -> Err Options
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Err Options) -> String -> Err Options
forall a b. (a -> b) -> a -> b
$ String
"Unknown Haskell option: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
                                            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" Known: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show (((String, HaskellOption) -> String)
-> [(String, HaskellOption)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, HaskellOption) -> String
forall a b. (a, b) -> a
fst [(String, HaskellOption)]
haskellOptionNames)
       literalCat :: String -> Err Options
literalCat  String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optLiteralCats :: Set Ident
optLiteralCats = (Ident -> Set Ident -> Set Ident)
-> Set Ident -> [Ident] -> Set Ident
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Ident -> Set Ident -> Set Ident
forall a. Ord a => a -> Set a -> Set a
Set.insert (Flags -> Set Ident
optLiteralCats Flags
o) (((String -> Ident) -> [String] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map String -> Ident
identS ([String] -> [Ident]) -> (String -> [String]) -> String -> [Ident]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
splitBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',')) String
x) }
       lexicalCat :: String -> Err Options
lexicalCat  String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optLexicalCats :: Set String
optLexicalCats = (String -> Set String -> Set String)
-> Set String -> [String] -> Set String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.insert (Flags -> Set String
optLexicalCats Flags
o) ((Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
splitBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') String
x) }
       outDir :: String -> Err Options
outDir      String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optOutputDir :: Maybe String
optOutputDir = String -> Maybe String
forall a. a -> Maybe a
Just String
x }
       gfLibPath :: String -> Err Options
gfLibPath   String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optGFLibPath :: Maybe [String]
optGFLibPath = [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
splitInModuleSearchPath String
x }
       gfDocuRoot :: String -> Err Options
gfDocuRoot  String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optDocumentRoot :: Maybe String
optDocumentRoot = String -> Maybe String
forall a. a -> Maybe a
Just String
x }
       recomp :: Recomp -> Err Options
recomp      Recomp
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optRecomp :: Recomp
optRecomp = Recomp
x }
       probsFile :: String -> Err Options
probsFile   String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optProbsFile :: Maybe String
optProbsFile = String -> Maybe String
forall a. a -> Maybe a
Just String
x }

       name :: String -> Err Options
name        String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optName :: Maybe String
optName = String -> Maybe String
forall a. a -> Maybe a
Just String
x }
       addLibDir :: String -> Err Options
addLibDir   String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optLibraryPath :: [String]
optLibraryPath = String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:Flags -> [String]
optLibraryPath Flags
o }
       setLibPath :: String -> Err Options
setLibPath  String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optLibraryPath :: [String]
optLibraryPath = String -> [String]
splitInModuleSearchPath String
x }
       preproc :: String -> Err Options
preproc     String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optPreprocessors :: [String]
optPreprocessors = Flags -> [String]
optPreprocessors Flags
o [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
x] }
       coding :: String -> Err Options
coding      String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optEncoding :: Maybe String
optEncoding = String -> Maybe String
forall a. a -> Maybe a
Just String
x }
       startcat :: String -> Err Options
startcat    String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optStartCat :: Maybe String
optStartCat = String -> Maybe String
forall a. a -> Maybe a
Just String
x }
       language :: String -> Err Options
language    String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optSpeechLanguage :: Maybe String
optSpeechLanguage = String -> Maybe String
forall a. a -> Maybe a
Just String
x }
       lexer :: String -> Err Options
lexer       String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optLexer :: Maybe String
optLexer = String -> Maybe String
forall a. a -> Maybe a
Just String
x }
       unlexer :: String -> Err Options
unlexer     String
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optUnlexer :: Maybe String
optUnlexer = String -> Maybe String
forall a. a -> Maybe a
Just String
x }

       pmcfg :: Bool -> Err Options
pmcfg       Bool
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optPMCFG :: Bool
optPMCFG = Bool
x }

       optimize :: String -> Err Options
optimize    String
x = case String -> [(String, Set Optimization)] -> Maybe (Set Optimization)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
x [(String, Set Optimization)]
optimizationPackages of
                         Just Set Optimization
p  -> (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optOptimizations :: Set Optimization
optOptimizations = Set Optimization
p }
                         Maybe (Set Optimization)
Nothing -> String -> Err Options
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Err Options) -> String -> Err Options
forall a b. (a -> b) -> a -> b
$ String
"Unknown optimization package: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x

       optimize_pgf :: Bool -> Err Options
optimize_pgf Bool
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optOptimizePGF :: Bool
optOptimizePGF = Bool
x }
       splitPGF :: Bool -> Err Options
splitPGF Bool
x = (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optSplitPGF :: Bool
optSplitPGF = Bool
x }

       cfgTransform :: String -> Err Options
cfgTransform String
x = let (String
x', Bool
b) = case String
x of
                                        'n':'o':'-':rest -> (String
rest, Bool
False)
                                        String
_                -> (String
x, Bool
True)
                         in case String -> [(String, CFGTransform)] -> Maybe CFGTransform
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
x' [(String, CFGTransform)]
cfgTransformNames of
                              Just CFGTransform
t  -> (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ CFGTransform -> Bool -> Flags -> Flags
setCFGTransform' CFGTransform
t Bool
b
                              Maybe CFGTransform
Nothing -> String -> Err Options
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Err Options) -> String -> Err Options
forall a b. (a -> b) -> a -> b
$ String
"Unknown CFG transformation: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x'
                                                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" Known: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show (((String, CFGTransform) -> String)
-> [(String, CFGTransform)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, CFGTransform) -> String
forall a b. (a, b) -> a
fst [(String, CFGTransform)]
cfgTransformNames)

       readDouble :: (t -> Flags -> Flags) -> String -> Err Options
readDouble t -> Flags -> Flags
f String
x = case ReadS t
forall a. Read a => ReadS a
reads String
x of
                          [(t
d,String
"")] -> (Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ t -> Flags -> Flags
f t
d
                          [(t, String)]
_        -> String -> Err Options
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"A floating point number is expected"

       dumpOption :: String -> Pass -> OptDescr (Err Options)
dumpOption String
s Pass
d = String
-> [String]
-> ArgDescr (Err Options)
-> String
-> OptDescr (Err Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"dump-"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
s] (Err Options -> ArgDescr (Err Options)
forall a. a -> ArgDescr a
NoArg ((Flags -> Flags) -> Err Options
set ((Flags -> Flags) -> Err Options)
-> (Flags -> Flags) -> Err Options
forall a b. (a -> b) -> a -> b
$ \Flags
o -> Flags
o { optDump :: [Dump]
optDump = Pass -> Dump
Dump Pass
dDump -> [Dump] -> [Dump]
forall a. a -> [a] -> [a]
:Flags -> [Dump]
optDump Flags
o})) (String
"Dump output of the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" phase.")

       set :: (Flags -> Flags) -> Err Options
set = Options -> Err Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Err Options)
-> ((Flags -> Flags) -> Options) -> (Flags -> Flags) -> Err Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Flags -> Flags) -> Options
Options

outputFormats :: [(String,OutputFormat)]
outputFormats :: [(String, OutputFormat)]
outputFormats = (((String, OutputFormat), String) -> (String, OutputFormat))
-> [((String, OutputFormat), String)] -> [(String, OutputFormat)]
forall a b. (a -> b) -> [a] -> [b]
map ((String, OutputFormat), String) -> (String, OutputFormat)
forall a b. (a, b) -> a
fst [((String, OutputFormat), String)]
outputFormatsExpl

outputFormatsExpl :: [((String,OutputFormat),String)]
outputFormatsExpl :: [((String, OutputFormat), String)]
outputFormatsExpl =
    [((String
"pgf_pretty",   OutputFormat
FmtPGFPretty),String
"human-readable pgf"),
     ((String
"canonical_gf", OutputFormat
FmtCanonicalGF),String
"Canonical GF source files"),
     ((String
"canonical_json", OutputFormat
FmtCanonicalJson),String
"Canonical JSON source files"),
     ((String
"js",           OutputFormat
FmtJavaScript),String
"JavaScript (whole grammar)"),
     ((String
"json",         OutputFormat
FmtJSON),String
"JSON (whole grammar)"),
     ((String
"python",       OutputFormat
FmtPython),String
"Python (whole grammar)"),
     ((String
"haskell",      OutputFormat
FmtHaskell),String
"Haskell (abstract syntax)"),
     ((String
"java",         OutputFormat
FmtJava),String
"Java (abstract syntax)"),
     ((String
"prolog",       OutputFormat
FmtProlog),String
"Prolog (whole grammar)"),
     ((String
"bnf",          OutputFormat
FmtBNF),String
"BNF (context-free grammar)"),
     ((String
"ebnf",         OutputFormat
FmtEBNF),String
"Extended BNF"),
     ((String
"regular",      OutputFormat
FmtRegular),String
"* regular grammar"),
     ((String
"nolr",         OutputFormat
FmtNoLR),String
"* context-free with no left recursion"),
     ((String
"srgs_xml",     OutputFormat
FmtSRGS_XML),String
"SRGS speech recognition format in XML"),
     ((String
"srgs_xml_nonrec",     OutputFormat
FmtSRGS_XML_NonRec),String
"SRGS XML, recursion eliminated"),
     ((String
"srgs_abnf",    OutputFormat
FmtSRGS_ABNF),String
"SRGS speech recognition format in ABNF"),
     ((String
"srgs_abnf_nonrec",    OutputFormat
FmtSRGS_ABNF_NonRec),String
"SRGS ABNF, recursion eliminated"),
     ((String
"jsgf",         OutputFormat
FmtJSGF),String
"JSGF speech recognition format"),
     ((String
"gsl",          OutputFormat
FmtGSL),String
"Nuance speech recognition format"),
     ((String
"vxml",         OutputFormat
FmtVoiceXML),String
"Voice XML based on abstract syntax"),
     ((String
"slf",          OutputFormat
FmtSLF),String
"SLF speech recognition format"),
     ((String
"regexp",       OutputFormat
FmtRegExp),String
"regular expression"),
     ((String
"fa",           OutputFormat
FmtFA),String
"finite automaton in graphviz format")
     ]

instance Show OutputFormat where
    show :: OutputFormat -> String
show = [(String, OutputFormat)] -> OutputFormat -> String
forall a. Eq a => [(String, a)] -> a -> String
lookupShow [(String, OutputFormat)]
outputFormats

instance Read OutputFormat where
    readsPrec :: Int -> ReadS OutputFormat
readsPrec = [(String, OutputFormat)] -> Int -> ReadS OutputFormat
forall a. [(String, a)] -> Int -> ReadS a
lookupReadsPrec [(String, OutputFormat)]
outputFormats

optimizationPackages :: [(String, Set Optimization)]
optimizationPackages :: [(String, Set Optimization)]
optimizationPackages =
    [(String
"all",         [Optimization] -> Set Optimization
forall a. Ord a => [a] -> Set a
Set.fromList [Optimization
OptStem,Optimization
OptCSE,Optimization
OptExpand,Optimization
OptParametrize]),
     (String
"values",      [Optimization] -> Set Optimization
forall a. Ord a => [a] -> Set a
Set.fromList [Optimization
OptStem,Optimization
OptCSE,Optimization
OptExpand]),
     (String
"noexpand",    [Optimization] -> Set Optimization
forall a. Ord a => [a] -> Set a
Set.fromList [Optimization
OptStem,Optimization
OptCSE]),

     -- deprecated
     (String
"all_subs",    [Optimization] -> Set Optimization
forall a. Ord a => [a] -> Set a
Set.fromList [Optimization
OptStem,Optimization
OptCSE,Optimization
OptExpand,Optimization
OptParametrize]),
     (String
"parametrize", [Optimization] -> Set Optimization
forall a. Ord a => [a] -> Set a
Set.fromList [Optimization
OptStem,Optimization
OptCSE,Optimization
OptExpand,Optimization
OptParametrize]),
     (String
"none",        [Optimization] -> Set Optimization
forall a. Ord a => [a] -> Set a
Set.fromList [Optimization
OptStem,Optimization
OptCSE,Optimization
OptExpand])
    ]

cfgTransformNames :: [(String, CFGTransform)]
cfgTransformNames :: [(String, CFGTransform)]
cfgTransformNames =
    [(String
"nolr",         CFGTransform
CFGNoLR),
     (String
"regular",      CFGTransform
CFGRegular),
     (String
"topdown",      CFGTransform
CFGTopDownFilter),
     (String
"bottomup",     CFGTransform
CFGBottomUpFilter),
     (String
"startcatonly", CFGTransform
CFGStartCatOnly),
     (String
"merge",        CFGTransform
CFGMergeIdentical),
     (String
"removecycles", CFGTransform
CFGRemoveCycles)]

haskellOptionNames :: [(String, HaskellOption)]
haskellOptionNames :: [(String, HaskellOption)]
haskellOptionNames =
    [(String
"noprefix", HaskellOption
HaskellNoPrefix),
     (String
"gadt",     HaskellOption
HaskellGADT),
     (String
"lexical",  HaskellOption
HaskellLexical),
     (String
"concrete", HaskellOption
HaskellConcrete),
     (String
"variants", HaskellOption
HaskellVariants),
     (String
"data",     HaskellOption
HaskellData),
     (String
"pgf2",     HaskellOption
HaskellPGF2)]

-- | This is for bacward compatibility. Since GHC 6.12 we
-- started using the native Unicode support in GHC but it
-- uses different names for the code pages.
renameEncoding :: String -> String
renameEncoding :: ShowS
renameEncoding String
"utf8"                      = String
"UTF-8"
renameEncoding String
"latin1"                    = String
"CP1252"
renameEncoding (Char
'c':Char
'p':String
s) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
s = Char
'C'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'P'Char -> ShowS
forall a. a -> [a] -> [a]
:String
s
renameEncoding String
s                           = String
s

lookupShow :: Eq a => [(String,a)] -> a -> String
lookupShow :: [(String, a)] -> a -> String
lookupShow [(String, a)]
xs a
z = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"lookupShow" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ a -> [(a, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
z [(a
y,String
x) | (String
x,a
y) <- [(String, a)]
xs]

lookupReadsPrec :: [(String,a)] -> Int -> ReadS a
lookupReadsPrec :: [(String, a)] -> Int -> ReadS a
lookupReadsPrec [(String, a)]
xs Int
_ String
s = [(a
z,String
rest) | (String
x,String
rest) <- ReadS String
lex String
s, (String
y,a
z) <- [(String, a)]
xs, String
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x]

onOff :: Fail.MonadFail m => (Bool -> m a) -> Bool -> ArgDescr (m a)
onOff :: (Bool -> m a) -> Bool -> ArgDescr (m a)
onOff Bool -> m a
f Bool
def = (Maybe String -> m a) -> String -> ArgDescr (m a)
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg Maybe String -> m a
g String
"[on,off]"
  where g :: Maybe String -> m a
g Maybe String
ma = m Bool -> (String -> m Bool) -> Maybe String -> m Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
def) String -> m Bool
forall (m :: * -> *). MonadFail m => String -> m Bool
readOnOff Maybe String
ma m Bool -> (Bool -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> m a
f
        readOnOff :: String -> m Bool
readOnOff String
x = case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x of
                        String
"on"  -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                        String
"off" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                        String
_     -> String -> m Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Bool) -> String -> m Bool
forall a b. (a -> b) -> a -> b
$ String
"Expected [on,off], got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
x

readOutputFormat :: Fail.MonadFail m => String -> m OutputFormat
readOutputFormat :: String -> m OutputFormat
readOutputFormat String
s =
    m OutputFormat
-> (OutputFormat -> m OutputFormat)
-> Maybe OutputFormat
-> m OutputFormat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m OutputFormat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m OutputFormat) -> String -> m OutputFormat
forall a b. (a -> b) -> a -> b
$ String
"Unknown output format: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s) OutputFormat -> m OutputFormat
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe OutputFormat -> m OutputFormat)
-> Maybe OutputFormat -> m OutputFormat
forall a b. (a -> b) -> a -> b
$ String -> [(String, OutputFormat)] -> Maybe OutputFormat
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s [(String, OutputFormat)]
outputFormats

-- FIXME: this is a copy of the function in GF.Devel.UseIO.
splitInModuleSearchPath :: String -> [FilePath]
splitInModuleSearchPath :: String -> [String]
splitInModuleSearchPath String
s = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isPathSep String
s of
  (String
f,Char
_:String
cs) -> String
f String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitInModuleSearchPath String
cs
  (String
f,String
_)    -> [String
f]
  where
    isPathSep :: Char -> Bool
    isPathSep :: Char -> Bool
isPathSep Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';'

--
-- * Convenience functions for checking options
--

verbAtLeast :: Options -> Verbosity -> Bool
verbAtLeast :: Options -> Verbosity -> Bool
verbAtLeast Options
opts Verbosity
v = (Flags -> Verbosity) -> Options -> Verbosity
forall a. (Flags -> a) -> Options -> a
flag Flags -> Verbosity
optVerbosity Options
opts Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
v

dump :: Options -> Dump -> Bool
dump :: Options -> Dump -> Bool
dump Options
opts Dump
d = (Flags -> Bool) -> Options -> Bool
forall a. (Flags -> a) -> Options -> a
flag ((Dump
d Dump -> [Dump] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([Dump] -> Bool) -> (Flags -> [Dump]) -> Flags -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flags -> [Dump]
optDump) Options
opts

cfgTransform :: Options -> CFGTransform -> Bool
cfgTransform :: Options -> CFGTransform -> Bool
cfgTransform Options
opts CFGTransform
t = CFGTransform -> Set CFGTransform -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member CFGTransform
t ((Flags -> Set CFGTransform) -> Options -> Set CFGTransform
forall a. (Flags -> a) -> Options -> a
flag Flags -> Set CFGTransform
optCFGTransforms Options
opts)

haskellOption :: Options -> HaskellOption -> Bool
haskellOption :: Options -> HaskellOption -> Bool
haskellOption Options
opts HaskellOption
o = HaskellOption -> Set HaskellOption -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member HaskellOption
o ((Flags -> Set HaskellOption) -> Options -> Set HaskellOption
forall a. (Flags -> a) -> Options -> a
flag Flags -> Set HaskellOption
optHaskellOptions Options
opts)

isLiteralCat :: Options -> Ident -> Bool
isLiteralCat :: Options -> Ident -> Bool
isLiteralCat Options
opts Ident
c = Ident -> Set Ident -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Ident
c ((Flags -> Set Ident) -> Options -> Set Ident
forall a. (Flags -> a) -> Options -> a
flag Flags -> Set Ident
optLiteralCats Options
opts)

isLexicalCat :: Options -> String -> Bool
isLexicalCat :: Options -> String -> Bool
isLexicalCat Options
opts String
c = String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member String
c ((Flags -> Set String) -> Options -> Set String
forall a. (Flags -> a) -> Options -> a
flag Flags -> Set String
optLexicalCats Options
opts)

--
-- * Convenience functions for setting options
--

setOptimization :: Optimization -> Bool -> Options
setOptimization :: Optimization -> Bool -> Options
setOptimization Optimization
o Bool
b = (Flags -> Flags) -> Options
modifyFlags (Optimization -> Bool -> Flags -> Flags
setOptimization' Optimization
o Bool
b)

setOptimization' :: Optimization -> Bool -> Flags -> Flags
setOptimization' :: Optimization -> Bool -> Flags -> Flags
setOptimization' Optimization
o Bool
b Flags
f = Flags
f { optOptimizations :: Set Optimization
optOptimizations = Optimization -> Bool -> Set Optimization -> Set Optimization
forall a. Ord a => a -> Bool -> Set a -> Set a
toggle Optimization
o Bool
b (Flags -> Set Optimization
optOptimizations Flags
f)}

setCFGTransform :: CFGTransform -> Bool -> Options
setCFGTransform :: CFGTransform -> Bool -> Options
setCFGTransform CFGTransform
t Bool
b = (Flags -> Flags) -> Options
modifyFlags (CFGTransform -> Bool -> Flags -> Flags
setCFGTransform' CFGTransform
t Bool
b)

setCFGTransform' :: CFGTransform -> Bool -> Flags -> Flags
setCFGTransform' :: CFGTransform -> Bool -> Flags -> Flags
setCFGTransform' CFGTransform
t Bool
b Flags
f = Flags
f { optCFGTransforms :: Set CFGTransform
optCFGTransforms = CFGTransform -> Bool -> Set CFGTransform -> Set CFGTransform
forall a. Ord a => a -> Bool -> Set a -> Set a
toggle CFGTransform
t Bool
b (Flags -> Set CFGTransform
optCFGTransforms Flags
f) }

toggle :: Ord a => a -> Bool -> Set a -> Set a
toggle :: a -> Bool -> Set a -> Set a
toggle a
o Bool
True  = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
o
toggle a
o Bool
False = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.delete a
o

--
-- * General utilities
--

readMaybe :: Read a => String -> Maybe a
readMaybe :: String -> Maybe a
readMaybe String
s = case ReadS a
forall a. Read a => ReadS a
reads String
s of
                [(a
x,String
"")] -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
                [(a, String)]
_        -> Maybe a
forall a. Maybe a
Nothing

toEnumBounded :: (Bounded a, Enum a, Ord a) => Int -> Maybe a
toEnumBounded :: Int -> Maybe a
toEnumBounded Int
i = let mi :: a
mi = a
forall a. Bounded a => a
minBound
                      ma :: a
ma = a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
mi
                   in if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> Int
forall a. Enum a => a -> Int
fromEnum a
mi Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Int
forall a. Enum a => a -> Int
fromEnum a
ma
                        then a -> Maybe a
forall a. a -> Maybe a
Just (Int -> a
forall a. Enum a => Int -> a
toEnum Int
i a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
mi)
                        else Maybe a
forall a. Maybe a
Nothing

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy a -> Bool
_ [] = []
splitBy a -> Bool
p [a]
s = case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
s of
                ([a]
l, a
_ : t :: [a]
t@(a
_ : [a]
_)) -> [a]
l [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitBy a -> Bool
p [a]
t
                ([a]
l, [a]
_) -> [[a]
l]

instance Functor OptDescr where
    fmap :: (a -> b) -> OptDescr a -> OptDescr b
fmap a -> b
f (Option String
cs [String]
ss ArgDescr a
d String
s) = String -> [String] -> ArgDescr b -> String -> OptDescr b
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
cs [String]
ss ((a -> b) -> ArgDescr a -> ArgDescr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ArgDescr a
d) String
s

instance Functor ArgDescr where
    fmap :: (a -> b) -> ArgDescr a -> ArgDescr b
fmap a -> b
f (NoArg a
x)    = b -> ArgDescr b
forall a. a -> ArgDescr a
NoArg (a -> b
f a
x)
    fmap a -> b
f (ReqArg String -> a
g String
s) = (String -> b) -> String -> ArgDescr b
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (a -> b
f (a -> b) -> (String -> a) -> String -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
g) String
s
    fmap a -> b
f (OptArg Maybe String -> a
g String
s) = (Maybe String -> b) -> String -> ArgDescr b
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg (a -> b
f (a -> b) -> (Maybe String -> a) -> Maybe String -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> a
g) String
s