{-# LANGUAGE Rank2Types #-}moduleOptions.Applicative.Common(-- * Option parsers---- | A 'Parser' is composed of a list of options. Several kinds of options-- are supported:---- * Flags: simple no-argument options. When a flag is encountered on the-- command line, its value is returned.---- * Options: options with an argument. An option can define a /reader/,-- which converts its argument from String to the desired value, or throws a-- parse error if the argument does not validate correctly.---- * Arguments: positional arguments, validated in the same way as option-- arguments.---- * Commands. A command defines a completely independent sub-parser. When a-- command is encountered, the whole command line is passed to the-- corresponding parser.--Parser,liftOpt,showOption,-- * Program descriptions---- A 'ParserInfo' describes a command line program, used to generate a help-- screen. Two help modes are supported: brief and full. In brief mode, only-- an option and argument summary is displayed, while in full mode each-- available option and command, including hidden ones, is described.---- A basic 'ParserInfo' with default values for fields can be created using-- the 'info' function.ParserInfo(..),-- * Running parsersrunParser,runParserFully,evalParser,-- * Low-level utilitiesmapParser,treeMapParser,optionNames)whereimportControl.Applicative(pure,(<*>),(<$>),(<|>))importControl.Monad(guard,mzero,msum,when)importControl.Monad.Trans.Class(lift)importControl.Monad.Trans.State(StateT(..),get,put,runStateT)importData.List(isPrefixOf)importData.Maybe(maybeToList,isJust)importData.Monoid(Monoid(..))importOptions.Applicative.InternalimportOptions.Applicative.TypesshowOption::OptName->StringshowOption(OptLongn)="--"++nshowOption(OptShortn)='-':[n]optionNames::OptReadera->[OptName]optionNames(OptReadernames__)=namesoptionNames(FlagReadernames_)=namesoptionNames_=[]isOptionPrefix::OptName->OptName->BoolisOptionPrefix(OptShortx)(OptShorty)=x==yisOptionPrefix(OptLongx)(OptLongy)=x`isPrefixOf`yisOptionPrefix__=False-- | Create a parser composed of a single option.liftOpt::Optiona->ParseraliftOpt=OptPdataMatchResult=NoMatch|Match(MaybeString)instanceMonoidMatchResultwheremempty=NoMatchmappendm@(Match_)_=mmappend_m=mtypeArgs=[String]optMatches::MonadPm=>Bool->OptReadera->String->Maybe(StateTArgsma)optMatchesdisambiguateoptarg=caseoptofOptReadernamesrdrno_arg_err->do(arg1,val)<-parsedguard$has_namearg1namesJust$doargs<-getletmb_args=uncons$maybeToListval++argsletmissing_arg=lift$missingArgPno_arg_err(crCompleterrdr)(arg',args')<-maybemissing_argreturnmb_argsputargs'caserunReadM(crReaderrdrarg')ofLefte->lift$errorForarg1eRightr->returnrFlagReadernamesx->do(arg1,Nothing)<-parsedguard$has_namearg1namesJust$returnxArgReaderrdr->doresult<-crReaderrdrargJust$returnresultCmdReader_f->flipfmap(farg)$\subp->StateT$\args->dosetContext(Justarg)subpprefs<-getPrefsletrunSubparser|prefBacktrackprefs=runParser|otherwise=\pa->(,)<$>runParserFullypa<*>pure[]runSubparser(infoParsersubp)argswhereerrorForname(ErrorMsgmsg)=errorP(ErrorMsg("option "++showOptionname++": "++msg))errorFor_e=errorPeparsed=caseargof'-':'-':arg1->Just$casespan(/='=')arg1of(_,"")->(OptLongarg1,Nothing)(arg1',_:rest)->(OptLongarg1',Justrest)'-':arg1->casearg1of[]->Nothing(a:rest)->Just(OptShorta,ifnullrestthenNothingelseJustrest)_->Nothinghas_namea|disambiguate=any(isOptionPrefixa)|otherwise=elemaisArg::OptReadera->BoolisArg(ArgReader_)=TrueisArg_=FalsestepParser::MonadPm=>ParserPrefs->String->Parsera->NondetT(StateTArgsm)(Parsera)stepParser__(NilP_)=mzerostepParserprefsarg(OptPopt)=dowhen(isArg(optMainopt))cutcaseoptMatchesdisambiguate(optMainopt)argofJustmatcher->pure<$>liftmatcherNothing->mzerowheredisambiguate=prefDisambiguateprefs&&optVisibilityopt>InternalstepParserprefsarg(MultPp1p2)=foldr1(<!>)[dop1'<-stepParserprefsargp1return(p1'<*>p2),dop2'<-stepParserprefsargp2return(p1<*>p2')]stepParserprefsarg(AltPp1p2)=msum[stepParserprefsargp1,stepParserprefsargp2]stepParserprefsarg(BindPpk)=dop'<-stepParserprefsargpx<-hoistMaybe$evalParserp'return(kx)-- | Apply a 'Parser' to a command line, and return a result and leftover-- arguments. This function returns an error if any parsing error occurs, or-- if any options are missing and don't have a default value.runParser::MonadPm=>Parsera->Args->m(a,Args)runParserpargs=caseargsof[]->exitPpresult(arg:argt)->doprefs<-getPrefsx<-do_stepprefsargargtcasexofLefte->case(result,e)of(Justr,ErrorMsg_)->returnr_->errorPeRight(p',args')->runParserp'args'whereresult=(,)<$>evalParserp<*>pureargsdo_stepprefsargargt=tryP.(`runStateT`argt).(>>=maybe((lift.parseError)arg)return).disamb(not(prefDisambiguateprefs))$stepParserprefsargpparseError::MonadPm=>String->maparseErrorarg=errorP.ErrorMsg$msgwheremsg=caseargof('-':_)->"Invalid option `"++arg++"'"_->"Invalid argument `"++arg++"'"runParserFully::MonadPm=>Parsera->Args->marunParserFullypargs=do(r,args')<-runParserpargsguard$nullargs'returnr-- | The default value of a 'Parser'. This function returns an error if any of-- the options don't have a default value.evalParser::Parsera->MaybeaevalParser(NilPr)=revalParser(OptP_)=NothingevalParser(MultPp1p2)=evalParserp1<*>evalParserp2evalParser(AltPp1p2)=evalParserp1<|>evalParserp2evalParser(BindPpk)=evalParserp>>=evalParser.k-- | Map a polymorphic function over all the options of a parser, and collect-- the results in a list.mapParser::(forallx.OptHelpInfo->Optionx->b)->Parsera->[b]mapParserf=flatten.treeMapParserfwhereflatten(Leafx)=[x]flatten(MultNodexs)=xs>>=flattenflatten(AltNodexs)=xs>>=flatten-- | Like 'mapParser', but collect the results in a tree structure.treeMapParser::(forallx.OptHelpInfo->Optionx->b)->Parsera->OptTreebtreeMapParserg=simplify.goFalseFalsegwherehas_default::Parsera->Boolhas_defaultp=isJust(evalParserp)go::Bool->Bool->(forallx.OptHelpInfo->Optionx->b)->Parsera->OptTreebgo___(NilP_)=MultNode[]gomdf(OptPopt)|optVisibilityopt>Internal=Leaf(f(OptHelpInfomd)opt)|otherwise=MultNode[]gomdf(MultPp1p2)=MultNode[gomdfp1,gomdfp2]gomdf(AltPp1p2)=AltNode[gomd'fp1,gomd'fp2]whered'=d||has_defaultp1||has_defaultp2go_df(BindPp_)=goTruedfpsimplify::OptTreea->OptTreeasimplify(Leafx)=Leafxsimplify(MultNodexs)=caseconcatMap(remove_mult.simplify)xsof[x]->xxs'->MultNodexs'whereremove_mult(MultNodets)=tsremove_multt=[t]simplify(AltNodexs)=caseconcatMap(remove_alt.simplify)xsof[]->MultNode[][x]->xxs'->AltNodexs'whereremove_alt(AltNodets)=tsremove_alt(MultNode[])=[]remove_altt=[t]