{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, UndecidableInstances, OverlappingInstances, TypeOperators #-}moduleReadArgswhereimportControl.Arrow(first)importData.MaybeimportData.ListimportData.TypeableimportSystem.EnvironmentimportSystem.ExitimportSystem.IO-- |parse the desired argument tuple from the command line or -- print a simple usage statment and quitreadArgs::ArgumentTuplea=>IOareadArgs=getArgs>>=readArgsFrom-- |read args from the given strings or -- print a simple usage statment and quit-- (so you can do option parsing first)readArgsFrom::ArgumentTuplea=>[String]->IOareadArgsFromss=letma@(~(Justa))=parseArgsFromssincasemaofNothing->doprogName<-getProgNamehPutStrLnstderr$"usage: "++progName++usageForaexitFailure_->returna-- |a class for types that can be parsed from exactly one command line argumentclassArguableawhereparse::String->Maybea-- |name's argument will usually be undefined, so when defining instances of-- Arguable, it should be lazy in its argumentname::a->String-- |all types that are typeable and readable can be used as simple argumentsinstance(Typeablet,Readt)=>Arguabletwhereparses=casereadssof[(i,"")]->Justiotherwise->Nothingnamet=showsTypeRep(typeOft)""-- |string is a special case, so that we don't force the user to double-quote-- their inputinstanceArguableStringwhereparse=Justname_="String"-- |char is a special case, so that we don't force the user to single-quote-- their inputinstanceArguableCharwhereparse[x]=Justxparsexs=Nothingname_="Char"-- |a class for types that can be parsed from some number of command line-- argumentsclassArgumentawhereparseArg::[String]->[(a,[String])]-- |argName's argument will usually be undefined, so when defining instances of-- Arguable, it should be lazy in its argumentargName::a->String-- |use the arguable tyep to just parse a single argumentinstanceArguablea=>ArgumentawhereparseArg[]=[]parseArg(s:ss)=doa<-maybeToList$parsesreturn(a,ss)argName=name-- |use Maybe when it should be parsed from one or zero (greedily)instanceArguablea=>Argument(Maybea)whereargName~(Justx)="["++namex++"]"parseArg[]=[(Nothing,[])]parseArgss'@(s:ss)=caseparsesofNothing->[(Nothing,ss')]justA->[(justA,ss),(Nothing,ss')]-- |use a list when it should be parsed from zero or more (greedily)instanceArguablea=>Argument[a]whereargName~(x:_)="["++namex++"...]"parseArgss=reverse$initsss'`zip`tailssswheress'=mapfromJust.takeWhileisJust$mapparsess-- |a wrapper type to indicate a non-greedy list or maybenewtypeNonGreedyma=NonGreedy{unNonGreedy::ma}deriving(Show,Eq)-- |use NonGreedy when it should be parsed non-greedily-- (e.g. @(NonGreedy xs :: NonGreedy [] Int, x :: Maybe Float) <- readArgs@)instanceArgument(ma)=>Argument(NonGreedyma)whereargName~(NonGreedym)=argNamemparseArg=map(firstNonGreedy).reverse.parseArg-- |make sure strings are handled as a separate type, not a list of charsinstanceArgumentStringwhereparseArg[]=[]parseArg(s:ss)=doa<-maybeToList$parsesreturn(a,ss)argName=name-- |a class for tuples of types that can be parsed from the entire list-- of argumentsclassArgumentTupleawhereparseArgsFrom::[String]->Maybea-- |usageFor's argument will usually be undefined, so when defining instances of-- Arguable, it should be lazy in its argumentusageFor::a->String-- |use () for no argumentsinstanceArgumentTuple()whereparseArgsFrom[]=Just()parseArgsFrom_=NothingusageFor=const""-- |use :& to construct arbitrary length tuples of any parsable argumentsdataa:&b=a:&bderiving(Show,Eq)infixr5:&instance(Argumenta,ArgumentTupley)=>ArgumentTuple(a:&y)whereparseArgsFromss=listToMaybe$do(a,ss')<-parseArgssy<-maybeToList$parseArgsFromss'return$a:&yusageFor~(a:&y)=" "++argNamea++usageFory-- Use :& to derive instances for all the normal tuple typesinstance(Argumentb,Argumenta)=>ArgumentTuple(b,a)whereparseArgsFromss=dob:&a:&()<-parseArgsFromssreturn(b,a)usageFor~(b,a)=usageFor(b:&a:&())instance(Argumentc,Argumentb,Argumenta)=>ArgumentTuple(c,b,a)whereparseArgsFromss=doc:&b:&a:&()<-parseArgsFromssreturn(c,b,a)usageFor~(c,b,a)=usageFor(c:&b:&a:&())instance(Argumentd,Argumentc,Argumentb,Argumenta)=>ArgumentTuple(d,c,b,a)whereparseArgsFromss=dod:&c:&b:&a:&()<-parseArgsFromssreturn(d,c,b,a)usageFor~(d,c,b,a)=usageFor(d:&c:&b:&a:&())instance(Argumente,Argumentd,Argumentc,Argumentb,Argumenta)=>ArgumentTuple(e,d,c,b,a)whereparseArgsFromss=doe:&d:&c:&b:&a:&()<-parseArgsFromssreturn(e,d,c,b,a)usageFor~(e,d,c,b,a)=usageFor(e:&d:&c:&b:&a:&())instance(Argumentf,Argumente,Argumentd,Argumentc,Argumentb,Argumenta)=>ArgumentTuple(f,e,d,c,b,a)whereparseArgsFromss=dof:&e:&d:&c:&b:&a:&()<-parseArgsFromssreturn(f,e,d,c,b,a)usageFor~(f,e,d,c,b,a)=usageFor(f:&e:&d:&c:&b:&a:&())instance(Argumentg,Argumentf,Argumente,Argumentd,Argumentc,Argumentb,Argumenta)=>ArgumentTuple(g,f,e,d,c,b,a)whereparseArgsFromss=dog:&f:&e:&d:&c:&b:&a:&()<-parseArgsFromssreturn(g,f,e,d,c,b,a)usageFor~(g,f,e,d,c,b,a)=usageFor(g:&f:&e:&d:&c:&b:&a:&())instance(Argumenth,Argumentg,Argumentf,Argumente,Argumentd,Argumentc,Argumentb,Argumenta)=>ArgumentTuple(h,g,f,e,d,c,b,a)whereparseArgsFromss=doh:&g:&f:&e:&d:&c:&b:&a:&()<-parseArgsFromssreturn(h,g,f,e,d,c,b,a)usageFor~(h,g,f,e,d,c,b,a)=usageFor(h:&g:&f:&e:&d:&c:&b:&a:&())instance(Argumenti,Argumenth,Argumentg,Argumentf,Argumente,Argumentd,Argumentc,Argumentb,Argumenta)=>ArgumentTuple(i,h,g,f,e,d,c,b,a)whereparseArgsFromss=doi:&h:&g:&f:&e:&d:&c:&b:&a:&()<-parseArgsFromssreturn(i,h,g,f,e,d,c,b,a)usageFor~(i,h,g,f,e,d,c,b,a)=usageFor(i:&h:&g:&f:&e:&d:&c:&b:&a:&())instance(Argumentj,Argumenti,Argumenth,Argumentg,Argumentf,Argumente,Argumentd,Argumentc,Argumentb,Argumenta)=>ArgumentTuple(j,i,h,g,f,e,d,c,b,a)whereparseArgsFromss=doj:&i:&h:&g:&f:&e:&d:&c:&b:&a:&()<-parseArgsFromssreturn(j,i,h,g,f,e,d,c,b,a)usageFor~(j,i,h,g,f,e,d,c,b,a)=usageFor(j:&i:&h:&g:&f:&e:&d:&c:&b:&a:&())instance(Argumentk,Argumentj,Argumenti,Argumenth,Argumentg,Argumentf,Argumente,Argumentd,Argumentc,Argumentb,Argumenta)=>ArgumentTuple(k,j,i,h,g,f,e,d,c,b,a)whereparseArgsFromss=dok:&j:&i:&h:&g:&f:&e:&d:&c:&b:&a:&()<-parseArgsFromssreturn(k,j,i,h,g,f,e,d,c,b,a)usageFor~(k,j,i,h,g,f,e,d,c,b,a)=usageFor(k:&j:&i:&h:&g:&f:&e:&d:&c:&b:&a:&())instance(Argumentl,Argumentk,Argumentj,Argumenti,Argumenth,Argumentg,Argumentf,Argumente,Argumentd,Argumentc,Argumentb,Argumenta)=>ArgumentTuple(l,k,j,i,h,g,f,e,d,c,b,a)whereparseArgsFromss=dol:&k:&j:&i:&h:&g:&f:&e:&d:&c:&b:&a:&()<-parseArgsFromssreturn(l,k,j,i,h,g,f,e,d,c,b,a)usageFor~(l,k,j,i,h,g,f,e,d,c,b,a)=usageFor(l:&k:&j:&i:&h:&g:&f:&e:&d:&c:&b:&a:&())instance(Argumentm,Argumentl,Argumentk,Argumentj,Argumenti,Argumenth,Argumentg,Argumentf,Argumente,Argumentd,Argumentc,Argumentb,Argumenta)=>ArgumentTuple(m,l,k,j,i,h,g,f,e,d,c,b,a)whereparseArgsFromss=dom:&l:&k:&j:&i:&h:&g:&f:&e:&d:&c:&b:&a:&()<-parseArgsFromssreturn(m,l,k,j,i,h,g,f,e,d,c,b,a)usageFor~(m,l,k,j,i,h,g,f,e,d,c,b,a)=usageFor(m:&l:&k:&j:&i:&h:&g:&f:&e:&d:&c:&b:&a:&())instance(Argumentn,Argumentm,Argumentl,Argumentk,Argumentj,Argumenti,Argumenth,Argumentg,Argumentf,Argumente,Argumentd,Argumentc,Argumentb,Argumenta)=>ArgumentTuple(n,m,l,k,j,i,h,g,f,e,d,c,b,a)whereparseArgsFromss=don:&m:&l:&k:&j:&i:&h:&g:&f:&e:&d:&c:&b:&a:&()<-parseArgsFromssreturn(n,m,l,k,j,i,h,g,f,e,d,c,b,a)usageFor~(n,m,l,k,j,i,h,g,f,e,d,c,b,a)=usageFor(n:&m:&l:&k:&j:&i:&h:&g:&f:&e:&d:&c:&b:&a:&())instance(Argumento,Argumentn,Argumentm,Argumentl,Argumentk,Argumentj,Argumenti,Argumenth,Argumentg,Argumentf,Argumente,Argumentd,Argumentc,Argumentb,Argumenta)=>ArgumentTuple(o,n,m,l,k,j,i,h,g,f,e,d,c,b,a)whereparseArgsFromss=doo:&n:&m:&l:&k:&j:&i:&h:&g:&f:&e:&d:&c:&b:&a:&()<-parseArgsFromssreturn(o,n,m,l,k,j,i,h,g,f,e,d,c,b,a)usageFor~(o,n,m,l,k,j,i,h,g,f,e,d,c,b,a)=usageFor(o:&n:&m:&l:&k:&j:&i:&h:&g:&f:&e:&d:&c:&b:&a:&())