aura-2.0.2: exec/Flags.hs

{-# 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 "<package=version>" <> 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 ) ]