{- |
    Module      :  $Header$
    Description :  Compiler options
    Copyright   :  (c) 2005        Martin Engelke
                       2007        Sebastian Fischer
                       2011 - 2016 Björn Peemöller
                       2016 - 2017 Finn Teegen
                       2018        Kai-Oliver Prott
    License     :  BSD-3-clause

    Maintainer  :  fte@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    This module defines data structures holding options for the
    compilation of Curry programs, and utility functions for printing
    help information as well as parsing the command line arguments.
-}
module CompilerOpts
  ( Options (..), CppOpts (..), PrepOpts (..), WarnOpts (..), DebugOpts (..)
  , OptimizationOpts(..), CaseMode (..), CymakeMode (..), Verbosity (..)
  , TargetType (..), WarnFlag (..), KnownExtension (..), DumpLevel (..)
  , dumpLevel
  , defaultOptions, defaultPrepOpts, defaultWarnOpts, defaultDebugOpts
  , getCompilerOpts, updateOpts, usage
  ) where

import           Data.List             (intercalate, nub)
import           Data.Maybe            (isJust)
import           Data.Char             (isDigit)
import qualified Data.Map    as Map    (Map, empty, insert)
import System.Console.GetOpt
import System.Environment              (getArgs, getProgName)
import System.FilePath                 ( addTrailingPathSeparator, normalise
                                       , splitSearchPath )

import Curry.Files.Filenames           (defaultOutDir)
import Curry.Syntax.Extension

-- -----------------------------------------------------------------------------
-- Option data structures
-- -----------------------------------------------------------------------------

-- |Compiler options
data Options = Options
  -- general
  { Options -> CymakeMode
optMode          :: CymakeMode          -- ^ modus operandi
  , Options -> Verbosity
optVerbosity     :: Verbosity           -- ^ verbosity level
  -- compilation
  , Options -> Bool
optForce         :: Bool                -- ^ force (re-)compilation of target
  , Options -> [FilePath]
optLibraryPaths  :: [FilePath]          -- ^ directories to search in
                                            --   for libraries
  , Options -> [FilePath]
optImportPaths   :: [FilePath]          -- ^ directories to search in
                                            --   for imports
  , Options -> FilePath
optOutDir        :: FilePath            -- ^ output directory for FlatCurry, ...
  , Options -> Maybe FilePath
optHtmlDir       :: Maybe FilePath      -- ^ output directory for HTML
  , Options -> Bool
optUseOutDir     :: Bool                -- ^ use subdir for output?
  , Options -> Bool
optInterface     :: Bool                -- ^ create a FlatCurry interface file?
  , Options -> PrepOpts
optPrepOpts      :: PrepOpts            -- ^ preprocessor options
  , Options -> WarnOpts
optWarnOpts      :: WarnOpts            -- ^ warning options
  , Options -> [TargetType]
optTargetTypes   :: [TargetType]        -- ^ what to generate
  , Options -> [KnownExtension]
optExtensions    :: [KnownExtension]    -- ^ enabled language extensions
  , Options -> DebugOpts
optDebugOpts     :: DebugOpts           -- ^ debug options
  , Options -> CaseMode
optCaseMode      :: CaseMode            -- ^ case mode
  , Options -> CppOpts
optCppOpts       :: CppOpts             -- ^ C preprocessor options
  , Options -> OptimizationOpts
optOptimizations :: OptimizationOpts -- ^ Optimization options
  } deriving Int -> Options -> ShowS
[Options] -> ShowS
Options -> FilePath
(Int -> Options -> ShowS)
-> (Options -> FilePath) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> FilePath
$cshow :: Options -> FilePath
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show

-- |C preprocessor options
data CppOpts = CppOpts
  { CppOpts -> Bool
cppRun         :: Bool                -- ^ run C preprocessor
  , CppOpts -> Map FilePath Int
cppDefinitions :: Map.Map String Int  -- ^ defintions for the C preprocessor
  } deriving Int -> CppOpts -> ShowS
[CppOpts] -> ShowS
CppOpts -> FilePath
(Int -> CppOpts -> ShowS)
-> (CppOpts -> FilePath) -> ([CppOpts] -> ShowS) -> Show CppOpts
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CppOpts] -> ShowS
$cshowList :: [CppOpts] -> ShowS
show :: CppOpts -> FilePath
$cshow :: CppOpts -> FilePath
showsPrec :: Int -> CppOpts -> ShowS
$cshowsPrec :: Int -> CppOpts -> ShowS
Show

-- |Preprocessor options
data PrepOpts = PrepOpts
  { PrepOpts -> Bool
ppPreprocess :: Bool      -- ^ apply custom preprocessor
  , PrepOpts -> FilePath
ppCmd        :: String    -- ^ preprocessor command
  , PrepOpts -> [FilePath]
ppOpts       :: [String]  -- ^ preprocessor options
  } deriving Int -> PrepOpts -> ShowS
[PrepOpts] -> ShowS
PrepOpts -> FilePath
(Int -> PrepOpts -> ShowS)
-> (PrepOpts -> FilePath) -> ([PrepOpts] -> ShowS) -> Show PrepOpts
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PrepOpts] -> ShowS
$cshowList :: [PrepOpts] -> ShowS
show :: PrepOpts -> FilePath
$cshow :: PrepOpts -> FilePath
showsPrec :: Int -> PrepOpts -> ShowS
$cshowsPrec :: Int -> PrepOpts -> ShowS
Show

data CaseMode
  = CaseModeFree
  | CaseModeHaskell
  | CaseModeProlog
  | CaseModeGoedel
  deriving (CaseMode -> CaseMode -> Bool
(CaseMode -> CaseMode -> Bool)
-> (CaseMode -> CaseMode -> Bool) -> Eq CaseMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaseMode -> CaseMode -> Bool
$c/= :: CaseMode -> CaseMode -> Bool
== :: CaseMode -> CaseMode -> Bool
$c== :: CaseMode -> CaseMode -> Bool
Eq, Int -> CaseMode -> ShowS
[CaseMode] -> ShowS
CaseMode -> FilePath
(Int -> CaseMode -> ShowS)
-> (CaseMode -> FilePath) -> ([CaseMode] -> ShowS) -> Show CaseMode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CaseMode] -> ShowS
$cshowList :: [CaseMode] -> ShowS
show :: CaseMode -> FilePath
$cshow :: CaseMode -> FilePath
showsPrec :: Int -> CaseMode -> ShowS
$cshowsPrec :: Int -> CaseMode -> ShowS
Show)

-- |Warning options
data WarnOpts = WarnOpts
  { WarnOpts -> Bool
wnWarn         :: Bool       -- ^ show warnings? (legacy option)
  , WarnOpts -> [WarnFlag]
wnWarnFlags    :: [WarnFlag] -- ^ Warnings flags (see below)
  , WarnOpts -> Bool
wnWarnAsError  :: Bool       -- ^ Should warnings be treated as errors?
  } deriving Int -> WarnOpts -> ShowS
[WarnOpts] -> ShowS
WarnOpts -> FilePath
(Int -> WarnOpts -> ShowS)
-> (WarnOpts -> FilePath) -> ([WarnOpts] -> ShowS) -> Show WarnOpts
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [WarnOpts] -> ShowS
$cshowList :: [WarnOpts] -> ShowS
show :: WarnOpts -> FilePath
$cshow :: WarnOpts -> FilePath
showsPrec :: Int -> WarnOpts -> ShowS
$cshowsPrec :: Int -> WarnOpts -> ShowS
Show

-- |Debug options
data DebugOpts = DebugOpts
  { DebugOpts -> [DumpLevel]
dbDumpLevels      :: [DumpLevel] -- ^ dump levels
  , DebugOpts -> Bool
dbDumpEnv         :: Bool        -- ^ dump compilation environment
  , DebugOpts -> Bool
dbDumpRaw         :: Bool        -- ^ dump data structure
  , DebugOpts -> Bool
dbDumpAllBindings :: Bool        -- ^ dump all bindings instead of just the
                                     --   local bindings
  , DebugOpts -> Bool
dbDumpSimple      :: Bool        -- ^ print more readable environments
  } deriving Int -> DebugOpts -> ShowS
[DebugOpts] -> ShowS
DebugOpts -> FilePath
(Int -> DebugOpts -> ShowS)
-> (DebugOpts -> FilePath)
-> ([DebugOpts] -> ShowS)
-> Show DebugOpts
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DebugOpts] -> ShowS
$cshowList :: [DebugOpts] -> ShowS
show :: DebugOpts -> FilePath
$cshow :: DebugOpts -> FilePath
showsPrec :: Int -> DebugOpts -> ShowS
$cshowsPrec :: Int -> DebugOpts -> ShowS
Show

data OptimizationOpts = OptimizationOpts
  { OptimizationOpts -> Bool
optDesugarNewtypes     :: Bool -- ^ Desugar newtypes
  , OptimizationOpts -> Bool
optInlineDictionaries  :: Bool -- ^ Inline type class dictionaries
  , OptimizationOpts -> Bool
optRemoveUnusedImports :: Bool -- ^ Remove unused imports in IL
  } deriving Int -> OptimizationOpts -> ShowS
[OptimizationOpts] -> ShowS
OptimizationOpts -> FilePath
(Int -> OptimizationOpts -> ShowS)
-> (OptimizationOpts -> FilePath)
-> ([OptimizationOpts] -> ShowS)
-> Show OptimizationOpts
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OptimizationOpts] -> ShowS
$cshowList :: [OptimizationOpts] -> ShowS
show :: OptimizationOpts -> FilePath
$cshow :: OptimizationOpts -> FilePath
showsPrec :: Int -> OptimizationOpts -> ShowS
$cshowsPrec :: Int -> OptimizationOpts -> ShowS
Show

