{-# LANGUAGE CPP #-}----------------------------------------------------------------------------------- | Command-line parser---- This is an abstract command-line parser used by DynFlags.---- (c) The University of Glasgow 2005---------------------------------------------------------------------------------moduleCmdLineParser(processArgs ,OptKind (..),GhcFlagMode (..),CmdLineP (..),getCmdLineState ,putCmdLineState ,Flag (..),defFlag ,defGhcFlag ,defGhciFlag ,defHiddenFlag ,errorsToGhcException ,Err (..),Warn (..),WarnReason (..),EwM ,runEwM ,addErr ,addWarn ,addFlagWarn ,getArg ,getCurLoc ,liftEwM ,deprecate )where#include "HsVersions.h"
importGhcPrelude importUtil importOutputable importPanic importBag importSrcLoc importJson importData.FunctionimportData.ListimportControl.Monad(liftM,ap)---------------------------------------------------------- The Flag and OptKind types--------------------------------------------------------dataFlag m =Flag {flagName ::String,-- Flag, without the leading "-"flagOptKind ::OptKind m ,-- What to do if we see itflagGhcMode ::GhcFlagMode -- Which modes this flag affects}defFlag::String->OptKind m ->Flag m defFlag name optKind =Flag name optKind AllModes defGhcFlag::String->OptKind m ->Flag m defGhcFlag name optKind =Flag name optKind OnlyGhc defGhciFlag::String->OptKind m ->Flag m defGhciFlag name optKind =Flag name optKind OnlyGhci defHiddenFlag::String->OptKind m ->Flag m defHiddenFlag name optKind =Flag name optKind HiddenFlag -- | GHC flag modes describing when a flag has an effect.dataGhcFlagMode =OnlyGhc -- ^ The flag only affects the non-interactive GHC|OnlyGhci -- ^ The flag only affects the interactive GHC|AllModes -- ^ The flag affects multiple ghc modes|HiddenFlag -- ^ This flag should not be seen in cli completiondataOptKind m -- Suppose the flag is -f=NoArg (EwM m ())-- -f all by itself|HasArg (String->EwM m ())-- -farg or -f arg|SepArg (String->EwM m ())-- -f arg|Prefix (String->EwM m ())-- -farg|OptPrefix (String->EwM m ())-- -f or -farg (i.e. the arg is optional)|OptIntSuffix (MaybeInt->EwM m ())-- -f or -f=n; pass n to fn|IntSuffix (Int->EwM m ())-- -f or -f=n; pass n to fn|FloatSuffix (Float->EwM m ())-- -f or -f=n; pass n to fn|PassFlag (String->EwM m ())-- -f; pass "-f" fn|AnySuffix (String->EwM m ())-- -f or -farg; pass entire "-farg" to fn---------------------------------------------------------- The EwM monad---------------------------------------------------------- | Used when filtering warnings: if a reason is given-- it can be filtered out when displaying.dataWarnReason =NoReason |ReasonDeprecatedFlag |ReasonUnrecognisedFlag deriving(Eq,Show)instanceOutputable WarnReason whereppr =text .showinstanceToJson WarnReason wherejson NoReason =JSNull jsonreason =JSString $showreason -- | A command-line error messagenewtypeErr =Err {errMsg ::Located String}-- | A command-line warning message and the reason it arosedataWarn =Warn {warnReason ::WarnReason ,warnMsg ::Located String}typeErrs =Bag Err typeWarns =Bag Warn -- EwM ("errors and warnings monad") is a monad-- transformer for m that adds an (err, warn) statenewtypeEwM m a =EwM {unEwM ::Located String-- Current parse arg->Errs ->Warns ->m (Errs ,Warns ,a )}instanceMonadm =>Functor(EwM m )wherefmap =liftMinstanceMonadm =>Applicative(EwM m )wherepure v =EwM (\_e w ->return(e ,w ,v ))(<*> )=apinstanceMonadm =>Monad(EwM m )where(EwM f )>>= k =EwM (\l e w ->do(e' ,w' ,r )<-f l e w unEwM(k r )l e' w' )runEwM::EwM m a ->m (Errs ,Warns ,a )runEwM action =unEwMaction (panic "processArgs: no arg yet")emptyBag emptyBag setArg::Located String->EwM m ()->EwM m ()setArg l (EwM f )=EwM (\_es ws ->f l es ws )addErr::Monadm =>String->EwM m ()addErr e =EwM (\(L loc _)es ws ->return(es `snocBag `Err (L loc e ),ws ,()))addWarn::Monadm =>String->EwM m ()addWarn =addFlagWarn NoReason addFlagWarn::Monadm =>WarnReason ->String->EwM m ()addFlagWarn reason msg =EwM $(\(L loc _)es ws ->return(es ,ws `snocBag `Warn reason (L loc msg ),()))deprecate::Monadm =>String->EwM m ()deprecate s =doarg <-getArg addFlagWarn ReasonDeprecatedFlag (arg ++" is deprecated: "++s )getArg::Monadm =>EwM m StringgetArg =EwM (\(L _arg )es ws ->return(es ,ws ,arg ))getCurLoc::Monadm =>EwM m SrcSpan getCurLoc =EwM (\(L loc _)es ws ->return(es ,ws ,loc ))liftEwM::Monadm =>m a ->EwM m a liftEwM action =EwM (\_es ws ->do{r <-action ;return(es ,ws ,r )})---------------------------------------------------------- A state monad for use in the command-line parser---------------------------------------------------------- (CmdLineP s) typically instantiates the 'm' in (EwM m) and (OptKind m)newtypeCmdLineP s a =CmdLineP {runCmdLine ::s ->(a ,s )}instanceFunctor(CmdLineP s )wherefmap =liftMinstanceApplicative(CmdLineP s )wherepure a =CmdLineP $\s ->(a ,s )(<*> )=apinstanceMonad(CmdLineP s )wherem >>= k =CmdLineP $\s ->let(a ,s' )=runCmdLinem s inrunCmdLine(k a )s' getCmdLineState::CmdLineP s s getCmdLineState =CmdLineP $\s ->(s ,s )putCmdLineState::s ->CmdLineP s ()putCmdLineState s =CmdLineP $\_->((),s )---------------------------------------------------------- Processing arguments--------------------------------------------------------processArgs::Monadm =>[Flag m ]-- cmdline parser spec->[Located String]-- args->m ([Located String],-- spare args[Err ],-- errors[Warn ])-- warningsprocessArgs spec args =do(errs ,warns ,spare )<-runEwM action return(spare ,bagToList errs ,bagToList warns )whereaction =process args []-- process :: [Located String] -> [Located String] -> EwM m [Located String]process []spare =return(reversespare )process(locArg @(L _('-':arg )):args )spare =casefindArg spec arg ofJust(rest ,opt_kind )->caseprocessOneArg opt_kind rest arg args ofLefterr ->letb =process args spare in(setArg locArg $addErr err )>>b Right(action ,rest )->letb =process rest spare in(setArg locArg $action )>>b Nothing->process args (locArg :spare )process(arg :args )spare =process args (arg :spare )processOneArg::OptKind m ->String->String->[Located String]->EitherString(EwM m (),[Located String])processOneArg opt_kind rest arg args =letdash_arg ='-':arg rest_no_eq =dropEq rest incaseopt_kind ofNoArg a ->ASSERT(null rest)Right(a,args)HasArg f |notNull rest_no_eq ->Right(f rest_no_eq ,args )|otherwise->caseargs of[]->missingArgErr dash_arg (L _arg1 :args1 )->Right(f arg1 ,args1 )-- See Trac #9776SepArg f ->caseargs of[]->missingArgErr dash_arg (L _arg1 :args1 )->Right(f arg1 ,args1 )-- See Trac #12625Prefix f |notNull rest_no_eq ->Right(f rest_no_eq ,args )|otherwise->missingArgErr dash_arg PassFlag f |notNull rest ->unknownFlagErr dash_arg |otherwise->Right(f dash_arg ,args )OptIntSuffix f |nullrest ->Right(f Nothing,args )|Justn <-parseInt rest_no_eq ->Right(f (Justn ),args )|otherwise->Left("malformed integer argument in "++dash_arg )IntSuffix f |Justn <-parseInt rest_no_eq ->Right(f n ,args )|otherwise->Left("malformed integer argument in "++dash_arg )FloatSuffix f |Justn <-parseFloat rest_no_eq ->Right(f n ,args )|otherwise->Left("malformed float argument in "++dash_arg )OptPrefix f ->Right(f rest_no_eq ,args )AnySuffix f ->Right(f dash_arg ,args )findArg::[Flag m ]->String->Maybe(String,OptKind m )findArg spec arg =casesortBy(compare`on`(length.fst))-- prefer longest matching flag[(removeSpaces rest ,optKind )|flag <-spec ,letoptKind =flagOptKindflag ,Justrest <-[stripPrefix(flagNameflag )arg ],arg_ok optKind rest arg ]of[]->Nothing(one :_)->Justone arg_ok::OptKind t ->[Char]->String->Boolarg_ok (NoArg _)rest _=nullrest arg_ok(HasArg _)__=Truearg_ok(SepArg _)rest _=nullrest arg_ok(Prefix _)__=True-- Missing argument checked for in processOneArg t-- to improve error message (Trac #12625)arg_ok(OptIntSuffix _)__=Truearg_ok(IntSuffix _)__=Truearg_ok(FloatSuffix _)__=Truearg_ok(OptPrefix _)__=Truearg_ok(PassFlag _)rest _=nullrest arg_ok(AnySuffix _)__=True-- | Parse an Int---- Looks for "433" or "=342", with no trailing gubbins-- * n or =n => Just n-- * gibberish => NothingparseInt::String->MaybeIntparseInt s =casereadss of((n ,""):_)->Justn _->NothingparseFloat::String->MaybeFloatparseFloat s =casereadss of((n ,""):_)->Justn _->Nothing-- | Discards a leading equals signdropEq::String->StringdropEq ('=':s )=s dropEqs =s unknownFlagErr::String->EitherStringa unknownFlagErr f =Left("unrecognised flag: "++f )missingArgErr::String->EitherStringa missingArgErr f =Left("missing argument for flag: "++f )---------------------------------------------------------- Utils---------------------------------------------------------- See Note [Handling errors when parsing flags]errorsToGhcException::[(String,-- LocationString)]-- Error->GhcException errorsToGhcException errs =UsageError $intercalate"\n"$[l ++": "++e |(l ,e )<-errs ]{- Note [Handling errors when parsing commandline flags]
Parsing of static and mode flags happens before any session is started, i.e.,
before the first call to 'GHC.withGhc'. Therefore, to report errors for
invalid usage of these two types of flags, we can not call any function that
needs DynFlags, as there are no DynFlags available yet (unsafeGlobalDynFlags
is not set either). So we always print "on the commandline" as the location,
which is true except for Api users, which is probably ok.
When reporting errors for invalid usage of dynamic flags we /can/ make use of
DynFlags, and we do so explicitly in DynFlags.parseDynamicFlagsFull.
Before, we called unsafeGlobalDynFlags when an invalid (combination of)
flag(s) was given on the commandline, resulting in panics (#9963).
-}