moduleDistribution.Cab.Commands(FunctionCommand,Option(..),deps,revdeps,installed,outdated,uninstall,search,genpaths,check,initSandbox,add,ghci)whereimportControl.Applicativehiding(many)importControl.MonadimportData.CharimportData.List(isPrefixOf,intercalate)importqualifiedData.MapasMimportDistribution.Cab.GenPathsimportDistribution.Cab.PkgDBimportDistribution.Cab.PrinterimportDistribution.Cab.SandboximportDistribution.Cab.VerDBimportDistribution.Cab.VersionimportSystem.ExitimportSystem.IOimportSystem.Processhiding(env)----------------------------------------------------------------typeFunctionCommand=[String]->[Option]->[String]->IO()dataOption=OptNoharm|OptRecursive|OptAll|OptInfo|OptFlagString|OptTest|OptHelp|OptBench|OptDepsOnly|OptLibProfile|OptExecProfile|OptJobsString|OptImportString|OptStaticderiving(Eq,Show)----------------------------------------------------------------search::FunctionCommandsearch[x]__=donvls<-toList<$>getVerDBAllRegisteredforM_(loknvls)$\(n,v)->putStrLn$n++" "++verToStringvwherekey=maptoLowerxsat(n,_)=key`isPrefixOf`maptoLowernlok=filtersatsearch___=dohPutStrLnstderr"One search-key should be specified."exitFailure----------------------------------------------------------------installed::FunctionCommandinstalled_opts_=dodb<-getDBoptsletpkgs=toPkgInfosdbforM_pkgs$\pkgi->doputStr$fullNameOfPkgInfopkgiextraInfoinfopkgiputStrLn""whenoptrec$printDepsTrueinfodb1pkgiwhereinfo=OptInfo`elem`optsoptrec=OptRecursive`elem`optsoutdated::FunctionCommandoutdated_opts_=dopkgs<-toPkgInfos<$>getDBoptsverDB<-toMap<$>getVerDBInstalledOnlyforM_pkgs$\p->caseM.lookup(nameOfPkgInfop)verDBofNothing->return()Justver->when(verOfPkgInfop/=ver)$putStrLn$fullNameOfPkgInfop++" < "++verToStringvergetDB::[Option]->IOPkgDBgetDBopts|optall=getSandbox>>=getPkgDB|otherwise=getSandbox>>=getUserPkgDBwhereoptall=OptAll`elem`opts----------------------------------------------------------------uninstall::FunctionCommanduninstallnmveropts_=douserDB<-getSandbox>>=getUserPkgDBpkg<-lookupPkgnmveruserDBletsortedPkgs=topSortedPkgspkguserDBifonlyOne&&lengthsortedPkgs/=1thendohPutStrLnstderr"The following packages depend on this. Use the \"-r\" option."mapM_(hPutStrLnstderr.fullNameOfPkgInfo)(initsortedPkgs)elsedounlessdoit$putStrLn"The following packages are deleted without the \"-n\" option."mapM_(unregisterdoitopts.pairNameOfPkgInfo)sortedPkgswhereonlyOne=OptRecursive`notElem`optsdoit=OptNoharm`notElem`optsunregister::Bool->[Option]->(String,String)->IO()unregisterdoit_(name,ver)=ifdoitthendoputStrLn$"Deleting "++name++" "++versandboxOpts<-getSandboxOpts2<$>getSandboxwhendoit$void.system$scriptsandboxOptselseputStrLn$name++" "++verwherescriptsandboxOpts="ghc-pkg unregister "++sandboxOpts++" "++name++"-"++ver----------------------------------------------------------------genpaths::FunctionCommandgenpaths___=genPaths----------------------------------------------------------------check::FunctionCommandcheck___=dosandboxOpts<-getSandboxOpts2<$>getSandboxvoid.system$scriptsandboxOptswherescriptsandboxOpts="ghc-pkg check -v "++sandboxOpts----------------------------------------------------------------deps::FunctionCommanddepsnmveropts_=printDependsnmveroptsprintDepsrevdeps::FunctionCommandrevdepsnmveropts_=printDependsnmveroptsprintRevDepsprintDepends::[String]->[Option]->(Bool->Bool->PkgDB->Int->PkgInfo->IO())->IO()printDependsnmveroptsfunc=dodb'<-getSandbox>>=getPkgDBpkg<-lookupPkgnmverdb'db<-getDBoptsfuncrecinfodb0pkgwhererec=OptRecursive`elem`optsinfo=OptInfo`elem`opts----------------------------------------------------------------lookupPkg::[String]->PkgDB->IOPkgInfolookupPkg[]_=dohPutStrLnstderr"Package name must be specified."exitFailurelookupPkg[name]db=checkOne$lookupByNamenamedblookupPkg[name,ver]db=checkOne$lookupByVersionnameverdblookupPkg__=dohPutStrLnstderr"Only one package name must be specified."exitFailurecheckOne::[PkgInfo]->IOPkgInfocheckOne[]=dohPutStrLnstderr"No such package found."exitFailurecheckOne[pkg]=returnpkgcheckOnepkgs=dohPutStrLnstderr"Package version must be specified."mapM_(hPutStrLnstderr.fullNameOfPkgInfo)pkgsexitFailure----------------------------------------------------------------initSandbox::FunctionCommandinitSandbox[]__=void.system$"cabal sandbox init"initSandbox[path]__=void.system$"cabal sandbox init --sandbox "++pathinitSandbox___=dohPutStrLnstderr"Only one argument is allowed"exitFailure----------------------------------------------------------------add::FunctionCommandadd[src]__=void.system$"cabal sandbox add-source "++srcadd___=dohPutStrLnstderr"A source path be specified."exitFailure----------------------------------------------------------------ghci::FunctionCommandghciargs_options=dosbxOpts<-getSandboxOpts<$>getSandboxvoid$system$"ghci"++" "++sbxOpts++" "++intercalate" "(options++args)