-- | Default compiler options
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options :: CymakeMode
-> Verbosity
-> Bool
-> [FilePath]
-> [FilePath]
-> FilePath
-> Maybe FilePath
-> Bool
-> Bool
-> PrepOpts
-> WarnOpts
-> [TargetType]
-> [KnownExtension]
-> DebugOpts
-> CaseMode
-> CppOpts
-> OptimizationOpts
-> Options
Options
  { optMode :: CymakeMode
optMode          = CymakeMode
ModeMake
  , optVerbosity :: Verbosity
optVerbosity     = Verbosity
VerbStatus
  , optForce :: Bool
optForce         = Bool
False
  , optLibraryPaths :: [FilePath]
optLibraryPaths  = []
  , optImportPaths :: [FilePath]
optImportPaths   = []
  , optOutDir :: FilePath
optOutDir        = FilePath
defaultOutDir
  , optHtmlDir :: Maybe FilePath
optHtmlDir       = Maybe FilePath
forall a. Maybe a
Nothing
  , optUseOutDir :: Bool
optUseOutDir     = Bool
True
  , optInterface :: Bool
optInterface     = Bool
True
  , optPrepOpts :: PrepOpts
optPrepOpts      = PrepOpts
defaultPrepOpts
  , optWarnOpts :: WarnOpts
optWarnOpts      = WarnOpts
defaultWarnOpts
  , optTargetTypes :: [TargetType]
optTargetTypes   = []
  , optExtensions :: [KnownExtension]
optExtensions    = []
  , optDebugOpts :: DebugOpts
optDebugOpts     = DebugOpts
defaultDebugOpts
  , optCaseMode :: CaseMode
optCaseMode      = CaseMode
CaseModeFree
  , optCppOpts :: CppOpts
optCppOpts       = CppOpts
defaultCppOpts
  , optOptimizations :: OptimizationOpts
optOptimizations = OptimizationOpts
defaultOptimizationOpts
  }

-- | Default C preprocessor options
defaultCppOpts :: CppOpts
defaultCppOpts :: CppOpts
defaultCppOpts = CppOpts :: Bool -> Map FilePath Int -> CppOpts
CppOpts
  { cppRun :: Bool
cppRun         = Bool
False
  , cppDefinitions :: Map FilePath Int
cppDefinitions = Map FilePath Int
forall k a. Map k a
Map.empty
  }

-- | Default preprocessor options
defaultPrepOpts :: PrepOpts
defaultPrepOpts :: PrepOpts
defaultPrepOpts = PrepOpts :: Bool -> FilePath -> [FilePath] -> PrepOpts
PrepOpts
  { ppPreprocess :: Bool
ppPreprocess = Bool
False
  , ppCmd :: FilePath
ppCmd        = ""
  , ppOpts :: [FilePath]
ppOpts       = []
  }

-- | Default warning options
defaultWarnOpts :: WarnOpts
defaultWarnOpts :: WarnOpts
defaultWarnOpts = WarnOpts :: Bool -> [WarnFlag] -> Bool -> WarnOpts
WarnOpts
  { wnWarn :: Bool
wnWarn        = Bool
True
  , wnWarnFlags :: [WarnFlag]
wnWarnFlags   = [WarnFlag]
stdWarnFlags
  , wnWarnAsError :: Bool
wnWarnAsError = Bool
False
  }

-- | Default dump options
defaultDebugOpts :: DebugOpts
defaultDebugOpts :: DebugOpts
defaultDebugOpts = DebugOpts :: [DumpLevel] -> Bool -> Bool -> Bool -> Bool -> DebugOpts
DebugOpts
  { dbDumpLevels :: [DumpLevel]
dbDumpLevels      = []
  , dbDumpEnv :: Bool
dbDumpEnv         = Bool
False
  , dbDumpRaw :: Bool
dbDumpRaw         = Bool
False
  , dbDumpAllBindings :: Bool
dbDumpAllBindings = Bool
False
  , dbDumpSimple :: Bool
dbDumpSimple      = Bool
False
  }

defaultOptimizationOpts :: OptimizationOpts
defaultOptimizationOpts :: OptimizationOpts
defaultOptimizationOpts = OptimizationOpts :: Bool -> Bool -> Bool -> OptimizationOpts
OptimizationOpts
  { optDesugarNewtypes :: Bool
optDesugarNewtypes     = Bool
False
  , optInlineDictionaries :: Bool
optInlineDictionaries  = Bool
True
  , optRemoveUnusedImports :: Bool
optRemoveUnusedImports = Bool
True
  }

-- |Modus operandi of the program
data CymakeMode
  = ModeHelp           -- ^ Show help information and exit
  | ModeVersion        -- ^ Show version and exit
  | ModeNumericVersion -- ^ Show numeric version, suitable for later processing
  | ModeMake           -- ^ Compile with dependencies
  deriving (CymakeMode -> CymakeMode -> Bool
(CymakeMode -> CymakeMode -> Bool)
-> (CymakeMode -> CymakeMode -> Bool) -> Eq CymakeMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CymakeMode -> CymakeMode -> Bool
$c/= :: CymakeMode -> CymakeMode -> Bool
== :: CymakeMode -> CymakeMode -> Bool
$c== :: CymakeMode -> CymakeMode -> Bool
Eq, Int -> CymakeMode -> ShowS
[CymakeMode] -> ShowS
CymakeMode -> FilePath
(Int -> CymakeMode -> ShowS)
-> (CymakeMode -> FilePath)
-> ([CymakeMode] -> ShowS)
-> Show CymakeMode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CymakeMode] -> ShowS
$cshowList :: [CymakeMode] -> ShowS
show :: CymakeMode -> FilePath
$cshow :: CymakeMode -> FilePath
showsPrec :: Int -> CymakeMode -> ShowS
$cshowsPrec :: Int -> CymakeMode -> ShowS
Show)

-- |Verbosity level
data Verbosity
  = VerbQuiet  -- ^ be quiet
  | VerbStatus -- ^ show status of compilation
  deriving (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 -> ShowS
[Verbosity] -> ShowS
Verbosity -> FilePath
(Int -> Verbosity -> ShowS)
-> (Verbosity -> FilePath)
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Verbosity] -> ShowS
$cshowList :: [Verbosity] -> ShowS
show :: Verbosity -> FilePath
$cshow :: Verbosity -> FilePath
showsPrec :: Int -> Verbosity -> ShowS
$cshowsPrec :: Int -> Verbosity -> ShowS
Show)

-- |Description and flag of verbosities
verbosities :: [(Verbosity, String, String)]
verbosities :: [(Verbosity, FilePath, FilePath)]
verbosities = [ ( Verbosity
VerbQuiet , "0", "quiet" )
              , ( Verbosity
VerbStatus, "1", "status")
              ]

-- |Type of the target file
data TargetType
  = Tokens               -- ^ Source code tokens
  | Comments             -- ^ Source code comments
  | Parsed               -- ^ Parsed source code
  | FlatCurry            -- ^ FlatCurry
  | AnnotatedFlatCurry   -- ^ Annotated FlatCurry
  | TypedFlatCurry       -- ^ Typed FlatCurry
  | AbstractCurry        -- ^ AbstractCurry
  | UntypedAbstractCurry -- ^ Untyped AbstractCurry
  | Html                 -- ^ HTML documentation
  | AST                  -- ^ Abstract-Syntax-Tree after checks
  | ShortAST             -- ^ Abstract-Syntax-Tree with shortened decls
    deriving (TargetType -> TargetType -> Bool
(TargetType -> TargetType -> Bool)
-> (TargetType -> TargetType -> Bool) -> Eq TargetType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetType -> TargetType -> Bool
$c/= :: TargetType -> TargetType -> Bool
== :: TargetType -> TargetType -> Bool
$c== :: TargetType -> TargetType -> Bool
Eq, Int -> TargetType -> ShowS
[TargetType] -> ShowS
TargetType -> FilePath
(Int -> TargetType -> ShowS)
-> (TargetType -> FilePath)
-> ([TargetType] -> ShowS)
-> Show TargetType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TargetType] -> ShowS
$cshowList :: [TargetType] -> ShowS
show :: TargetType -> FilePath
$cshow :: TargetType -> FilePath
showsPrec :: Int -> TargetType -> ShowS
$cshowsPrec :: Int -> TargetType -> ShowS
Show)

