moduleSystem.Console.CmdArgs.Explicit.TypewhereimportControl.ArrowimportControl.MonadimportData.CharimportData.ListimportData.MaybeimportData.Monoid-- | A name, either the name of a flag (@--/foo/@) or the name of a mode.typeName=String-- | A help message that goes with either a flag or a mode.typeHelp=String-- | The type of a flag, i.e. @--foo=/TYPE/@.typeFlagHelp=String----------------------------------------------------------------------- UTILITY-- | Parse a boolean, accepts as True: true yes on enabled 1. parseBool::String->MaybeBoolparseBools|ls`elem`true=JustTrue|ls`elem`false=JustFalse|otherwise=Nothingwherels=maptoLowerstrue=["true","yes","on","enabled","1"]false=["false","no","off","disabled","0"]----------------------------------------------------------------------- GROUPS-- | A group of items (modes or flags). The items are treated as a list, but the-- group structure is used when displaying the help message.dataGroupa=Group{groupUnnamed::[a]-- ^ Normal items.,groupHidden::[a]-- ^ Items that are hidden (not displayed in the help message).,groupNamed::[(Help,[a])]-- ^ Items that have been grouped, along with a description of each group.}derivingShowinstanceFunctorGroupwherefmapf(Groupabc)=Group(mapfa)(mapfb)(map(second$mapf)c)instanceMonoid(Groupa)wheremempty=Group[][][]mappend(Groupx1x2x3)(Groupy1y2y3)=Group(x1++y1)(x2++y2)(x3++y3)-- | Convert a group into a list.fromGroup::Groupa->[a]fromGroup(Groupxyz)=x++y++concatMapsndz-- | Convert a list into a group, placing all fields in 'groupUnnamed'.toGroup::[a]->GroupatoGroupx=Groupx[][]----------------------------------------------------------------------- TYPES-- | A mode. Do not use the 'Mode' constructor directly, instead-- use 'mode' to construct the 'Mode' and then record updates.-- Each mode has three main features:---- * A list of submodes ('modeGroupModes')---- * A list of flags ('modeGroupFlags')---- * Optionally an unnamed argument ('modeArgs')---- To produce the help information for a mode, either use 'helpText' or 'show'.dataModea=Mode{modeGroupModes::Group(Modea)-- ^ The available sub-modes,modeNames::[Name]-- ^ The names assigned to this mode (for the root mode, this name is used as the program name),modeValue::a-- ^ Value to start with,modeCheck::a->EitherStringa-- ^ Check the value reprsented by a mode is correct, after applying all flags,modeReform::a->Maybe[String]-- ^ Given a value, try to generate the input arguments.,modeExpandAt::Bool-- ^ Expand @\@@ arguments with 'expandArgsAt', defaults to 'True', only applied if using an 'IO' processing function.-- Only the root 'Mode's value will be used.,modeHelp::Help-- ^ Help text,modeHelpSuffix::[String]-- ^ A longer help suffix displayed after a mode,modeArgs::([Arga],Maybe(Arga))-- ^ The unnamed arguments, a series of arguments, followed optionally by one for all remaining slots,modeGroupFlags::Group(Flaga)-- ^ Groups of flags}-- | Extract the modes from a 'Mode'modeModes::Modea->[Modea]modeModes=fromGroup.modeGroupModes-- | Extract the flags from a 'Mode'modeFlags::Modea->[Flaga]modeFlags=fromGroup.modeGroupFlags-- | The 'FlagInfo' type has the following meaning:------ > FlagReq FlagOpt FlagOptRare/FlagNone-- > -xfoo -x=foo -x=foo -x -foo-- > -x foo -x=foo -x foo -x foo-- > -x=foo -x=foo -x=foo -x=foo-- > --xx foo --xx=foo --xx foo --xx foo-- > --xx=foo --xx=foo --xx=foo --xx=foodataFlagInfo=FlagReq-- ^ Required argument|FlagOptString-- ^ Optional argument|FlagOptRareString-- ^ Optional argument that requires an = before the value|FlagNone-- ^ No argumentderiving(Eq,Ord,Show)-- | Extract the value from inside a 'FlagOpt' or 'FlagOptRare', or raises an error.fromFlagOpt::FlagInfo->StringfromFlagOpt(FlagOptx)=xfromFlagOpt(FlagOptRarex)=x-- | A function to take a string, and a value, and either produce an error message-- (@Left@), or a modified value (@Right@).typeUpdatea=String->a->EitherStringa-- | A flag, consisting of a list of flag names and other information.dataFlaga=Flag{flagNames::[Name]-- ^ The names for the flag.,flagInfo::FlagInfo-- ^ Information about a flag's arguments.,flagValue::Updatea-- ^ The way of processing a flag.,flagType::FlagHelp-- ^ The type of data for the flag argument, i.e. FILE\/DIR\/EXT,flagHelp::Help-- ^ The help message associated with this flag.}-- | An unnamed argument. Anything not starting with @-@ is considered an argument,-- apart from @\"-\"@ which is considered to be the argument @\"-\"@, and any arguments-- following @\"--\"@. For example:---- > programname arg1 -j - --foo arg3 -- -arg4 --arg5=1 arg6---- Would have the arguments:---- > ["arg1","-","arg3","-arg4","--arg5=1","arg6"]dataArga=Arg{argValue::Updatea-- ^ A way of processing the argument.,argType::FlagHelp-- ^ The type of data for the argument, i.e. FILE\/DIR\/EXT,argRequire::Bool-- ^ Is at least one of these arguments required, the command line will fail if none are set}----------------------------------------------------------------------- CHECK FLAGS-- | Check that a mode is well formed.checkMode::Modea->MaybeStringcheckModex=msum[checkNames"modes"$concatMapmodeNames$modeModesx,msum$mapcheckMode$modeModesx,checkGroup$modeGroupModesx,checkGroup$modeGroupFlagsx,checkNames"flag names"$concatMapflagNames$modeFlagsx]wherecheckGroup::Groupa->MaybeStringcheckGroupx=msum[check"Empty group name"$all(not.null.fst)$groupNamedx,check"Empty group contents"$all(not.null.snd)$groupNamedx]checkNames::String->[Name]->MaybeStringcheckNamesmsgxs=check"Empty names"(all(not.null)xs)`mplus`dobad<-listToMaybe$xs\\nubxsletdupe=filter(==bad)xsreturn$"Sanity check failed, multiple "++msg++": "++unwords(mapshowdupe)check::String->Bool->MaybeStringcheckmsgTrue=NothingcheckmsgFalse=Justmsg----------------------------------------------------------------------- REMAPclassRemapmwhereremap::(a->b)-- ^ Embed a value->(b->(a,a->b))-- ^ Extract the mode and give a way of re-embedding->ma->mbremap2::Remapm=>(a->b)->(b->a)->ma->mbremap2fg=remapf(\x->(gx,f))instanceRemapModewhereremapfgx=x{modeGroupModes=fmap(remapfg)$modeGroupModesx,modeValue=f$modeValuex,modeCheck=\v->let(a,b)=gvinfmapb$modeCheckxa,modeReform=modeReformx.fst.g,modeArgs=(fmap(remapfg)***fmap(remapfg))$modeArgsx,modeGroupFlags=fmap(remapfg)$modeGroupFlagsx}instanceRemapFlagwhereremapfgx=x{flagValue=remapUpdatefg$flagValuex}instanceRemapArgwhereremapfgx=x{argValue=remapUpdatefg$argValuex}remapUpdatefgupd=\sv->let(a,b)=gvinfmapb$updsa----------------------------------------------------------------------- MODE/MODES CREATORS-- | Create an empty mode specifying only 'modeValue'. All other fields will usually be populated-- using record updates.modeEmpty::a->ModeamodeEmptyx=Modemempty[]xRight(constNothing)True""[]([],Nothing)mempty-- | Create a mode with a name, an initial value, some help text, a way of processing arguments-- and a list of flags.mode::Name->a->Help->Arga->[Flaga]->Modeamodenamevaluehelpargflags=(modeEmptyvalue){modeNames=[name],modeHelp=help,modeArgs=([],Justarg),modeGroupFlags=toGroupflags}-- | Create a list of modes, with a program name, an initial value, some help text and the child modes.modes::String->a->Help->[Modea]->Modeamodesnamevaluehelpxs=(modeEmptyvalue){modeNames=[name],modeHelp=help,modeGroupModes=toGroupxs}----------------------------------------------------------------------- FLAG CREATORS-- | Create a flag taking no argument value, with a list of flag names, an update function-- and some help text.flagNone::[Name]->(a->a)->Help->FlagaflagNonenamesfhelp=FlagnamesFlagNoneupd""helpwhereupd_x=Right$fx-- | Create a flag taking an optional argument value, with an optional value, a list of flag names,-- an update function, the type of the argument and some help text.flagOpt::String->[Name]->Updatea->FlagHelp->Help->FlagaflagOptdefnamesupdtyphelp=Flagnames(FlagOptdef)updtyphelp-- | Create a flag taking a required argument value, with a list of flag names,-- an update function, the type of the argument and some help text.flagReq::[Name]->Updatea->FlagHelp->Help->FlagaflagReqnamesupdtyphelp=FlagnamesFlagRequpdtyphelp-- | Create an argument flag, with an update function and the type of the argument.flagArg::Updatea->FlagHelp->ArgaflagArgupdtyp=ArgupdtypFalse-- | Create a boolean flag, with a list of flag names, an update function and some help text.flagBool::[Name]->(Bool->a->a)->Help->FlagaflagBoolnamesfhelp=Flagnames(FlagOptRare"")upd""helpwhereupdsx=caseifs==""thenJustTrueelseparseBoolsofJustb->Right$fbxNothing->Left"expected boolean value (true/false)"