{-# LANGUAGE OverloadedStrings #-} module Flags ( Program(..), opts , PacmanOp( Sync ), SyncOp( SyncUpgrade ), MiscOp , AuraOp(..), _AurSync, _AurIgnore, _AurIgnoreGroup , AurOp(..), BackupOp(..), CacheOp(..), LogOp(..), OrphanOp(..) ) where import Aura.Cache (defaultPackageCache) import Aura.Pacman (defaultLogFile, pacmanConfFile) import Aura.Settings import Aura.Types import BasePrelude hiding (Version, exp, log, option) import qualified Data.List.NonEmpty as NEL import qualified Data.Set as S import Data.Set.NonEmpty (NESet) import qualified Data.Set.NonEmpty as NES import qualified Data.Text as T import Lens.Micro import Options.Applicative import System.Path (Absolute, Path, fromAbsoluteFilePath, toFilePath) --- -- | A description of a run of Aura to attempt. data Program = Program { -- ^ Whether Aura handles everything, or the ops and input are just passed down to Pacman. _operation :: Either (PacmanOp, S.Set MiscOp) AuraOp -- ^ Settings common to both Aura and Pacman. , _commons :: CommonConfig -- ^ Settings specific to building packages. , _buildConf :: BuildConfig -- ^ The human language of text output. , _language :: Maybe Language } deriving (Show) -- | Inherited operations that are fed down to Pacman. data PacmanOp = Database (Either DatabaseOp (NESet PkgName)) | Files (S.Set FilesOp) | Query (Either QueryOp (S.Set QueryFilter, S.Set PkgName)) | Remove (S.Set RemoveOp) (NESet PkgName) | Sync (Either SyncOp (S.Set PkgName)) (S.Set SyncSwitch) | TestDeps (NESet T.Text) | Upgrade (S.Set UpgradeSwitch) (NESet PkgName) deriving (Show) instance Flagable PacmanOp where asFlag (Database (Left o)) = "-D" : asFlag o asFlag (Database (Right fs)) = "-D" : asFlag fs asFlag (Files os) = "-F" : asFlag os asFlag (Query (Left o)) = "-Q" : asFlag o asFlag (Query (Right (fs, ps))) = "-Q" : asFlag ps ++ asFlag fs asFlag (Remove os ps) = "-R" : asFlag os ++ asFlag ps asFlag (Sync (Left o) ss) = "-S" : asFlag ss ++ asFlag o asFlag (Sync (Right ps) ss) = "-S" : asFlag ss ++ asFlag ps asFlag (TestDeps ps) = "-T" : asFlag ps asFlag (Upgrade s ps) = "-U" : asFlag s ++ asFlag ps data DatabaseOp = DBCheck | DBAsDeps (NESet T.Text) | DBAsExplicit (NESet T.Text) deriving (Show) instance Flagable DatabaseOp where asFlag DBCheck = ["--check"] asFlag (DBAsDeps ps) = "--asdeps" : asFlag ps asFlag (DBAsExplicit ps) = "--asexplicit" : asFlag ps data FilesOp = FilesList (NESet T.Text) | FilesOwns T.Text | FilesSearch T.Text | FilesRegex | FilesRefresh | FilesMachineReadable deriving (Eq, Ord, Show) instance Flagable FilesOp where asFlag (FilesList fs) = "--list" : asFlag fs asFlag (FilesOwns f) = ["--owns", f] asFlag (FilesSearch f) = ["--search", f] asFlag FilesRegex = ["--regex"] asFlag FilesRefresh = ["--refresh"] asFlag FilesMachineReadable = ["--machinereadable"] data QueryOp = QueryChangelog (NESet T.Text) | QueryGroups (NESet T.Text) | QueryInfo (NESet T.Text) | QueryCheck (NESet T.Text) | QueryList (NESet T.Text) | QueryOwns (NESet T.Text) | QueryFile (NESet T.Text) | QuerySearch T.Text deriving (Show) instance Flagable QueryOp where asFlag (QueryChangelog ps) = "--changelog" : asFlag ps asFlag (QueryGroups ps) = "--groups" : asFlag ps asFlag (QueryInfo ps) = "--info" : asFlag ps asFlag (QueryCheck ps) = "--check" : asFlag ps asFlag (QueryList ps) = "--list" : asFlag ps asFlag (QueryOwns ps) = "--owns" : asFlag ps asFlag (QueryFile ps) = "--file" : asFlag ps asFlag (QuerySearch t) = ["--search", t] data QueryFilter = QueryDeps | QueryExplicit | QueryForeign | QueryNative | QueryUnrequired | QueryUpgrades deriving (Eq, Ord, Show) instance Flagable QueryFilter where asFlag QueryDeps = ["--deps"] asFlag QueryExplicit = ["--explicit"] asFlag QueryForeign = ["--foreign"] asFlag QueryNative = ["--native"] asFlag QueryUnrequired = ["--unrequired"] asFlag QueryUpgrades = ["--upgrades"] data RemoveOp = RemoveCascade | RemoveNoSave | RemoveRecursive | RemoveUnneeded deriving (Eq, Ord, Show) instance Flagable RemoveOp where asFlag RemoveCascade = ["--cascade"] asFlag RemoveNoSave = ["--nosave"] asFlag RemoveRecursive = ["--recursive"] asFlag RemoveUnneeded = ["--unneeded"] data SyncOp = SyncClean | SyncGroups (NESet T.Text) | SyncInfo (NESet T.Text) | SyncList T.Text | SyncSearch T.Text | SyncUpgrade (S.Set T.Text) | SyncDownload (NESet T.Text) deriving (Show) instance Flagable SyncOp where asFlag SyncClean = ["--clean"] asFlag (SyncGroups gs) = "--groups" : asFlag gs asFlag (SyncInfo ps) = "--info" : asFlag ps asFlag (SyncList r) = ["--list", r] asFlag (SyncSearch s) = ["--search", s] asFlag (SyncUpgrade ps) = "--sysupgrade" : asFlag ps asFlag (SyncDownload ps) = "--downloadonly" : asFlag ps data SyncSwitch = SyncRefresh | SyncIgnore (S.Set PkgName) | SyncIgnoreGroup (S.Set PkgGroup) deriving (Eq, Ord, Show) instance Flagable SyncSwitch where asFlag SyncRefresh = ["--refresh"] asFlag (SyncIgnore ps) = ["--ignore", T.intercalate "," $ asFlag ps ] asFlag (SyncIgnoreGroup gs) = ["--ignoregroup" , T.intercalate "," $ asFlag gs ] data UpgradeSwitch = UpgradeAsDeps | UpgradeAsExplicit | UpgradeIgnore (S.Set PkgName) | UpgradeIgnoreGroup (S.Set PkgGroup) deriving (Eq, Ord, Show) instance Flagable UpgradeSwitch where asFlag UpgradeAsDeps = ["--asdeps"] asFlag UpgradeAsExplicit = ["--asexplicit"] asFlag (UpgradeIgnore ps) = ["--ignore", T.intercalate "," $ asFlag ps ] asFlag (UpgradeIgnoreGroup gs) = ["--ignoregroup", T.intercalate "," $ asFlag gs ] -- | Flags common to several Pacman operations. data MiscOp = MiscArch (Path Absolute) | MiscAssumeInstalled T.Text | MiscColor T.Text | MiscConfirm | MiscDBOnly | MiscDBPath (Path Absolute) | MiscGpgDir (Path Absolute) | MiscHookDir (Path Absolute) | MiscNoDeps | MiscNoProgress | MiscNoScriptlet | MiscPrint | MiscPrintFormat T.Text | MiscRoot (Path Absolute) | MiscVerbose deriving (Eq, Ord, Show) instance Flagable MiscOp where asFlag (MiscArch p) = ["--arch", T.pack $ toFilePath p] asFlag (MiscAssumeInstalled p) = ["--assume-installed", p] asFlag (MiscColor c) = ["--color", c] asFlag (MiscDBPath p) = ["--dbpath", T.pack $ toFilePath p] asFlag (MiscGpgDir p) = ["--gpgdir", T.pack $ toFilePath p] asFlag (MiscHookDir p) = ["--hookdir", T.pack $ toFilePath p] asFlag (MiscPrintFormat s) = ["--print-format", s] asFlag (MiscRoot p) = ["--root", T.pack $ toFilePath p] asFlag MiscConfirm = ["--confirm"] asFlag MiscDBOnly = ["--dbonly"] asFlag MiscNoDeps = ["--nodeps"] asFlag MiscNoProgress = ["--noprogressbar"] asFlag MiscNoScriptlet = ["--noscriptlet"] asFlag MiscPrint = ["--print"] asFlag MiscVerbose = ["--verbose"] -- | Operations unique to Aura. data AuraOp = AurSync (Either AurOp (NESet PkgName)) (S.Set AurSwitch) | Backup (Maybe BackupOp) | Cache (Either CacheOp (NESet PkgName)) | Log (Maybe LogOp) | Orphans (Maybe OrphanOp) | Version | Languages | ViewConf deriving (Show) _AurSync :: Traversal' AuraOp (S.Set AurSwitch) _AurSync f (AurSync o s) = AurSync o <$> f s _AurSync _ x = pure x data AurOp = AurDeps (NESet PkgName) | AurInfo (NESet PkgName) | AurPkgbuild (NESet PkgName) | AurSearch T.Text | AurUpgrade (S.Set PkgName) | AurJson (NESet PkgName) deriving (Show) data AurSwitch = AurIgnore (S.Set PkgName) | AurIgnoreGroup (S.Set PkgGroup) deriving (Eq, Ord, Show) _AurIgnore :: Traversal' AurSwitch (S.Set PkgName) _AurIgnore f (AurIgnore s) = AurIgnore <$> f s _AurIgnore _ x = pure x _AurIgnoreGroup :: Traversal' AurSwitch (S.Set PkgGroup) _AurIgnoreGroup f (AurIgnoreGroup s) = AurIgnoreGroup <$> f s _AurIgnoreGroup _ x = pure x data BackupOp = BackupClean Word | BackupRestore | BackupList deriving (Show) data CacheOp = CacheBackup (Path Absolute) | CacheClean Word | CacheCleanNotSaved | CacheSearch T.Text deriving (Show) data LogOp = LogInfo (NESet PkgName) | LogSearch T.Text deriving (Show) data OrphanOp = OrphanAbandon | OrphanAdopt (NESet PkgName) deriving (Show) opts :: ParserInfo Program opts = info (program <**> helper) (fullDesc <> header "Aura - Package manager for Arch Linux and the AUR.") program :: Parser Program program = Program <$> (fmap Right aurOps <|> (curry Left <$> pacOps <*> misc)) <*> commonConfig <*> buildConfig <*> optional language where aurOps = aursync <|> backups <|> cache <|> log <|> orphans <|> version' <|> languages <|> viewconf pacOps = database <|> files <|> queries <|> remove <|> sync <|> testdeps <|> upgrades aursync :: Parser AuraOp aursync = bigA *> (AurSync <$> (fmap (Right . NES.fromList . fmap (PkgName . T.toLower) . NES.toList) someArgs <|> fmap Left mods) <*> (S.fromList <$> many switches) ) where bigA = flag' () (long "aursync" <> short 'A' <> help "Install packages from the AUR.") mods = ds <|> ainfo <|> pkgb <|> search <|> upgrade <|> aur ds = AurDeps <$> (flag' () (long "deps" <> short 'd' <> hidden <> help "View dependencies of an AUR package.") *> somePkgs') ainfo = AurInfo <$> (flag' () (long "info" <> short 'i' <> hidden <> help "View AUR package information.") *> somePkgs') pkgb = AurPkgbuild <$> (flag' () (long "pkgbuild" <> short 'p' <> hidden <> help "View an AUR package's PKGBUILD file.") *> somePkgs') search = AurSearch <$> strOption (long "search" <> short 's' <> metavar "STRING" <> hidden <> help "Search the AUR via a search string.") upgrade = AurUpgrade <$> (flag' () (long "sysupgrade" <> short 'u' <> hidden <> help "Upgrade all installed AUR packages.") *> fmap (S.map PkgName) manyArgs') aur = AurJson <$> (flag' () (long "json" <> hidden <> help "Retrieve package JSON straight from the AUR.") *> somePkgs') switches = ign <|> igg ign = AurIgnore . S.fromList . map PkgName . T.split (== ',') <$> strOption (long "ignore" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore given packages.") igg = AurIgnoreGroup . S.fromList . map PkgGroup . T.split (== ',') <$> strOption (long "ignoregroup" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore packages from the given groups.") backups :: Parser AuraOp backups = bigB *> (Backup <$> optional mods) where bigB = flag' () (long "save" <> short 'B' <> help "Save a package state.") mods = clean <|> restore <|> lst clean = BackupClean <$> option auto (long "clean" <> short 'c' <> metavar "N" <> hidden <> help "Keep the most recent N states, delete the rest.") restore = flag' BackupRestore (long "restore" <> short 'r' <> hidden <> help "Restore a previous package state.") lst = flag' BackupList (long "list" <> short 'l' <> hidden <> help "Show all saved package state filenames.") cache :: Parser AuraOp cache = bigC *> (Cache <$> (fmap Left mods <|> fmap Right somePkgs)) where bigC = flag' () (long "downgrade" <> short 'C' <> help "Interact with the package cache.") mods = backup <|> clean <|> clean' <|> search backup = CacheBackup . fromAbsoluteFilePath <$> strOption (long "backup" <> short 'b' <> metavar "PATH" <> help "Backup the package cache to a given directory." <> hidden) clean = CacheClean <$> option auto (long "clean" <> short 'c' <> metavar "N" <> help "Save the most recent N versions of a package in the cache, deleting the rest." <> hidden) clean' = flag' CacheCleanNotSaved (long "notsaved" <> help "Clean out any cached package files which doesn't appear in any saved state." <> hidden) search = CacheSearch <$> strOption (long "search" <> short 's' <> metavar "STRING" <> help "Search the package cache via a search string." <> hidden) log :: Parser AuraOp log = bigL *> (Log <$> optional mods) where bigL = flag' () (long "viewlog" <> short 'L' <> help "View the Pacman log.") mods = inf <|> sch inf = LogInfo <$> (flag' () (long "info" <> short 'i' <> help "Display the installation history for given packages." <> hidden) *> somePkgs') sch = LogSearch <$> strOption (long "search" <> short 's' <> metavar "STRING" <> help "Search the Pacman log via a search string." <> hidden) orphans :: Parser AuraOp orphans = bigO *> (Orphans <$> optional mods) where bigO = flag' () (long "orphans" <> short 'O' <> help "Display all orphan packages.") mods = abandon <|> adopt abandon = flag' OrphanAbandon (long "abandon" <> short 'j' <> hidden <> help "Uninstall all orphan packages.") adopt = OrphanAdopt <$> (flag' () (long "adopt" <> hidden <> help "Mark some packages' install reason as 'Explicit'.") *> somePkgs') version' :: Parser AuraOp version' = flag' Version (long "version" <> short 'V' <> help "Display Aura's version.") languages :: Parser AuraOp languages = flag' Languages (long "languages" <> help "Show all human languages available for output.") viewconf :: Parser AuraOp viewconf = flag' ViewConf (long "viewconf" <> help "View the Pacman config file.") buildConfig :: Parser BuildConfig buildConfig = BuildConfig <$> makepkg <*> bp <*> optional bu <*> trunc <*> buildSwitches where makepkg = S.fromList <$> many (ia <|> as <|> si) ia = flag' IgnoreArch (long "ignorearch" <> hidden <> help "Exposed makepkg flag.") as = flag' AllSource (long "allsource" <> hidden <> help "Exposed makepkg flag.") si = flag' SkipInteg (long "skipinteg" <> hidden <> help "Skip all makepkg integrity checks.") bp = fmap fromAbsoluteFilePath (strOption (long "build" <> metavar "PATH" <> hidden <> help "Directory in which to build packages.")) <|> pure defaultBuildDir bu = User <$> strOption (long "builduser" <> metavar "USER" <> hidden <> help "User account to build as.") trunc = fmap Head (option auto (long "head" <> metavar "N" <> hidden <> help "Only show top N search results.")) <|> fmap Tail (option auto (long "tail" <> metavar "N" <> hidden <> help "Only show last N search results.")) <|> pure None buildSwitches :: Parser (S.Set BuildSwitch) buildSwitches = S.fromList <$> many (lv <|> dmd <|> dsm <|> dpb <|> rbd <|> he <|> ucp <|> dr <|> sa <|> fo <|> npc) where dmd = flag' DeleteMakeDeps (long "delmakedeps" <> short 'a' <> hidden <> help "Uninstall makedeps after building.") dsm = flag' DontSuppressMakepkg (long "unsuppress" <> short 'x' <> hidden <> help "Unsuppress makepkg output.") dpb = flag' DiffPkgbuilds (long "diff" <> short 'k' <> hidden <> help "Show PKGBUILD diffs.") rbd = flag' RebuildDevel (long "devel" <> hidden <> help "Rebuild all git/hg/svn/darcs-based packages.") he = flag' HotEdit (long "hotedit" <> hidden <> help "Edit a PKGBUILD before building.") ucp = flag' UseCustomizepkg (long "custom" <> hidden <> help "Run customizepkg before building.") dr = flag' DryRun (long "dryrun" <> hidden <> help "Run dependency checks and PKGBUILD diffs, but don't build.") sa = flag' SortAlphabetically (long "abc" <> hidden <> help "Sort search results alphabetically.") lv = flag' LowVerbosity (long "quiet" <> short 'q' <> hidden <> help "Display less information.") fo = flag' ForceBuilding (long "force" <> hidden <> help "Always (re)build specified packages.") npc = flag' NoPkgbuildCheck (long "noanalysis" <> hidden <> help "Do not analyse PKGBUILDs for security flaws.") commonConfig :: Parser CommonConfig commonConfig = CommonConfig <$> cap <*> cop <*> lfp <*> commonSwitches where cap = fmap (Right . fromAbsoluteFilePath) (strOption (long "cachedir" <> hidden <> help "Use an alternate package cache location.")) <|> pure (Left defaultPackageCache) cop = fmap (Right . fromAbsoluteFilePath) (strOption (long "config" <> hidden <> help "Use an alternate Pacman config file.")) <|> pure (Left pacmanConfFile) lfp = fmap (Right . fromAbsoluteFilePath) (strOption (long "logfile" <> hidden <> help "Use an alternate Pacman log.")) <|> pure (Left defaultLogFile) commonSwitches :: Parser (S.Set CommonSwitch) commonSwitches = S.fromList <$> many (nc <|> no <|> dbg <|> clr) where nc = flag' NoConfirm (long "noconfirm" <> hidden <> help "Never ask for Aura or Pacman confirmation.") no = flag' NeededOnly (long "needed" <> hidden <> help "Don't rebuild/reinstall up-to-date packages.") dbg = flag' Debug (long "debug" <> hidden <> help "Print useful debugging info.") clr = Colour . f <$> strOption (long "color" <> metavar "WHEN" <> hidden <> help "Colourize the output.") f :: String -> ColourMode f "never" = Never f "always" = Always f _ = Auto database :: Parser PacmanOp database = bigD *> (Database <$> (fmap Right somePkgs <|> fmap Left mods)) where bigD = flag' () (long "database" <> short 'D' <> help "Interact with the package database.") mods = check <|> asdeps <|> asexp check = flag' DBCheck (long "check" <> short 'k' <> hidden <> help "Test local database validity.") asdeps = DBAsDeps <$> (flag' () (long "asdeps" <> hidden <> help "Mark packages as being dependencies.") *> someArgs') asexp = DBAsExplicit <$> (flag' () (long "asexplicit" <> hidden <> help "Mark packages as being explicitely installed.") *> someArgs') files :: Parser PacmanOp files = bigF *> (Files <$> fmap S.fromList (many mods)) where bigF = flag' () (long "files" <> short 'F' <> help "Interact with the file database.") mods = lst <|> own <|> sch <|> rgx <|> rfr <|> mch lst = FilesList <$> (flag' () (long "list" <> short 'l' <> hidden <> help "List the files owned by given packages.") *> someArgs') own = FilesOwns <$> strOption (long "owns" <> short 'o' <> metavar "FILE" <> hidden <> help "Query the package that owns FILE.") sch = FilesSearch <$> strOption (long "search" <> short 's' <> metavar "FILE" <> hidden <> help "Find package files that match the given FILEname.") rgx = flag' FilesRegex (long "regex" <> short 'x' <> hidden <> help "Interpret the input of -Fs as a regex.") rfr = flag' FilesRefresh (long "refresh" <> short 'y' <> hidden <> help "Download fresh package databases.") mch = flag' FilesMachineReadable (long "machinereadable" <> hidden <> help "Produce machine-readable output.") queries :: Parser PacmanOp queries = bigQ *> (Query <$> (fmap Right query <|> fmap Left mods)) where bigQ = flag' () (long "query" <> short 'Q' <> help "Interact with the local package database.") query = curry (second (S.map PkgName)) <$> queryFilters <*> manyArgs mods = chl <|> gps <|> inf <|> lst <|> own <|> fls <|> sch <|> chk chl = QueryChangelog <$> (flag' () (long "changelog" <> short 'c' <> hidden <> help "View a package's changelog.") *> someArgs') gps = QueryGroups <$> (flag' () (long "groups" <> short 'g' <> hidden <> help "View all members of a package group.") *> someArgs') inf = QueryInfo <$> (flag' () (long "info" <> short 'i' <> hidden <> help "View package information.") *> someArgs') lst = QueryList <$> (flag' () (long "list" <> short 'l' <> hidden <> help "List files owned by a package.") *> someArgs') chk = QueryCheck <$> (flag' () (long "check" <> short 'k' <> hidden <> help "Check that package files exist.") *> someArgs') own = QueryOwns <$> (flag' () (long "owns" <> short 'o' <> hidden <> help "Find the package some file belongs to.") *> someArgs') fls = QueryFile <$> (flag' () (long "file" <> short 'p' <> hidden <> help "Query a package file.") *> someArgs') sch = QuerySearch <$> strOption (long "search" <> short 's' <> metavar "REGEX" <> hidden <> help "Search the local database.") queryFilters :: Parser (S.Set QueryFilter) queryFilters = S.fromList <$> many (dps <|> exp <|> frg <|> ntv <|> urq <|> upg) where dps = flag' QueryDeps (long "deps" <> short 'd' <> hidden <> help "[filter] Only list packages installed as deps.") exp = flag' QueryExplicit (long "explicit" <> short 'e' <> hidden <> help "[filter] Only list explicitly installed packages.") frg = flag' QueryForeign (long "foreign" <> short 'm' <> hidden <> help "[filter] Only list AUR packages.") ntv = flag' QueryNative (long "native" <> short 'n' <> hidden <> help "[filter] Only list official packages.") urq = flag' QueryUnrequired (long "unrequired" <> short 't' <> hidden <> help "[filter] Only list packages not required as a dependency to any other.") upg = flag' QueryUpgrades (long "upgrades" <> short 'u' <> hidden <> help "[filter] Only list outdated packages.") remove :: Parser PacmanOp remove = bigR *> (Remove <$> mods <*> somePkgs) where bigR = flag' () (long "remove" <> short 'R' <> help "Uninstall packages.") mods = S.fromList <$> many (cascade <|> nosave <|> recurse <|> unneeded) cascade = flag' RemoveCascade (long "cascade" <> short 'c' <> hidden <> help "Remove packages and all others that depend on them.") nosave = flag' RemoveNoSave (long "nosave" <> short 'n' <> hidden <> help "Remove configuration files as well.") recurse = flag' RemoveRecursive (long "recursive" <> short 's' <> hidden <> help "Remove unneeded dependencies.") unneeded = flag' RemoveUnneeded (long "unneeded" <> short 'u' <> hidden <> help "Remove unneeded packages.") sync :: Parser PacmanOp sync = bigS *> (Sync <$> (fmap (Right . S.map PkgName) manyArgs <|> fmap Left mods) <*> (S.fromList <$> many (ref <|> ign <|> igg))) where bigS = flag' () (long "sync" <> short 'S' <> help "Install official packages.") ref = flag' SyncRefresh (long "refresh" <> short 'y' <> hidden <> help "Update the package database.") mods = cln <|> gps <|> inf <|> lst <|> sch <|> upg <|> dnl cln = flag' SyncClean (long "clean" <> short 'c' <> hidden <> help "Remove old packages from the cache.") gps = SyncGroups <$> (flag' () (long "groups" <> short 'g' <> hidden <> help "View members of a package group.") *> someArgs') inf = SyncInfo <$> (flag' () (long "info" <> short 'i' <> hidden <> help "View package information.") *> someArgs') lst = SyncList <$> strOption (long "list" <> short 'l' <> metavar "REPO" <> hidden <> help "List the packages in a REPO.") sch = SyncSearch <$> strOption (long "search" <> short 's' <> metavar "REGEX" <> hidden <> help "Search the official package repos.") upg = SyncUpgrade <$> (flag' () (long "sysupgrade" <> short 'u' <> hidden <> help "Upgrade installed packages.") *> manyArgs') dnl = SyncDownload <$> (flag' () (long "downloadonly" <> short 'w' <> hidden <> help "Download package tarballs.") *> someArgs') ign = SyncIgnore . S.fromList . map PkgName . T.split (== ',') <$> strOption (long "ignore" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore given packages.") igg = SyncIgnoreGroup . S.fromList . map PkgGroup . T.split (== ',') <$> strOption (long "ignoregroup" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore packages from the given groups.") misc :: Parser (S.Set MiscOp) misc = S.fromList <$> many (ar <|> dbp <|> roo <|> ver <|> gpg <|> hd <|> con <|> dbo <|> nop <|> nos <|> pf <|> nod <|> prt <|> asi) where ar = MiscArch . fromAbsoluteFilePath <$> strOption (long "arch" <> metavar "ARCH" <> hidden <> help "Use an alternate architecture.") dbp = MiscDBPath . fromAbsoluteFilePath <$> strOption (long "dbpath" <> short 'b' <> metavar "PATH" <> hidden <> help "Use an alternate database location.") roo = MiscRoot . fromAbsoluteFilePath <$> strOption (long "root" <> short 'r' <> metavar "PATH" <> hidden <> help "Use an alternate installation root.") ver = flag' MiscVerbose (long "verbose" <> short 'v' <> hidden <> help "Be more verbose.") gpg = MiscGpgDir . fromAbsoluteFilePath <$> strOption (long "gpgdir" <> metavar "PATH" <> hidden <> help "Use an alternate GnuGPG directory.") hd = MiscHookDir . fromAbsoluteFilePath <$> strOption (long "hookdir" <> metavar "PATH" <> hidden <> help "Use an alternate hook directory.") con = flag' MiscConfirm (long "confirm" <> hidden <> help "Always ask for confirmation.") dbo = flag' MiscDBOnly (long "dbonly" <> hidden <> help "Only modify database entries, not package files.") nop = flag' MiscNoProgress (long "noprogressbar" <> hidden <> help "Don't show a progress bar when downloading.") nos = flag' MiscNoScriptlet (long "noscriptlet" <> hidden <> help "Don't run available install scriptlets.") pf = MiscPrintFormat <$> strOption (long "print-format" <> metavar "STRING" <> hidden <> help "Specify how targets should be printed.") nod = flag' MiscNoDeps (long "nodeps" <> short 'd' <> hidden <> help "Skip dependency version checks.") prt = flag' MiscPrint (long "print" <> short 'p' <> hidden <> help "Print the targets instead of performing the operation.") asi = MiscAssumeInstalled <$> strOption (long "assume-installed" <> metavar "" <> hidden <> help "Add a virtual package to satisfy dependencies.") testdeps :: Parser PacmanOp testdeps = bigT *> (TestDeps <$> someArgs) where bigT = flag' () (long "deptest" <> short 'T' <> help "Test dependencies - useful for scripts.") upgrades :: Parser PacmanOp upgrades = bigU *> (Upgrade <$> (S.fromList <$> many mods) <*> somePkgs) where bigU = flag' () (long "upgrade" <> short 'U' <> help "Install given package files.") mods = asd <|> ase <|> ign <|> igg asd = flag' UpgradeAsDeps (long "asdeps" <> hidden) ase = flag' UpgradeAsExplicit (long "asexplicit" <> hidden) ign = UpgradeIgnore . S.fromList . map PkgName . T.split (== ',') <$> strOption (long "ignore" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore given packages.") igg = UpgradeIgnoreGroup . S.fromList . map PkgGroup . T.split (== ',') <$> strOption (long "ignoregroup" <> metavar "PKG(,PKG,...)" <> hidden <> help "Ignore packages from the given groups.") somePkgs :: Parser (NESet PkgName) somePkgs = NES.fromList . fromJust . NEL.nonEmpty . map PkgName <$> some (argument str (metavar "PACKAGES")) -- | Same as `someArgs`, but the help message "brief display" won't show PACKAGES. somePkgs' :: Parser (NESet PkgName) somePkgs' = NES.fromList . fromJust . NEL.nonEmpty . map PkgName <$> some (argument str (metavar "PACKAGES" <> hidden)) -- | One or more arguments. someArgs :: Parser (NESet T.Text) someArgs = NES.fromList . fromJust . NEL.nonEmpty <$> some (argument str (metavar "PACKAGES")) -- | Same as `someArgs`, but the help message "brief display" won't show PACKAGES. someArgs' :: Parser (NESet T.Text) someArgs' = NES.fromList . fromJust . NEL.nonEmpty <$> some (argument str (metavar "PACKAGES" <> hidden)) -- | Zero or more arguments. manyArgs :: Parser (S.Set T.Text) manyArgs = S.fromList <$> many (argument str (metavar "PACKAGES")) -- | Zero or more arguments. manyArgs' :: Parser (S.Set T.Text) manyArgs' = S.fromList <$> many (argument str (metavar "PACKAGES" <> hidden)) language :: Parser Language language = foldr1 (<|>) $ map (\(f, v) -> flag' v (long f <> hidden)) langs where langs = [ ( "japanese", Japanese ), ( "日本語", Japanese ) , ( "polish", Polish ), ( "polski", Polish ) , ( "croatian", Croatian ), ( "hrvatski", Croatian ) , ( "swedish", Swedish ), ( "svenska", Swedish ) , ( "german", German ), ( "deutsch", German ) , ( "spanish", Spanish ), ( "español", Spanish ) , ( "portuguese", Portuguese ), ( "português", Portuguese ) , ( "french", French), ( "français", French ) , ( "russian", Russian ), ( "русский", Russian ) , ( "italian", Italian ), ( "italiano", Italian ) , ( "serbian", Serbian ), ( "српски", Serbian ) , ( "norwegian", Norwegian ), ( "norsk", Norwegian ) , ( "indonesian", Indonesia ) , ( "chinese", Chinese ), ( "中文", Chinese ) , ( "esperanto", Esperanto ) ]