-- |Warnings flags
data WarnFlag
  = WarnMultipleImports      -- ^ Warn for multiple imports
  | WarnDisjoinedRules       -- ^ Warn for disjoined function rules
  | WarnUnusedGlobalBindings -- ^ Warn for unused global bindings
  | WarnUnusedBindings       -- ^ Warn for unused local bindings
  | WarnNameShadowing        -- ^ Warn for name shadowing
  | WarnOverlapping          -- ^ Warn for overlapping rules/alternatives
  | WarnIncompletePatterns   -- ^ Warn for incomplete pattern matching
  | WarnMissingSignatures    -- ^ Warn for missing type signatures
  | WarnMissingMethods       -- ^ Warn for missing method implementations
  | WarnOrphanInstances      -- ^ Warn for orphan instances
  | WarnIrregularCaseMode    -- ^ Warn for irregular case mode
  | WarnRedundantContext     -- ^ Warn for redundant context in type signatures
    deriving (WarnFlag -> WarnFlag -> Bool
(WarnFlag -> WarnFlag -> Bool)
-> (WarnFlag -> WarnFlag -> Bool) -> Eq WarnFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WarnFlag -> WarnFlag -> Bool
$c/= :: WarnFlag -> WarnFlag -> Bool
== :: WarnFlag -> WarnFlag -> Bool
$c== :: WarnFlag -> WarnFlag -> Bool
Eq, WarnFlag
WarnFlag -> WarnFlag -> Bounded WarnFlag
forall a. a -> a -> Bounded a
maxBound :: WarnFlag
$cmaxBound :: WarnFlag
minBound :: WarnFlag
$cminBound :: WarnFlag
Bounded, Int -> WarnFlag
WarnFlag -> Int
WarnFlag -> [WarnFlag]
WarnFlag -> WarnFlag
WarnFlag -> WarnFlag -> [WarnFlag]
WarnFlag -> WarnFlag -> WarnFlag -> [WarnFlag]
(WarnFlag -> WarnFlag)
-> (WarnFlag -> WarnFlag)
-> (Int -> WarnFlag)
-> (WarnFlag -> Int)
-> (WarnFlag -> [WarnFlag])
-> (WarnFlag -> WarnFlag -> [WarnFlag])
-> (WarnFlag -> WarnFlag -> [WarnFlag])
-> (WarnFlag -> WarnFlag -> WarnFlag -> [WarnFlag])
-> Enum WarnFlag
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 :: WarnFlag -> WarnFlag -> WarnFlag -> [WarnFlag]
$cenumFromThenTo :: WarnFlag -> WarnFlag -> WarnFlag -> [WarnFlag]
enumFromTo :: WarnFlag -> WarnFlag -> [WarnFlag]
$cenumFromTo :: WarnFlag -> WarnFlag -> [WarnFlag]
enumFromThen :: WarnFlag -> WarnFlag -> [WarnFlag]
$cenumFromThen :: WarnFlag -> WarnFlag -> [WarnFlag]
enumFrom :: WarnFlag -> [WarnFlag]
$cenumFrom :: WarnFlag -> [WarnFlag]
fromEnum :: WarnFlag -> Int
$cfromEnum :: WarnFlag -> Int
toEnum :: Int -> WarnFlag
$ctoEnum :: Int -> WarnFlag
pred :: WarnFlag -> WarnFlag
$cpred :: WarnFlag -> WarnFlag
succ :: WarnFlag -> WarnFlag
$csucc :: WarnFlag -> WarnFlag
Enum, Int -> WarnFlag -> ShowS
[WarnFlag] -> ShowS
WarnFlag -> FilePath
(Int -> WarnFlag -> ShowS)
-> (WarnFlag -> FilePath) -> ([WarnFlag] -> ShowS) -> Show WarnFlag
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [WarnFlag] -> ShowS
$cshowList :: [WarnFlag] -> ShowS
show :: WarnFlag -> FilePath
$cshow :: WarnFlag -> FilePath
showsPrec :: Int -> WarnFlag -> ShowS
$cshowsPrec :: Int -> WarnFlag -> ShowS
Show)

-- |Warning flags enabled by default
stdWarnFlags :: [WarnFlag]
stdWarnFlags :: [WarnFlag]
stdWarnFlags =
  [ WarnFlag
WarnMultipleImports   , WarnFlag
WarnDisjoinedRules   --, WarnUnusedGlobalBindings
  , WarnFlag
WarnUnusedBindings    , WarnFlag
WarnNameShadowing    , WarnFlag
WarnOverlapping
  , WarnFlag
WarnIncompletePatterns, WarnFlag
WarnMissingSignatures, WarnFlag
WarnMissingMethods
  , WarnFlag
WarnIrregularCaseMode , WarnFlag
WarnRedundantContext
  ]

-- |Description and flag of warnings flags
warnFlags :: [(WarnFlag, String, String)]
warnFlags :: [(WarnFlag, FilePath, FilePath)]
warnFlags =
  [ ( WarnFlag
WarnMultipleImports     , "multiple-imports"
    , "multiple imports"               )
  , ( WarnFlag
WarnDisjoinedRules      , "disjoined-rules"
    , "disjoined function rules"       )
  , ( WarnFlag
WarnUnusedGlobalBindings, "unused-global-bindings"
    , "unused bindings"                )
  , ( WarnFlag
WarnUnusedBindings      , "unused-bindings"
    , "unused bindings"                )
  , ( WarnFlag
WarnNameShadowing       , "name-shadowing"
    , "name shadowing"                 )
  , ( WarnFlag
WarnOverlapping         , "overlapping"
    , "overlapping function rules"     )
  , ( WarnFlag
WarnIncompletePatterns  , "incomplete-patterns"
    , "incomplete pattern matching"    )
  , ( WarnFlag
WarnMissingSignatures   , "missing-signatures"
    , "missing type signatures"        )
  , ( WarnFlag
WarnMissingMethods      , "missing-methods"
    , "missing method implementations" )
  , ( WarnFlag
WarnOrphanInstances     , "orphan-instances"
    , "orphan instances"               )
  , ( WarnFlag
WarnIrregularCaseMode   , "irregular-case-mode"
    , "irregular case mode")
  , ( WarnFlag
WarnRedundantContext    , "redundant-context"
    , "redundant context")
  ]

-- |Dump level
data DumpLevel
  = DumpCondCompiled      -- ^ dump source code after conditional compiling
  | DumpParsed            -- ^ dump source code after parsing
  | DumpExtensionChecked  -- ^ dump source code after extension checking
  | DumpTypeSyntaxChecked -- ^ dump source code after type syntax checking
  | DumpKindChecked       -- ^ dump source code after kind checking
  | DumpSyntaxChecked     -- ^ dump source code after syntax checking
  | DumpPrecChecked       -- ^ dump source code after precedence checking
  | DumpDeriveChecked     -- ^ dump source code after derive checking
  | DumpInstanceChecked   -- ^ dump source code after instance checking
  | DumpTypeChecked       -- ^ dump source code after type checking
  | DumpExportChecked     -- ^ dump source code after export checking
  | DumpQualified         -- ^ dump source code after qualification
  | DumpDerived           -- ^ dump source code after deriving
  | DumpDesugared         -- ^ dump source code after desugaring
  | DumpDictionaries      -- ^ dump source code after dictionary transformation
  | DumpNewtypes          -- ^ dump source code after removing newtype constructors
  | DumpSimplified        -- ^ dump source code after simplification
  | DumpLifted            -- ^ dump source code after lambda-lifting
  | DumpTranslated        -- ^ dump IL code after translation
  | DumpCaseCompleted     -- ^ dump IL code after case completion
  | DumpTypedFlatCurry    -- ^ dump typed FlatCurry code
  | DumpFlatCurry         -- ^ dump FlatCurry code
    deriving (DumpLevel -> DumpLevel -> Bool
(DumpLevel -> DumpLevel -> Bool)
-> (DumpLevel -> DumpLevel -> Bool) -> Eq DumpLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DumpLevel -> DumpLevel -> Bool
$c/= :: DumpLevel -> DumpLevel -> Bool
== :: DumpLevel -> DumpLevel -> Bool
$c== :: DumpLevel -> DumpLevel -> Bool
Eq, DumpLevel
DumpLevel -> DumpLevel -> Bounded DumpLevel
forall a. a -> a -> Bounded a
maxBound :: DumpLevel
$cmaxBound :: DumpLevel
minBound :: DumpLevel
$cminBound :: DumpLevel
Bounded, Int -> DumpLevel
DumpLevel -> Int
DumpLevel -> [DumpLevel]
DumpLevel -> DumpLevel
DumpLevel -> DumpLevel -> [DumpLevel]
DumpLevel -> DumpLevel -> DumpLevel -> [DumpLevel]
(DumpLevel -> DumpLevel)
-> (DumpLevel -> DumpLevel)
-> (Int -> DumpLevel)
-> (DumpLevel -> Int)
-> (DumpLevel -> [DumpLevel])
-> (DumpLevel -> DumpLevel -> [DumpLevel])
-> (DumpLevel -> DumpLevel -> [DumpLevel])
-> (DumpLevel -> DumpLevel -> DumpLevel -> [DumpLevel])
-> Enum DumpLevel
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 :: DumpLevel -> DumpLevel -> DumpLevel -> [DumpLevel]
$cenumFromThenTo :: DumpLevel -> DumpLevel -> DumpLevel -> [DumpLevel]
enumFromTo :: DumpLevel -> DumpLevel -> [DumpLevel]
$cenumFromTo :: DumpLevel -> DumpLevel -> [DumpLevel]
enumFromThen :: DumpLevel -> DumpLevel -> [DumpLevel]
$cenumFromThen :: DumpLevel -> DumpLevel -> [DumpLevel]
enumFrom :: DumpLevel -> [DumpLevel]
$cenumFrom :: DumpLevel -> [DumpLevel]
fromEnum :: DumpLevel -> Int
$cfromEnum :: DumpLevel -> Int
toEnum :: Int -> DumpLevel
$ctoEnum :: Int -> DumpLevel
pred :: DumpLevel -> DumpLevel
$cpred :: DumpLevel -> DumpLevel
succ :: DumpLevel -> DumpLevel
$csucc :: DumpLevel -> DumpLevel
Enum, Int -> DumpLevel -> ShowS
[DumpLevel] -> ShowS
DumpLevel -> FilePath
(Int -> DumpLevel -> ShowS)
-> (DumpLevel -> FilePath)
-> ([DumpLevel] -> ShowS)
-> Show DumpLevel
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DumpLevel] -> ShowS
$cshowList :: [DumpLevel] -> ShowS
show :: DumpLevel -> FilePath
$cshow :: DumpLevel -> FilePath
showsPrec :: Int -> DumpLevel -> ShowS
$cshowsPrec :: Int -> DumpLevel -> ShowS
Show)

