moduleSystem.Console.CmdArgs.Explicit.Process(process,processValue,processArgs)whereimportSystem.Console.CmdArgs.Explicit.TypeimportControl.ArrowimportData.ListimportData.MaybeimportSystem.EnvironmentimportSystem.Exit-- | Process the flags obtained by @getArgs@ with a mode. Displays-- an error and exits with failure if the command line fails to parse, or returns-- the associated value. Implemented in terms of 'process'.processArgs::Modea->IOaprocessArgsm=doxs<-getArgscaseprocessmxsofLeftx->doputStrLnx;exitFailureRightx->returnx-- | Process a list of flags (usually obtained from @getArgs@) with a mode. Displays-- an error and exits with failure if the command line fails to parse, or returns-- the associated value. Implemeneted in terms of 'process'.processValue::Modea->[String]->aprocessValuemxs=caseprocessmxsofLeftx->errorxRightx->x-- | Process a list of flags (usually obtained from @getArgs@) with a mode. Returns-- @Left@ and an error message if the command line fails to parse, or @Right@ and-- the associated value.process::Modea->[String]->EitherStringaprocess=processModeprocessMode::Modea->[String]->EitherStringaprocessModemargs=casefindofAmbiguousxs->Left$ambiguous"mode"axsFoundx->processModexasNotFound|isNothing(modeArgsm)&&args/=[]&&not(null$modeModesm)&&not("-"`isPrefixOf`concatargs)->Left$missing"mode"$concatMapmodeNames$modeModesm|otherwise->eitherLeft(modeCheckm)$processFlagsm(modeValuem)argswhere(find,a,as)=caseargsof[]->(NotFound,"",[])x:xs->(lookupName(map(modeNames&&&id)$modeModesm)x,x,xs)dataSa=S{val::a,args::[String],errs::[String]}stop::Sa->Maybe(EitherStringa)stops|not$null$errss=Just$Left$last$errss|null$argss=Just$Right$vals|otherwise=Nothingerr::Sa->String->Saerrsx=s{errs=x:errss}upd::Sa->(a->EitherStringa)->Saupdsf=casef$valsofLeftx->errsxRightx->s{val=x}processFlags::Modea->a->[String]->EitherStringaprocessFlagsmodeval_args_=f$Sval_args_[]wherefs=fromMaybe(f$processFlagmodes)$stopspickFlagslongmode=[(filter(\x->(lengthx>1)==long)$flagNamesflag,(flagInfoflag,flag))|flag<-modeFlagsmode]processFlag::Modea->Sa->SaprocessFlagmodes_@S{args=('-':'-':xs):ys}|xs/=""=caselookupName(pickFlagsTruemode)aofAmbiguousposs->errs$ambiguous"flag"("--"++a)possNotFound->errs$"Unknown flag: --"++aFound(arg,flag)->caseargofFlagNone|nullb->upds$flagValueflag""|otherwise->errs$"Unhandled argument to flag, none expected: --"++xsFlagReq|nullb&&nullys->errs$"Flag requires argument: --"++xs|nullb->upds{args=tailys}$flagValueflag$headys|otherwise->upds$flagValueflag$tailb_|nullb->upds$flagValueflag$fromFlagOptarg|otherwise->upds$flagValueflag$tailbwheres=s_{args=ys}(a,b)=break(=='=')xsprocessFlagmodes_@S{args=('-':x:xs):ys}|x/='-'=caselookupName(pickFlagsFalsemode)[x]ofAmbiguousposs->errs$ambiguous"flag"['-',x]possNotFound->errs$"Unknown flag: -"++[x]Found(arg,flag)->caseargofFlagNone|"="`isPrefixOf`xs->errs$"Unhandled argument to flag, none expected: -"++[x]|otherwise->upds_{args=['-':xs|xs/=""]++ys}$flagValueflag""FlagReq|nullxs&&nullys->errs$"Flag requires argument: -"++[x]|nullxs->upds_{args=tailys}$flagValueflag$headys|otherwise->upds_{args=ys}$flagValueflag$if"="`isPrefixOf`xsthentailxselsexsFlagOptx|nullxs->upds_{args=ys}$flagValueflagx|otherwise->upds_{args=ys}$flagValueflag$if"="`isPrefixOf`xsthentailxselsexsFlagOptRarex|"="`isPrefixOf`xs->upds_{args=ys}$flagValueflag$tailxs|otherwise->upds_{args=['-':xs|xs/=""]++ys}$flagValueflagxwheres=s_{args=ys}processFlagmodes_@S{args="--":ys}=fs_{args=ys}wherefs|isJust$stops=s|otherwise=f$processArgmodesprocessFlagmodes=processArgmodesprocessArgmodes_@S{args=x:ys}=casemodeArgsmodeofNothing->errs$"Unhandled argument, none expected: "++xJustarg->caseargValueargx(vals)ofLefte->errs$"Unhandled argument, "++e++": "++xRightv->s{val=v}wheres=s_{args=ys}----------------------------------------------------------------------- UTILITIESambiguoustypgotxs="Ambiguous "++typ++" '"++got++"', could be any of: "++unwordsxsmissingtypxs="Missing "++typ++", wanted any of: "++unwordsxsdataLookupNamea=NotFound|Ambiguous[Name]|Founda-- different order to lookup so can potentially partially-apply itlookupName::[([Name],a)]->Name->LookupNamealookupNamenamesvalue=case(match(==),matchisPrefixOf)of([],[])->NotFound([],[x])->Found$sndx([],xs)->Ambiguous$mapfstxs([x],_)->Found$sndx(xs,_)->Ambiguous$mapfstxswherematchop=[(headys,v)|(xs,v)<-names,letys=filter(opvalue)xs,ys/=[]]