-- |Description and flag of dump levels
dumpLevel :: [(DumpLevel, String, String)]
dumpLevel :: [(DumpLevel, FilePath, FilePath)]
dumpLevel = [ (DumpLevel
DumpCondCompiled     , "dump-cond" , "conditional compiling"           )
            , (DumpLevel
DumpParsed           , "dump-parse", "parsing"                         )
            , (DumpLevel
DumpExtensionChecked , "dump-exc"  , "extension checking"              )
            , (DumpLevel
DumpTypeSyntaxChecked, "dump-tsc"  , "type syntax checking"            )
            , (DumpLevel
DumpKindChecked      , "dump-kc"   , "kind checking"                   )
            , (DumpLevel
DumpSyntaxChecked    , "dump-sc"   , "syntax checking"                 )
            , (DumpLevel
DumpPrecChecked      , "dump-pc"   , "precedence checking"             )
            , (DumpLevel
DumpDeriveChecked    , "dump-dc"   , "derive checking"                 )
            , (DumpLevel
DumpInstanceChecked  , "dump-inc"  , "instance checking"               )
            , (DumpLevel
DumpTypeChecked      , "dump-tc"   , "type checking"                   )
            , (DumpLevel
DumpExportChecked    , "dump-ec"   , "export checking"                 )
            , (DumpLevel
DumpQualified        , "dump-qual" , "qualification"                   )
            , (DumpLevel
DumpDerived          , "dump-deriv", "deriving"                        )
            , (DumpLevel
DumpDesugared        , "dump-ds"   , "desugaring"                      )
            , (DumpLevel
DumpDictionaries     , "dump-dict" , "dictionary insertion"            )
            , (DumpLevel
DumpNewtypes         , "dump-new"  , "removing newtype constructors"   )
            , (DumpLevel
DumpLifted           , "dump-lift" , "lifting"                         )
            , (DumpLevel
DumpSimplified       , "dump-simpl", "simplification"                  )
            , (DumpLevel
DumpTranslated       , "dump-trans", "pattern matching compilation"    )
            , (DumpLevel
DumpCaseCompleted    , "dump-cc"   , "case completion"                 )
            , (DumpLevel
DumpTypedFlatCurry   , "dump-tflat", "translation into typed FlatCurry")
            , (DumpLevel
DumpFlatCurry        , "dump-flat" , "translation into FlatCurry"      )
            ]

-- |Description and flag of language extensions
extensions :: [(KnownExtension, String, String)]
extensions :: [(KnownExtension, FilePath, FilePath)]
extensions =
  [ ( KnownExtension
AnonFreeVars             , "AnonFreeVars"
    , "enable anonymous free variables"              )
  , ( KnownExtension
CPP                      , "CPP"
    , "run C preprocessor"                           )
  , ( KnownExtension
FunctionalPatterns       , "FunctionalPatterns"
    , "enable functional patterns"                   )
  , ( KnownExtension
NegativeLiterals         , "NegativeLiterals"
    , "desugar negated literals as negative literal" )
  , ( KnownExtension
NoImplicitPrelude        , "NoImplicitPrelude"
    , "do not implicitly import the Prelude"         )
  ]

-- -----------------------------------------------------------------------------
-- Parsing of the command line options.
--
-- Because some flags require additional arguments, the structure is slightly
-- more complicated to enable malformed arguments to be reported.
-- -----------------------------------------------------------------------------

-- |Instead of just returning the resulting 'Options' structure, we also
-- collect errors from arguments passed to specific options.
type OptErr = (Options, [String])

-- |An 'OptErrTable' consists of a list of entries of the following form:
--   * a flag to be recognized on the command line
--   * an explanation text for the usage information
--   * a modification funtion adjusting the options structure
-- The type is parametric about the option's type to adjust.
type OptErrTable opt = [(String, String, opt -> opt)]

onOpts :: (Options -> Options) -> OptErr -> OptErr
onOpts :: (Options -> Options) -> OptErr -> OptErr
onOpts f :: Options -> Options
f (opts :: Options
opts, errs :: [FilePath]
errs) = (Options -> Options
f Options
opts, [FilePath]
errs)

onCppOpts :: (CppOpts -> CppOpts) -> OptErr -> OptErr
onCppOpts :: (CppOpts -> CppOpts) -> OptErr -> OptErr
onCppOpts f :: CppOpts -> CppOpts
f (opts :: Options
opts, errs :: [FilePath]
errs) = (Options
opts { optCppOpts :: CppOpts
optCppOpts = CppOpts -> CppOpts
f (Options -> CppOpts
optCppOpts Options
opts) }, [FilePath]
errs)

onPrepOpts :: (PrepOpts -> PrepOpts) -> OptErr -> OptErr
onPrepOpts :: (PrepOpts -> PrepOpts) -> OptErr -> OptErr
onPrepOpts f :: PrepOpts -> PrepOpts
f (opts :: Options
opts, errs :: [FilePath]
errs) = (Options
opts { optPrepOpts :: PrepOpts
optPrepOpts = PrepOpts -> PrepOpts
f (Options -> PrepOpts
optPrepOpts Options
opts) }, [FilePath]
errs)

onWarnOpts :: (WarnOpts -> WarnOpts) -> OptErr -> OptErr
onWarnOpts :: (WarnOpts -> WarnOpts) -> OptErr -> OptErr
onWarnOpts f :: WarnOpts -> WarnOpts
f (opts :: Options
opts, errs :: [FilePath]
errs) = (Options
opts { optWarnOpts :: WarnOpts
optWarnOpts = WarnOpts -> WarnOpts
f (Options -> WarnOpts
optWarnOpts Options
opts) }, [FilePath]
errs)

onDebugOpts :: (DebugOpts -> DebugOpts) -> OptErr -> OptErr
onDebugOpts :: (DebugOpts -> DebugOpts) -> OptErr -> OptErr
onDebugOpts f :: DebugOpts -> DebugOpts
f (opts :: Options
opts, errs :: [FilePath]
errs)
  = (Options
opts { optDebugOpts :: DebugOpts
optDebugOpts = DebugOpts -> DebugOpts
f (Options -> DebugOpts
optDebugOpts Options
opts) }, [FilePath]
errs)

onOptimOpts :: (OptimizationOpts -> OptimizationOpts) -> OptErr -> OptErr
onOptimOpts :: (OptimizationOpts -> OptimizationOpts) -> OptErr -> OptErr
onOptimOpts f :: OptimizationOpts -> OptimizationOpts
f (opts :: Options
opts, errs :: [FilePath]
errs)
    = (Options
opts { optOptimizations :: OptimizationOpts
optOptimizations = OptimizationOpts -> OptimizationOpts
f (Options -> OptimizationOpts
optOptimizations Options
opts) }, [FilePath]
errs)

withArg :: ((a -> b) -> OptErr -> OptErr)
        -> (String -> a -> b) -> String -> OptErr -> OptErr
withArg :: ((a -> b) -> OptErr -> OptErr)
-> (FilePath -> a -> b) -> FilePath -> OptErr -> OptErr
withArg lift :: (a -> b) -> OptErr -> OptErr
lift f :: FilePath -> a -> b
f arg :: FilePath
arg = (a -> b) -> OptErr -> OptErr
lift (FilePath -> a -> b
f FilePath
arg)

addErr :: String -> OptErr -> OptErr
addErr :: FilePath -> OptErr -> OptErr
addErr err :: FilePath
err (opts :: Options
opts, errs :: [FilePath]
errs) = (Options
opts, [FilePath]
errs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
err])

mkOptDescr :: ((opt -> opt) -> OptErr -> OptErr)
           -> String -> [String] -> String -> String -> OptErrTable opt
           -> OptDescr (OptErr -> OptErr)
mkOptDescr :: ((opt -> opt) -> OptErr -> OptErr)
-> FilePath
-> [FilePath]
-> FilePath
-> FilePath
-> OptErrTable opt
-> OptDescr (OptErr -> OptErr)
mkOptDescr lift :: (opt -> opt) -> OptErr -> OptErr
lift flags :: FilePath
flags longFlags :: [FilePath]
longFlags arg :: FilePath
arg what :: FilePath
what tbl :: OptErrTable opt
tbl = FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option FilePath
flags [FilePath]
longFlags
  ((FilePath -> OptErr -> OptErr)
-> FilePath -> ArgDescr (OptErr -> OptErr)
forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (((opt -> opt) -> OptErr -> OptErr)
-> FilePath -> OptErrTable opt -> FilePath -> OptErr -> OptErr
forall opt.
((opt -> opt) -> OptErr -> OptErr)
-> FilePath -> OptErrTable opt -> FilePath -> OptErr -> OptErr
parseOptErr (opt -> opt) -> OptErr -> OptErr
lift FilePath
what OptErrTable opt
tbl) FilePath
arg)
  ("set " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
what FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ " `" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
arg FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ "', where `" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
arg FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ "' is one of\n"
    FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ OptErrTable opt -> FilePath
forall opt. OptErrTable opt -> FilePath
renderOptErrTable OptErrTable opt
tbl)

parseOptErr :: ((opt -> opt) -> OptErr -> OptErr)
            -> String -> OptErrTable opt -> String -> OptErr -> OptErr
parseOptErr :: ((opt -> opt) -> OptErr -> OptErr)
-> FilePath -> OptErrTable opt -> FilePath -> OptErr -> OptErr
parseOptErr lift :: (opt -> opt) -> OptErr -> OptErr
lift what :: FilePath
what table :: OptErrTable opt
table opt :: FilePath
opt = case FilePath -> OptErrTable opt -> Maybe (opt -> opt)
forall t b a. Eq t => t -> [(t, b, a)] -> Maybe a
lookup3 FilePath
opt OptErrTable opt
table of
  Just f :: opt -> opt
f  -> (opt -> opt) -> OptErr -> OptErr
lift opt -> opt
f
  Nothing -> FilePath -> OptErr -> OptErr
addErr (FilePath -> OptErr -> OptErr) -> FilePath -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ "unrecognized " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
what FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ '`' Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
opt FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ "'\n"
  where
  lookup3 :: t -> [(t, b, a)] -> Maybe a
lookup3 _ []                  = Maybe a
forall a. Maybe a
Nothing
  lookup3 k :: t
k ((k' :: t
k', _, v2 :: a
v2) : kvs :: [(t, b, a)]
kvs)
    | t
k t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
k'                   = a -> Maybe a
forall a. a -> Maybe a
Just a
v2
    | Bool
otherwise                 = t -> [(t, b, a)] -> Maybe a
lookup3 t
k [(t, b, a)]
kvs

renderOptErrTable :: OptErrTable opt -> String
renderOptErrTable :: OptErrTable opt -> FilePath
renderOptErrTable ds :: OptErrTable opt
ds
  = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "\n" ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath, opt -> opt) -> FilePath)
-> OptErrTable opt -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\(k :: FilePath
k, d :: FilePath
d, _) -> "  " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
rpad Int
maxLen FilePath
k FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
d) OptErrTable opt
ds
  where
  maxLen :: Int
maxLen = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath, opt -> opt) -> Int)
-> OptErrTable opt -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(k :: FilePath
k, _, _) -> FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
k) OptErrTable opt
ds
  rpad :: Int -> ShowS
rpad n :: Int
n x :: FilePath
x = FilePath
x FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
x) ' '

-- | All available compiler options
options :: [OptDescr (OptErr -> OptErr)]
options :: [OptDescr (OptErr -> OptErr)]
options =
  -- modus operandi
  [ FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option "h?" ["help"]
      ((OptErr -> OptErr) -> ArgDescr (OptErr -> OptErr)
forall a. a -> ArgDescr a
NoArg ((Options -> Options) -> OptErr -> OptErr
onOpts ((Options -> Options) -> OptErr -> OptErr)
-> (Options -> Options) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ opts :: Options
opts -> Options
opts { optMode :: CymakeMode
optMode = CymakeMode
ModeHelp }))
      "display this help and exit"
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option "V"  ["version"]
      ((OptErr -> OptErr) -> ArgDescr (OptErr -> OptErr)
forall a. a -> ArgDescr a
NoArg ((Options -> Options) -> OptErr -> OptErr
onOpts ((Options -> Options) -> OptErr -> OptErr)
-> (Options -> Options) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ opts :: Options
opts -> Options
opts { optMode :: CymakeMode
optMode = CymakeMode
ModeVersion }))
      "show the version number and exit"
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option ""   ["numeric-version"]
      ((OptErr -> OptErr) -> ArgDescr (OptErr -> OptErr)
forall a. a -> ArgDescr a
NoArg ((Options -> Options) -> OptErr -> OptErr
onOpts ((Options -> Options) -> OptErr -> OptErr)
-> (Options -> Options) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ opts :: Options
opts -> Options
opts { optMode :: CymakeMode
optMode = CymakeMode
ModeNumericVersion }))
      "show the numeric version number and exit"
  -- verbosity
  , ((Options -> Options) -> OptErr -> OptErr)
-> FilePath
-> [FilePath]
-> FilePath
-> FilePath
-> OptErrTable Options
-> OptDescr (OptErr -> OptErr)
forall opt.
((opt -> opt) -> OptErr -> OptErr)
-> FilePath
-> [FilePath]
-> FilePath
-> FilePath
-> OptErrTable opt
-> OptDescr (OptErr -> OptErr)
mkOptDescr (Options -> Options) -> OptErr -> OptErr
onOpts "v" ["verbosity"] "n" "verbosity level" OptErrTable Options
verbDescriptions
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option "q"  ["no-verb"]
      ((OptErr -> OptErr) -> ArgDescr (OptErr -> OptErr)
forall a. a -> ArgDescr a
NoArg ((Options -> Options) -> OptErr -> OptErr
onOpts ((Options -> Options) -> OptErr -> OptErr)
-> (Options -> Options) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ opts :: Options
opts -> Options
opts { optVerbosity :: Verbosity
optVerbosity = Verbosity
VerbQuiet } ))
      "set verbosity level to quiet"
  -- compilation
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option "f"  ["force"]
      ((OptErr -> OptErr) -> ArgDescr (OptErr -> OptErr)
forall a. a -> ArgDescr a
NoArg ((Options -> Options) -> OptErr -> OptErr
onOpts ((Options -> Options) -> OptErr -> OptErr)
-> (Options -> Options) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ opts :: Options
opts -> Options
opts { optForce :: Bool
optForce = Bool
True }))
      "force compilation of target file"
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option "P"  ["lib-dir"]
      ((FilePath -> OptErr -> OptErr)
-> FilePath -> ArgDescr (OptErr -> OptErr)
forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (((Options -> Options) -> OptErr -> OptErr)
-> (FilePath -> Options -> Options) -> FilePath -> OptErr -> OptErr
forall a b.
((a -> b) -> OptErr -> OptErr)
-> (FilePath -> a -> b) -> FilePath -> OptErr -> OptErr
withArg (Options -> Options) -> OptErr -> OptErr
onOpts ((FilePath -> Options -> Options) -> FilePath -> OptErr -> OptErr)
-> (FilePath -> Options -> Options) -> FilePath -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ arg :: FilePath
arg opts :: Options
opts -> Options
opts { optLibraryPaths :: [FilePath]
optLibraryPaths =
        [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Options -> [FilePath]
optLibraryPaths Options
opts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath]
splitSearchPath FilePath
arg}) "dir[:dir]")
      "search for libraries in dir[:dir]"
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option "i"  ["import-dir"]
      ((FilePath -> OptErr -> OptErr)
-> FilePath -> ArgDescr (OptErr -> OptErr)
forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (((Options -> Options) -> OptErr -> OptErr)
-> (FilePath -> Options -> Options) -> FilePath -> OptErr -> OptErr
forall a b.
((a -> b) -> OptErr -> OptErr)
-> (FilePath -> a -> b) -> FilePath -> OptErr -> OptErr
withArg (Options -> Options) -> OptErr -> OptErr
onOpts ((FilePath -> Options -> Options) -> FilePath -> OptErr -> OptErr)
-> (FilePath -> Options -> Options) -> FilePath -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ arg :: FilePath
arg opts :: Options
opts -> Options
opts { optImportPaths :: [FilePath]
optImportPaths =
        [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Options -> [FilePath]
optImportPaths Options
opts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
              ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
normalise ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
addTrailingPathSeparator) (FilePath -> [FilePath]
splitSearchPath FilePath
arg)
              }) "dir[:dir]")
      "search for imports in dir[:dir]"
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option "o"  ["outdir"]
      ((FilePath -> OptErr -> OptErr)
-> FilePath -> ArgDescr (OptErr -> OptErr)
forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (((Options -> Options) -> OptErr -> OptErr)
-> (FilePath -> Options -> Options) -> FilePath -> OptErr -> OptErr
forall a b.
((a -> b) -> OptErr -> OptErr)
-> (FilePath -> a -> b) -> FilePath -> OptErr -> OptErr
withArg (Options -> Options) -> OptErr -> OptErr
onOpts ((FilePath -> Options -> Options) -> FilePath -> OptErr -> OptErr)
-> (FilePath -> Options -> Options) -> FilePath -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ arg :: FilePath
arg opts :: Options
opts -> Options
opts { optOutDir :: FilePath
optOutDir = FilePath
arg }) "dir")
      "write compilation artifacts (FlatCurry, ...) into directory `dir'"
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option []   ["htmldir"]
      ((FilePath -> OptErr -> OptErr)
-> FilePath -> ArgDescr (OptErr -> OptErr)
forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (((Options -> Options) -> OptErr -> OptErr)
-> (FilePath -> Options -> Options) -> FilePath -> OptErr -> OptErr
forall a b.
((a -> b) -> OptErr -> OptErr)
-> (FilePath -> a -> b) -> FilePath -> OptErr -> OptErr
withArg (Options -> Options) -> OptErr -> OptErr
onOpts ((FilePath -> Options -> Options) -> FilePath -> OptErr -> OptErr)
-> (FilePath -> Options -> Options) -> FilePath -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ arg :: FilePath
arg opts :: Options
opts -> Options
opts { optHtmlDir :: Maybe FilePath
optHtmlDir =
        FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
arg }) "dir")
      "write HTML documentation into directory `dir'"
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option ""   ["no-outdir", "no-subdir"]
      ((OptErr -> OptErr) -> ArgDescr (OptErr -> OptErr)
forall a. a -> ArgDescr a
NoArg ((Options -> Options) -> OptErr -> OptErr
onOpts ((Options -> Options) -> OptErr -> OptErr)
-> (Options -> Options) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ opts :: Options
opts -> Options
opts { optUseOutDir :: Bool
optUseOutDir = Bool
False }))
      ("disable writing to `" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
defaultOutDir FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ "' subdirectory")
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option ""   ["no-intf"]
      ((OptErr -> OptErr) -> ArgDescr (OptErr -> OptErr)
forall a. a -> ArgDescr a
NoArg ((Options -> Options) -> OptErr -> OptErr
onOpts ((Options -> Options) -> OptErr -> OptErr)
-> (Options -> Options) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ opts :: Options
opts -> Options
opts { optInterface :: Bool
optInterface = Bool
False }))
      "do not create an interface file"
    -- legacy warning flags
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option ""   ["no-warn"]
      ((OptErr -> OptErr) -> ArgDescr (OptErr -> OptErr)
forall a. a -> ArgDescr a
NoArg ((WarnOpts -> WarnOpts) -> OptErr -> OptErr
onWarnOpts ((WarnOpts -> WarnOpts) -> OptErr -> OptErr)
-> (WarnOpts -> WarnOpts) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ opts :: WarnOpts
opts -> WarnOpts
opts { wnWarn :: Bool
wnWarn = Bool
False }))
      "do not print warnings"
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option ""   ["no-overlap-warn"]
      ((OptErr -> OptErr) -> ArgDescr (OptErr -> OptErr)
forall a. a -> ArgDescr a
NoArg ((WarnOpts -> WarnOpts) -> OptErr -> OptErr
onWarnOpts ((WarnOpts -> WarnOpts) -> OptErr -> OptErr)
-> (WarnOpts -> WarnOpts) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ opts :: WarnOpts
opts -> WarnOpts
opts {wnWarnFlags :: [WarnFlag]
wnWarnFlags =
        WarnFlag -> [WarnFlag] -> [WarnFlag]
forall a. Eq a => a -> [a] -> [a]
addFlag WarnFlag
WarnOverlapping (WarnOpts -> [WarnFlag]
wnWarnFlags WarnOpts
opts) }))
      "do not print warnings for overlapping rules"
  -- target types
  , TargetType -> FilePath -> FilePath -> OptDescr (OptErr -> OptErr)
targetOption TargetType
Tokens                 "tokens"
      "generate token stream"
  , TargetType -> FilePath -> FilePath -> OptDescr (OptErr -> OptErr)
targetOption TargetType
Comments               "comments"
      "generate comments stream"
  , TargetType -> FilePath -> FilePath -> OptDescr (OptErr -> OptErr)
targetOption TargetType
Parsed                 "parse-only"
      "generate source representation"
  , TargetType -> FilePath -> FilePath -> OptDescr (OptErr -> OptErr)
targetOption TargetType
FlatCurry              "flat"
      "generate FlatCurry code"
  , TargetType -> FilePath -> FilePath -> OptDescr (OptErr -> OptErr)
targetOption TargetType
TypedFlatCurry         "typed-flat"
      "generate typed FlatCurry code"
  , TargetType -> FilePath -> FilePath -> OptDescr (OptErr -> OptErr)
targetOption TargetType
AnnotatedFlatCurry     "type-annotated-flat"
      "generate type-annotated FlatCurry code"
  , TargetType -> FilePath -> FilePath -> OptDescr (OptErr -> OptErr)
targetOption TargetType
AbstractCurry          "acy"
      "generate typed AbstractCurry"
  , TargetType -> FilePath -> FilePath -> OptDescr (OptErr -> OptErr)
targetOption TargetType
UntypedAbstractCurry   "uacy"
      "generate untyped AbstractCurry"
  , TargetType -> FilePath -> FilePath -> OptDescr (OptErr -> OptErr)
targetOption TargetType
Html                   "html"
      "generate html documentation"
  , TargetType -> FilePath -> FilePath -> OptDescr (OptErr -> OptErr)
targetOption TargetType
AST                    "ast"
      "generate abstract syntax tree"
  , TargetType -> FilePath -> FilePath -> OptDescr (OptErr -> OptErr)
targetOption TargetType
ShortAST               "short-ast"
      "generate shortened abstract syntax tree for documentation"
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option "F"  []
      ((OptErr -> OptErr) -> ArgDescr (OptErr -> OptErr)
forall a. a -> ArgDescr a
NoArg ((PrepOpts -> PrepOpts) -> OptErr -> OptErr
onPrepOpts ((PrepOpts -> PrepOpts) -> OptErr -> OptErr)
-> (PrepOpts -> PrepOpts) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ opts :: PrepOpts
opts -> PrepOpts
opts { ppPreprocess :: Bool
ppPreprocess = Bool
True }))
      "use custom preprocessor"
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option ""   ["pgmF"]
      ((FilePath -> OptErr -> OptErr)
-> FilePath -> ArgDescr (OptErr -> OptErr)
forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (((PrepOpts -> PrepOpts) -> OptErr -> OptErr)
-> (FilePath -> PrepOpts -> PrepOpts)
-> FilePath
-> OptErr
-> OptErr
forall a b.
((a -> b) -> OptErr -> OptErr)
-> (FilePath -> a -> b) -> FilePath -> OptErr -> OptErr
withArg (PrepOpts -> PrepOpts) -> OptErr -> OptErr
onPrepOpts ((FilePath -> PrepOpts -> PrepOpts)
 -> FilePath -> OptErr -> OptErr)
-> (FilePath -> PrepOpts -> PrepOpts)
-> FilePath
-> OptErr
-> OptErr
forall a b. (a -> b) -> a -> b
$ \ arg :: FilePath
arg opts :: PrepOpts
opts -> PrepOpts
opts { ppCmd :: FilePath
ppCmd = FilePath
arg})
        "cmd")
      "execute preprocessor command <cmd>"
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option ""   ["optF"]
      ((FilePath -> OptErr -> OptErr)
-> FilePath -> ArgDescr (OptErr -> OptErr)
forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (((PrepOpts -> PrepOpts) -> OptErr -> OptErr)
-> (FilePath -> PrepOpts -> PrepOpts)
-> FilePath
-> OptErr
-> OptErr
forall a b.
((a -> b) -> OptErr -> OptErr)
-> (FilePath -> a -> b) -> FilePath -> OptErr -> OptErr
withArg (PrepOpts -> PrepOpts) -> OptErr -> OptErr
onPrepOpts ((FilePath -> PrepOpts -> PrepOpts)
 -> FilePath -> OptErr -> OptErr)
-> (FilePath -> PrepOpts -> PrepOpts)
-> FilePath
-> OptErr
-> OptErr
forall a b. (a -> b) -> a -> b
$ \ arg :: FilePath
arg opts :: PrepOpts
opts ->
        PrepOpts
opts { ppOpts :: [FilePath]
ppOpts = PrepOpts -> [FilePath]
ppOpts PrepOpts
opts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
arg]}) "option")
      "execute preprocessor with option <option>"
  -- extensions
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option "e"  ["extended"]
      ((OptErr -> OptErr) -> ArgDescr (OptErr -> OptErr)
forall a. a -> ArgDescr a
NoArg ((Options -> Options) -> OptErr -> OptErr
onOpts ((Options -> Options) -> OptErr -> OptErr)
-> (Options -> Options) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ opts :: Options
opts -> Options
opts { optExtensions :: [KnownExtension]
optExtensions =
        [KnownExtension] -> [KnownExtension]
forall a. Eq a => [a] -> [a]
nub ([KnownExtension] -> [KnownExtension])
-> [KnownExtension] -> [KnownExtension]
forall a b. (a -> b) -> a -> b
$ [KnownExtension]
kielExtensions [KnownExtension] -> [KnownExtension] -> [KnownExtension]
forall a. [a] -> [a] -> [a]
++ Options -> [KnownExtension]
optExtensions Options
opts }))
      "enable extended Curry functionalities"
  , ((Options -> Options) -> OptErr -> OptErr)
-> FilePath
-> [FilePath]
-> FilePath
-> FilePath
-> OptErrTable Options
-> OptDescr (OptErr -> OptErr)
forall opt.
((opt -> opt) -> OptErr -> OptErr)
-> FilePath
-> [FilePath]
-> FilePath
-> FilePath
-> OptErrTable opt
-> OptDescr (OptErr -> OptErr)
mkOptDescr (Options -> Options) -> OptErr -> OptErr
onOpts      "c" ["case-mode"] "mode" "case mode"           OptErrTable Options
caseModeDescriptions
  , ((Options -> Options) -> OptErr -> OptErr)
-> FilePath
-> [FilePath]
-> FilePath
-> FilePath
-> OptErrTable Options
-> OptDescr (OptErr -> OptErr)
forall opt.
((opt -> opt) -> OptErr -> OptErr)
-> FilePath
-> [FilePath]
-> FilePath
-> FilePath
-> OptErrTable opt
-> OptDescr (OptErr -> OptErr)
mkOptDescr (Options -> Options) -> OptErr -> OptErr
onOpts      "X" []            "ext"  "language extension"  OptErrTable Options
extDescriptions
  , ((WarnOpts -> WarnOpts) -> OptErr -> OptErr)
-> FilePath
-> [FilePath]
-> FilePath
-> FilePath
-> OptErrTable WarnOpts
-> OptDescr (OptErr -> OptErr)
forall opt.
((opt -> opt) -> OptErr -> OptErr)
-> FilePath
-> [FilePath]
-> FilePath
-> FilePath
-> OptErrTable opt
-> OptDescr (OptErr -> OptErr)
mkOptDescr (WarnOpts -> WarnOpts) -> OptErr -> OptErr
onWarnOpts  "W" []            "opt"  "warning option"      OptErrTable WarnOpts
warnDescriptions
  , ((DebugOpts -> DebugOpts) -> OptErr -> OptErr)
-> FilePath
-> [FilePath]
-> FilePath
-> FilePath
-> OptErrTable DebugOpts
-> OptDescr (OptErr -> OptErr)
forall opt.
((opt -> opt) -> OptErr -> OptErr)
-> FilePath
-> [FilePath]
-> FilePath
-> FilePath
-> OptErrTable opt
-> OptDescr (OptErr -> OptErr)
mkOptDescr (DebugOpts -> DebugOpts) -> OptErr -> OptErr
onDebugOpts "d" []            "opt"  "debug option"        OptErrTable DebugOpts
debugDescriptions
  , ((OptimizationOpts -> OptimizationOpts) -> OptErr -> OptErr)
-> FilePath
-> [FilePath]
-> FilePath
-> FilePath
-> OptErrTable OptimizationOpts
-> OptDescr (OptErr -> OptErr)
forall opt.
((opt -> opt) -> OptErr -> OptErr)
-> FilePath
-> [FilePath]
-> FilePath
-> FilePath
-> OptErrTable opt
-> OptDescr (OptErr -> OptErr)
mkOptDescr (OptimizationOpts -> OptimizationOpts) -> OptErr -> OptErr
onOptimOpts "O" []            "opt"  "optimization option" OptErrTable OptimizationOpts
optimizeDescriptions
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option ""   ["cpp"]
      ((OptErr -> OptErr) -> ArgDescr (OptErr -> OptErr)
forall a. a -> ArgDescr a
NoArg ((CppOpts -> CppOpts) -> OptErr -> OptErr
onCppOpts ((CppOpts -> CppOpts) -> OptErr -> OptErr)
-> (CppOpts -> CppOpts) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ opts :: CppOpts
opts -> CppOpts
opts { cppRun :: Bool
cppRun = Bool
True }))
      "run C preprocessor"
  , FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option "D"  []
      ((FilePath -> OptErr -> OptErr)
-> FilePath -> ArgDescr (OptErr -> OptErr)
forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (((OptErr -> OptErr) -> OptErr -> OptErr)
-> (FilePath -> OptErr -> OptErr) -> FilePath -> OptErr -> OptErr
forall a b.
((a -> b) -> OptErr -> OptErr)
-> (FilePath -> a -> b) -> FilePath -> OptErr -> OptErr
withArg (OptErr -> OptErr) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
($) FilePath -> OptErr -> OptErr
parseCppDefinition) "s=v")
      "define symbol `s` with value `v` for the C preprocessor"
  ]

parseCppDefinition :: String -> OptErr -> OptErr
parseCppDefinition :: FilePath -> OptErr -> OptErr
parseCppDefinition arg :: FilePath
arg optErr :: OptErr
optErr
  | Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
s) Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
v) Bool -> Bool -> Bool
&& (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit FilePath
v
  = (CppOpts -> CppOpts) -> OptErr -> OptErr
onCppOpts (FilePath -> FilePath -> CppOpts -> CppOpts
addCppDefinition FilePath
s FilePath
v) OptErr
optErr
  | Bool
otherwise
  = FilePath -> OptErr -> OptErr
addErr (ShowS
cppDefinitionErr FilePath
arg) OptErr
optErr
  where (s :: FilePath
s, v :: FilePath
v) = Int -> ShowS
forall a. Int -> [a] -> [a]
drop 1 ShowS -> (FilePath, FilePath) -> (FilePath, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ('=' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) FilePath
arg

addCppDefinition :: String -> String -> CppOpts -> CppOpts
addCppDefinition :: FilePath -> FilePath -> CppOpts -> CppOpts
addCppDefinition s :: FilePath
s v :: FilePath
v opts :: CppOpts
opts =
  CppOpts
opts { cppDefinitions :: Map FilePath Int
cppDefinitions = FilePath -> Int -> Map FilePath Int -> Map FilePath Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FilePath
s (FilePath -> Int
forall a. Read a => FilePath -> a
read FilePath
v) (CppOpts -> Map FilePath Int
cppDefinitions CppOpts
opts) }

cppDefinitionErr :: String -> String
cppDefinitionErr :: ShowS
cppDefinitionErr = FilePath -> ShowS
forall a. [a] -> [a] -> [a]
(++) "Invalid format for option '-D': "

targetOption :: TargetType -> String -> String -> OptDescr (OptErr -> OptErr)
targetOption :: TargetType -> FilePath -> FilePath -> OptDescr (OptErr -> OptErr)
targetOption ty :: TargetType
ty flag :: FilePath
flag
  = FilePath
-> [FilePath]
-> ArgDescr (OptErr -> OptErr)
-> FilePath
-> OptDescr (OptErr -> OptErr)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option "" [FilePath
flag] ((OptErr -> OptErr) -> ArgDescr (OptErr -> OptErr)
forall a. a -> ArgDescr a
NoArg ((Options -> Options) -> OptErr -> OptErr
onOpts ((Options -> Options) -> OptErr -> OptErr)
-> (Options -> Options) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
$ \ opts :: Options
opts -> Options
opts { optTargetTypes :: [TargetType]
optTargetTypes =
      [TargetType] -> [TargetType]
forall a. Eq a => [a] -> [a]
nub ([TargetType] -> [TargetType]) -> [TargetType] -> [TargetType]
forall a b. (a -> b) -> a -> b
$ TargetType
ty TargetType -> [TargetType] -> [TargetType]
forall a. a -> [a] -> [a]
: Options -> [TargetType]
optTargetTypes Options
opts }))

verbDescriptions :: OptErrTable Options
verbDescriptions :: OptErrTable Options
verbDescriptions = ((Verbosity, FilePath, FilePath)
 -> (FilePath, FilePath, Options -> Options))
-> [(Verbosity, FilePath, FilePath)] -> OptErrTable Options
forall a b. (a -> b) -> [a] -> [b]
map (Verbosity, FilePath, FilePath)
-> (FilePath, FilePath, Options -> Options)
forall a b. (Verbosity, a, b) -> (a, b, Options -> Options)
toDescr [(Verbosity, FilePath, FilePath)]
verbosities
  where
  toDescr :: (Verbosity, a, b) -> (a, b, Options -> Options)
toDescr (flag :: Verbosity
flag, name :: a
name, desc :: b
desc)
    = (a
name, b
desc, \ opts :: Options
opts -> Options
opts { optVerbosity :: Verbosity
optVerbosity = Verbosity
flag })

extDescriptions :: OptErrTable Options
extDescriptions :: OptErrTable Options
extDescriptions = ((KnownExtension, FilePath, FilePath)
 -> (FilePath, FilePath, Options -> Options))
-> [(KnownExtension, FilePath, FilePath)] -> OptErrTable Options
forall a b. (a -> b) -> [a] -> [b]
map (KnownExtension, FilePath, FilePath)
-> (FilePath, FilePath, Options -> Options)
forall a b. (KnownExtension, a, b) -> (a, b, Options -> Options)
toDescr [(KnownExtension, FilePath, FilePath)]
extensions
  where
  toDescr :: (KnownExtension, a, b) -> (a, b, Options -> Options)
toDescr (flag :: KnownExtension
flag, name :: a
name, desc :: b
desc)
    = (a
name, b
desc,
        \opts :: Options
opts -> let cppOpts :: CppOpts
cppOpts = Options -> CppOpts
optCppOpts Options
opts
                 in Options
opts { optCppOpts :: CppOpts
optCppOpts    =
                             CppOpts
cppOpts { cppRun :: Bool
cppRun = CppOpts -> Bool
cppRun CppOpts
cppOpts Bool -> Bool -> Bool
|| KnownExtension
flag KnownExtension -> KnownExtension -> Bool
forall a. Eq a => a -> a -> Bool
== KnownExtension
CPP }
                         , optExtensions :: [KnownExtension]
optExtensions = KnownExtension -> [KnownExtension] -> [KnownExtension]
forall a. Eq a => a -> [a] -> [a]
addFlag KnownExtension
flag (Options -> [KnownExtension]
optExtensions Options
opts)
                         })


caseModeDescriptions :: OptErrTable Options
caseModeDescriptions :: OptErrTable Options
caseModeDescriptions
  = [ ( "free"   , "use free case mode"
        , \ opts :: Options
opts -> Options
opts { optCaseMode :: CaseMode
optCaseMode = CaseMode
CaseModeFree    } )
    , ( "haskell", "use haskell style case mode"
        , \ opts :: Options
opts -> Options
opts { optCaseMode :: CaseMode
optCaseMode = CaseMode
CaseModeHaskell } )
    , ( "prolog" , "use prolog style case mode"
        , \ opts :: Options
opts -> Options
opts { optCaseMode :: CaseMode
optCaseMode = CaseMode
CaseModeProlog  } )
    , ( "goedel"  , "use goedel case mode"
        , \ opts :: Options
opts -> Options
opts { optCaseMode :: CaseMode
optCaseMode = CaseMode
CaseModeGoedel  } )
    ]

warnDescriptions :: OptErrTable WarnOpts
warnDescriptions :: OptErrTable WarnOpts
warnDescriptions
  = [ ( "all"  , "turn on all warnings"
        , \ opts :: WarnOpts
opts -> WarnOpts
opts { wnWarnFlags :: [WarnFlag]
wnWarnFlags = [WarnFlag
forall a. Bounded a => a
minBound .. WarnFlag
forall a. Bounded a => a
maxBound] } )
    , ("none" , "turn off all warnings"
        , \ opts :: WarnOpts
opts -> WarnOpts
opts { wnWarnFlags :: [WarnFlag]
wnWarnFlags = []                     } )
    , ("error", "treat warnings as errors"
        , \ opts :: WarnOpts
opts -> WarnOpts
opts { wnWarnAsError :: Bool
wnWarnAsError = Bool
True                 } )
    ] OptErrTable WarnOpts
-> OptErrTable WarnOpts -> OptErrTable WarnOpts
forall a. [a] -> [a] -> [a]
++ ((WarnFlag, FilePath, FilePath)
 -> (FilePath, FilePath, WarnOpts -> WarnOpts))
-> [(WarnFlag, FilePath, FilePath)] -> OptErrTable WarnOpts
forall a b. (a -> b) -> [a] -> [b]
map (WarnFlag, FilePath, FilePath)
-> (FilePath, FilePath, WarnOpts -> WarnOpts)
forall a.
(WarnFlag, a, FilePath) -> (a, FilePath, WarnOpts -> WarnOpts)
turnOn [(WarnFlag, FilePath, FilePath)]
warnFlags OptErrTable WarnOpts
-> OptErrTable WarnOpts -> OptErrTable WarnOpts
forall a. [a] -> [a] -> [a]
++ ((WarnFlag, FilePath, FilePath)
 -> (FilePath, FilePath, WarnOpts -> WarnOpts))
-> [(WarnFlag, FilePath, FilePath)] -> OptErrTable WarnOpts
forall a b. (a -> b) -> [a] -> [b]
map (WarnFlag, FilePath, FilePath)
-> (FilePath, FilePath, WarnOpts -> WarnOpts)
turnOff [(WarnFlag, FilePath, FilePath)]
warnFlags
  where
  turnOn :: (WarnFlag, a, FilePath) -> (a, FilePath, WarnOpts -> WarnOpts)
turnOn (flag :: WarnFlag
flag, name :: a
name, desc :: FilePath
desc)
    = (a
name, "warn for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
desc
      , \ opts :: WarnOpts
opts -> WarnOpts
opts { wnWarnFlags :: [WarnFlag]
wnWarnFlags = WarnFlag -> [WarnFlag] -> [WarnFlag]
forall a. Eq a => a -> [a] -> [a]
addFlag WarnFlag
flag (WarnOpts -> [WarnFlag]
wnWarnFlags WarnOpts
opts)})
  turnOff :: (WarnFlag, FilePath, FilePath)
-> (FilePath, FilePath, WarnOpts -> WarnOpts)
turnOff (flag :: WarnFlag
flag, name :: FilePath
name, desc :: FilePath
desc)
    = ("no-" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
name, "do not warn for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
desc
      , \ opts :: WarnOpts
opts -> WarnOpts
opts { wnWarnFlags :: [WarnFlag]
wnWarnFlags = WarnFlag -> [WarnFlag] -> [WarnFlag]
forall a. Eq a => a -> [a] -> [a]
removeFlag WarnFlag
flag (WarnOpts -> [WarnFlag]
wnWarnFlags WarnOpts
opts)})

debugDescriptions :: OptErrTable DebugOpts
debugDescriptions :: OptErrTable DebugOpts
debugDescriptions =
  [ ( "dump-all"          , "dump everything"
    , \ opts :: DebugOpts
opts -> DebugOpts
opts { dbDumpLevels :: [DumpLevel]
dbDumpLevels = [DumpLevel
forall a. Bounded a => a
minBound .. DumpLevel
forall a. Bounded a => a
maxBound]    })
  , ( "dump-none"         , "dump nothing"
    , \ opts :: DebugOpts
opts -> DebugOpts
opts { dbDumpLevels :: [DumpLevel]
dbDumpLevels = []                        })
  , ( "dump-env"          , "additionally dump compiler environment"
    , \ opts :: DebugOpts
opts -> DebugOpts
opts { dbDumpEnv :: Bool
dbDumpEnv = Bool
True                         })
  , ( "dump-raw"          , "dump as raw AST (instead of pretty printing)"
    , \ opts :: DebugOpts
opts -> DebugOpts
opts { dbDumpRaw :: Bool
dbDumpRaw = Bool
True                         })
  , ( "dump-all-bindings" , "when dumping bindings, dump all instead of just local ones"
    , \ opts :: DebugOpts
opts -> DebugOpts
opts { dbDumpAllBindings :: Bool
dbDumpAllBindings = Bool
True                 })
  , ( "dump-simple" , "print a simplified, more readable environment"
    , \ opts :: DebugOpts
opts -> DebugOpts
opts { dbDumpSimple :: Bool
dbDumpSimple = Bool
True                      })

  ] OptErrTable DebugOpts
-> OptErrTable DebugOpts -> OptErrTable DebugOpts
forall a. [a] -> [a] -> [a]
++ ((DumpLevel, FilePath, FilePath)
 -> (FilePath, FilePath, DebugOpts -> DebugOpts))
-> [(DumpLevel, FilePath, FilePath)] -> OptErrTable DebugOpts
forall a b. (a -> b) -> [a] -> [b]
map (DumpLevel, FilePath, FilePath)
-> (FilePath, FilePath, DebugOpts -> DebugOpts)
forall a.
(DumpLevel, a, FilePath) -> (a, FilePath, DebugOpts -> DebugOpts)
toDescr [(DumpLevel, FilePath, FilePath)]
dumpLevel
  where
  toDescr :: (DumpLevel, a, FilePath) -> (a, FilePath, DebugOpts -> DebugOpts)
toDescr (flag :: DumpLevel
flag, name :: a
name, desc :: FilePath
desc)
    = (a
name , "dump code after " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
desc
        , \ opts :: DebugOpts
opts -> DebugOpts
opts { dbDumpLevels :: [DumpLevel]
dbDumpLevels = DumpLevel -> [DumpLevel] -> [DumpLevel]
forall a. Eq a => a -> [a] -> [a]
addFlag DumpLevel
flag (DebugOpts -> [DumpLevel]
dbDumpLevels DebugOpts
opts)})

optimizeDescriptions :: OptErrTable OptimizationOpts
optimizeDescriptions :: OptErrTable OptimizationOpts
optimizeDescriptions =
  [ ( "desugar-newtypes"        , "desugars newtypes in FlatCurry"
    , \ opts :: OptimizationOpts
opts -> OptimizationOpts
opts { optDesugarNewtypes :: Bool
optDesugarNewtypes     = Bool
True    })
  , ( "inline-dictionaries"     , "inlines type class dictionaries"
    , \ opts :: OptimizationOpts
opts -> OptimizationOpts
opts { optInlineDictionaries :: Bool
optInlineDictionaries  = Bool
True    })
  , ( "remove-unused-imports"   , "removes unused imports"
    , \ opts :: OptimizationOpts
opts -> OptimizationOpts
opts { optRemoveUnusedImports :: Bool
optRemoveUnusedImports = Bool
True    })
  , ( "no-desugar-newtypes"     , "prevents desugaring of newtypes in FlatCurry"
    , \ opts :: OptimizationOpts
opts -> OptimizationOpts
opts { optDesugarNewtypes :: Bool
optDesugarNewtypes     = Bool
False   })
  , ( "no-inline-dictionaries"  , "prevents inlining of type class dictionaries"
    , \ opts :: OptimizationOpts
opts -> OptimizationOpts
opts { optInlineDictionaries :: Bool
optInlineDictionaries  = Bool
False   })
  , ( "no-remove-unused-imports", "prevents removing of unused imports"
    , \ opts :: OptimizationOpts
opts -> OptimizationOpts
opts { optRemoveUnusedImports :: Bool
optRemoveUnusedImports = Bool
False   })
  ]

addFlag :: Eq a => a -> [a] -> [a]
addFlag :: a -> [a] -> [a]
addFlag o :: a
o opts :: [a]
opts = [a] -> [a]
forall a. Eq a => [a] -> [a]
nub ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a
o a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
opts

removeFlag :: Eq a => a -> [a] -> [a]
removeFlag :: a -> [a] -> [a]
removeFlag o :: a
o = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
o)

-- |Update the 'Options' record by the parsed and processed arguments
updateOpts :: Options -> [String] -> (Options, [String], [String])
updateOpts :: Options -> [FilePath] -> (Options, [FilePath], [FilePath])
updateOpts opts :: Options
opts args :: [FilePath]
args = (Options
opts', [FilePath]
files, [FilePath]
errs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
errs2 [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ Options -> [FilePath] -> [FilePath]
checkOpts Options
opts [FilePath]
files)
  where
  (opts' :: Options
opts', errs2 :: [FilePath]
errs2) = (OptErr -> (OptErr -> OptErr) -> OptErr)
-> OptErr -> [OptErr -> OptErr] -> OptErr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((OptErr -> OptErr) -> OptErr -> OptErr)
-> OptErr -> (OptErr -> OptErr) -> OptErr
forall a b c. (a -> b -> c) -> b -> a -> c
flip (OptErr -> OptErr) -> OptErr -> OptErr
forall a b. (a -> b) -> a -> b
($)) (Options
opts, []) [OptErr -> OptErr]
optErrs
  (optErrs :: [OptErr -> OptErr]
optErrs, files :: [FilePath]
files, errs :: [FilePath]
errs) = ArgOrder (OptErr -> OptErr)
-> [OptDescr (OptErr -> OptErr)]
-> [FilePath]
-> ([OptErr -> OptErr], [FilePath], [FilePath])
forall a.
ArgOrder a
-> [OptDescr a] -> [FilePath] -> ([a], [FilePath], [FilePath])
getOpt ArgOrder (OptErr -> OptErr)
forall a. ArgOrder a
Permute [OptDescr (OptErr -> OptErr)]
options [FilePath]
args

-- |Parse the command line arguments
parseOpts :: [String] -> (Options, [String], [String])
parseOpts :: [FilePath] -> (Options, [FilePath], [FilePath])
parseOpts = Options -> [FilePath] -> (Options, [FilePath], [FilePath])
updateOpts Options
defaultOptions

-- |Check options and files and return a list of error messages
checkOpts :: Options -> [String] -> [String]
checkOpts :: Options -> [FilePath] -> [FilePath]
checkOpts opts :: Options
opts _
  = [ "The option '--htmldir' is only valid for HTML generation mode"
    | Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (Options -> Maybe FilePath
optHtmlDir Options
opts) Bool -> Bool -> Bool
&& TargetType
Html TargetType -> [TargetType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Options -> [TargetType]
optTargetTypes Options
opts ]

-- |Print the usage information of the command line tool.
usage :: String -> String
usage :: ShowS
usage prog :: FilePath
prog = FilePath -> [OptDescr (OptErr -> OptErr)] -> FilePath
forall a. FilePath -> [OptDescr a] -> FilePath
usageInfo FilePath
header [OptDescr (OptErr -> OptErr)]
options
  where header :: FilePath
header = "usage: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
prog FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ " [OPTION] ... MODULES ..."

-- |Retrieve the compiler 'Options'
getCompilerOpts :: IO (String, Options, [String], [String])
getCompilerOpts :: IO (FilePath, Options, [FilePath], [FilePath])
getCompilerOpts = do
  [FilePath]
args <- IO [FilePath]
getArgs
  FilePath
prog <- IO FilePath
getProgName
  let (opts :: Options
opts, files :: [FilePath]
files, errs :: [FilePath]
errs) = [FilePath] -> (Options, [FilePath], [FilePath])
parseOpts [FilePath]
args
  (FilePath, Options, [FilePath], [FilePath])
-> IO (FilePath, Options, [FilePath], [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
prog, Options
opts, [FilePath]
files, [FilePath]
errs)