aura 2.2.1 → 2.3.0

raw patch · 36 files changed

+1384/−1056 lines, 36 filesdep +hashabledep −aeson-prettydep −errorsdep −generic-lensdep ~aurPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable

Dependencies removed: aeson-pretty, errors, generic-lens, microlens-ghc, mwc-random, nonempty-containers, paths, pretty-simple, semigroupoids, servant-client-core, these, witherable-class

Dependency ranges changed: aur

API changes (from Hackage documentation)

Files

• CHANGELOG.md +62/−7
• aura.cabal +5/−18
• doc/aura.8 +2/−0
• exec/Flags.hs +99/−92
• exec/Settings.hs +4/−3
• exec/aura.hs +26/−19
• lib/Aura/Build.hs +57/−56
• lib/Aura/Cache.hs +10/−14
• lib/Aura/Commands/A.hs +47/−48
• lib/Aura/Commands/B.hs +12/−11
• lib/Aura/Commands/C.hs +60/−47
• lib/Aura/Commands/L.hs +7/−13
• lib/Aura/Commands/O.hs +3/−7
• lib/Aura/Core.hs +42/−33
• lib/Aura/Dependencies.hs +56/−49
• lib/Aura/Diff.hs +5/−4
• lib/Aura/IO.hs +105/−0
• lib/Aura/Install.hs +123/−101
• lib/Aura/Languages.hs +143/−81
• lib/Aura/Languages/Fields.hs +19/−14
• lib/Aura/Logo.hs +2/−1
• lib/Aura/MakePkg.hs +24/−23
• lib/Aura/Packages/AUR.hs +40/−40
• lib/Aura/Packages/Repository.hs +36/−22
• lib/Aura/Pacman.hs +19/−17
• lib/Aura/Pkgbuild/Base.hs +6/−5
• lib/Aura/Pkgbuild/Editing.hs +17/−19
• lib/Aura/Pkgbuild/Fetch.hs +1/−3
• lib/Aura/Pkgbuild/Records.hs +4/−9
• lib/Aura/Pkgbuild/Security.hs +83/−11
• lib/Aura/Settings.hs +15/−10
• lib/Aura/Shell.hs +71/−0
• lib/Aura/State.hs +18/−22
• lib/Aura/Types.hs +91/−77
• lib/Aura/Utils.hs +68/−178
• test/Test.hs +2/−2

@@ -1,40 +1,95 @@ # Aura Changelog +## 2.3.0 (2020-04-22)++#### Added++- Allow `--asdeps` to be passed to `-A` commands.+- `-y` can be passed to `-A` commands again, like `-Ayu`.+- Dutch translations. Thank you, Joris Blanken!++#### Changed++- ~15% reduction in binary size and much faster compiles due to removal of+  unnecessary dependencies.+- `-Cc` now reports how much storage space was cleared.+- A few more messages when using `--log-level=debug`.++#### Removed++- `makepkgConfFile` wasn't being used anywhere.++#### Fixed++- A bug involving multiple prompts appearing at the same time when more than one+  package needs a custom provider selection.+  [#541](https://github.com/fosskers/aura/issues/541)+- A bug involving the `+` character appearing in package names, like `crypto++`.+  [#520](https://github.com/fosskers/aura/issues/520)+- A regression where the name of a parent package wouldn't be displayed when a+  dependency couldn't be found.+  [#513](https://github.com/fosskers/aura/issues/513)+ ## 2.2.1 (2020-03-01) -- Pass the Pacman flag `--overwrite` through properly.+#### Changed+ - Further improved Italian translations. +#### Fixed++- Pass the Pacman flag `--overwrite` through properly.+ ## 2.2.0 (2020-02-25) -- **New Feature:**: `--log-level` flag. Setting this to `debug` will give you-  some verbose logging output. This is different from the usual `-x` behaviour.-- **Bug Fix:** Users with many AUR packages installed will no longer see-  mysterious AUR connection failures.-  ([#528](https://github.com/fosskers/aura/issues/528))+#### Added++- `--log-level` flag. Setting this to `debug` will give you some verbose logging+  output. This is different from the usual `-x` behaviour.++#### Changed+ - Updated Italian translations. Grazie, Cristian Tentella! - Support for GHC 8.8.2. +#### Fixed++- Users with many AUR packages installed will no longer see mysterious AUR+  connection failures. ([#528](https://github.com/fosskers/aura/issues/528))+ ## 2.1.0 (2020-02-17) +#### Added+ - Reinstated `-Aw`, which downloads a snapshot tarball of an AUR package.  ## 2.0.6 (2020-02-16) +#### Fixed+ - Fixed the broken `-S`.  ## 2.0.5 (2020-02-16) +#### Fixed+ - Fixed a bug that prevented `-Syuu` and `-Scc`.  ## 2.0.4 (2020-02-08) +#### Changed+ - Removed `fused-effects` dependency in favour of `rio` to simplify code.  ## 2.0.3 +#### Changed+ - Updated Spanish translations. Thanks to Max Ferrer!-- Fixed bug #543. Thanks to Alexey Kotlyarov!++#### Fixed++- Bug #543 involving locales. Thanks to Alexey Kotlyarov!  ## 2.0.2 

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               aura-version:            2.2.1+version:            2.3.0 synopsis:           A secure package manager for Arch Linux and the AUR. description:   Aura is a package manager for Arch Linux. It connects to both the@@ -27,11 +27,7 @@   default-language:   Haskell2010   default-extensions:     NoImplicitPrelude-    BangPatterns-    LambdaCase     OverloadedStrings-    TupleSections-    TypeApplications    ghc-options:     -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns@@ -43,16 +39,13 @@     , bytestring  ^>=0.10     , containers  ^>=0.6     , microlens   ^>=0.4-    , paths       ^>=0.2     , rio         ^>=0.1.13     , text        ^>=1.2     , versions    ^>=3.5  common libexec   build-depends:-    , errors                       ^>=2.3     , http-client                  >=0.5 && <0.7-    , nonempty-containers          ^>=0.3     , prettyprinter                >=1.2 && <1.7     , prettyprinter-ansi-terminal  ^>=1.1     , transformers                 ^>=0.5@@ -74,6 +67,7 @@     Aura.Dependencies     Aura.Diff     Aura.Install+    Aura.IO     Aura.Languages     Aura.Languages.Fields     Aura.Logo@@ -87,31 +81,25 @@     Aura.Pkgbuild.Records     Aura.Pkgbuild.Security     Aura.Settings+    Aura.Shell     Aura.State     Aura.Types     Aura.Utils    build-depends:     , aeson             >=1.2  && <1.5-    , aeson-pretty      ^>=0.8     , algebraic-graphs  >=0.1  && <0.6-    , aur               ^>=6.3+    , aur               ^>=7.0     , filepath          ^>=1.4-    , generic-lens      >=1.1  && <1.3+    , hashable          ^>= 1.3     , http-types        >=0.9  && <0.13     , language-bash     >=0.8  && <0.10     , megaparsec        >=7    && <9-    , microlens-ghc     ^>=0.4-    , mwc-random        ^>=0.14     , network-uri       ^>=2.6     , scheduler         >=1.1  && <1.5-    , semigroupoids     >=5.2  && <5.4-    , servant-client-core >= 0.16 && < 0.18     , stm               ^>=2.5-    , these             ^>=1.0     , time              >=1.8  && <1.10     , unliftio          ^>=0.2-    , witherable-class  ^>=0  executable aura   import:         commons, libexec@@ -126,7 +114,6 @@     , aura     , http-client-tls       ^>=0.3     , optparse-applicative  >=0.14 && <0.16-    , pretty-simple         >=2.1  && <3.3  test-suite aura-test   import:         commons

@@ -423,3 +423,5 @@ ( Japanese   ) Onoue Takuro .P ( Esperanto  ) Zachary "Ghosy" Matthews+.P+(   Dutch    ) Joris Blanken

@@ -1,7 +1,7 @@ module Flags   ( Program(..), opts-  , PacmanOp( Sync ), SyncOp( SyncUpgrade ), MiscOp-  , AuraOp(..), _AurSync, _AurIgnore, _AurIgnoreGroup+  , PacmanOp( Sync ), SyncOp( SyncUpgrade ), SyncSwitch(..), MiscOp+  , AuraOp(..), AurSwitch(..), _AurSync, _AurIgnore, _AurIgnoreGroup   , AurOp(..), BackupOp(..), CacheOp(..), LogOp(..), OrphanOp(..)   ) where @@ -9,16 +9,15 @@ import           Aura.Pacman (defaultLogFile, pacmanConfFile) import           Aura.Settings import           Aura.Types-import           Data.Set.NonEmpty (NESet)-import qualified Data.Set.NonEmpty as NES import           Lens.Micro (Traversal') import           Options.Applicative import           RIO hiding (exp, log)+import           RIO.FilePath import           RIO.List.Partial (foldr1)-import qualified RIO.NonEmpty.Partial as NEL+import qualified RIO.NonEmpty as NEL+import qualified RIO.NonEmpty.Partial as NELP import qualified RIO.Set as S import qualified RIO.Text as T-import           System.Path (Absolute, Path, fromAbsoluteFilePath, toFilePath)  --- @@ -37,13 +36,13 @@   } deriving (Show)  -- | Inherited operations that are fed down to Pacman.-data PacmanOp = Database (Either DatabaseOp (NESet PkgName))+data PacmanOp = Database (Either DatabaseOp (NonEmpty PkgName))               | Files    (Set FilesOp)               | Query    (Either QueryOp (Set QueryFilter, Set PkgName))-              | Remove   (Set RemoveOp) (NESet PkgName)+              | Remove   (Set RemoveOp) (NonEmpty PkgName)               | Sync     (Either (NonEmpty SyncOp) (Set PkgName)) (Set SyncSwitch)-              | TestDeps (NESet Text)-              | Upgrade  (Set UpgradeSwitch) (NESet PkgName)+              | TestDeps (NonEmpty Text)+              | Upgrade  (Set UpgradeSwitch) (NonEmpty PkgName)               deriving (Show)  instance Flagable PacmanOp where@@ -59,8 +58,8 @@   asFlag (Upgrade s ps)           = "-U" : asFlag s ++ asFlag ps  data DatabaseOp = DBCheck-                | DBAsDeps     (NESet Text)-                | DBAsExplicit (NESet Text)+                | DBAsDeps     (NonEmpty Text)+                | DBAsExplicit (NonEmpty Text)                 deriving (Show)  instance Flagable DatabaseOp where@@ -68,7 +67,7 @@   asFlag (DBAsDeps ps)     = "--asdeps" : asFlag ps   asFlag (DBAsExplicit ps) = "--asexplicit" : asFlag ps -data FilesOp = FilesList  (NESet Text)+data FilesOp = FilesList  (NonEmpty Text)              | FilesOwns   Text              | FilesSearch Text              | FilesRegex@@ -84,13 +83,13 @@   asFlag FilesRefresh         = ["--refresh"]   asFlag FilesMachineReadable = ["--machinereadable"] -data QueryOp = QueryChangelog (NESet Text)-             | QueryGroups    (NESet Text)-             | QueryInfo      (NESet Text)-             | QueryCheck     (NESet Text)-             | QueryList      (NESet Text)-             | QueryOwns      (NESet Text)-             | QueryFile      (NESet Text)+data QueryOp = QueryChangelog (NonEmpty Text)+             | QueryGroups    (NonEmpty Text)+             | QueryInfo      (NonEmpty Text)+             | QueryCheck     (NonEmpty Text)+             | QueryList      (NonEmpty Text)+             | QueryOwns      (NonEmpty Text)+             | QueryFile      (NonEmpty Text)              | QuerySearch     Text              deriving (Show) @@ -133,12 +132,12 @@   asFlag RemoveUnneeded  = ["--unneeded"]  data SyncOp = SyncClean-            | SyncGroups   (NESet Text)-            | SyncInfo     (NESet Text)+            | SyncGroups   (NonEmpty Text)+            | SyncInfo     (NonEmpty Text)             | SyncList      Text             | SyncSearch    Text             | SyncUpgrade  (Set Text)-            | SyncDownload (NESet Text)+            | SyncDownload (NonEmpty Text)             deriving (Eq, Ord, Show)  instance Flagable SyncOp where@@ -177,32 +176,32 @@   asFlag (UpgradeOverwrite glob) = "--overwrite" : asFlag glob  -- | Flags common to several Pacman operations.-data MiscOp = MiscArch    (Path Absolute)+data MiscOp = MiscArch    FilePath             | MiscAssumeInstalled Text             | MiscColor   Text             | MiscConfirm             | MiscDBOnly-            | MiscDBPath  (Path Absolute)-            | MiscGpgDir  (Path Absolute)-            | MiscHookDir (Path Absolute)+            | MiscDBPath  FilePath+            | MiscGpgDir  FilePath+            | MiscHookDir FilePath             | MiscNoDeps             | MiscNoProgress             | MiscNoScriptlet             | MiscPrint             | MiscPrintFormat Text-            | MiscRoot    (Path Absolute)+            | MiscRoot    FilePath             | MiscVerbose             deriving (Eq, Ord, Show)  instance Flagable MiscOp where-  asFlag (MiscArch p)            = ["--arch", T.pack $ toFilePath p]+  asFlag (MiscArch p)            = ["--arch", T.pack 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 (MiscDBPath p)          = ["--dbpath", T.pack p]+  asFlag (MiscGpgDir p)          = ["--gpgdir", T.pack p]+  asFlag (MiscHookDir p)         = ["--hookdir", T.pack p]   asFlag (MiscPrintFormat s)     = ["--print-format", s]-  asFlag (MiscRoot p)            = ["--root", T.pack $ toFilePath p]+  asFlag (MiscRoot p)            = ["--root", T.pack p]   asFlag MiscConfirm             = ["--confirm"]   asFlag MiscDBOnly              = ["--dbonly"]   asFlag MiscNoDeps              = ["--nodeps"]@@ -212,9 +211,9 @@   asFlag MiscVerbose             = ["--verbose"]  -- | Operations unique to Aura.-data AuraOp = AurSync (Either AurOp (NESet PkgName)) (Set AurSwitch)+data AuraOp = AurSync (Either AurOp (NonEmpty PkgName)) (Set AurSwitch)             | Backup  (Maybe  BackupOp)-            | Cache   (Either CacheOp (NESet PkgName))+            | Cache   (Either CacheOp (NonEmpty PkgName))             | Log     (Maybe  LogOp)             | Orphans (Maybe  OrphanOp)             | Version@@ -226,17 +225,18 @@ _AurSync f (AurSync o s) = AurSync o <$> f s _AurSync _ x             = pure x -data AurOp = AurDeps     (NESet PkgName)-           | AurInfo     (NESet PkgName)-           | AurPkgbuild (NESet PkgName)+data AurOp = AurDeps     (NonEmpty PkgName)+           | AurInfo     (NonEmpty PkgName)+           | AurPkgbuild (NonEmpty PkgName)            | AurSearch    Text            | AurUpgrade  (Set PkgName)-           | AurJson     (NESet PkgName)-           | AurTarball  (NESet PkgName)+           | AurJson     (NonEmpty PkgName)+           | AurTarball  (NonEmpty PkgName)            deriving (Show)  data AurSwitch = AurIgnore      (Set PkgName)                | AurIgnoreGroup (Set PkgGroup)+               | AurRepoSync                deriving (Eq, Ord, Show)  _AurIgnore :: Traversal' AurSwitch (Set PkgName)@@ -249,14 +249,15 @@  data BackupOp = BackupClean Word | BackupRestore | BackupList deriving (Show) -data CacheOp = CacheBackup (Path Absolute) | CacheClean Word | CacheCleanNotSaved | CacheSearch Text deriving (Show)+data CacheOp = CacheBackup FilePath | CacheClean Word | CacheCleanNotSaved | CacheSearch Text deriving (Show) -data LogOp = LogInfo (NESet PkgName) | LogSearch Text deriving (Show)+data LogOp = LogInfo (NonEmpty PkgName) | LogSearch Text deriving (Show) -data OrphanOp = OrphanAbandon | OrphanAdopt (NESet PkgName) deriving (Show)+data OrphanOp = OrphanAbandon | OrphanAdopt (NonEmpty PkgName) deriving (Show)  opts :: ParserInfo Program-opts = info (program <**> helper) (fullDesc <> header "Aura - Package manager for Arch Linux and the AUR.")+opts = info (program <**> helper)+  (fullDesc <> header "Aura - Package manager for Arch Linux and the AUR.")  program :: Parser Program program = Program@@ -272,7 +273,7 @@ aursync :: Parser AuraOp aursync = bigA *>   (AurSync-   <$> (fmap (Right . NES.fromList . fmap (PkgName . T.toLower) . NES.toList) someArgs <|> fmap Left mods)+   <$> (fmap (Right . NEL.map (PkgName . T.toLower)) someArgs <|> fmap Left mods)    <*> (S.fromList <$> many switches)   )   where bigA    = flag' () (long "aursync" <> short 'A' <> help "Install packages from the AUR.")@@ -284,11 +285,12 @@         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')         tarball = AurTarball <$> (flag' () (long "downloadonly" <> short 'w' <> hidden <> help "Download a package tarball.") *> 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.")+        switches = ign <|> igg <|> y+        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.")+        y    = flag' AurRepoSync (short 'y' <> hidden <> help "Do an -Sy before continuing.")  backups :: Parser AuraOp backups = bigB *> (Backup <$> optional mods)@@ -302,7 +304,7 @@ 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)+        backup = CacheBackup <$> option (eitherReader absFilePath) (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)@@ -336,7 +338,7 @@         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."))+        bp      = option (eitherReader absFilePath) (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."))@@ -344,7 +346,7 @@           <|> pure None  buildSwitches :: Parser (Set BuildSwitch)-buildSwitches = S.fromList <$> many (lv <|> dmd <|> dsm <|> dpb <|> rbd <|> he <|> ucp <|> dr <|> sa <|> fo <|> npc)+buildSwitches = S.fromList <$> many (lv <|> dmd <|> dsm <|> dpb <|> rbd <|> he <|> ucp <|> dr <|> sa <|> fo <|> npc <|> asd)   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.")@@ -356,17 +358,18 @@         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.")+        asd = flag' AsDeps (long "asdeps" <> hidden <> help "All installed packages will be marked as dependencies.")  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."))+  where cap = fmap Right+                   (option (eitherReader absFilePath) (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."))+        cop = fmap Right+                   (option (eitherReader absFilePath) (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."))+        lfp = fmap Right+                   (option (eitherReader absFilePath) (long "logfile"  <> hidden <> help "Use an alternate Pacman log."))               <|> pure (Left defaultLogFile)  commonSwitches :: Parser (Set CommonSwitch)@@ -436,7 +439,7 @@ 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 = NEL.fromList <$> some (cln <|> gps <|> inf <|> lst <|> sch <|> upg <|> dnl)+        mods = NELP.fromList <$> some (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')@@ -451,17 +454,17 @@  misc :: Parser (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.")+  where ar  = MiscArch+              <$> option (eitherReader absFilePath) (long "arch" <> metavar "ARCH" <> hidden <> help "Use an alternate architecture.")+        dbp = MiscDBPath+              <$> option (eitherReader absFilePath) (long "dbpath" <> short 'b' <> metavar "PATH" <> hidden <> help "Use an alternate database location.")+        roo = MiscRoot+              <$> option (eitherReader absFilePath) (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.")+        gpg = MiscGpgDir+              <$> option (eitherReader absFilePath) (long "gpgdir" <> metavar "PATH" <> hidden <> help "Use an alternate GnuGPG directory.")+        hd  = MiscHookDir+              <$> option (eitherReader absFilePath) (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.")@@ -486,20 +489,20 @@         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 . NEL.fromList . map PkgName <$> some (argument str (metavar "PACKAGES"))+somePkgs :: Parser (NonEmpty PkgName)+somePkgs = NELP.fromList . 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 . NEL.fromList . map PkgName <$> some (argument str (metavar "PACKAGES" <> hidden))+somePkgs' :: Parser (NonEmpty PkgName)+somePkgs' = NELP.fromList . map PkgName <$> some (argument str (metavar "PACKAGES" <> hidden))  -- | One or more arguments.-someArgs :: Parser (NESet Text)-someArgs = NES.fromList . NEL.fromList <$> some (argument str (metavar "PACKAGES"))+someArgs :: Parser (NonEmpty Text)+someArgs = NEL.nub . NELP.fromList <$> some (argument str (metavar "PACKAGES"))  -- | Same as `someArgs`, but the help message "brief display" won't show PACKAGES.-someArgs' :: Parser (NESet Text)-someArgs' = NES.fromList . NEL.fromList <$> some (argument str (metavar "PACKAGES" <> hidden))+someArgs' :: Parser (NonEmpty Text)+someArgs' = NEL.nub . NELP.fromList <$> some (argument str (metavar "PACKAGES" <> hidden))  -- | Zero or more arguments. manyArgs :: Parser (Set Text)@@ -511,21 +514,22 @@  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 )+  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 ) ]+                , ( "chinese",    Chinese ),    ( "中文",         Chinese )+                , ( "esperanto",  Esperanto )+                , ( "dutch",      Dutch ),      ( "nederlands", Dutch ) ]  logLevel :: Parser LogLevel logLevel = option (eitherReader l)@@ -538,3 +542,6 @@     l "warn"  = Right LevelWarn     l "error" = Right LevelError     l _       = Left "Must be one of debug|info|warn|error"++absFilePath :: String -> Either String FilePath+absFilePath fp = bool (Left $ "Not absolute: " <> fp) (Right fp) $ isAbsolute fp

@@ -29,10 +29,10 @@ import           Aura.Packages.Repository (pacmanRepo) import           Aura.Pacman import           Aura.Settings+import           Aura.Shell import           Aura.Types-import           Aura.Utils+import           Aura.Utils (nes) import           Data.Bifunctor (Bifunctor(..))-import qualified Data.Set.NonEmpty as NES import           Flags import           Lens.Micro (folded, (^..), _Right) import           Network.HTTP.Client (newManager)@@ -57,7 +57,7 @@   environment <- M.fromList . map (bimap T.pack T.pack) <$> getEnvironment   manager     <- newManager tlsManagerSettings   isTerm      <- hIsTerminalDevice stdout-  fromGroups  <- maybe (pure S.empty) groupPackages . NES.nonEmptySet+  fromGroups  <- maybe (pure S.empty) groupPackages . nes     $ getIgnoredGroups confFile <> igg   let language = checkLang lng environment   bu <- maybe (throwM $ Failure whoIsBuildUser_1) pure@@ -79,6 +79,7 @@                  , logPathOf   =                      first (\x -> fromMaybe x $ getLogFilePath confFile) $ logPathOf co }           , buildConfigOf = bc { buildUserOf = Just bu}+          , logLevelOf = ll           , logFuncOf = logFunc }     f (Env repos ss) 

@@ -1,6 +1,4 @@-{-# LANGUAGE CPP              #-}-{-# LANGUAGE DataKinds        #-}-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-}  {- @@ -42,23 +40,22 @@ import           Aura.Commands.L as L import           Aura.Commands.O as O import           Aura.Core+import           Aura.IO import           Aura.Languages import           Aura.Logo import           Aura.Pacman import           Aura.Settings import           Aura.Types-import           Aura.Utils (putTextLn)+import           Aura.Utils (nes) import           Data.Bifunctor (first)-import qualified Data.Set.NonEmpty as NES import           Data.Text.Prettyprint.Doc import           Data.Text.Prettyprint.Doc.Render.Terminal import           Flags import           Options.Applicative (execParser) import           RIO hiding (first)+import qualified RIO.Set as S import           Settings-import           System.Path (toFilePath) import           System.Process.Typed (proc, runProcess)-import           Text.Pretty.Simple (pPrintNoColor)  --- @@ -85,27 +82,32 @@     f (Failure fl) = fl $ langOf (settings env)  exit :: Settings -> Either (Doc AnsiStyle) () -> IO a-exit ss (Left e)  = scold ss e *> exitFailure+exit ss (Left e)  = scold ss (const e) *> exitFailure exit _  (Right _) = exitSuccess  execOpts :: Either (PacmanOp, Set MiscOp) AuraOp -> RIO Env () execOpts ops = do   logDebug "Interpreting CLI options."   ss <- asks settings-  when (shared ss Debug) $ do-    liftIO . pPrintNoColor $ ops-    liftIO . pPrintNoColor $ buildConfigOf ss-    liftIO . pPrintNoColor $ commonConfigOf ss-  let p (ps, ms) = liftIO . pacman $+  when (logLevelOf ss == LevelDebug) $ do+    logDebug $ displayShow ops+    logDebug . displayShow $ buildConfigOf ss+    logDebug . displayShow $ commonConfigOf ss++  let p :: (PacmanOp, Set MiscOp) -> RIO Env ()+      p (ps, ms) = liftIO . pacman $         asFlag ps         ++ foldMap asFlag ms         ++ asFlag (commonConfigOf ss)         ++ bool [] ["--quiet"] (switch ss LowVerbosity)+   case ops of     Left o@(Sync (Left sops) _, _)-      | any isUpgrade sops -> sudo (liftIO $ B.saveState ss) *> p o+      | any isUpgrade sops -> sudo (liftIO $ B.saveState ss) >> p o     Left o -> logDebug "Performing a pacman operation." >> p o-    Right (AurSync o _) ->+    Right (AurSync o sws) -> do+      when (any isYWithA sws)+        $ sudo $ p (Sync (Right mempty) (S.singleton SyncRefresh), mempty)       case o of         Right ps              -> bool (trueRoot . sudo) id (switch ss DryRun) $ A.install ps         Left (AurDeps ps)     -> A.displayPkgDeps ps@@ -136,7 +138,7 @@     Right (Orphans o) ->       case o of         Nothing               -> liftIO O.displayOrphans-        Just OrphanAbandon    -> sudo $ liftIO orphans >>= traverse_ removePkgs . NES.nonEmptySet+        Just OrphanAbandon    -> sudo $ liftIO orphans >>= traverse_ removePkgs . nes         Just (OrphanAdopt ps) -> O.adoptPkg ps     Right Version   -> liftIO $ versionInfo >>= animateVersionMsg ss auraVersion     Right Languages -> displayOutputLanguages@@ -146,13 +148,18 @@ isUpgrade (SyncUpgrade _) = True isUpgrade _               = False +-- | Did the user supply a `-y` alongside an `-A` command?+isYWithA :: AurSwitch -> Bool+isYWithA AurRepoSync = True+isYWithA _           = False+ displayOutputLanguages :: RIO Env () displayOutputLanguages = do   ss <- asks settings-  liftIO . notify ss . displayOutputLanguages_1 $ langOf ss-  liftIO $ traverse_ (putTextLn . tshow) [English ..]+  notify ss displayOutputLanguages_1+  traverse_ (putTextLn . tshow) [English ..]  viewConfFile :: RIO Env () viewConfFile = do   pth <- asks (either id id . configPathOf . commonConfigOf . settings)-  void . runProcess $ proc "less" [toFilePath pth]+  void . runProcess $ proc "less" [pth]

@@ -1,6 +1,3 @@-{-# LANGUAGE DataKinds        #-}-{-# LANGUAGE FlexibleContexts #-}- -- | -- Module    : Aura.Build -- Copyright : (c) Colin Woodbury, 2012 - 2020@@ -15,120 +12,124 @@   ) where  import           Aura.Core+import           Aura.IO import           Aura.Languages import           Aura.MakePkg import           Aura.Packages.AUR (clone) import           Aura.Pacman (pacman) import           Aura.Settings+import           Aura.Shell (chown) import           Aura.Types import           Aura.Utils import           Control.Monad.Trans.Except-import           Data.Generics.Product (field)-import           Data.Semigroup.Foldable (fold1)-import           Data.Set.NonEmpty (NESet)-import qualified Data.Set.NonEmpty as NES-import           Data.Witherable.Class (wither)+import           Data.Hashable (hash) import           RIO-import           RIO.Directory (setCurrentDirectory)+import           RIO.Directory+import           RIO.FilePath import qualified RIO.NonEmpty as NEL+import           RIO.Partial (fromJust) import qualified RIO.Set as S import qualified RIO.Text as T-import           System.Path-import           System.Path.IO+import           RIO.Time import           System.Process.Typed-import           System.Random.MWC (GenIO, createSystemRandom, uniform)  --- -srcPkgStore :: Path Absolute-srcPkgStore = fromAbsoluteFilePath "/var/cache/aura/src"+srcPkgStore :: FilePath+srcPkgStore = "/var/cache/aura/src"  -- | Expects files like: \/var\/cache\/pacman\/pkg\/*.pkg.tar.xz-installPkgFiles :: NESet PackagePath -> RIO Env ()+installPkgFiles :: NonEmpty PackagePath -> RIO Env () installPkgFiles files = do   ss <- asks settings   liftIO $ checkDBLock ss-  liftIO . pacman $ ["-U"] <> map (T.pack . toFilePath . path) (toList files) <> asFlag (commonConfigOf ss)+  liftIO . pacman $ ["-U"] <> map (T.pack . ppPath) (toList files) <> asFlag (commonConfigOf ss)  -- | All building occurs within temp directories, -- or in a location specified by the user with flags.-buildPackages :: NESet Buildable -> RIO Env (NESet PackagePath)-buildPackages bs = do-  g <- liftIO createSystemRandom-  wither (build g) (toList bs) >>= maybe bad (pure . fold1) . NEL.nonEmpty-  where bad = throwM $ Failure buildFail_10+buildPackages :: NonEmpty Buildable -> RIO Env (NonEmpty PackagePath)+buildPackages bs = mapMaybeA build (NEL.toList bs) >>= maybe bad (pure . fold1) . NEL.nonEmpty+  where+    bad :: RIO Env a+    bad = throwM $ Failure buildFail_10  -- | Handles the building of Packages. Fails nicely. -- Assumed: All dependencies are already installed.-build :: GenIO -> Buildable -> RIO Env (Maybe (NESet PackagePath))-build g p = do-  ss     <- asks settings-  liftIO $ notify ss (buildPackages_1 (p ^. field @"name") (langOf ss)) *> hFlush stdout-  result <- liftIO $ build' ss g p+build :: Buildable -> RIO Env (Maybe (NonEmpty PackagePath))+build p = do+  logDebug $ "Building: " <> display (pnName $ bName p)+  ss <- asks settings+  notify ss (buildPackages_1 $ bName p) *> hFlush stdout+  result <- build' ss p   either buildFail (pure . Just) result  -- | Should never throw an IO Exception. In theory all errors -- will come back via the @Language -> String@ function.-build' :: Settings -> GenIO -> Buildable -> IO (Either Failure (NESet PackagePath))-build' ss g b = do+build' :: Settings -> Buildable -> RIO Env (Either Failure (NonEmpty PackagePath))+build' ss b = do   let pth = buildPathOf $ buildConfigOf ss-  createDirectoryIfMissing True pth-  setCurrentDirectory $ toFilePath pth-  buildDir <- randomDirName g b-  createDirectoryIfMissing True buildDir-  setCurrentDirectory $ toFilePath buildDir+  liftIO $ createDirectoryIfMissing True pth+  setCurrentDirectory pth+  buildDir <- liftIO $ randomDirName b+  liftIO $ createDirectoryIfMissing True buildDir+  setCurrentDirectory buildDir   runExceptT $ do     bs <- ExceptT $ cloneRepo b usr-    lift . setCurrentDirectory $ toFilePath bs-    lift $ overwritePkgbuild ss b-    pNames <- ExceptT $ makepkg ss usr-    paths  <- lift . fmap NES.fromList . traverse (moveToCachePath ss) $ NES.toList pNames-    lift . when (S.member AllSource . makepkgFlagsOf $ buildConfigOf ss) $+    liftIO $ setCurrentDirectory bs+    liftIO $ overwritePkgbuild ss b+    pNames <- ExceptT . liftIO $ makepkg ss usr+    paths  <- liftIO $ traverse (moveToCachePath ss) pNames+    liftIO . when (S.member AllSource . makepkgFlagsOf $ buildConfigOf ss) $       makepkgSource usr >>= traverse_ moveToSourcePath     pure paths-  where usr = fromMaybe (User "桜木花道") . buildUserOf $ buildConfigOf ss+  where+    usr :: User+    usr = fromMaybe (User "桜木花道") . buildUserOf $ buildConfigOf ss  -- | Create a temporary directory with a semi-random name based on -- the `Buildable` we're working with.-randomDirName :: GenIO -> Buildable -> IO (Path Absolute)-randomDirName g b = do+randomDirName :: Buildable -> IO FilePath+randomDirName b = do   pwd <- getCurrentDirectory-  v   <- uniform g :: IO Word-  let dir = T.unpack (b ^. field @"name" . field @"name") <> "-" <> show v-  pure $ pwd </> fromUnrootedFilePath dir+  UTCTime _ dt <- getCurrentTime+  let nh = hash . pnName $ bName b+      vh = hash $ bVersion b+      v  = abs $ nh + vh + floor dt+      dir = T.unpack (pnName $ bName b) <> "-" <> show v+  pure $ pwd </> dir -cloneRepo :: Buildable -> User -> IO (Either Failure (Path Absolute))+cloneRepo :: Buildable -> User -> RIO Env (Either Failure FilePath) cloneRepo pkg usr = do-  currDir <- getCurrentDirectory-  scriptsDir <- chown usr currDir [] *> clone pkg+  currDir <- liftIO getCurrentDirectory+  logDebug $ "Currently in: " <> displayShow currDir+  scriptsDir <- liftIO $ chown usr currDir [] *> clone pkg   case scriptsDir of-    Nothing -> pure . Left . Failure . buildFail_7 $ pkg ^. field @"name"+    Nothing -> pure . Left . Failure . buildFail_7 $ bName pkg     Just sd -> chown usr sd ["-R"] $> Right sd  -- | The user may have edited the original PKGBUILD. If they have, we need to -- overwrite what's been downloaded before calling `makepkg`. overwritePkgbuild :: Settings -> Buildable -> IO () overwritePkgbuild ss p = when (switch ss HotEdit || switch ss UseCustomizepkg) $-  writeFileBinary "PKGBUILD" $ p ^. field @"pkgbuild" . field @"pkgbuild"+  writeFileBinary "PKGBUILD" . pkgbuild $ bPkgbuild p  -- | Inform the user that building failed. Ask them if they want to -- continue installing previous packages that built successfully. buildFail :: Failure -> RIO Env (Maybe a) buildFail (Failure err) = do   ss <- asks settings-  liftIO . scold ss . err $ langOf ss-  response <- liftIO $ optionalPrompt ss buildFail_6-  bool (throwM $ Failure buildFail_5) (pure Nothing) response+  scold ss err+  withOkay ss buildFail_6 buildFail_5 $ pure Nothing  -- | Moves a file to the pacman package cache and returns its location.-moveToCachePath :: Settings -> Path Absolute -> IO PackagePath-moveToCachePath ss p = copy $> PackagePath newName+moveToCachePath :: Settings -> FilePath -> IO PackagePath+moveToCachePath ss p = copy $> fromJust (packagePath newName)   where newName = pth </> takeFileName p         pth     = either id id . cachePathOf $ commonConfigOf ss         copy    = runProcess . setStderr closed . setStdout closed-                  $ proc "cp" ["--reflink=auto", toFilePath p, toFilePath newName ]+                  $ proc "cp" ["--reflink=auto", p, newName]  -- | Moves a file to the aura src package cache and returns its location.-moveToSourcePath :: Path Absolute -> IO (Path Absolute)+moveToSourcePath :: FilePath -> IO FilePath moveToSourcePath p = renameFile p newName $> newName   where newName = srcPkgStore </> takeFileName p

@@ -1,4 +1,4 @@-{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE TupleSections #-}  -- | -- Module    : Aura.Cache@@ -20,16 +20,12 @@  import           Aura.Settings import           Aura.Types-import           Data.Generics.Product (field)-import           Data.Set.NonEmpty (NESet)-import qualified Data.Set.NonEmpty as NES import           RIO+import           RIO.Directory+import           RIO.FilePath import qualified RIO.Map as M import qualified RIO.Set as S import qualified RIO.Text as T-import           System.Path-    (Absolute, Path, fromAbsoluteFilePath, toFilePath, (</>))-import           System.Path.IO (getDirectoryContents)  --- @@ -37,8 +33,8 @@ newtype Cache = Cache { _cache :: Map SimplePkg PackagePath }  -- | The default location of the package cache: \/var\/cache\/pacman\/pkg\/-defaultPackageCache :: Path Absolute-defaultPackageCache = fromAbsoluteFilePath "/var/cache/pacman/pkg/"+defaultPackageCache :: FilePath+defaultPackageCache = "/var/cache/pacman/pkg/"  -- SILENT DROPS PATHS THAT DON'T PARSE -- Maybe that's okay, since we don't know what non-package garbage files@@ -49,17 +45,17 @@ cache = Cache . M.fromList . mapMaybe (\p -> (,p) <$> simplepkg p)  -- | Given a path to the package cache, yields its contents in a usable form.-cacheContents :: Path Absolute -> IO Cache-cacheContents pth = cache . map (PackagePath . (pth </>)) <$> getDirectoryContents pth+cacheContents :: FilePath -> IO Cache+cacheContents pth = cache . mapMaybe (packagePath . (pth </>)) <$> getDirectoryContents pth  -- | All packages from a given `Set` who have a copy in the cache.-pkgsInCache :: Settings -> NESet PkgName -> IO (Set PkgName)+pkgsInCache :: Settings -> Set PkgName -> IO (Set PkgName) pkgsInCache ss ps = do   c <- cacheContents . either id id . cachePathOf $ commonConfigOf ss-  pure . S.filter (`NES.member` ps) . S.map (^. field @"name") . M.keysSet $ _cache c+  pure . S.filter (`S.member` ps) . S.map spName . M.keysSet $ _cache c  -- | Any entries (filepaths) in the cache that match a given `Text`. cacheMatches :: Settings -> Text -> IO [PackagePath] cacheMatches ss input = do   c <- cacheContents . either id id . cachePathOf $ commonConfigOf ss-  pure . filter (T.isInfixOf input . T.pack . toFilePath . path) . M.elems $ _cache c+  pure . filter (T.isInfixOf input . T.pack . ppPath) . M.elems $ _cache c

@@ -1,7 +1,5 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE MultiWayIf        #-}-{-# LANGUAGE ViewPatterns      #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase   #-}  -- | -- Module    : Aura.Commands.A@@ -26,6 +24,7 @@ import           Aura.Colour import           Aura.Core import qualified Aura.Install as I+import           Aura.IO import           Aura.Languages import           Aura.Packages.AUR import           Aura.Pkgbuild.Fetch@@ -33,15 +32,10 @@ import           Aura.State (saveState) import           Aura.Types import           Aura.Utils-import           Control.Error.Util (hush)-import           Data.Aeson.Encode.Pretty (encodePretty)-import           Data.Generics.Product (field)-import           Data.Set.NonEmpty (NESet)-import qualified Data.Set.NonEmpty as NES+import           Data.Aeson import           Data.Text.Prettyprint.Doc import           Data.Text.Prettyprint.Doc.Render.Terminal import           Data.Versions (Versioning, prettyV, versioning)-import           Lens.Micro (each, (^..)) import           Linux.Arch.Aur import           Network.HTTP.Client (Manager) import           RIO@@ -61,19 +55,19 @@ upgradeAURPkgs :: Set PkgName -> RIO Env () upgradeAURPkgs pkgs = do   ss <- asks settings-  liftIO . notify ss . upgradeAURPkgs_1 $ langOf ss+  notify ss upgradeAURPkgs_1   fs <- liftIO (foreigns ss)-  traverse_ (upgrade pkgs) $ NES.nonEmptySet fs+  traverse_ (upgrade pkgs) $ nes fs  -- | Foreign packages to consider for upgrading, after "ignored packages" have -- been taken into consideration. foreigns :: Settings -> IO (Set SimplePkg)-foreigns ss = S.filter (notIgnored . view (field @"name")) <$> foreignPackages+foreigns ss = S.filter (notIgnored . spName) <$> foreignPackages   where notIgnored p = not . S.member p $ ignoresOf ss -upgrade :: Set PkgName -> NESet SimplePkg -> RIO Env ()+upgrade :: Set PkgName -> NonEmpty SimplePkg -> RIO Env () upgrade pkgs fs = do-  logDebug $ "Considering " <> display (NES.size fs) <> " 'foreign' packages for upgrade."+  logDebug $ "Considering " <> display (NEL.length fs) <> " 'foreign' packages for upgrade."   unless (null pkgs)     $ logDebug $ "Also installing " <> display (S.size pkgs) <> " other packages."   ss        <- asks settings@@ -86,44 +80,49 @@     Just a  -> auraUpgrade a     Nothing -> do       devel <- develPkgCheck-      liftIO . notify ss . upgradeAURPkgs_2 $ langOf ss-      if | null toUpgrade && null devel -> liftIO . warn ss . upgradeAURPkgs_3 $ langOf ss-         | otherwise -> do-             reportPkgsToUpgrade toUpgrade (toList devel)-             liftIO . unless (switch ss DryRun) $ saveState ss-             traverse_ I.install . NES.nonEmptySet $ S.fromList names <> pkgs <> devel+      notify ss upgradeAURPkgs_2+      if null toUpgrade && null devel+        then warn ss upgradeAURPkgs_3+        else do+          reportPkgsToUpgrade toUpgrade (toList devel)+          liftIO . unless (switch ss DryRun) $ saveState ss+          traverse_ I.install . nes $ S.fromList names <> pkgs <> devel -possibleUpdates :: NESet SimplePkg -> RIO Env [(AurInfo, Versioning)]-possibleUpdates (NES.toList -> pkgs) = do-  aurInfos <- aurInfo $ fmap (^. field @"name") pkgs+possibleUpdates :: NonEmpty SimplePkg -> RIO Env [(AurInfo, Versioning)]+possibleUpdates pkgs = do+  aurInfos <- aurInfo $ fmap spName pkgs   let !names  = map aurNameOf aurInfos       aurPkgs = NEL.filter (\(SimplePkg (PkgName n) _) -> n `elem` names) pkgs   logDebug "Package lookup successful."-  pure . filter isntMostRecent . zip aurInfos $ aurPkgs ^.. each . field @"version"+  pure . filter isntMostRecent . zip aurInfos $ map spVersion aurPkgs  -- | Is there an update for Aura that we could apply first? auraCheck :: [PkgName] -> RIO Env (Maybe PkgName) auraCheck ps = join <$> traverse f auraPkg-  where f a = do-          ss <- asks settings-          bool Nothing (Just a) <$> liftIO (optionalPrompt ss auraCheck_1)-        auraPkg | "aura" `elem` ps     = Just "aura"-                | "aura-bin" `elem` ps = Just "aura-bin"-                | otherwise            = Nothing+  where+    f :: a -> RIO Env (Maybe a)+    f a = do+      ss <- asks settings+      bool Nothing (Just a) <$> liftIO (optionalPrompt ss auraCheck_1) +    auraPkg :: Maybe PkgName+    auraPkg | "aura" `elem` ps     = Just "aura"+            | "aura-bin" `elem` ps = Just "aura-bin"+            | otherwise            = Nothing+ auraUpgrade :: PkgName -> RIO Env ()-auraUpgrade = I.install . NES.singleton+auraUpgrade = I.install . pure  develPkgCheck :: RIO Env (Set PkgName) develPkgCheck = asks settings >>= \ss ->   if switch ss RebuildDevel then liftIO develPkgs else pure S.empty  -- | The result of @-Ai@.-aurPkgInfo :: NESet PkgName -> RIO Env ()-aurPkgInfo = aurInfo . NES.toList >=> traverse_ displayAurPkgInfo+aurPkgInfo :: NonEmpty PkgName -> RIO Env ()+aurPkgInfo = aurInfo >=> traverse_ displayAurPkgInfo  displayAurPkgInfo :: AurInfo -> RIO Env ()-displayAurPkgInfo ai = asks settings >>= \ss -> liftIO . putTextLn $ renderAurPkgInfo ss ai <> "\n"+displayAurPkgInfo ai = asks settings >>= \ss -> putTextLn $ renderAurPkgInfo ss ai <> "\n"  renderAurPkgInfo :: Settings -> AurInfo -> Text renderAurPkgInfo ss ai = dtot . colourCheck ss $ entrify ss fields entries@@ -146,14 +145,14 @@ aurPkgSearch :: Text -> RIO Env () aurPkgSearch regex = do   ss <- asks settings-  db <- S.map (^. field @"name" . field @"name") <$> liftIO foreignPackages+  db <- S.map (pnName . spName) <$> liftIO foreignPackages   let t = case truncationOf $ buildConfigOf ss of  -- Can't this go anywhere else?             None   -> id             Head n -> take $ fromIntegral n             Tail n -> reverse . take (fromIntegral n) . reverse   results <- fmap (\x -> (x, aurNameOf x `S.member` db)) . t             <$> aurSearch regex-  liftIO $ traverse_ (putTextLn . renderSearch ss regex) results+  traverse_ (putTextLn . renderSearch ss regex) results  renderSearch :: Settings -> Text -> (AurInfo, Bool) -> Text renderSearch ss r (i, e) = searchResult@@ -171,28 +170,28 @@             Nothing -> green . pretty $ aurVersionOf i  -- | The result of @-Ap@.-displayPkgbuild :: NESet PkgName -> RIO Env ()+displayPkgbuild :: NonEmpty PkgName -> RIO Env () displayPkgbuild ps = do   man <- asks (managerOf . settings)   pbs <- catMaybes <$> traverse (liftIO . getPkgbuild man) (toList ps)-  traverse_ (\p -> B.putStr p >> B.putStr "\n") $ pbs ^.. each . field @"pkgbuild"+  traverse_ ((\p -> B.putStr p >> B.putStr "\n") . pkgbuild) pbs  isntMostRecent :: (AurInfo, Versioning) -> Bool isntMostRecent (ai, v) = trueVer > Just v   where trueVer = hush . versioning $ aurVersionOf ai  -- | Similar to @-Ai@, but yields the raw data as JSON instead.-aurJson :: NESet PkgName -> RIO Env ()+aurJson :: NonEmpty PkgName -> RIO Env () aurJson ps = do   m <- asks (managerOf . settings)-  infos <- liftMaybeM (Failure connectionFailure_1) . fmap hush . liftIO $ f m ps-  traverse_ (BL.putStrLn . encodePretty) infos+  infos <- liftMaybeM (Failure connectFailure_1) . fmap hush . liftIO $ f m ps+  traverse_ (BL.putStrLn . encode) infos   where-    f :: Manager -> NESet PkgName -> IO (Either ClientError [AurInfo])-    f m = info m . (^.. each . field @"name") . toList+    f :: Manager -> NonEmpty PkgName -> IO (Either AurError [AurInfo])+    f m = info m . map pnName . NEL.toList  -- | @https://aur.archlinux.org/cgit/aur.git/snapshot/aura-bin.tar.gz@-fetchTarball :: NESet PkgName -> RIO Env ()+fetchTarball :: NonEmpty PkgName -> RIO Env () fetchTarball ps = do   ss <- asks settings   traverse_ (liftIO . g ss) ps@@ -203,7 +202,7 @@      g :: Settings -> PkgName -> IO ()     g ss p@(PkgName pn) = urlContents (managerOf ss) (f p) >>= \case-      Nothing -> warn ss . missingPkg_5 p $ langOf ss+      Nothing -> warn ss $ missingPkg_5 p       Just bs -> writeFileBinary (T.unpack pn <> ".tar.gz") bs  ------------@@ -212,9 +211,9 @@ reportPkgsToUpgrade :: [(AurInfo, Versioning)] -> [PkgName] -> RIO Env () reportPkgsToUpgrade ups pns = do   ss <- asks settings-  liftIO . notify ss . reportPkgsToUpgrade_1 $ langOf ss+  notify ss reportPkgsToUpgrade_1   liftIO $ putDoc (colourCheck ss . vcat $ map f ups' <> map g devels) >> putTextLn "\n"-  where devels   = pns ^.. each . field @"name"+  where devels   = map pnName pns         ups'     = map (second prettyV) ups         nLen     = maximum $ map (T.length . aurNameOf . fst) ups <> map T.length devels         vLen     = maximum $ map (T.length . snd) ups'

@@ -1,4 +1,4 @@-{-# LANGUAGE MultiWayIf    #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns  #-}  -- |@@ -17,16 +17,16 @@   ) where  import           Aura.Core (warn)+import           Aura.IO import           Aura.Languages import           Aura.Settings import           Aura.State-import           Aura.Utils (optionalPrompt, putTextLn) import           RIO+import           RIO.Directory+import           RIO.FilePath import qualified RIO.List as L import qualified RIO.NonEmpty as NEL import qualified RIO.Text as T-import           System.Path (takeFileName, toFilePath, toUnrootedFilePath)-import           System.Path.IO (removeFile)  --- @@ -35,18 +35,19 @@ cleanStates ss (fromIntegral -> n) = do   stfs <- reverse <$> getStateFiles   (pinned, others) <- L.partition p <$> traverse (\sf -> (sf,) <$> readState sf) stfs-  warn ss . cleanStates_4 (length stfs) $ langOf ss-  unless (null pinned) . warn ss . cleanStates_6 (length pinned) $ langOf ss+  warn ss $ cleanStates_4 (length stfs)+  unless (null pinned) . warn ss $ cleanStates_6 (length pinned)   forM_ (NEL.nonEmpty stfs) $ \stfs' -> do-    let mostRecent = T.pack . toUnrootedFilePath . takeFileName $ NEL.head stfs'-    warn ss . cleanStates_5 mostRecent $ langOf ss+    let mostRecent = T.pack . takeFileName $ NEL.head stfs'+    warn ss $ cleanStates_5 mostRecent   okay <- optionalPrompt ss $ cleanStates_2 n-  if | not okay  -> warn ss . cleanStates_3 $ langOf ss-     | otherwise -> traverse_ (removeFile . fst) . drop n $ others+  if not okay+    then warn ss cleanStates_3+    else traverse_ (removeFile . fst) . drop n $ others   where     p :: (a, Maybe PkgState) -> Bool     p = maybe False pinnedOf . snd  -- | The result of @-Bl@. listStates :: IO ()-listStates = getStateFiles >>= traverse_ (putTextLn . T.pack . toFilePath)+listStates = getStateFiles >>= traverse_ (putTextLn . T.pack)

@@ -1,6 +1,6 @@-{-# LANGUAGE DataKinds        #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiWayIf       #-}+{-# LANGUAGE BangPatterns       #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE TypeApplications   #-}  -- | -- Module    : Aura.Commands.C@@ -21,39 +21,39 @@ import           Aura.Cache import           Aura.Colour (red) import           Aura.Core+import           Aura.IO import           Aura.Languages import           Aura.Pacman (pacman) import           Aura.Settings+import           Aura.Shell import           Aura.State import           Aura.Types-import           Aura.Utils-import           Data.Generics.Product (field)-import           Data.Set.NonEmpty (NESet)-import qualified Data.Set.NonEmpty as NES-import           Lens.Micro ((^?), _Just)+import           Aura.Utils (nes) import           RIO+import           RIO.Directory import qualified RIO.List as L import qualified RIO.Map as M import qualified RIO.NonEmpty as NEL import qualified RIO.Set as S import qualified RIO.Text as T-import           System.Path-import           System.Path.IO (copyFile, doesDirectoryExist, removeFile)  ---  -- | Interactive. Gives the user a choice as to exactly what versions -- they want to downgrade to.-downgradePackages :: NESet PkgName -> RIO Env ()+downgradePackages :: NonEmpty PkgName -> RIO Env () downgradePackages pkgs = do-  ss    <- asks settings+  ss <- asks settings   let cachePath = either id id . cachePathOf $ commonConfigOf ss-  reals <- liftIO $ pkgsInCache ss pkgs-  traverse_ (report red reportBadDowngradePkgs_1) . NEL.nonEmpty . toList $ NES.toSet pkgs S.\\ reals+  reals <- liftIO $ pkgsInCache ss pkgsSet+  traverse_ (report red reportBadDowngradePkgs_1) . nes $ pkgsSet S.\\ reals   unless (null reals) $ do     cache   <- liftIO $ cacheContents cachePath     choices <- traverse (getDowngradeChoice cache) $ toList reals-    liftIO . pacman $ "-U" : asFlag (commonConfigOf ss) <> map (T.pack . toFilePath . path) choices+    liftIO . pacman $ "-U" : asFlag (commonConfigOf ss) <> map (T.pack . ppPath) choices+  where+    pkgsSet :: Set PkgName+    pkgsSet = S.fromList $ NEL.toList pkgs  -- | For a given package, get a choice from the user about which version of it to -- downgrade to.@@ -63,8 +63,8 @@     Nothing      -> throwM . Failure $ reportBadDowngradePkgs_2 pkg     Just choices -> do       ss <- asks settings-      liftIO . notify ss . getDowngradeChoice_1 pkg $ langOf ss-      liftIO $ getSelection (T.pack . toFilePath . path) choices+      notify ss $ getDowngradeChoice_1 pkg+      liftIO $ getSelection (T.pack . ppPath) choices  getChoicesFromCache :: Cache -> PkgName -> [PackagePath] getChoicesFromCache (Cache cache) p = L.sort . M.elems $ M.filterWithKey (\(SimplePkg pn _) _ -> p == pn) cache@@ -74,39 +74,39 @@ searchCache ps = do   ss <- asks settings   matches <- liftIO $ cacheMatches ss ps-  liftIO . traverse_ (putTextLn . T.pack . toFilePath . path) $ L.sort matches+  traverse_ (putTextLn . T.pack . ppPath) $ L.sort matches  -- | The destination folder must already exist for the back-up to begin.-backupCache :: Path Absolute -> RIO Env ()+backupCache :: FilePath -> RIO Env () backupCache dir = do   exists <- liftIO $ doesDirectoryExist dir-  if | not exists -> throwM $ Failure backupCache_3-     | otherwise  -> confirmBackup dir >>= backup dir+  if not exists+    then throwM $ Failure backupCache_3+    else confirmBackup dir >>= backup dir -confirmBackup :: Path Absolute -> RIO Env Cache+confirmBackup :: FilePath -> RIO Env Cache confirmBackup dir = do   ss    <- asks settings   cache <- liftIO . cacheContents . either id id . cachePathOf $ commonConfigOf ss-  liftIO . notify ss $ backupCache_4 (toFilePath dir) (langOf ss)-  liftIO . notify ss $ backupCache_5 (M.size $ _cache cache) (langOf ss)-  okay  <- liftIO $ optionalPrompt ss backupCache_6-  bool (throwM $ Failure backupCache_7) (pure cache) okay+  notify ss $ backupCache_4 dir+  notify ss $ backupCache_5 (M.size $ _cache cache)+  withOkay ss backupCache_6 backupCache_7 $ pure cache -backup :: Path Absolute -> Cache -> RIO Env ()+backup :: FilePath -> Cache -> RIO Env () backup dir (Cache cache) = do   ss <- asks settings-  liftIO . notify ss . backupCache_8 $ langOf ss-  liftIO $ putTextLn ""  -- So that the cursor can rise at first.+  notify ss backupCache_8+  putTextLn ""  -- So that the cursor can rise at first.   copyAndNotify dir (M.elems cache) 1  -- | Manages the file copying and display of the real-time progress notifier.-copyAndNotify :: Path Absolute -> [PackagePath] -> Int -> RIO Env ()+copyAndNotify :: FilePath -> [PackagePath] -> Int -> RIO Env () copyAndNotify _ [] _ = pure ()-copyAndNotify dir (PackagePath p : ps) n = do+copyAndNotify dir (p : ps) n = do   ss <- asks settings   liftIO $ raiseCursorBy 1-  liftIO . warn ss . copyAndNotify_1 n $ langOf ss-  liftIO $ copyFile p dir+  warn ss $ copyAndNotify_1 n+  liftIO $ copyFile (ppPath p) dir   copyAndNotify dir ps $ n + 1  -- | Keeps a certain number of package files in the cache according to@@ -115,41 +115,54 @@ cleanCache toSave   | toSave == 0 = do       ss <- asks settings-      liftIO . warn ss . cleanCache_2 $ langOf ss+      warn ss cleanCache_2       liftIO $ pacman ["-Scc"]   | otherwise = do       ss <- asks settings-      liftIO . warn ss . cleanCache_3 toSave $ langOf ss-      okay <- liftIO $ optionalPrompt ss cleanCache_4-      bool (throwM $ Failure cleanCache_5) (clean (fromIntegral toSave)) okay+      let cachePath = either id id . cachePathOf $ commonConfigOf ss+      -- Measuring the cache size before removal --+      beforeCache@(Cache c) <- liftIO $ cacheContents cachePath+      beforeBytes <- liftIO $ cacheSize beforeCache+      notify ss $ cleanCache_7 (fromIntegral $ M.size c) beforeBytes+      -- Proceed with user confirmation --+      warn ss $ cleanCache_3 toSave+      withOkay ss cleanCache_4 cleanCache_5 $ do+        clean toSave beforeCache+        afterCache <- liftIO $ cacheContents cachePath+        afterBytes <- liftIO $ cacheSize afterCache+        notify ss $ cleanCache_8 (beforeBytes - afterBytes) -clean :: Int -> RIO Env ()-clean toSave = do+-- | How big, in megabytes, are all the files in the cache?+cacheSize :: Cache -> IO Word+cacheSize (Cache cache) = do+  bytes <- foldl' (+) 0 <$> traverse (getFileSize . ppPath) (M.elems cache)+  pure . floor @Double $ fromIntegral bytes / 1_048_576  -- 1024 * 1024++clean :: Word -> Cache -> RIO Env ()+clean toSave (Cache cache) = do   ss <- asks settings-  liftIO . notify ss . cleanCache_6 $ langOf ss-  let cachePath = either id id . cachePathOf $ commonConfigOf ss-  (Cache cache) <- liftIO $ cacheContents cachePath+  notify ss cleanCache_6   let !files    = M.elems cache-      grouped   = take toSave . reverse <$> groupByName files+      grouped   = take (fromIntegral toSave) . reverse <$> groupByName files       toRemove  = files L.\\ fold grouped-  liftIO $ traverse_ (removeFile . path) toRemove+  liftIO $ traverse_ (removeFile . ppPath) toRemove  -- | Only package files with a version not in any PkgState will be -- removed. cleanNotSaved :: RIO Env () cleanNotSaved = do   ss <- asks settings-  liftIO . notify ss . cleanNotSaved_1 $ langOf ss+  notify ss cleanNotSaved_1   sfs <- liftIO getStateFiles   states <- fmap catMaybes . liftIO $ traverse readState sfs   let cachePath = either id id . cachePathOf $ commonConfigOf ss   (Cache cache)  <- liftIO $ cacheContents cachePath   let duds = M.filterWithKey (\p _ -> any (inState p) states) cache   prop <- liftIO . optionalPrompt ss $ cleanNotSaved_2 $ M.size duds-  when prop . liftIO . traverse_ (removeFile . path) $ M.elems duds+  when prop . liftIO . traverse_ (removeFile . ppPath) $ M.elems duds  -- | Typically takes the contents of the package cache as an argument. groupByName :: [PackagePath] -> [[PackagePath]] groupByName pkgs = L.groupBy sameBaseName $ L.sort pkgs     where sameBaseName a b = baseName a == baseName b-          baseName p = simplepkg p ^? _Just . field @"name"+          baseName p = spName <$> simplepkg p

@@ -1,7 +1,3 @@-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleContexts      #-}- -- | -- Module    : Aura.Commands.L -- Copyright : (c) Colin Woodbury, 2012 - 2020@@ -18,18 +14,16 @@  import           Aura.Colour (dtot, red) import           Aura.Core (Env(..), report)+import           Aura.IO import           Aura.Languages import           Aura.Settings import           Aura.Types (PkgName(..)) import           Aura.Utils-import           Data.Generics.Product (field)-import           Data.Set.NonEmpty (NESet) import           Data.Text.Prettyprint.Doc import           RIO hiding (FilePath) import qualified RIO.NonEmpty as NEL import qualified RIO.Text as T import qualified RIO.Text.Partial as T-import           System.Path (toFilePath) import           System.Process.Typed (proc, runProcess)  ---@@ -46,25 +40,25 @@ -- | Pipes the pacman log file through a @less@ session. viewLogFile :: RIO Env () viewLogFile = do-  pth <- asks (toFilePath . either id id . logPathOf . commonConfigOf . settings)+  pth <- asks (either id id . logPathOf . commonConfigOf . settings)   void . runProcess $ proc "less" [pth]  -- | Print all lines in the log file which contain a given `Text`. searchLogFile :: Settings -> Text -> IO () searchLogFile ss input = do-  let pth = toFilePath . either id id . logPathOf $ commonConfigOf ss+  let pth = either id id . logPathOf $ commonConfigOf ss   logFile <- T.lines . decodeUtf8Lenient <$> readFileBinary pth   traverse_ putTextLn $ searchLines input logFile  -- | The result of @-Li@.-logInfoOnPkg :: NESet PkgName -> RIO Env ()+logInfoOnPkg :: NonEmpty PkgName -> RIO Env () logInfoOnPkg pkgs = do   ss <- asks settings-  let pth = toFilePath . either id id . logPathOf $ commonConfigOf ss+  let pth = either id id . logPathOf $ commonConfigOf ss   logFile <- Log . T.lines . decodeUtf8Lenient <$> readFileBinary pth   let (bads, goods) = fmapEither (logLookup logFile) $ toList pkgs   traverse_ (report red reportNotInLog_1) $ NEL.nonEmpty bads-  liftIO . traverse_ putTextLn $ map (renderEntry ss) goods+  traverse_ (putTextLn . renderEntry ss) goods  logLookup :: Log -> PkgName -> Either PkgName LogEntry logLookup (Log lns) p = case matches of@@ -74,7 +68,7 @@              , firstInstall = T.take 16 $ T.tail h              , upgrades = fromIntegral . length $ filter (T.isInfixOf " upgraded ") t              , recent = reverse . take 5 $ reverse t }-  where matches = filter (T.isInfixOf (" " <> (p ^. field @"name") <> " (")) lns+  where matches = filter (T.isInfixOf (" " <> pnName p <> " (")) lns  renderEntry :: Settings -> LogEntry -> Text renderEntry ss (LogEntry (PkgName pn) fi us rs) =

@@ -1,5 +1,3 @@-{-# LANGUAGE DataKinds        #-}- -- | -- Module    : Aura.Commands.O -- Copyright : (c) Colin Woodbury, 2012 - 2020@@ -11,19 +9,17 @@ module Aura.Commands.O ( displayOrphans, adoptPkg ) where  import Aura.Core (Env(..), orphans, sudo)+import Aura.IO (putTextLn) import Aura.Pacman (pacman) import Aura.Types-import Aura.Utils (putTextLn)-import Data.Generics.Product (field)-import Data.Set.NonEmpty (NESet) import RIO  ---  -- | Print the result of @pacman -Qqdt@ displayOrphans :: IO ()-displayOrphans = orphans >>= traverse_ (putTextLn . view (field @"name"))+displayOrphans = orphans >>= traverse_ (putTextLn . pnName)  -- | Identical to @-D --asexplicit@.-adoptPkg :: NESet PkgName -> RIO Env ()+adoptPkg :: NonEmpty PkgName -> RIO Env () adoptPkg pkgs = sudo . liftIO . pacman $ ["-D", "--asexplicit"] <> asFlag pkgs

@@ -1,7 +1,5 @@-{-# LANGUAGE DataKinds          #-} {-# LANGUAGE DeriveGeneric      #-} {-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE MultiWayIf         #-}  -- | -- Module    : Aura.Core@@ -30,27 +28,25 @@   ) where  import           Aura.Colour+import           Aura.IO import           Aura.Languages import           Aura.Pacman import           Aura.Pkgbuild.Editing (hotEdit) import           Aura.Settings+import           Aura.Shell import           Aura.Types import           Aura.Utils import           Control.Monad.Trans.Maybe import           Data.Bifunctor (bimap)-import           Data.Generics.Product (field, typed)-import           Data.Set.NonEmpty (NESet)-import qualified Data.Set.NonEmpty as NES import           Data.Text.Prettyprint.Doc import           Data.Text.Prettyprint.Doc.Render.Terminal-import           Data.These (These(..)) import           RIO hiding ((<>)) import qualified RIO.ByteString as B+import           RIO.Directory (doesFileExist) import qualified RIO.List as L import qualified RIO.NonEmpty as NEL import qualified RIO.Set as S import qualified RIO.Text as T-import           System.Path.IO (doesFileExist)  --- @@ -64,15 +60,18 @@ data Env = Env { repository :: !Repository, settings :: !Settings }   deriving stock (Generic) +settingsL :: Lens' Env Settings+settingsL f e = (\ss -> e { settings = ss }) <$> f (settings e)+ instance HasLogFunc Env where-  logFuncL = typed @Settings . typed @LogFunc+  logFuncL = settingsL . logFuncOfL  -- | A `Repository` is a place where packages may be fetched from. Multiple -- repositories can be combined with the `Semigroup` instance. Checks packages -- in batches for efficiency. data Repository = Repository   { repoCache :: !(TVar (Map PkgName Package))-  , repoLookup :: Settings -> NESet PkgName -> IO (Maybe (Set PkgName, Set Package)) }+  , repoLookup :: Settings -> NonEmpty PkgName -> IO (Maybe (Set PkgName, Set Package)) }  -- NOTE The `repoCache` value passed to the combined `Repository` constructor is -- irrelevant, and only sits there for typechecking purposes. Each `Repository`@@ -80,7 +79,7 @@ instance Semigroup Repository where   a <> b = Repository (repoCache a) $ \ss ps -> runMaybeT $ do     items@(bads, goods) <- MaybeT $ repoLookup a ss ps-    case NES.nonEmptySet bads of+    case nes bads of       Nothing    -> pure items       Just bads' -> second (goods <>) <$> MaybeT (repoLookup b ss bads') @@ -89,15 +88,21 @@ --------------------------------- -- | Partition a list of packages into pacman and buildable groups. Yes, this is -- the correct signature. As far as this function (in isolation) is concerned,--- there is no way to guarantee that the list of `NESet`s will itself be+-- there is no way to guarantee that the list of `NonEmpty`s will itself be -- non-empty.-partitionPkgs :: NonEmpty (NESet Package) -> ([Prebuilt], [NESet Buildable])-partitionPkgs = bimap fold f . L.unzip . map g . toList-  where g = fmapEither toEither . toList-        f = mapMaybe (fmap NES.fromList . NEL.nonEmpty)-        toEither (FromAUR b)  = Right b-        toEither (FromRepo b) = Left b+partitionPkgs :: NonEmpty (NonEmpty Package) -> ([Prebuilt], [NonEmpty Buildable])+partitionPkgs = bimap fold f . L.unzip . map g . NEL.toList+  where+    g :: NonEmpty Package -> ([Prebuilt], [Buildable])+    g = fmapEither toEither . NEL.toList +    f :: [[a]] -> [NonEmpty a]+    f = mapMaybe NEL.nonEmpty++    toEither :: Package -> Either Prebuilt Buildable+    toEither (FromAUR b)  = Right b+    toEither (FromRepo b) = Left b+ -- | Package a Buildable, running the customization handler first. packageBuildable :: Settings -> Buildable -> IO Package packageBuildable ss b = FromAUR <$> hotEdit ss b@@ -130,64 +135,68 @@  -- | Any package whose name is suffixed by git, hg, svn, darcs, cvs, or bzr. develPkgs :: IO (Set PkgName)-develPkgs = S.filter isDevelPkg . S.map (^. field @"name") <$> foreignPackages+develPkgs = S.filter isDevelPkg . S.map spName <$> foreignPackages   where isDevelPkg (PkgName pkg) = any (`T.isSuffixOf` pkg) suffixes         suffixes = ["-git", "-hg", "-svn", "-darcs", "-cvs", "-bzr"]  -- | Returns what it was given if the package is already installed. -- Reasoning: Using raw bools can be less expressive. isInstalled :: PkgName -> IO (Maybe PkgName)-isInstalled pkg = bool Nothing (Just pkg) <$> pacmanSuccess ["-Qq", pkg ^. field @"name"]+isInstalled pkg = bool Nothing (Just pkg) <$> pacmanSuccess ["-Qq", pnName pkg]  -- | An @-Rsu@ call.-removePkgs :: NESet PkgName -> RIO Env ()+removePkgs :: NonEmpty PkgName -> RIO Env () removePkgs pkgs = do   pacOpts <- asks (commonConfigOf . settings)   liftIO . pacman $ ["-Rsu"] <> asFlag pkgs <> asFlag pacOpts  -- | Depedencies which are not installed, or otherwise provided by some -- installed package.-newtype Unsatisfied = Unsatisfied (NESet Dep)+newtype Unsatisfied = Unsatisfied (NonEmpty Dep)  -- | The opposite of `Unsatisfied`.-newtype Satisfied = Satisfied (NESet Dep)+newtype Satisfied = Satisfied (NonEmpty Dep)  -- | Similar to `isSatisfied`, but dependencies are checked in a batch, since -- @-T@ can accept multiple inputs.-areSatisfied :: NESet Dep -> IO (These Unsatisfied Satisfied)+areSatisfied :: NonEmpty Dep -> IO (These Unsatisfied Satisfied) areSatisfied ds = do   unsats <- S.fromList . mapMaybe parseDep <$> unsat-  pure . bimap Unsatisfied Satisfied $ NES.partition (`S.member` unsats) ds+  pure . bimap Unsatisfied Satisfied $ partNonEmpty (f unsats) ds   where     unsat :: IO [Text]     unsat = pacmanLines $ "-T" : map renderedDep (toList ds) +    f :: Set Dep -> Dep -> These Dep Dep+    f unsats d | S.member d unsats = This d+               | otherwise = That d+ -- | Block further action until the database is free. checkDBLock :: Settings -> IO () checkDBLock ss = do   locked <- doesFileExist lockFile-  when locked $ (warn ss . checkDBLock_1 $ langOf ss) *> B.getLine *> checkDBLock ss+  when locked $ warn ss checkDBLock_1 *> B.getLine *> checkDBLock ss  ------- -- MISC  -- Too specific for `Utilities.hs` or `Aura.Utils` -------  -- | Print some message in green with Aura flair.-notify :: Settings -> Doc AnsiStyle -> IO ()-notify ss = putStrLnA ss . green+notify :: MonadIO m => Settings -> (Language -> Doc AnsiStyle) -> m ()+notify ss msg = putStrLnA ss $ green (msg $ langOf ss)  -- | Print some message in yellow with Aura flair.-warn :: Settings -> Doc AnsiStyle -> IO ()-warn ss = putStrLnA ss . yellow+warn :: MonadIO m => Settings -> (Language -> Doc AnsiStyle) -> m ()+warn ss msg = putStrLnA ss $ yellow (msg $ langOf ss)  -- | Print some message in red with Aura flair.-scold :: Settings -> Doc AnsiStyle -> IO ()-scold ss = putStrLnA ss . red+scold :: MonadIO m => Settings -> (Language -> Doc AnsiStyle) -> m ()+scold ss msg = putStrLnA ss $ red (msg $ langOf ss)  -- | Report a message with multiple associated items. Usually a list of -- naughty packages. report :: (Doc AnsiStyle -> Doc AnsiStyle) -> (Language -> Doc AnsiStyle) -> NonEmpty PkgName -> RIO Env () report c msg pkgs = do   ss <- asks settings-  liftIO . putStrLnA ss . c . msg $ langOf ss-  liftIO . putTextLn . dtot . colourCheck ss . vsep . map (cyan . pretty . view (field @"name")) $ toList pkgs+  putStrLnA ss . c . msg $ langOf ss+  putTextLn . dtot . colourCheck ss . vsep . map (cyan . pretty . pnName) $ toList pkgs

@@ -1,7 +1,7 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE MultiWayIf        #-}-{-# LANGUAGE PatternSynonyms   #-}+{-# LANGUAGE DeriveGeneric   #-}+{-# LANGUAGE LambdaCase      #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TupleSections   #-}  -- | -- Module    : Aura.Dependencies@@ -18,17 +18,12 @@ import qualified Algebra.Graph.NonEmpty.AdjacencyMap as NAM import           Algebra.Graph.ToGraph (isAcyclic) import           Aura.Core+import           Aura.IO import           Aura.Languages import           Aura.Settings import           Aura.Types-import           Aura.Utils (maybe', putText)-import           Control.Error.Util (note)-import           Data.Generics.Product (field)-import           Data.Semigroup.Foldable (foldMap1)-import           Data.Set.NonEmpty (pattern IsEmpty, pattern IsNonEmpty, NESet)-import qualified Data.Set.NonEmpty as NES-import           Data.These (these)-import           Data.Versions+import           Aura.Utils+import           Data.Versions hiding (Lens') import           Lens.Micro import           RIO import qualified RIO.Map as M@@ -44,97 +39,109 @@   , satisfied :: Set PkgName }   deriving (Generic) +toInstallL :: Lens' Resolution (Map PkgName Package)+toInstallL f r = (\m -> r { toInstall = m }) <$> f (toInstall r)++satisfiedL :: Lens' Resolution (Set PkgName)+satisfiedL f r = (\s -> r { satisfied = s }) <$> f (satisfied r)+ -- | Given some `Package`s, determine its full dependency graph. -- The graph is collapsed into layers of packages which are not -- interdependent, and thus can be built and installed as a group. -- -- Deeper layers of the result list (generally) depend on the previous layers.-resolveDeps :: Repository -> NESet Package -> RIO Env (NonEmpty (NESet Package))+resolveDeps :: Repository -> NonEmpty Package -> RIO Env (NonEmpty (NonEmpty Package)) resolveDeps repo ps = do   ss <- asks settings   res <- liftIO $ (Just <$> resolveDeps' ss repo ps) `catchAny` const (pure Nothing)-  Resolution m s <- maybe (throwM $ Failure connectionFailure_1) pure res-  unless (length ps == length m) $ liftIO (putText "\n")+  Resolution m s <- maybe (throwM $ Failure connectFailure_1) pure res+  unless (length ps == length m) $ putText "\n"   let de = conflicts ss m s   unless (null de) . throwM . Failure $ missingPkg_2 de   either throwM pure $ sortInstall m  -- | Solve dependencies for a set of `Package`s assumed to not be -- installed/satisfied.-resolveDeps' :: Settings -> Repository -> NESet Package -> IO Resolution+resolveDeps' :: Settings -> Repository -> NonEmpty Package -> IO Resolution resolveDeps' ss repo ps = resolve (Resolution mempty mempty) ps   where     -- | Only searches for packages that we haven't checked yet.-    resolve :: Resolution -> NESet Package -> IO Resolution-    resolve r@(Resolution m _) xs = maybe' (pure r) (NES.nonEmptySet goods) $ \goods' -> do-      let m' = M.fromList (map (pname &&& id) $ toList goods')-          r' = r & field @"toInstall" %~ (<> m')+    resolve :: Resolution -> NonEmpty Package -> IO Resolution+    resolve r@(Resolution m _) xs = maybe' (pure r) (NEL.nonEmpty goods) $ \goods' -> do+      let m' = M.fromList . map (pname &&& id) $ toList goods'+          r' = r & toInstallL %~ (<> m')       these (const $ pure r') (satisfy r') (const $ satisfy r') $ dividePkgs goods'       where-        goods :: Set Package-        goods = NES.filter (\p -> not $ pname p `M.member` m) xs+        goods :: [Package]+        goods = NEL.filter (\p -> not $ pname p `M.member` m) xs      -- | All dependencies from all potential `Buildable`s.-    allDeps :: NESet Buildable -> Set Dep-    allDeps = foldMap1 (S.fromList . (^.. field @"deps" . each))+    allDeps :: NonEmpty Buildable -> Set Dep+    allDeps = foldMap1 (S.fromList . (^.. to bDeps . each))      -- | Deps which are not yet queued for install.     freshDeps :: Resolution -> Set Dep -> Set Dep     freshDeps (Resolution m s) = S.filter f       where         f :: Dep -> Bool-        f d = let n = d ^. field @"name" in not $ M.member n m || S.member n s+        f d = let n = dName d in not $ M.member n m || S.member n s      -- | Consider only "unsatisfied" deps.-    satisfy :: Resolution -> NESet Buildable -> IO Resolution-    satisfy r bs = maybe' (pure r) (NES.nonEmptySet . freshDeps r $ allDeps bs) $+    satisfy :: Resolution -> NonEmpty Buildable -> IO Resolution+    satisfy r bs = maybe' (pure r) (nes . freshDeps r $ allDeps bs) $       areSatisfied >=> these (lookups r) (pure . r') (\uns sat -> lookups (r' sat) uns)       where         r' :: Satisfied -> Resolution-        r' (Satisfied sat) = r & field @"satisfied" %~ (<> f sat)+        r' (Satisfied sat) = r & satisfiedL %~ (<> f sat) -        f :: NESet Dep -> Set PkgName-        f = S.map (^. field @"name") . NES.toSet+        -- | Unique names of some dependencies.+        f :: NonEmpty Dep -> Set PkgName+        f = S.fromList . NEL.toList . NEL.map dName      -- TODO What about if `repoLookup` reports deps that don't exist?     -- i.e. the left-hand side of the tuple.     -- | Lookup unsatisfied deps and recurse the entire lookup process.     lookups :: Resolution -> Unsatisfied -> IO Resolution     lookups r (Unsatisfied ds) = do-      let names = NES.map (^. field @"name") ds+      let names = NEL.map dName ds       repoLookup repo ss names >>= \case         Nothing -> throwString "AUR Connection Error"-        Just (_, IsEmpty) -> throwString "Non-existant deps"-        Just (_, IsNonEmpty goods) -> resolve r goods+        Just (_, could) -> case nes could of+          Nothing    -> throwString "Non-existant deps"+          Just goods -> resolve r goods  conflicts :: Settings -> Map PkgName Package -> Set PkgName -> [DepError] conflicts ss m s = foldMap f m   where     pm :: Map PkgName Package-    pm = M.fromList $ map (\p -> (pprov p ^. field @"provides", p)) $ toList m+    pm = M.fromList $ map (\p -> (provides $ pprov p, p)) $ toList m      f :: Package -> [DepError]     f (FromRepo _) = []-    f (FromAUR b)  = flip mapMaybe (b ^. field @"deps") $ \d ->-      let dn = d ^. field @"name"+    f (FromAUR b)  = flip mapMaybe (bDeps b) $ \d ->+      let dn = dName d       -- Don't do conflict checks for deps which are known to be satisfied on       -- the system.-      in if | S.member dn s -> Nothing-            | otherwise     -> case M.lookup dn m <|> M.lookup dn pm of-                                Nothing -> Just $ NonExistant dn-                                Just p  -> realPkgConflicts ss (b ^. field @"name") p d+      in if S.member dn s then Nothing+         else case M.lookup dn m <|> M.lookup dn pm of+                Nothing -> Just . NonExistant dn $ bName b+                Just p  -> realPkgConflicts ss (bName b) p d -sortInstall :: Map PkgName Package -> Either Failure (NonEmpty (NESet Package))+sortInstall :: Map PkgName Package -> Either Failure (NonEmpty (NonEmpty Package)) sortInstall m = case cycles depGraph of-  [] -> note (Failure missingPkg_3) . NEL.nonEmpty . mapMaybe NES.nonEmptySet $ batch depGraph+  [] -> note (Failure missingPkg_3) . NEL.nonEmpty . mapMaybe nes $ batch depGraph   cs -> Left . Failure . missingPkg_4 $ map (NEL.map pname . NAM.vertexList1) cs-  where f (FromRepo _)  = []-        f p@(FromAUR b) = mapMaybe (\d -> fmap (p,) $ (d ^. field @"name") `M.lookup` m) $ b ^. field @"deps" -- TODO handle "provides"?-        depGraph  = overlay connected singles-        elems     = M.elems m-        connected = edges $ foldMap f elems-        singles   = overlays $ map vertex elems+  where+    f :: Package -> [(Package, Package)]+    f (FromRepo _)  = []+    f p@(FromAUR b) = mapMaybe (\d -> fmap (p,) $ dName d `M.lookup` m)+      $ bDeps b -- TODO handle "provides"? +    depGraph  = overlay connected singles+    elems     = M.elems m+    connected = edges $ foldMap f elems+    singles   = overlays $ map vertex elems+ cycles :: Ord a => AdjacencyMap a -> [NAM.AdjacencyMap a] cycles = filter (not . isAcyclic) . vertexList . scc @@ -161,7 +168,7 @@     | otherwise                       = Nothing     where pn       = pname pkg           curVer   = pver pkg & release .~ []-          reqVer   = (dep ^. field @"demand") & _VersionDemand . release .~ []+          reqVer   = dDemand dep & _VersionDemand . release .~ []           lang     = langOf ss           toIgnore = ignoresOf ss           failMsg1 = getRealPkgConflicts_2 pn lang

@@ -10,7 +10,6 @@  import Aura.Settings import RIO-import System.Path (Absolute, Path, toFilePath) import System.Process.Typed (proc, runProcess)  ---@@ -19,6 +18,8 @@ -- Output will be coloured unless colour is deactivated by -- `--color never` or by detection of a non-terminal output -- target.-diff :: MonadIO m => Settings -> Path Absolute -> Path Absolute -> m ()-diff ss f1 f2 = void . runProcess . proc "diff" $ c <> ["-u", toFilePath f1, toFilePath f2]-  where c = bool ["--color"] [] $ shared ss (Colour Never)+diff :: MonadIO m => Settings -> FilePath -> FilePath -> m ()+diff ss f1 f2 = void . runProcess . proc "diff" $ c <> ["-u", f1, f2]+  where+    c :: [FilePath]+    c = bool ["--color"] [] $ shared ss (Colour Never)

@@ -0,0 +1,105 @@+-- |+-- Module    : Aura.IO+-- Copyright : (c) Colin Woodbury, 2012 - 2020+-- License   : GPL3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+-- User-facing input and output utilities.++module Aura.IO where++import           Aura.Colour+import           Aura.Languages (whitespace, yesNoMessage, yesPattern)+import           Aura.Settings+import           Aura.Types (Failure(..), Language)+import           Data.Text.Prettyprint.Doc+import           Data.Text.Prettyprint.Doc.Render.Terminal+import           RIO+import qualified RIO.ByteString as B+import qualified RIO.ByteString.Lazy as BL+import           RIO.List.Partial (maximum)+import qualified RIO.Text as T+import           Text.Printf (printf)++---++----------------+-- CUSTOM OUTPUT+----------------+-- | Print a `Doc` with Aura flair after performing a `colourCheck`.+putStrLnA :: MonadIO m => Settings -> Doc AnsiStyle -> m ()+putStrLnA ss d = putStrA ss $ d <> hardline++-- | Will remove all colour annotations if the user specified @--color=never@.+putStrA :: MonadIO m => Settings -> Doc AnsiStyle -> m ()+putStrA ss d = B.putStr . encodeUtf8 . dtot $ "aura >>=" <+> colourCheck ss d++-- | Strip colours from a `Doc` if @--color=never@ is specified,+-- or if the output target isn't a terminal.+colourCheck :: Settings -> Doc ann -> Doc ann+colourCheck ss | shared ss (Colour Never)  = unAnnotate+               | shared ss (Colour Always) = id+               | isTerminal ss = id+               | otherwise = unAnnotate++putText :: MonadIO m => Text -> m ()+putText = B.putStr . encodeUtf8++putTextLn :: MonadIO m => Text -> m ()+putTextLn = BL.putStrLn . BL.fromStrict . encodeUtf8++-- | Format two lists into two nice rows a la `-Qi` or `-Si`.+entrify :: Settings -> [Text] -> [Doc AnsiStyle] -> Doc AnsiStyle+entrify ss fs es = vsep $ zipWith combine fs' es+  where fs' = padding ss fs+        combine f e = annotate bold (pretty f) <+> ":" <+> e++-- | Right-pads strings according to the longest string in the group.+padding :: Settings -> [Text] -> [Text]+padding ss fs = map (T.justifyLeft longest ws) fs+  where ws      = whitespace $ langOf ss+        longest = maximum $ map T.length fs++----------+-- PROMPTS+----------+yesNoPrompt :: Settings -> Doc AnsiStyle -> IO Bool+yesNoPrompt ss msg = do+  putStrA ss . yellow $ msg <+> yesNoMessage (langOf ss) <> " "+  hFlush stdout+  response <- decodeUtf8Lenient <$> B.getLine+  pure $ isAffirmative (langOf ss) response++-- | An empty response emplies "yes".+isAffirmative :: Language -> Text -> Bool+isAffirmative l t = T.null t || elem (T.toCaseFold t) (yesPattern l)++-- | Doesn't prompt when `--noconfirm` is used.+optionalPrompt :: Settings -> (Language -> Doc AnsiStyle) -> IO Bool+optionalPrompt ss msg | shared ss NoConfirm = pure True+                      | otherwise           = yesNoPrompt ss (msg $ langOf ss)++withOkay+  :: Settings+  -> (Language -> Doc AnsiStyle)+  -> (Language -> Doc AnsiStyle)+  -> RIO e a+  -> RIO e a+withOkay ss asking failed f = do+  okay <- liftIO $ optionalPrompt ss asking+  bool (throwM $ Failure failed) f okay++-- | Given a number of selections, allows the user to choose one.+getSelection :: Foldable f => (a -> Text) -> f a -> IO a+getSelection f choiceLabels = do+  let quantity = length choiceLabels+      valids   = map tshow [1..quantity]+      pad      = show . length . show $ quantity+      choices  = zip valids $ toList choiceLabels+  traverse_ (\(l,v) -> printf ("%" <> pad <> "s. %s\n") l (f v)) choices+  BL.putStr ">> "+  hFlush stdout+  userChoice <- decodeUtf8Lenient <$> B.getLine+  case userChoice `lookup` choices of+    Just valid -> pure valid+    Nothing    -> getSelection f choiceLabels  -- Ask again.

@@ -1,8 +1,5 @@-{-# LANGUAGE DataKinds        #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MonoLocalBinds   #-}-{-# LANGUAGE MultiWayIf       #-}-{-# LANGUAGE ViewPatterns     #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ViewPatterns #-}  -- | -- Module    : Aura.Install@@ -24,6 +21,7 @@ import           Aura.Core import           Aura.Dependencies (resolveDeps) import           Aura.Diff (diff)+import           Aura.IO import           Aura.Languages import           Aura.Packages.AUR (aurLookup) import           Aura.Pacman (pacman, pacmanSuccess)@@ -32,15 +30,12 @@ import           Aura.Pkgbuild.Security import           Aura.Settings import           Aura.Types-import           Aura.Utils (fmapEither, optionalPrompt, putTextLn)+import           Aura.Utils import           Control.Scheduler (Comp(..), traverseConcurrently)-import           Data.Generics.Product (HasField'(..), field, super)-import           Data.Semigroup.Foldable (fold1)-import           Data.Set.NonEmpty (NESet)-import qualified Data.Set.NonEmpty as NES+import           Data.Text.Prettyprint.Doc+import           Data.Text.Prettyprint.Doc.Render.Terminal import           Language.Bash.Pretty (prettyText) import           Language.Bash.Syntax (ShellCommand)-import           Lens.Micro (each, (^..)) import           RIO hiding (FilePath) import           RIO.Directory (setCurrentDirectory) import qualified RIO.List as L@@ -48,24 +43,23 @@ import qualified RIO.NonEmpty as NEL import qualified RIO.Set as S import qualified RIO.Text as T-import           System.Path (fromAbsoluteFilePath)  --- --- | High level 'install' command. Handles installing--- dependencies.-install :: NESet PkgName -> RIO Env ()+-- | High level 'install' command. Handles installing dependencies.+install :: NonEmpty PkgName -> RIO Env () install pkgs = do   ss <- asks settings-  if | not $ switch ss DeleteMakeDeps -> install' pkgs-     | otherwise -> do -- `-a` was used.-         orphansBefore <- liftIO orphans-         install' pkgs-         orphansAfter <- liftIO orphans-         let makeDeps = NES.nonEmptySet (orphansAfter S.\\ orphansBefore)-         traverse_ (\mds -> liftIO (notify ss . removeMakeDepsAfter_1 $ langOf ss) *> removePkgs mds) makeDeps+  if not $ switch ss DeleteMakeDeps+    then install' pkgs+    else do -- `-a` was used.+      orphansBefore <- liftIO orphans+      install' pkgs+      orphansAfter <- liftIO orphans+      let makeDeps = nes $ orphansAfter S.\\ orphansBefore+      traverse_ (\mds -> liftIO (notify ss removeMakeDepsAfter_1) *> removePkgs mds) makeDeps -install' :: NESet PkgName -> RIO Env ()+install' :: NonEmpty PkgName -> RIO Env () install' pkgs = do   rpstry   <- asks repository   ss       <- asks settings@@ -73,34 +67,37 @@               (pure S.empty)               (S.fromList . catMaybes <$> liftIO (traverseConcurrently Par' isInstalled $ toList pkgs))               $ shared ss NeededOnly-  let !pkgs' = NES.toSet pkgs-  if | shared ss NeededOnly && unneeded == pkgs' -> liftIO . warn ss . install_2 $ langOf ss-     | otherwise -> do-         let (ignored, notIgnored) = S.partition (`S.member` ignoresOf ss) pkgs'-         installAnyway <- confirmIgnored ignored-         case NES.nonEmptySet $ (notIgnored <> installAnyway) S.\\ unneeded of-           Nothing        -> liftIO . warn ss . install_2 $ langOf ss-           Just toInstall -> do-             traverse_ (report yellow reportUnneededPackages_1) . NEL.nonEmpty $ toList unneeded-             (nons, toBuild) <- liftMaybeM (Failure connectionFailure_1) . liftIO $ aurLookup (managerOf ss) toInstall-             pkgbuildDiffs toBuild-             traverse_ (report red reportNonPackages_1) . NEL.nonEmpty $ toList nons-             case NES.nonEmptySet $ S.map (\b -> b { isExplicit = True }) toBuild of-               Nothing       -> throwM $ Failure install_2-               Just toBuild' -> do-                 liftIO $ notify ss (install_5 $ langOf ss) *> hFlush stdout-                 allPkgs <- depsToInstall rpstry toBuild'-                 let (repoPkgs, buildPkgs) = second uniquePkgBase $ partitionPkgs allPkgs-                 unless (switch ss NoPkgbuildCheck) $ traverse_ (traverse_ analysePkgbuild) buildPkgs-                 reportPkgsToInstall repoPkgs buildPkgs-                 unless (switch ss DryRun) $ do-                   continue <- liftIO $ optionalPrompt ss install_3-                   if | not continue -> throwM $ Failure install_4-                      | otherwise    -> do-                          traverse_ repoInstall $ NEL.nonEmpty repoPkgs-                          let !mbuildPkgs = NEL.nonEmpty buildPkgs-                          traverse_ (liftIO . storePkgbuilds . fold1) mbuildPkgs-                          traverse_ buildAndInstall mbuildPkgs+  let !pkgs' = S.fromList $ NEL.toList pkgs+  if shared ss NeededOnly && unneeded == pkgs'+    then warn ss install_2+    else do+      let (ignored, notIgnored) = S.partition (`S.member` ignoresOf ss) pkgs'+      installAnyway <- confirmIgnored ignored+      case nes $ (notIgnored <> installAnyway) S.\\ unneeded of+        Nothing        -> warn ss install_2+        Just toInstall -> do+          traverse_ (report yellow reportUnneededPackages_1) . NEL.nonEmpty+            $ toList unneeded+          (nons, toBuild) <- liftMaybeM (Failure connectFailure_1) . liftIO+            $ aurLookup (managerOf ss) toInstall+          pkgbuildDiffs toBuild+          traverse_ (report red reportNonPackages_1) . NEL.nonEmpty $ toList nons+          let !explicits = bool (S.map (\b -> b { bIsExplicit = True }) toBuild) toBuild+                $ switch ss AsDeps+          case nes explicits of+            Nothing       -> throwM $ Failure install_2+            Just toBuild' -> do+              notify ss install_5 *> hFlush stdout+              allPkgs <- depsToInstall rpstry toBuild'+              let (repoPkgs, buildPkgs) = second uniquePkgBase $ partitionPkgs allPkgs+              unless (switch ss NoPkgbuildCheck)+                $ traverse_ (traverse_ analysePkgbuild) buildPkgs+              reportPkgsToInstall repoPkgs buildPkgs+              unless (switch ss DryRun) . withOkay ss install_3 install_4 $ do+                traverse_ repoInstall $ NEL.nonEmpty repoPkgs+                let !mbuildPkgs = NEL.nonEmpty buildPkgs+                traverse_ (liftIO . storePkgbuilds . fold1) mbuildPkgs+                traverse_ buildAndInstall mbuildPkgs  -- | Determine if a package's PKGBUILD might contain malicious bash code. analysePkgbuild :: Buildable -> RIO Env ()@@ -109,96 +106,122 @@   let f = do         yes <- liftIO $ optionalPrompt ss security_6         when yes . throwM $ Failure security_7-  case parsedPB $ b ^. field @"pkgbuild" of-    Nothing -> liftIO (warn ss (security_1 (b ^. field @"name") $ langOf ss)) *> f+  case parsedPB $ bPkgbuild b of+    Nothing -> warn ss (security_1 $ bName b) *> f     Just l  -> case bannedTerms l of       []  -> pure ()       bts -> do-        liftIO $ scold ss (security_5 (b ^. field @"name") $ langOf ss)+        scold ss . security_5 $ bName b         liftIO $ traverse_ (displayBannedTerms ss) bts         f  displayBannedTerms :: Settings -> (ShellCommand, BannedTerm) -> IO () displayBannedTerms ss (stmt, b) = do   putTextLn . T.pack $ "\n    " <> prettyText stmt <> "\n"-  warn ss $ reportExploit b lang-  where lang = langOf ss+  warn ss $ reportExploit b  -- | Give anything that was installed as a dependency the /Install Reason/ of -- "Installed as a dependency for another package".-annotateDeps :: NESet Buildable -> IO ()-annotateDeps bs = unless (null bs') . void . pacmanSuccess $ ["-D", "--asdeps"] <> asFlag (bs' ^.. each . field @"name")-  where bs' = filter (not . isExplicit) $ toList bs+annotateDeps :: NonEmpty Buildable -> IO ()+annotateDeps bs = unless (null bs') . void . pacmanSuccess+  $ ["-D", "--asdeps"] <> asFlag (map bName bs')+  where+    bs' :: [Buildable]+    bs' = NEL.filter (not . bIsExplicit) bs  -- | Reduce a list of candidate packages to build, such that there is only one -- instance of each "Package Base". This will ensure that split packages will -- only be built once each. Precedence is given to packages that actually -- match the base name (e.g. llvm50 vs llvm50-libs).-uniquePkgBase :: [NESet Buildable] -> [NESet Buildable]-uniquePkgBase bs = mapMaybe (NES.nonEmptySet . S.filter (\b -> (b ^. field @"name") `S.member` goods) . NES.toSet) bs-  where f a b | (a ^. field @"name") == (a ^. field @"base") = a-              | (b ^. field @"name") == (b ^. field @"base") = b-              | otherwise = a-        goods = S.fromList . (^.. each . field @"name") . M.elems . M.fromListWith f $ map (view (field @"base") &&& id) bs'-        bs'   = foldMap toList bs+uniquePkgBase :: [NonEmpty Buildable] -> [NonEmpty Buildable]+uniquePkgBase bs = mapMaybe g bs+  where+    bs' :: [Buildable]+    bs' = foldMap NEL.toList bs +    g :: NonEmpty Buildable -> Maybe (NonEmpty Buildable)+    g = NEL.nonEmpty . L.nub . NEL.filter (\b -> bName b `S.member` goods)++    f :: Buildable -> Buildable -> Buildable+    f a b | bName a == bBase a = a+          | bName b == bBase b = b+          | otherwise = a++    goods :: Set PkgName+    goods = S.fromList . map bName . M.elems . M.fromListWith f $ map (bBase &&& id) bs'+ confirmIgnored :: Set PkgName -> RIO Env (Set PkgName) confirmIgnored (toList -> ps) = do   ss <- asks settings   S.fromList <$> filterM (liftIO . optionalPrompt ss . confirmIgnored_1) ps -depsToInstall :: Repository -> NESet Buildable -> RIO Env (NonEmpty (NESet Package))+-- | The nested `NonEmpty`s represent the package "hierarchy", namely, what can+-- be built/installed before what.+depsToInstall :: Repository -> NonEmpty Buildable -> RIO Env (NonEmpty (NonEmpty Package)) depsToInstall repo bs = do   ss <- asks settings-  traverse (liftIO . packageBuildable ss) (NES.toList bs) >>= resolveDeps repo . NES.fromList+  traverse (liftIO . packageBuildable ss) bs >>= resolveDeps repo  repoInstall :: NonEmpty Prebuilt -> RIO Env () repoInstall ps = do   pacOpts <- asks (asFlag . commonConfigOf . settings)-  liftIO . pacman $ ["-S", "--asdeps"] <> pacOpts <> asFlag (ps ^.. each . field @"name")+  liftIO . pacman $ ["-S", "--asdeps"] <> pacOpts <> asFlag (NEL.map pName ps) -buildAndInstall :: NonEmpty (NESet Buildable) -> RIO Env ()+buildAndInstall :: NonEmpty (NonEmpty Buildable) -> RIO Env () buildAndInstall bss = do   pth   <- asks (either id id . cachePathOf . commonConfigOf . settings)   cache <- liftIO $ cacheContents pth   traverse_ (f cache) bss-  where f (Cache cache) bs = do-          ss <- asks settings-          let (ps, cached) = fmapEither g $ toList bs-              g b = case (b ^. super @SimplePkg) `M.lookup` cache of-                Just pp | not (switch ss ForceBuilding) -> Right pp-                _                                       -> Left b-          built <- traverse (buildPackages . NES.fromList) $ NEL.nonEmpty ps-          traverse_ installPkgFiles $ built <> (NES.fromList <$> NEL.nonEmpty cached)-          liftIO $ annotateDeps bs+  where+    -- TODO There is a weird edge case (which might be impossible anyway) where+    -- `built` and the `traverse_` line below don't run, but `annotateDeps` is+    -- called anyway. There is definitely a better way to manage the `NonEmpty`s+    -- here.+    f :: Cache -> NonEmpty Buildable -> RIO Env ()+    f (Cache cache) bs = do+      ss <- asks settings+      let (ps, cached) = fmapEither g $ NEL.toList bs+          g b = case bToSP b `M.lookup` cache of+            Just pp | not (switch ss ForceBuilding) -> Right pp+            _                                       -> Left b+      built <- traverse buildPackages $ NEL.nonEmpty ps+      traverse_ installPkgFiles $ built <> NEL.nonEmpty cached+      liftIO $ annotateDeps bs  ------------ -- REPORTING ------------ -- | Display dependencies. The result of @-Ad@.-displayPkgDeps :: NESet PkgName -> RIO Env ()+displayPkgDeps :: NonEmpty PkgName -> RIO Env () displayPkgDeps ps = do   rpstry <- asks repository   ss <- asks settings-  let f = depsToInstall rpstry >=> reportDeps (switch ss LowVerbosity) . partitionPkgs-  (_, goods) <- liftMaybeM (Failure connectionFailure_1) . liftIO $ aurLookup (managerOf ss) ps-  traverse_ f $ NES.nonEmptySet goods-  where reportDeps True  = liftIO . uncurry reportListOfDeps-        reportDeps False = uncurry reportPkgsToInstall -reportPkgsToInstall :: [Prebuilt] -> [NESet Buildable] -> RIO Env ()+  let f :: NonEmpty Buildable -> RIO Env ()+      f = depsToInstall rpstry >=> reportDeps (switch ss LowVerbosity) . partitionPkgs++  (_, goods) <- liftMaybeM (Failure connectFailure_1) . liftIO $ aurLookup (managerOf ss) ps+  traverse_ f $ nes goods+  where+    reportDeps :: Bool -> ([Prebuilt], [NonEmpty Buildable]) -> RIO Env ()+    reportDeps True  = liftIO . uncurry reportListOfDeps+    reportDeps False = uncurry reportPkgsToInstall++reportPkgsToInstall :: [Prebuilt] -> [NonEmpty Buildable] -> RIO Env () reportPkgsToInstall rps bps = do-  let (explicits, ds) = L.partition isExplicit $ foldMap toList bps-  f reportPkgsToInstall_1 rps-  f reportPkgsToInstall_3 ds-  f reportPkgsToInstall_2 explicits+  let (explicits, ds) = L.partition bIsExplicit $ foldMap NEL.toList bps+  f reportPkgsToInstall_1 $ map pName rps+  f reportPkgsToInstall_3 $ map bName ds+  f reportPkgsToInstall_2 $ map bName explicits   where-    f m xs = traverse_ (report green m) . NEL.nonEmpty . L.sort $ xs ^.. each . field @"name"+    f :: (Language -> Doc AnsiStyle) -> [PkgName] -> RIO Env ()+    f m xs = traverse_ (report green m) . NEL.nonEmpty $ L.sort xs -reportListOfDeps :: [Prebuilt] -> [NESet Buildable] -> IO ()-reportListOfDeps rps bps = f rps *> f (foldMap toList bps)-  where f :: HasField' "name" s PkgName => [s] -> IO ()-        f = traverse_ putTextLn . L.sort . (^.. each . field' @"name" . field' @"name")+reportListOfDeps :: [Prebuilt] -> [NonEmpty Buildable] -> IO ()+reportListOfDeps rps bps = f (map pName rps) *> f (map bName $ foldMap NEL.toList bps)+  where+    f :: [PkgName] -> IO ()+    f = traverse_ putTextLn . L.sort . map pnName  pkgbuildDiffs :: Set Buildable -> RIO Env () pkgbuildDiffs ps = asks settings >>= check@@ -210,14 +233,13 @@     displayDiff :: Buildable -> RIO Env ()     displayDiff p = do       ss <- asks settings-      let pn   = p ^. field @"name"-          lang = langOf ss+      let pn = bName p       isStored <- liftIO $ hasPkgbuildStored pn       if not isStored-        then liftIO . warn ss $ reportPkgbuildDiffs_1 pn lang+        then warn ss $ reportPkgbuildDiffs_1 pn         else liftIO $ do           setCurrentDirectory "/tmp"           let new = "/tmp/new.pb"-          writeFileBinary new $ p ^. field @"pkgbuild" . field @"pkgbuild"-          liftIO . warn ss $ reportPkgbuildDiffs_3 pn lang-          diff ss (pkgbuildPath pn) $ fromAbsoluteFilePath new+          writeFileBinary new . pkgbuild $ bPkgbuild p+          warn ss $ reportPkgbuildDiffs_3 pn+          diff ss (pkgbuildPath pn) new

@@ -1,5 +1,5 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE ViewPatterns      #-}+{-# LANGUAGE LambdaCase   #-}+{-# LANGUAGE ViewPatterns #-}  {-# OPTIONS_HADDOCK prune #-} {-# OPTIONS_GHC -fno-warn-missing-export-lists #-}@@ -29,6 +29,7 @@ Kai Zhang                                     | Chinese Onoue Takuro                                  | Japanese Zachary "Ghosy" Matthews                      | Esperanto+Joris Blanken                                 | Dutch -}  module Aura.Languages where@@ -36,7 +37,6 @@ import           Aura.Colour import qualified Aura.Languages.Fields as Fields import           Aura.Types-import           Data.Generics.Product (field) import           Data.Ratio ((%)) import           Data.Text.Prettyprint.Doc import           Data.Text.Prettyprint.Doc.Render.Terminal@@ -65,27 +65,29 @@     , (Chinese,    "Kai Zhang")     , (Japanese,   "Onoue Takuro")     , (Esperanto,  "Zachary Matthews")+    , (Dutch,      "Joris Blanken")     ]  -- These need updating! Or removing... languageNames :: Language -> Map Language T.Text-languageNames = M.fromList . zip [ Japanese, Polish, Croatian, Swedish, German, Spanish, Portuguese, French, Russian, Italian, Serbian, Norwegian, Indonesia, Chinese, Esperanto ] . \case-    Japanese   -> [ "日本語", "ポーランド語", "クロアチア語", "スウェーデン語", "ドイツ語", "スペイン語", "ポルトガル語", "フランス語", "ロシア語", "イタリア語", "セルビア語", "ノルウェー語", "インドネシア語", "中国語", "エスペラント" ]-    Polish     -> [ "Japanese", "polski", "chorwacki", "szwedzki", "niemiecki", "hiszpański", "portugalski", "francuski", "rosyjski", "", "", "", "Indonesian", "Chinese", "Esperanto" ]-    Croatian   -> [ "Japanese", "poljski", "hrvatski", "švedski", "njemački", "španjolski", "portugalski", "francuski", "ruski", "talijanski", "srpski", "norveški", "Indonesian", "Chinese", "Esperanto" ]-    Swedish    -> [ "Japanese", "Polska", "Kroatiska", "Svenska", "Tyska", "Spanska", "Portugisiska", "Franska", "Ryska", "Italienska", "Serbiska", "Norska", "Indonesian", "Chinese", "Esperanto" ]-    German     -> [ "Japanisch", "Polnisch", "Kroatisch", "Schwedisch", "Deutsch", "Spanisch", "Portugiesisch", "Französisch", "Russisch", "Italienisch", "Serbisch", "Norwegisch", "Indonesisch", "Chinese", "Esperanto" ]-    Spanish    -> [ "Japanese", "Polaco", "Croata", "Sueco", "Alemán", "Español", "Portugués", "Francés", "Ruso", "Italiano", "Serbio", "Noruego", "Indonesio", "Chinese", "Esperanto" ]-    Portuguese -> [ "Japonês", "Polonês", "Croata", "Sueco", "Alemão", "Espanhol", "Português", "Francês", "Russo", "Italiano", "Sérvio", "Norueguês", "Indonésio", "Chinês", "Esperanto" ]-    French     -> [ "Japanese", "Polonais", "Croate", "Suédois", "Allemand", "Espagnol", "Portugais", "Français", "Russe", "Italien", "Serbe", "Norvégien", "Indonesian", "Chinese", "Esperanto" ]-    Russian    -> [ "Японский", "Польский", "Хорватский", "Шведский", "Немецкий", "Испанский", "Португальский", "Французский", "Русский", "Итальянский", "Сербский", "Норвежский", "Индонезийский", "Китайский", "Эсперанто" ]-    Italian    -> [ "Giapponese", "Polacco", "Croato", "Svedese", "Tedesco", "Spagnolo", "Portoghese", "Francese", "Russo", "Italiano", "Serbo", "Norvegese", "Indonesiano", "Cinese", "Esperanto" ]-    Serbian    -> [ "Japanese", "Пољски", "Хрватски", "Шведски", "Немачки", "Шпански", "Португалски", "Француски", "Руски", "Италијански", "Српски", "", "Indonesian", "Chinese", "Esperanto" ]-    Norwegian  -> [ "Japanese", "Polsk", "Kroatisk", "Svensk", "Tysk", "Spansk", "Portugisisk", "Fransk", "Russisk", "Italiensk", "Serbisk", "Norsk", "Indonesian", "Chinese", "Esperanto" ]-    Indonesia  -> [ "Japanese", "Polandia", "Kroasia", "Swedia", "Jerman", "Spanyol", "Portugis", "Prancis", "Rusia", "Italia", "Serbia", "Norwegia", "Indonesian", "Chinese", "Esperanto" ]-    Chinese    -> [ "日语", "波兰语", "克罗地亚语", "瑞典语", "德语", "西班牙语", "葡萄牙语", "法语", "俄语", "意大利语", "塞尔维亚语", "挪威语", "印度尼西亚语", "中文", "世界语" ]-    Esperanto  -> [ "La japana", "La pola", "La kroata", "La sevda", "La germana", "La hispana", "La portugala", "La franca", "La rusa", "La itala", "La serba", "La norvega", "La indonezia", "La ĉina", "Esperanto" ]-    _          -> [ "Japanese", "Polish", "Croatian", "Swedish", "German", "Spanish", "Portuguese", "French", "Russian", "Italian", "Serbian", "Norwegian", "Indonesian", "Chinese", "Esperanto" ]+languageNames = M.fromList . zip [ Japanese, Polish, Croatian, Swedish, German, Spanish, Portuguese, French, Russian, Italian, Serbian, Norwegian, Indonesia, Chinese, Esperanto, Dutch ] . \case+    Japanese   -> [ "日本語", "ポーランド語", "クロアチア語", "スウェーデン語", "ドイツ語", "スペイン語", "ポルトガル語", "フランス語", "ロシア語", "イタリア語", "セルビア語", "ノルウェー語", "インドネシア語", "中国語", "エスペラント", "オランダ語" ]+    Polish     -> [ "Japanese", "polski", "chorwacki", "szwedzki", "niemiecki", "hiszpański", "portugalski", "francuski", "rosyjski", "", "", "", "Indonesian", "Chinese", "Esperanto", "Dutch" ]+    Croatian   -> [ "Japanese", "poljski", "hrvatski", "švedski", "njemački", "španjolski", "portugalski", "francuski", "ruski", "talijanski", "srpski", "norveški", "Indonesian", "Chinese", "Esperanto", "Dutch" ]+    Swedish    -> [ "Japanese", "Polska", "Kroatiska", "Svenska", "Tyska", "Spanska", "Portugisiska", "Franska", "Ryska", "Italienska", "Serbiska", "Norska", "Indonesian", "Chinese", "Esperanto", "Dutch" ]+    German     -> [ "Japanisch", "Polnisch", "Kroatisch", "Schwedisch", "Deutsch", "Spanisch", "Portugiesisch", "Französisch", "Russisch", "Italienisch", "Serbisch", "Norwegisch", "Indonesisch", "Chinese", "Esperanto", "Dutch" ]+    Spanish    -> [ "Japanese", "Polaco", "Croata", "Sueco", "Alemán", "Español", "Portugués", "Francés", "Ruso", "Italiano", "Serbio", "Noruego", "Indonesio", "Chinese", "Esperanto", "Dutch" ]+    Portuguese -> [ "Japonês", "Polonês", "Croata", "Sueco", "Alemão", "Espanhol", "Português", "Francês", "Russo", "Italiano", "Sérvio", "Norueguês", "Indonésio", "Chinês", "Esperanto", "Dutch" ]+    French     -> [ "Japanese", "Polonais", "Croate", "Suédois", "Allemand", "Espagnol", "Portugais", "Français", "Russe", "Italien", "Serbe", "Norvégien", "Indonesian", "Chinese", "Esperanto", "Dutch" ]+    Russian    -> [ "Японский", "Польский", "Хорватский", "Шведский", "Немецкий", "Испанский", "Португальский", "Французский", "Русский", "Итальянский", "Сербский", "Норвежский", "Индонезийский", "Китайский", "Эсперанто", "Dutch" ]+    Italian    -> [ "Giapponese", "Polacco", "Croato", "Svedese", "Tedesco", "Spagnolo", "Portoghese", "Francese", "Russo", "Italiano", "Serbo", "Norvegese", "Indonesiano", "Cinese", "Esperanto", "Dutch" ]+    Serbian    -> [ "Japanese", "Пољски", "Хрватски", "Шведски", "Немачки", "Шпански", "Португалски", "Француски", "Руски", "Италијански", "Српски", "", "Indonesian", "Chinese", "Esperanto", "Dutch" ]+    Norwegian  -> [ "Japanese", "Polsk", "Kroatisk", "Svensk", "Tysk", "Spansk", "Portugisisk", "Fransk", "Russisk", "Italiensk", "Serbisk", "Norsk", "Indonesian", "Chinese", "Esperanto", "Dutch" ]+    Indonesia  -> [ "Japanese", "Polandia", "Kroasia", "Swedia", "Jerman", "Spanyol", "Portugis", "Prancis", "Rusia", "Italia", "Serbia", "Norwegia", "Indonesian", "Chinese", "Esperanto", "Dutch" ]+    Chinese    -> [ "日语", "波兰语", "克罗地亚语", "瑞典语", "德语", "西班牙语", "葡萄牙语", "法语", "俄语", "意大利语", "塞尔维亚语", "挪威语", "印度尼西亚语", "中文", "世界语", "Dutch" ]+    Esperanto  -> [ "La japana", "La pola", "La kroata", "La sevda", "La germana", "La hispana", "La portugala", "La franca", "La rusa", "La itala", "La serba", "La norvega", "La indonezia", "La ĉina", "Esperanto", "La nederlanda" ]+    Dutch      -> [ "Japans", "Pools", "Kroatisch", "Zweeds", "Duits", "Spaans", "Portugees", "Frans", "Russisch", "Italiaans", "Servisch", "Noors", "Indonesisch", "Chinees", "Esperanto", "Nederlands" ]+    _          -> [ "Japanese", "Polish", "Croatian", "Swedish", "German", "Spanish", "Portuguese", "French", "Russian", "Italian", "Serbian", "Norwegian", "Indonesian", "Chinese", "Esperanto", "Dutch" ]  translatorMsgTitle :: Language -> Text translatorMsgTitle = \case@@ -104,6 +106,7 @@     Indonesia  -> "Penerjemah Aura:"     Chinese    -> "Aura 的翻译者："     Esperanto  -> "Tradukistoj de Aura:"+    Dutch      -> "Aura Vertalers:"     _          -> "Aura Translators:"  translatorMsg :: Language -> [Text]@@ -115,9 +118,9 @@         formatLang (translator, lang') = " (" <> lang' <> ") " <> translator         langNames = languageNames lang --- Wrap a String in backticks+-- | Make some `Text` cyan. Previous wrapped things in backticks. bt :: Text -> Doc AnsiStyle-bt cs = "`" <> pretty cs <> "`"+bt cs = cyan $ pretty cs  whitespace :: Language -> Char whitespace Japanese = '　'  -- \12288@@ -140,6 +143,7 @@     "id" -> Indonesia     "zh" -> Chinese     "eo" -> Esperanto+    "nl" -> Dutch     _    -> English  ----------------------@@ -161,6 +165,7 @@     Chinese    -> "包数据库已锁定。请在解锁后按下回车以继续。"     Swedish    -> "Paketdatabasen är låst. Klicka på enter när den är upplåst."     Esperanto  -> "La datumbazo de pakaĵoj estas ŝlosita. Premu enen-klavo kiam la datumbazo estas malŝlosita por daŭrigi"+    Dutch      -> "De pakket databank is vergrendelt. Druk op enter wanneer het ontgrendelt is."     _          -> "The package database is locked. Press enter when it's unlocked to continue."  trueRoot_3 :: Language -> Doc AnsiStyle@@ -174,6 +179,7 @@     Chinese    -> "自从 makepkg v4.2 以后，就不能以根用户身份构建软件了。"     Swedish    -> "I makepkg v4.2 och uppåt är det inte tillåtet att bygga som root."     Esperanto  -> "Depost makepkg v4.2, konstruanto ĉefuzante ne eblas."+    Dutch      -> "Vanaf makepkg v4.2 is het niet langer mogelijk om als root te bouwen."     _          -> "As of makepkg v4.2, building as root is no longer possible."  mustBeRoot_1 :: Language -> Doc AnsiStyle@@ -193,13 +199,14 @@     Indonesia  -> "Anda harus menggunakan " <> sudo <> " untuk melakukannya."     Chinese    -> "除非是根用户，否则不能执行此操作。"     Esperanto  -> "Vi ne povas fari ĉi tiun operacion, sen " <> sudo <> "."+    Dutch      -> "U kunt deze operatie niet uitvoeren zonder " <> sudo <> " te gebruiken."     _          -> "You cannot perform this operation without using sudo."  ----------------------- -- Aura/Build functions ----------------------- buildPackages_1 :: PkgName -> Language -> Doc AnsiStyle-buildPackages_1 (bt . view (field @"name") -> p) = \case+buildPackages_1 (bt . pnName -> p) = \case     Japanese   -> p <> "を作成中・・・"     Polish     -> "Budowanie " <> p <> "..."     Croatian   -> "Gradim " <> p <> "..."@@ -214,7 +221,8 @@     Norwegian  -> "Bygger " <> p <> "..."     Indonesia  -> "Membangun " <> p <> "..."     Chinese    -> p <> " 正在构建中..."-    Esperanto  -> "Muntanta" <> p <> "..."+    Esperanto  -> "Muntanta " <> p <> "..."+    Dutch      -> "Pakket " <> p <> " aan het bouwen..."     _          -> "Building " <> p <> "..."  buildFail_5 :: Language -> Doc AnsiStyle@@ -234,6 +242,7 @@     Indonesia  -> "Proses gagal."     Chinese    -> "构建失败。"     Esperanto  -> "Muntado paneis"+    Dutch      -> "Bouwen is mislukt."     _          -> "Building failed."  -- NEEDS TRANSLATION@@ -253,11 +262,12 @@     Chinese    -> "你仍然希望继续吗？"     Swedish    -> "Vill du fortsätta ändå?"     Esperanto  -> "Ĉu vi volas daŭrigi?"+    Dutch      -> "Wilt U toch doorgaan?"     _          -> "Would you like to continue anyway?"  -- NEEDS TRANSLATION buildFail_7 :: PkgName -> Language -> Doc AnsiStyle-buildFail_7 (bt . view (field @"name") -> p) = \case+buildFail_7 (bt . pnName -> p) = \case     Japanese   -> p <> "のビルドスクリプトを収得できませんでした。"     Polish     -> "Nie udało się pozyskać skryptów budowania dla " <> p <> "."     German     -> "Herunterladen der Build-Skripte für " <> p <> " fehlgeschlagen."@@ -269,6 +279,7 @@     Chinese    -> "无法获得 " <> p <> " 的构建脚本。"     Swedish    -> "Kunde inte hämta byggskript för " <> p <> "."     Esperanto  -> "Paneis akiri muntaj skriptoj de " <> p <> "."+    Dutch      -> "Verkrijgen van bouw scripten mislukt voor " <> p <> "."     _          -> "Failed to obtain build scripts for " <> p <> "."  buildFail_8 :: Language -> Doc AnsiStyle@@ -279,6 +290,7 @@     Russian    -> "Произошла ошибка makepkg."     Italian    -> "C'è stato un errore nell'esecuzione di makepkg."     Esperanto  -> "Paneo de makepkg okazis."+    Dutch      -> "Er is een fout opgetreden in makepkg."     _          -> "There was a makepkg failure."  buildFail_9 :: Language -> Doc AnsiStyle@@ -286,6 +298,7 @@   Spanish   -> "Error al detectar todos los archivo de paquete (*.pkg.tar.xz)."   Italian   -> "Non è stato possibile trovare nessun archivio risultante dalla compilazione del pacchetto (*.pkg.tar.xz)."   Esperanto -> "Paneis detekti ĉiujn dosierojn de pakaĵoj (*.pkg.tar.xz)."+  Dutch     -> "Detecteren van built package files mislukt (*.pkg.tar.xz)."   _         -> "Failed to detect any built package files (*.pkg.tar.xz)."  buildFail_10 :: Language -> Doc AnsiStyle@@ -293,6 +306,7 @@   Spanish   -> "Los paquetes no se pudieron construir."   Italian   -> "Non è stato possibile compilare i pacchetti."   Esperanto -> "Ĉiuj pakaĵoj paneis munti."+  Dutch     -> "Het bouwen van alle pakketten is mislukt."   _         -> "Every package failed to build."  buildFail_11 :: Language -> Doc AnsiStyle@@ -301,6 +315,7 @@   Spanish    -> "Construcción fallida. ¿Te gustaría ver el error?"   Italian    -> "La compilazione è fallita. Visionare l'errore?"   Esperanto  -> "Muntado paneis. Ĉu vi volas vidi la eraron?"+  Dutch      -> "Bouwen mislukt. Wilt U de fouten zien?"   _          -> "Building failed. Would you like to see the error?"  ------------------------------@@ -308,7 +323,7 @@ ------------------------------ -- NEEDS UPDATE TO MATCH NEW ENGLISH getRealPkgConflicts_1 :: PkgName -> PkgName -> Text -> Text -> Language -> Doc AnsiStyle-getRealPkgConflicts_1 (bt . view (field @"name") -> prnt) (bt . view (field @"name") -> p) (bt -> r) (bt -> d) = \case+getRealPkgConflicts_1 (bt . pnName -> prnt) (bt . pnName -> p) (bt -> r) (bt -> d) = \case     Japanese   -> "パッケージ" <> p <> "はバージョン" <> d <> "を要するが" <> "一番最新のバージョンは" <> r <> "。"     Polish     -> "Zależność " <> p <> " powinna być w wersji " <> d <> ", ale najnowsza wersja to " <> r <> "."     Croatian   -> "Zavisnost " <> p <> " zahtjeva verziju " <> d <> ", a najnovija dostupna verzija je " <> r <> "."@@ -324,10 +339,11 @@     Indonesia  -> "Dependensi " <> p <> " meminta versi " <> d <> " namun versi paling baru adalah " <> r <> "."     Chinese    -> "依赖 " <> p <> " 需要版本 " <> d <> "，但是最新的版本是 " <> r <> "。"     Esperanto  -> "La pakaĵo, " <> prnt <> ", dependas de versio " <> d <> " de " <> p <> ", sed la plej nova versio estas " <> r <> "."+    Dutch      -> "Het pakket " <> prnt <> ", hangt af van versie " <> d <> " van " <> p <> ", maar de meest recente versie is " <> r <> "."     _          -> "The package " <> prnt <> " depends on version " <> d <> " of " <> p <> ", but the most recent version is " <> r <> "."  getRealPkgConflicts_2 :: PkgName -> Language -> Doc AnsiStyle-getRealPkgConflicts_2 (bt . view (field @"name") -> p) = \case+getRealPkgConflicts_2 (bt . pnName -> p) = \case   Japanese   -> p <> "は無視されるパッケージ！`pacman.conf`を参考に。"   Polish     -> p <> " jest ignorowany! Sprawdź plik `pacman.conf`."   Croatian   -> p <> " je ignoriran paket! Provjerite svoj `pacman.conf`."@@ -343,6 +359,7 @@   Indonesia  -> p <> " merupakan paket yang diabaikan! Lihat `pacman.conf` anda."   Chinese    -> p <> " 是一个被忽略的包！请查看你的 `pacman.conf` 文件。"   Esperanto  -> p <> " estas malatenta pakaĵo! Vidu vian `pacman.conf` dosieron."+  Dutch      -> p <> " is een genegeerd pakket! Bekijk uw `pacman.conf` file."   _          -> p <> " is an ignored package! See your `pacman.conf` file."  missingPkg_2 :: [DepError] -> Language -> Doc AnsiStyle@@ -351,18 +368,20 @@ depError :: Language -> DepError -> Doc AnsiStyle depError _ (VerConflict s) = s depError _ (Ignored s)     = s-depError l (NonExistant (PkgName s)) = case l of+depError l (NonExistant (PkgName s) (PkgName par)) = case l of   Spanish    -> "La dependencia " <> bt s <> " no pudo ser encontrada."   Portuguese -> "A dependência " <> bt s <> " não foi encontrada."   Russian    -> "Зависимость " <> bt s <> " не найдена."   Italian    -> "Non è stato possibile trovare la dipendenza " <> bt s <> "."-  Esperanto  -> "La dependeco " <> bt s <> " ne povis troviĝi."-  _          -> "The dependency " <> bt s <> " couldn't be found."+  Esperanto  -> "La dependeco " <> bt s <> " de " <> bt par <> " ne povis troviĝi."+  Dutch      -> "Het afhankelijkheid " <> bt s <> "kan niet worden gevonden."+  _          -> "The dependency " <> bt s <> " of " <> bt par <> " couldn't be found." depError l (BrokenProvides (PkgName pkg) (Provides (PkgName pro)) (PkgName n)) = case l of   Spanish    -> "El paquete " <> bt pkg <> " necesita " <> bt n <> " que proporciona " <> bt pro <> "."   Russian    -> "Пакету " <> bt pkg <> " требуется " <> bt n <> ", предоставляющий " <> bt pro <> "."   Esperanto  -> "La pakaĵo, " <> bt pkg <> " bezonas " <> bt n <> ", kiu donas " <> bt pro <> "."   Italian    -> "Il pacchetto " <> bt pkg <> " ha bisogno di " <> bt n <> ", che rende disponibile " <> bt pro <> "."+  Dutch      -> "Het pakket" <> bt pkg <> " heeft " <> bt n <> " nodig, die " <> bt pro <> " biedt."   _          -> "The package " <> bt pkg <> " needs " <> bt n <> ", which provides " <> bt pro <> "."  missingPkg_3 :: Language -> Doc AnsiStyle@@ -370,18 +389,23 @@   Spanish    -> "Se produjo un error al reorganizar el gráfico de dependencia. Si ves esto, algo está muy mal."   Esperanto  -> "Eraro okazis kiam reorganizi la grafeo de dependeco. Io estas erarega."   Italian    -> "C'è stato un errore nella riorganizzazione della gerarchia delle dipendenze. Se vedi questo messaggio, qualcosa è andato davvero storto."+  Dutch      -> "Er is een fout opgetreden bij het reorganizeren van de afhankelijkheidsgrafiek. Als U dit ziet, is er iets heel erg mis."   _          -> "There was an error reorganizing the dependency graph. If you see this, something is very wrong."  missingPkg_4 :: [NonEmpty PkgName] -> Language -> Doc AnsiStyle missingPkg_4 pns = \case   Spanish    -> vsep $ "Se detectaron los siguientes ciclos de dependencia:" : pns'   Italian    -> vsep $ "Sono stati individuati i seguenti cicli di dipendenza:" : pns'+  Dutch      -> vsep $ "The volgende afhankelijkheidscycli zijn gedetecteerd:" : pns'   _ -> vsep $ "The following dependency cycles were detected:" : pns'-  where pns' = map (hsep . map pretty . L.intersperse "=>" . map (view (field @"name")) . toList) pns+  where+    pns' :: [Doc ann]+    pns' = map (hsep . map pretty . L.intersperse "=>" . map pnName . toList) pns  missingPkg_5 :: PkgName -> Language -> Doc AnsiStyle missingPkg_5 (PkgName p) = \case   Italian   -> bt p <> " non esiste."+  Dutch     -> bt p <> " bestaat niet."   _         -> bt p <> " does not exist."  -----------------@@ -404,6 +428,7 @@     Indonesia  -> "Berikut ini adalah bahasa yang tersedia:"     Chinese    -> "以下语言是可用的："     Esperanto  -> "La sekvaj lingvo estas disponebla:"+    Dutch      -> "De volgende talen zijn beschikbaar:"     _          -> "The following languages are available:"  ----------------------------@@ -426,6 +451,7 @@     Chinese    -> "Aura 可以升级。先升级 aura？"     Swedish    -> "Det finns en uppdatering tillgänglig till Aura. Vill du uppdatera Aura först?"     Esperanto  -> "Ĝisdatigo de Aura estas disponebla. Ĉu ĝisdatigas ĝin?"+    Dutch      -> "Aura update beschikbaar. Eerst updaten?"     _          -> "Aura update available. Update it first?"  install_2 :: Language -> Doc AnsiStyle@@ -445,6 +471,7 @@     Indonesia  -> "Tidak ada paket valid yang dispesifikkan."     Chinese    -> "没有指定有效的包。"     Esperanto  -> "Ne validajn pakaĵojn specifis"+    Dutch      -> "Geen geldige pakketen gespecificeerd."     _          -> "No valid packages specified."  install_3 :: Language -> Doc AnsiStyle@@ -464,6 +491,7 @@     Indonesia  -> "Lanjut?"     Chinese    -> "继续？"     Esperanto  -> "Ĉu daŭrigi?"+    Dutch      -> "Doorgaan?"     _          -> "Continue?"  install_4 :: Language -> Doc AnsiStyle@@ -483,6 +511,7 @@     Indonesia  -> "Instalasi dibatalkan secara paksa."     Chinese    -> "手动安装已中止。"     Esperanto  -> "Instalon ĉesigi permane"+    Dutch      -> "Installatie handmatig afgebroken."     _          -> "Installation manually aborted."  install_5 :: Language -> Doc AnsiStyle@@ -502,11 +531,12 @@     Indonesia  -> "Menentukan dependensi..."     Chinese    -> "确定依赖中..."     Esperanto  -> "Difinas dependecojn..."+    Dutch      -> "Afhankelijkheden aan het bepalen..."     _          -> "Determining dependencies..."  -- 2014 December  7 @ 14:45 - NEEDS TRANSLATIONS confirmIgnored_1 :: PkgName -> Language -> Doc AnsiStyle-confirmIgnored_1 (bt . view (field @"name") -> p) = \case+confirmIgnored_1 (bt . pnName -> p) = \case     Japanese   -> p <> "は無視されるはずのパッケージです。それでも続行しますか？"     Polish     -> p <> " jest oznaczony jako ignorowany. Zainstalować mimo tego?"     Spanish    -> p <> " está marcado como ignorado. ¿Deseas instalarlo de todas formas?"@@ -516,6 +546,7 @@     Chinese    -> p <> " 已被标记为忽略。仍然安装？"     Swedish    -> p <> " är markerad som ignorerad. Vill du installera ändå?"     Esperanto  -> p <> " estas markita kiel malatenta. Ĉu instali?"+    Dutch      -> p <> " is gemarkeerd als genegeerd. Toch installeren?"     _          -> p <> " is marked as Ignored. Install anyway?"  -- NEEDS UPDATE TO REFLECT CHANGED ENGLISH@@ -536,6 +567,7 @@     Indonesia  -> "Paket berikut ini bukan merupakan paket AUR:"     Chinese    -> "以下软件不是 AUR 包："     Esperanto  -> "La sekvaj ne estas pakaĵoj de la AUR:"+    Dutch      -> "De volgende pakketten zijn geen AUR pakketten:"     _          -> "The following are not AUR packages:"  -- NEEDS TRANSLATION@@ -551,6 +583,7 @@     Chinese    -> "以下包已被安装："     Swedish    -> "Följande paket är redan installerade:"     Esperanto  -> "La sekvaj pakaĵoj jam instaliĝas:"+    Dutch      -> "The volgende pakketten zijn al geinstalleerd:"     _          -> "The following packages are already installed:"  reportPkgsToInstall_1 :: Language -> Doc AnsiStyle@@ -570,6 +603,7 @@     Indonesia  -> "Dependensi dari repositori:"     Chinese    -> "仓库依赖："     Esperanto  -> "Dependecoj de deponejo:"+    Dutch      -> "Repository afhankelijkheden:"     _          -> "Repository dependencies:"  -- NEEDS AN UPDATE@@ -589,6 +623,7 @@     Chinese    -> "AUR 包："     Swedish    -> "AUR Paket:"     Esperanto  -> "Pakaĵoj de AUR:"+    Dutch      -> "AUR Pakketten:"     _          -> "AUR Packages:"  reportPkgsToInstall_3 :: Language -> Doc AnsiStyle@@ -606,11 +641,12 @@     Serbian    -> "Зависности из AUR-а:"     Norwegian  -> "Avhengigheter fra AUR:"     Esperanto  -> "Dependencoj de AUR:"+    Dutch      -> "AUR-afhankelijkheden:"     _          -> "AUR dependencies:"  -- NEEDS TRANSLATION reportPkgbuildDiffs_1 :: PkgName -> Language -> Doc AnsiStyle-reportPkgbuildDiffs_1 (bt . view (field @"name") -> p) = \case+reportPkgbuildDiffs_1 (bt . pnName -> p) = \case     Japanese   -> p <> "のPKGBUILDはまだ保存されていません。"     Polish     -> p <> " nie ma jeszcze przechowywanego pliku PKGBUILD."     Croatian   -> p <> " još nema pohranjen PKGBUILD."@@ -626,31 +662,12 @@     Chinese    -> p <> " 还没有保存的 PKGBUILD。"     Swedish    -> p <> " har ännu ingen PKGBUILD."     Esperanto  -> p <> " ne havas PKGBUILD jam."+    Dutch      -> p <> " heeft nog geen opgeslagen PKGBUILD."     _          -> p <> " has no stored PKGBUILD yet."  -- NEEDS TRANSLATION-reportPkgbuildDiffs_2 :: Text -> Language -> Doc AnsiStyle-reportPkgbuildDiffs_2 (bt -> p) = \case-    Japanese   -> p <> "のPKGBUILDは最新です。"-    Polish     -> "PKGBUILD pakietu " <> p <> " jest aktualny."-    Croatian   -> "PKGBUILD paketa " <> p <> " je na najnovijoj verziji."-    German     -> "PKGBUILD von " <> p <> " ist aktuell."-    Spanish    -> "El PKGBUILD de " <> p <> " está actualizado."-    Portuguese -> "O PKGBUILD de " <> p <> "está atualizado."-    Russian    -> "PKGBUILD " <> p <> " является новейшим."-    French     -> "Le PKGBUILD de " <> p <> " est à jour."-    Italian    -> "Il PKGBUILD di " <> p <> " è aggiornato all'ultima versione."-    Serbian    -> "PKGBUILD пакета " <> p <> " је ажуран."-    Norwegian  -> p <> "'s PKGBUILD er oppdatert."-    Indonesia  -> "PKGBUILD dari paket " <> p <> " sudah mutakhir."-    Chinese    -> p <> " 的 PKGBUILD 已经最新。"-    Swedish    -> "PKGBUILD för " <> p <> " är aktuell."-    Esperanto  -> p <> " PKGBUILD estas ĝisdata."-    _          -> p <> " PKGBUILD is up to date."---- NEEDS TRANSLATION reportPkgbuildDiffs_3 :: PkgName -> Language -> Doc AnsiStyle-reportPkgbuildDiffs_3 (bt . view (field @"name") -> p) = \case+reportPkgbuildDiffs_3 (bt . pnName -> p) = \case     Japanese   -> p <> "のPKGBUILD変更報告："     Polish     -> "Zmiany w PKGBUILD dla " <> p <> ":"     Croatian   -> "Promjene u PKGBUILD-u za " <> p <> ":"@@ -666,6 +683,7 @@     Chinese    -> p <> " 的 PKGBUILD 变化："     Swedish    -> "Förändringar i PKGBUILD för " <> p <> ":"     Esperanto  -> p <> " PKGBUILD ŝanĝoj:"+    Dutch      -> p <> " PKGBUILD aanpassingen:"     _          -> p <> " PKGBUILD changes:"  -- NEEDS TRANSLATION@@ -686,6 +704,7 @@     Indonesia  -> "Paket AUR yang akan ditingkatkan:"     Chinese    -> "要升级的 AUR 包："     Esperanto  -> "Pakaĵoj de AUR ĝisdatigi:"+    Dutch      -> "AUR-Pakketten om te upgraden:"     _          -> "AUR Packages to upgrade:"  -- NEEDS UPDATING@@ -706,12 +725,14 @@     Indonesia  -> "Berikut ini tidak mempunyai versi pada cache, sehingga tidak akan diturunkan:"     Chinese    -> "以下包在缓存中没有版本，所以无法被降级："     Esperanto  -> "La sekvaj pakaĵoj havas ne kaŝmemorigitajn versiojn, do ĝi ne povas malpromociigi:"+    Dutch      -> "De volgende pakketten hebben geen versie in de cache, en kunnen dus niet gedowngrade worden."     _          -> "The following have no versions in the cache, and thus can’t be downgraded:"  reportBadDowngradePkgs_2 :: PkgName -> Language -> Doc AnsiStyle reportBadDowngradePkgs_2 (PkgName p) = \case   Spanish     -> pretty p <+> "no tiene una versión en la caché."   Italian     -> pretty p <+> "non ha alcuna versione nella cache."+  Dutch       -> pretty p <+> "heeft geen versie in de cache."   _ -> pretty p <+> "has no version in the cache."  upgradeAURPkgs_1 :: Language -> Doc AnsiStyle@@ -731,6 +752,7 @@     Indonesia  -> "Mengambil informasi paket..."     Chinese    -> "正在获取包信息..."     Esperanto  -> "Venigas informacion de pakaĵoj..."+    Dutch      -> "Pakket informatie aan het ophalen..."     _          -> "Fetching package information..."  upgradeAURPkgs_2 :: Language -> Doc AnsiStyle@@ -750,6 +772,7 @@     Indonesia  -> "Membandingkan versi paket..."     Chinese    -> "正在比较包的版本..."     Esperanto  -> "Komparas versiojn de pakaĵoj..."+    Dutch      -> "Pakket versies aan het vergelijken..."     _          -> "Comparing package versions..."  upgradeAURPkgs_3 :: Language -> Doc AnsiStyle@@ -769,6 +792,7 @@     Indonesia  -> "Tidak ada peningkatan AUR yang dibutuhkan."     Chinese    -> "没有需要升级的 AUR 包。"     Esperanto  -> "Ne ĝisdatigoj de pakaĵoj de AUR necesas."+    Dutch      -> "Geen AUR-pakket upgrades vereist."     _          -> "No AUR package upgrades necessary."  removeMakeDepsAfter_1 :: Language -> Doc AnsiStyle@@ -788,6 +812,7 @@     Indonesia  -> "Menghapus dependensi `make` yang tidak dibutuhkan..."     Chinese    -> "移除不需要的 make 依赖..."     Esperanto  -> "Forigas nenecesajn dependecojn de make..."+    Dutch      -> "Onnodige make afhankelijkheden aan het verwijderen..."     _          -> "Removing unneeded make dependencies..."  ----------------------------@@ -811,6 +836,7 @@     Chinese    -> s <> " 个包的状态将会保留。删除其它的？"     Swedish    -> s <> " paket kommer att bevaras. Ta bort resten?"     Esperanto  -> s <> " statoj de pakaĵoj teniĝas. Ĉu forigi la ceteron?"+    Dutch      -> s <> " pakketstatussen worden behouden. De rest verwijderen?"     _          -> s <> " package states will be kept. Remove the rest?"  -- NEEDS TRANSLATION@@ -831,6 +857,7 @@     Chinese    -> "没有删除任何包。"     Swedish    -> "Inga paket togs bort."     Esperanto  -> "Ne statojn de pakaĵoj forigis."+    Dutch      -> "Geen pakketstatussen verwijderd."     _          -> "No package states were removed."  cleanStates_4 :: Int -> Language -> Doc AnsiStyle@@ -840,6 +867,7 @@   Russian   -> "У вас сейчас " <+> pretty n <+> pluralRussian " сохраненное состояние пакета" " сохраненных состояний пакета" " сохраненных состояний пакетов." n   Italian   -> "Al momento ci sono" <+> pretty n <+> "stati di pacchetti salvati."   Esperanto -> "Vi havas " <+> pretty n <+> " konservajn statojn de pakaĵoj."+  Dutch     -> "U heeft momenteel" <+> pretty n <+> "opgeslagen pakketstatussen."   _         -> "You currently have" <+> pretty n <+> "saved package states."  cleanStates_5 :: Text -> Language -> Doc AnsiStyle@@ -849,12 +877,14 @@   Russian   -> "Последнее сохраненное:" <+> pretty t   Italian   -> "Salvato più recentemente:" <+> pretty t   Esperanto -> "Lastaj konservaj:" <+> pretty t+  Dutch     -> "Meest recent opgeslagen:" <+> pretty t   _         -> "Most recently saved:" <+> pretty t  cleanStates_6 :: Int -> Language -> Doc AnsiStyle cleanStates_6 n = \case   Spanish   -> pretty n <+> "de estos están anclados y no se eliminarán."   Italian   -> pretty n <+> "di questi sono stati fissati, perciò non saranno rimossi."+  Dutch     -> pretty n <+> "hiervan zijn vastgezet, en worden niet verwijderd."   _         -> pretty n <+> "of these are pinned, and won't be removed."  readState_1 :: Language -> Doc AnsiStyle@@ -864,13 +894,14 @@     Russian    -> "Это состояние не распознано. Это корректный JSON?"     Italian    -> "Non è stato possibile analizzare il file di stato. E' correttamente formattato in JSON?"     Esperanto  -> "Tiu statdosiero paneis sintake analizi. Ĉu ĝi estas valida JSON?"+    Dutch      -> "Dat statusbestand kon niet worden geparseerd. Is het legale JSON?"     _          -> "That state file failed to parse. Is it legal JSON?"  ---------------------------- -- Aura/Commands/C functions ---------------------------- getDowngradeChoice_1 :: PkgName -> Language -> Doc AnsiStyle-getDowngradeChoice_1 (bt . view (field @"name") -> p) = \case+getDowngradeChoice_1 (bt . pnName -> p) = \case     Japanese   -> p <> "はどのバージョンにしますか？"     Polish     -> "Którą wersję pakietu " <> p <> " zainstalować?"     Croatian   -> "Koju verziju paketa " <> p <> " želite?"@@ -886,6 +917,7 @@     Indonesia  -> "Versi dari paket " <> p <> " mana yang anda inginkan?"     Chinese    -> "你希望安装 " <> p <> " 的哪个版本？"     Esperanto  -> "Kiu versio de " <> p <> " vi volas?"+    Dutch      -> "Welke versie van " <> p <> " wil je?"     _          -> "What version of " <> p <> " do you want?"  backupCache_3 :: Language -> Doc AnsiStyle@@ -905,6 +937,7 @@     Indonesia  -> "Lokasi `backup` tidak ada."     Chinese    -> "备份位置不存在。"     Esperanto  -> "La savkopia loko ne ekzistas."+    Dutch      -> "De back-up lokatie bestaat niet."     _          -> "The backup location does not exist."  backupCache_4 :: FilePath -> Language -> Doc AnsiStyle@@ -924,6 +957,7 @@     Indonesia  -> "Melakukan `backup` pada direktori " <> dir     Chinese    -> "正在将缓存备份到 " <> dir     Esperanto  -> "Enarkivigas la kaŝdosieron al " <> dir+    Dutch      -> "Back-up van cache aan het maken naar " <> dir     _          -> "Backing up cache to " <> dir  backupCache_5 :: Int -> Language -> Doc AnsiStyle@@ -943,6 +977,7 @@     Indonesia  -> "Jumlah paket yang di-`backup`: " <> n     Chinese    -> "将要备份的包文件：" <> n     Esperanto  -> "La dosierojn de la pakaĵoj enarkivigi: " <> n+    Dutch      -> "Pakketbestanden om te back-uppen: " <> n     _          -> "Package files to backup: " <> n  backupCache_6 :: Language -> Doc AnsiStyle@@ -962,6 +997,7 @@     Indonesia  -> "Lanjutkan dengan `backup`?"     Chinese    -> "开始备份？"     Esperanto  -> "Ĉu daŭrigu enarkivigi?"+    Dutch      -> "Doorgaan met back-up?"     _          -> "Proceed with backup?"  backupCache_7 :: Language -> Doc AnsiStyle@@ -981,6 +1017,7 @@     Indonesia  -> "Proses `backup` dibatalkan secara paksa."     Chinese    -> "手动备份已中止。"     Esperanto  -> "Enarkivigadon ĉesigis permane."+    Dutch      -> "Back-up handmatig afgebroken."     _          -> "Backup manually aborted."  backupCache_8 :: Language -> Doc AnsiStyle@@ -1000,6 +1037,7 @@     Indonesia  -> "Melakukan `backup`. Proses ini akan berjalan untuk beberapa menit..."     Chinese    -> "正在备份中。可能需要几分钟的时间..."     Esperanto  -> "Enarkiviganta. Ĉi tiu eble daŭros dum kelkaj tagoj..."+    Dutch      -> "Aan het back-uppen. Dit kan een aantal minuten duren..."     _          -> "Backing up. This may take a few minutes..."  copyAndNotify_1 :: Int -> Language -> Doc AnsiStyle@@ -1019,6 +1057,7 @@     Indonesia  -> "Menyalin #[" <> n <> "]"     Chinese    -> "正在复制 #[" <> n <> "]"     Esperanto  -> "Kopianta #[" <> n <> "]"+    Dutch      -> "Kopiëren #[" <> n <> "]"     _          -> "Copying #[" <> n <> "]"  cleanCache_2 :: Language -> Doc AnsiStyle@@ -1038,6 +1077,7 @@     Indonesia  -> "Akan menghapus SEMUA `cache` paket"     Chinese    -> "这将会删除全部的包缓存。"     Esperanto  -> "Ĉi tiu forigos la TUTAN kaŝmemoron de pakaĵoj."+    Dutch      -> "Hiermee wordt de GEHELE pakketcache verwijderd."     _          -> "This will delete the ENTIRE package cache."  cleanCache_3 :: Word -> Language -> Doc AnsiStyle@@ -1057,6 +1097,7 @@     Indonesia  -> s <> " berkas dari tiap paket akan disimpan."     Chinese    -> "每个包文件将会保存 " <> s <> " 个版本。"     Esperanto  -> s <> " de ĉiu dosiero de pakaĵo teniĝos."+    Dutch      -> s <> " van elk pakketbestand wordt bewaard."     _          -> s <> " of each package file will be kept."  cleanCache_4 :: Language -> Doc AnsiStyle@@ -1076,6 +1117,7 @@     Indonesia  -> "Selainnya akan dihapus. Ikhlas kan?"     Chinese    -> "其余的将会被删除。确定？"     Esperanto  -> "La cetero foriĝos. Ĉu bone?"+    Dutch      -> "De rest wordt verwijderd. OK?"     _          -> "The rest will be deleted. Okay?"  cleanCache_5 :: Language -> Doc AnsiStyle@@ -1095,6 +1137,7 @@     Indonesia  -> "Pembersihan `cache` dibatalkan secara paksa."     Chinese    -> "手动清理缓存已中止。"     Esperanto  -> "Puriganta Kaŝmemoro ĉesis permane."+    Dutch      -> "Cachereiniging handmatig afgebroken."     _          -> "Cache cleaning manually aborted."  cleanCache_6 :: Language -> Doc AnsiStyle@@ -1114,8 +1157,17 @@     Indonesia  -> "Membersihkan `cache` paket..."     Chinese    -> "正在清理包缓存..."     Esperanto  -> "Purigas Kaŝmemoron de pakaĵoj..."+    Dutch      -> "Pakketcache aan het reinigen..."     _          -> "Cleaning package cache..." +cleanCache_7 :: Word -> Word -> Language -> Doc AnsiStyle+cleanCache_7 (bt . tshow -> ps) (bt . tshow -> bytes) = \case+  _ -> "The cache contains " <> ps <> " packages, consuming " <> bytes <> " megabytes."++cleanCache_8 :: Word -> Language -> Doc AnsiStyle+cleanCache_8 (bt . tshow -> bytes) = \case+  _ -> bytes <> " megabytes freed."+ -- NEEDS TRANSLATION cleanNotSaved_1 :: Language -> Doc AnsiStyle cleanNotSaved_1 = \case@@ -1133,6 +1185,7 @@     Chinese    -> "正在确定不需要的包文件..."     Swedish    -> "Beräknar onödiga paketfiler..."     Esperanto  -> "Decidas nebezonajn dosierojn de pakaĵoj..."+    Dutch      -> "Overbodige pakketbestanden aan het vaststellen..."     _          -> "Determining unneeded package files..."  -- NEEDS TRANSLATION@@ -1152,6 +1205,7 @@     Chinese    -> "发现了 " <> s <> " 个不需要的包文件。是否删除？"     Swedish    -> s <> " oanvända paket hittades. Ta bort?"     Esperanto  -> s <> " nebezonajn dosierojn de pakaĵoj trovis. Ĉu forigi"+    Dutch      -> s <> " overbodige pakketbestanden gevonden. Verwijderen?"     _          -> s <> " unneeded package files found. Delete?"  ----------------------------@@ -1180,6 +1234,7 @@     Indonesia  -> "Tidak terlihat pada berkas log:"     Chinese    -> "这些没有在日志文件中出现："     Esperanto  -> "Ĉi tiuj ne enestis la protokolajn dosierojn:"+    Dutch      -> "Deze zijn niet verschenen in het logbestand:"     _          -> "These have not appeared in the log file:"  -------------------------------@@ -1187,21 +1242,22 @@ -------------------------------  -- https://github.com/fosskers/aura/issues/498-connectionFailure_1 :: Language -> Doc AnsiStyle-connectionFailure_1 = \case+connectFailure_1 :: Language -> Doc AnsiStyle+connectFailure_1 = \case   Spanish -> "No se pudo contactar con el AUR. ¿Tienes conexión a internet?"   Italian -> "Non è stato possibile contattare l'AUR. Il computer è connesso ad internet?"+  Dutch   -> "Contact opnemen met de AUR mislukt. Heeft U een internet connectie?"   _       -> "Failed to contact the AUR. Do you have an internet connection?"  miscAURFailure_1 :: Language -> Doc AnsiStyle miscAURFailure_1 = \case   Italian   -> "C'è stato un errore sconosciuto nel contattare l'AUR."+  Dutch     -> "Contact opnemen met de AUR is op een onbekende manier mislukt."   _         -> "Contacting the AUR failed in some unknown way." -miscAURFailure_2 :: Language -> Doc AnsiStyle-miscAURFailure_2 = \case-  Italian   -> "Il server dell'AUR ha rifiutato la richiesta."-  _         -> "The AUR server rejected the request."+miscAURFailure_3 :: Language -> Doc AnsiStyle+miscAURFailure_3 = \case+  _ -> "The JSON returned from the AUR server could not be decoded."  infoFields :: Language -> [Text] infoFields = sequence [ Fields.repository@@ -1236,6 +1292,7 @@     Indonesia  -> "Ketinggalan Zaman!"     Chinese    -> "过期！"     Esperanto  -> "Neĝisdata!"+    Dutch      -> "Verouderd!"     _          -> "Out of Date!" outOfDateMsg Nothing = green . \case     Japanese   -> "最新"@@ -1253,6 +1310,7 @@     Indonesia  -> "Mutakhir"     Chinese    -> "最新"     Esperanto  -> "Ĝisdata"+    Dutch      -> "Up-to-date"     _          -> "Up to Date"  -- NEEDS TRANSLATION@@ -1273,6 +1331,7 @@     Chinese    -> "孤包！"     Swedish    -> "Föräldralös!"     Esperanto  -> "Orfita!"+    Dutch      -> "Verweest!"     _          -> "Orphaned!"  -----------------------@@ -1296,6 +1355,7 @@     Chinese    -> "已保存包状态。"     Swedish    -> "Det lokala pakettillståndet har sparats."     Esperanto  -> "Konservita stato de pakaĵo."+    Dutch      -> "Pakketstatus opgeslagen."     _          -> "Saved package state."  -- NEEDS TRANSLATION@@ -1316,6 +1376,7 @@     Chinese    -> "请求的降级版本对以下包不可用："     Swedish    -> "Den begärda nedgraderingen finns inte tillgänglig för:"     Esperanto  -> "Petitajn malpromociajn versiojn ne estas disponebla de:"+    Dutch      -> "Verzochtte downgrade versies niet beschikbaar voor:"     _          -> "Requested downgrade versions not available for:"  restoreState_2 :: Language -> Doc AnsiStyle@@ -1328,6 +1389,7 @@     Chinese    -> "没有要恢复的已保存状态。（使用 -B 保存当前状态）"     Swedish    -> "Inga sparade tillstånd att återhämta. (Använd -B för att spara det nuvarande tillståndet)"     Esperanto  -> "Ne konservitaj statoj restaŭros. (Uzu -B konservi la aktualan staton)"+    Dutch      -> "Er zijn geen opgeslagen statussen om te herstellen. (Gebruik -B om de huidige staat op te slaan)"     _          -> "No saved states to be restored. (Use -B to save the current state)"  -- NEEDS TRANSLATION@@ -1348,6 +1410,7 @@     Chinese    -> "没有包需要改变。"     Swedish    -> "Inga paket behöver ändras."     Esperanto  -> "Ne pakaĵoj devas ŝanĝiĝi."+    Dutch      -> "Er zijn geen pakketten die wijzigingen nodig hebben."     _          -> "No packages need changing."  --------------------------------------@@ -1360,6 +1423,7 @@     Russian    -> "Не удается определить, от имени какого пользователя производить сборку."     Italian    -> "Non è stato possibile determinare l'utente che eseguirà la compilazione."     Esperanto  -> "Ne povas decidi, per kiu konto de uzanto munti."+    Dutch      -> "Kan niet bepalen met welk gebruikers account te bouwen."     _          -> "Can't determine which user account to build with."  ------------------------@@ -1383,6 +1447,7 @@     Chinese    -> "请检查你的输入。"     Swedish    -> "Var god dubbelkolla indata."     Esperanto  -> "Bonvolu kontroli vian enigon."+    Dutch      -> "Controleer alstublieft uw input."     _          -> "Please check your input."  confParsing_1 :: Language -> Doc AnsiStyle@@ -1392,19 +1457,21 @@     Russian    -> "Не удается распознать формат вашего файла pacman.conf."     Italian    -> "Non è stato possibile analizzare il file pacman.conf."     Esperanto  -> "Ne kapablas sintaske analizi vian dosieron, pacman.conf."+    Dutch      -> "Niet in staat om uw pacman.conf bestand te parseren."     _          -> "Unable to parse your pacman.conf file."  provides_1 :: PkgName -> Language -> Doc AnsiStyle-provides_1 (bt . view (field @"name") -> pro) = \case+provides_1 (bt . pnName -> pro) = \case     Spanish    -> pro <+> "se requiere como una dependencia, que es proporcionada por múltiples paquetes. Por favor, seleccione uno:"     Italian    -> pro <+> "è richiesto come dipendenza; si trova in molteplici pacchetti. Selezionarne uno:"+    Dutch      -> pro <+> "is vereist als afhankelijkheid, die wordt geleverd door meerdere pakketten. Selecteer er alstublieft een:"     _          -> pro <+> "is required as a dependency, which is provided by multiple packages. Please select one:"  ---------------------------------- -- Aura/Pkgbuild/Editing functions ---------------------------------- hotEdit_1 :: PkgName -> Language -> Doc AnsiStyle-hotEdit_1 (bt . view (field @"name") -> p) = \case+hotEdit_1 (bt . pnName -> p) = \case     Japanese   -> p <> "のPKGBUILDを編成しますか？"     Polish     -> "Czy chcesz edytować PKGBUILD " <> p <> "?"     Croatian   -> "Želite li izmjeniti PKGBUILD " <> p <> "?"@@ -1420,26 +1487,9 @@     Indonesia  -> "Apakah anda ingin menyunting PKGBUILD untuk paket " <> p <> "?"     Chinese    -> "你希望编辑 " <> p <> " 的 PKGBUILD 文件吗？"     Esperanto  -> "Ĉu vi volas redakti la PKGBUILD de " <> p <> "?"+    Dutch      -> "Wilt u het PKGBUILD-bestand van " <> p <> " bewerken?"     _          -> "Would you like to edit the PKGBUILD of " <> p <> "?" -customizepkg_1 :: Language -> Doc AnsiStyle-customizepkg_1 = let customizepkg = bt "customizepkg" in \case-    Japanese   -> customizepkg <+> "はインストールされていません。"-    Polish     -> customizepkg <+> "nie zainstalowany."-    Croatian   -> customizepkg <+> "nije instaliran."-    German     -> customizepkg <+> "ist nicht installiert."-    Spanish    -> customizepkg <+> "no está instalado."-    Norwegian  -> customizepkg <+> "er ikke installert."-    Italian    -> customizepkg <+> "non è installato."-    Portuguese -> customizepkg <+> "não está instalado."-    French     -> customizepkg <+> "n'est pas installé."-    Russian    -> customizepkg <+> "не установлен."-    Indonesia  -> customizepkg <+> "tidak terinstal."-    Chinese    -> customizepkg <+> " 没有被安装。"-    Swedish    -> customizepkg <+> "är inte installerad"-    Esperanto  -> customizepkg <+> "ne estas instalita."-    _          -> customizepkg <+> "isn't installed."- ------------------------------ -- Pkgbuild Security functions ------------------------------@@ -1447,60 +1497,70 @@ security_1 (PkgName p) = \case   Spanish   -> "El PKGBUILD de" <+> bt p <+> "era demasiado complejo de analizar - puede estar ofuscando código malicioso."   Italian   -> "Il PKGBUILD di" <+> bt p <+> "è troppo complesso per essere analizzato - è possibile che stia offuscando codice malevolo."+  Dutch     -> "Het PKGBUILD-bestand van" <+> bt p <+> " was te complex om te parseren - het kan schadelijke code versluieren."   _ -> "The PKGBUILD of" <+> bt p <+> "was too complex to parse - it may be obfuscating malicious code."  security_2 :: Text -> Language -> Doc AnsiStyle security_2 (bt -> t) = \case   Spanish   -> t <+> "se puede usar para descargar scripts arbitrarios que este PKGBUILD no rastrea."   Italian   -> t <+> "può essere usato per scaricare script arbitrari non tracciati da questo PKGBUILD."+  Dutch     -> t <+> "kan gebruikt worden om willekeurige scripten te downloaden die niet worden bijgehouden door dit PKGBUILD-bestand."   _ -> t <+> "can be used to download arbitrary scripts that aren't tracked by this PKGBUILD."  security_3 :: Text -> Language -> Doc AnsiStyle security_3 (bt -> t) = \case   Spanish   -> t <+> "se puede usar para ejecutar código arbitrario que este PKGBUILD no rastrea."   Italian   -> t <+> "può essere usato per eseguire codice arbitrario non tracciato da questo PKGBUILD."+  Dutch     -> t <+> "kan gebruikt worden om willekeurige code uit te voeren die niet worden bijgehouden door dit PKGBUILD-bestand."   _ -> t <+> "can be used to execute arbitrary code not tracked by this PKGBUILD."  security_4 :: Text -> Language -> Doc AnsiStyle security_4 (bt -> t) = \case   Spanish   -> t <+> "indica que alguien puede estar intentando obtener acceso de root a su máquina."   Italian   -> t <+> "indica che forse qualcuno sta cercando di ottenere accesso alla tua macchina come root."+  Dutch     -> t <+> "geeft aan dat iemand mogelijk root-toegang to uw machine probeert te krijgen."   _ -> t <+> "indicates that someone may be trying to gain root access to your machine."  security_5 :: PkgName -> Language -> Doc AnsiStyle security_5 (PkgName p) = \case   Spanish   -> "ADVERTENCIA: El PKGBUILD de" <+> bt p <+> "contiene expresiones bash en la lista negra."   Italian   -> "ATTENZIONE: Il PKGBUILD di" <+> bt p <+> "contiene espressioni bash presenti nella lista nera."+  Dutch     -> "WAARSCHUWING: De PKGBUILD van" <+> bt p <+> "bevat bash uitdrukkingen die op de zwarte lijst staan."   _ -> "WARNING: The PKGBUILD of" <+> bt p <+> "contains blacklisted bash expressions."  security_6 :: Language -> Doc AnsiStyle security_6 = \case   Spanish   -> "¿Desea salir del proceso de compilación?"   Italian   -> "Terminare la compilazione?"+  Dutch     -> "Wilt u het bouw process stoppen?"   _ -> "Do you wish to quit the build process?"  security_7 :: Language -> Doc AnsiStyle security_7 = \case   Spanish   -> "Se canceló el procesamiento posterior para evitar el código bash potencialmente malicioso."   Italian   -> "Non saranno eseguite altre operazioni al fine di evitare l'esecuzione di codice bash potenzialmente malevolo."+  Dutch     -> "Verdere verwerking geannuleerd om het uitvoeren van potentieel schadelijke bash-code te voorkomen."   _ -> "Cancelled further processing to avoid potentially malicious bash code."  security_8 :: Text -> Language -> Doc AnsiStyle security_8 (bt -> t) = \case   Spanish   -> t <+> "es un comando bash integrado en los campos de la matriz del PKGBUILD."   Italian   -> t <+> "è un comando bash presente all'interno degli array del tuo PKGBUILD."+  Dutch     -> t <+> "is een bash-opdracht die is opgenomen in uw PKGBUILD-arrayvelden."   _ -> t <+> "is a bash command inlined in your PKGBUILD array fields."  security_9 :: Text -> Language -> Doc AnsiStyle security_9 (bt -> t) = \case   Spanish   -> t <+> "es algo extraño para tener en sus campos de matriz. ¿Es seguro?"   Italian   -> t <+> "è una cosa strana da trovare all'interno degli array. E' sicura?"+  Dutch     -> t <+> "is een vreemd ding om in uw arrayvelden te hebben. Is het veilig?"   _ -> t <+> "is a strange thing to have in your array fields. Is it safe?"  security_10 :: Text -> Language -> Doc AnsiStyle security_10 (bt -> t) = \case   Spanish   -> t <+> "implica que alguien estaba tratando de ser astuto con las variables para ocultar comandos maliciosos."   Italian   -> t <+> "implica che qualcuno stava trafficando con le variabili per nascondere comandi malevoli."+  Dutch     -> t <+> "impliceert dat iemand slim probeerde om te gaan met variabelen om schadelijke opdrachten te verbergen."   _ -> t <+> "implies that someone was trying to be clever with variables to hide malicious commands."  -----------------------@@ -1518,6 +1578,7 @@     French     -> "[O/n]"     Russian    -> "[Д/н]"     Esperanto  -> "[J/n]"+    Dutch      -> "[J/n]"     _          -> "[Y/n]"  yesPattern :: Language -> [T.Text]@@ -1532,6 +1593,7 @@     French     -> ["o", "oui"]     Russian    -> ["д", "да"]     Esperanto  -> ["j", "jes"]+    Dutch      -> ["j", "ja"]     _          -> ["y", "yes"]  ----------------------

@@ -1,3 +1,5 @@+{-# LANGUAGE LambdaCase #-}+ {-# OPTIONS_HADDOCK prune #-}  -- |@@ -31,6 +33,7 @@     Norwegian  -> "Pakke"     Indonesia  -> "Paket"     Esperanto  -> "Pakaĵo"+    Dutch      -> "Pakket"     _          -> "Package"  firstInstall :: Language -> Text@@ -49,6 +52,7 @@     Norwegian  -> "Første installasjon"     Indonesia  -> "Versi sistem"     Esperanto  -> "Unua Instalo"+    Dutch      -> "Eerste installatie"     _          -> "First Install"  upgrades :: Language -> Text@@ -67,6 +71,7 @@     Norwegian  -> "Oppgraderinger"     Indonesia  -> "Tingkatkan"     Esperanto  -> "Noveldonoj"+    Dutch      -> "Upgrades"     _          -> "Upgrades"  recentActions :: Language -> Text@@ -85,6 +90,7 @@     Norwegian  -> "Nylige hendelser"     Indonesia  -> "Aksi sekarang"     Esperanto  -> "Ĵusaj Agoj"+    Dutch      -> "Recente Acties"     _          -> "Recent Actions"  repository :: Language -> Text@@ -103,6 +109,7 @@     Norwegian  -> "Depot"     Indonesia  -> "Lumbung"     Esperanto  -> "Deponejo"+    Dutch      -> "Repository"     _          -> "Repository"  name :: Language -> Text@@ -121,6 +128,7 @@     Norwegian  -> "Navn"     Indonesia  -> "Nama"     Esperanto  -> "Nomo"+    Dutch      -> "Naam"     _          -> "Name"  version :: Language -> Text@@ -139,6 +147,7 @@     Norwegian  -> "Versjon"     Indonesia  -> "Versi"     Esperanto  -> "Versio"+    Dutch      -> "Versie"     _          -> "Version"  aurStatus :: Language -> Text@@ -155,6 +164,7 @@     Serbian    -> "Статус у AUR-у"     Indonesia  -> "Status AUR"     Esperanto  -> "Stato en AUR"+    Dutch      -> "AUR Status"     _          -> "AUR Status"  -- NEEDS TRANSLATION@@ -169,6 +179,7 @@     Norwegian  -> "Vedlikeholder"     Indonesia  -> "Pemelihara"     Esperanto  -> "Daŭriganto"+    Dutch      -> "Onderhouder"     _          -> "Maintainer"  projectUrl :: Language -> Text@@ -187,6 +198,7 @@     Norwegian  -> "Prosjekt-URL"     Indonesia  -> "URL Proyek"     Esperanto  -> "URL de Projekto"+    Dutch      -> "Project URL"     _          -> "Project URL"  aurUrl :: Language -> Text@@ -202,6 +214,7 @@     Serbian    -> "Страница у AUR-у"     Indonesia  -> "URL AUR"     Esperanto  -> "URL en AUR"+    Dutch      -> "AUR URL"     _          -> "AUR URL"  license :: Language -> Text@@ -220,6 +233,7 @@     Norwegian  -> "Lisens"     Indonesia  -> "Lisensi"     Esperanto  -> "Permesilo"+    Dutch      -> "Licentie"     _          -> "License"  dependsOn :: Language -> Text@@ -236,6 +250,7 @@     Norwegian  -> "Er avhengig av"     Indonesia  -> "Bergantung pada"     Esperanto  -> "Dependi de"+    Dutch      -> "Hangt af van"     _          -> "Depends On"  buildDeps :: Language -> Text@@ -249,6 +264,7 @@     Italian    -> "Dipendenze di compilazione"     Indonesia  -> "Dependensi bangun"     Esperanto  -> "Muntaj Dependecoj"+    Dutch      -> "Bouw afhankelijkheden"     _          -> "Build Deps"  votes :: Language -> Text@@ -267,6 +283,7 @@     Norwegian  -> "Stemmer"     Indonesia  -> "Suara"     Esperanto  -> "Balotiloj"+    Dutch      -> "Stemmen"     _          -> "Votes"  popularity :: Language -> Text@@ -276,6 +293,7 @@     Portuguese -> "Popularidade"     Italian    -> "Popolarità"     Esperanto  -> "Populareco"+    Dutch      -> "Populairiteit"     _          -> "Popularity"  description :: Language -> Text@@ -294,18 +312,5 @@     Norwegian  -> "Beskrivelse"     Indonesia  -> "Deskripsi"     Esperanto  -> "Priskribo"+    Dutch      -> "Beschrijving"     _          -> "Description"--makeDeps :: Language -> Text-makeDeps = \case-    Polish     -> "Zależności Make"-    Croatian   -> "Make Zavisnosti"-    German     -> "Make-Abhängigkeiten"-    Spanish    -> "Dependencias de compilación"-    Portuguese -> "Dependências de compilação"-    French     -> "Dépendances de compilation"-    Russian    -> "Зависимости Make"-    Italian    -> "Dipendenze di compilazione"-    Indonesia  -> "Dependensi bangun"-    Esperanto  -> "Make Dependecoj"-    _          -> "Make Deps"

@@ -9,10 +9,11 @@ module Aura.Logo ( animateVersionMsg ) where  import           Aura.Colour (dtot, yellow)+import           Aura.IO import           Aura.Languages (translatorMsg) import           Aura.Pacman (verMsgPad) import           Aura.Settings-import           Aura.Utils+import           Aura.Shell import           Data.Text.Prettyprint.Doc import           RIO import qualified RIO.Text as T

@@ -1,3 +1,5 @@+{-# LANGUAGE TupleSections #-}+ -- | -- Module    : Aura.State -- Copyright : (c) Colin Woodbury, 2012 - 2020@@ -9,42 +11,34 @@ module Aura.MakePkg   ( makepkg   , makepkgSource-  , makepkgConfFile   ) where +import           Aura.IO (optionalPrompt) import           Aura.Languages import           Aura.Settings import           Aura.Types-import           Aura.Utils (optionalPrompt)-import           Control.Error.Util (note)-import           Data.Set.NonEmpty (NESet)-import qualified Data.Set.NonEmpty as NES+import           Aura.Utils (note) import           Lens.Micro (_2) import           RIO import qualified RIO.ByteString.Lazy as BL+import           RIO.Directory+import           RIO.FilePath import qualified RIO.NonEmpty as NEL import qualified RIO.Text as T-import           System.Path-    (Absolute, Path, fromAbsoluteFilePath, toFilePath, (</>))-import           System.Path.IO (getCurrentDirectory, getDirectoryContents) import           System.Process.Typed  --- --- | The default location of the makepkg configuration: \/etc\/makepkg.conf-makepkgConfFile :: Path Absolute-makepkgConfFile = fromAbsoluteFilePath "/etc/makepkg.conf"--makepkgCmd :: Path Absolute-makepkgCmd = fromAbsoluteFilePath "/usr/bin/makepkg"+makepkgCmd :: FilePath+makepkgCmd = "/usr/bin/makepkg"  -- | Given the current user name, build the package of whatever -- directory we're in.-makepkg :: Settings -> User -> IO (Either Failure (NESet (Path Absolute)))+makepkg :: Settings -> User -> IO (Either Failure (NonEmpty FilePath)) makepkg ss usr = make ss usr (proc cmd $ opts <> colour) >>= g   where     (cmd, opts) = runStyle usr . map T.unpack . foldMap asFlag . makepkgFlagsOf $ buildConfigOf ss-    g (ExitSuccess, _, fs)   = pure . note (Failure buildFail_9) . fmap NES.fromList $ NEL.nonEmpty fs+    g (ExitSuccess, _, fs)   = pure . note (Failure buildFail_9) $ NEL.nonEmpty fs     g (ExitFailure _, se, _) = do       unless (switch ss DontSuppressMakepkg) $ do         showError <- optionalPrompt ss buildFail_11@@ -57,25 +51,32 @@  -- | Actually build the package, guarding on exceptions. -- Yields the filepaths of the built package tarballs.-make :: MonadIO m => Settings -> User -> ProcessConfig stdin stdout stderr -> m (ExitCode, BL.ByteString, [Path Absolute])+make :: MonadIO m+  => Settings+  -> User+  -> ProcessConfig stdin stdout stderr+  -> m (ExitCode, BL.ByteString, [FilePath]) make ss (User usr) pc = do   (ec, se) <- runIt ss pc-  res <- readProcess $ proc "sudo" ["-u", T.unpack usr, toFilePath makepkgCmd, "--packagelist"]-  let fs = map (fromAbsoluteFilePath . T.unpack) . T.lines . decodeUtf8Lenient . BL.toStrict $ res ^. _2+  res <- readProcess $ proc "sudo" ["-u", T.unpack usr, makepkgCmd, "--packagelist"]+  let fs = map T.unpack . T.lines . decodeUtf8Lenient . BL.toStrict $ res ^. _2   pure (ec, se, fs) -runIt :: MonadIO m => Settings -> ProcessConfig stdin stdout stderr -> m (ExitCode, BL.ByteString)+runIt :: MonadIO m+  => Settings+  -> ProcessConfig stdin stdout stderr+  -> m (ExitCode, BL.ByteString) runIt ss pc | switch ss DontSuppressMakepkg = (,mempty) <$> runProcess pc             | otherwise = (\(ec, _, se) -> (ec, se)) <$> readProcess pc  -- | Make a source package. See `man makepkg` and grep for `--allsource`.-makepkgSource :: User -> IO [Path Absolute]+makepkgSource :: User -> IO [FilePath] makepkgSource usr = do   void . runProcess $ proc cmd opts   pwd <- getCurrentDirectory-  filter (T.isSuffixOf ".src.tar.gz" . T.pack . toFilePath) . map (pwd </>) <$> getDirectoryContents pwd+  filter (T.isSuffixOf ".src.tar.gz" . T.pack) . map (pwd </>) <$> getDirectoryContents pwd     where (cmd, opts) = runStyle usr ["--allsource"]  -- | As of makepkg v4.2, building with `--asroot` is no longer allowed. runStyle :: User -> [String] -> (FilePath, [String])-runStyle (User usr) opts = ("sudo", ["-u", T.unpack usr, toFilePath makepkgCmd] <> opts)+runStyle (User usr) opts = ("sudo", ["-u", T.unpack usr, makepkgCmd] <> opts)

@@ -1,7 +1,6 @@-{-# LANGUAGE BangPatterns          #-}-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase   #-}+ -- | -- Module    : Aura.Packages.AUR -- Copyright : (c) Colin Woodbury, 2012 - 2020@@ -28,38 +27,33 @@ import           Aura.Pkgbuild.Fetch import           Aura.Settings import           Aura.Types-import           Aura.Utils (fmapEither, groupsOf)-import           Control.Error.Util (hush, note)+import           Aura.Utils import           Control.Monad.Trans.Maybe import           Control.Scheduler (Comp(..), traverseConcurrently)-import           Data.Generics.Product (field)-import           Data.Set.NonEmpty (NESet)-import qualified Data.Set.NonEmpty as NES import           Data.Versions (versioning) import           Lens.Micro (each, non, (^..)) import           Linux.Arch.Aur import           Network.HTTP.Client (Manager) import           RIO+import           RIO.Directory+import           RIO.FilePath import qualified RIO.List as L import qualified RIO.Map as M import qualified RIO.NonEmpty as NEL import qualified RIO.Set as S import qualified RIO.Text as T-import           Servant.Client.Core (responseBody)-import           System.Path-import           System.Path.IO (getCurrentDirectory) import           System.Process.Typed  ---  -- | Attempt to retrieve info about a given `Set` of packages from the AUR.-aurLookup :: Manager -> NESet PkgName -> IO (Maybe (Set PkgName, Set Buildable))+aurLookup :: Manager -> NonEmpty PkgName -> IO (Maybe (Set PkgName, Set Buildable)) aurLookup m names = runMaybeT $ do   infos <- MaybeT . fmap hush . info m $ foldr (\(PkgName pn) acc -> pn : acc) [] names   badsgoods <- lift $ traverseConcurrently Par' (buildable m) infos   let (bads, goods) = partitionEithers badsgoods-      goodNames     = S.fromList $ goods ^.. each . field @"name"-  pure (S.fromList bads <> NES.toSet names S.\\ goodNames, S.fromList goods)+      goodNames     = S.fromList $ goods ^.. each . to bName+  pure (S.fromList bads <> S.fromList (NEL.toList names) S.\\ goodNames, S.fromList goods)  -- | Yield fully realized `Package`s from the AUR. aurRepo :: IO Repository@@ -68,7 +62,7 @@    -- TODO Use `data-or` here to offer `Or (NESet PkgName) (NESet Package)`?   -- Yes that sounds like a good idea :)-  let f :: Settings -> NESet PkgName -> IO (Maybe (Set PkgName, Set Package))+  let f :: Settings -> NonEmpty PkgName -> IO (Maybe (Set PkgName, Set Package))       f ss ps = do         --- Retrieve cached Packages ---         cache <- readTVarIO tv@@ -77,7 +71,7 @@         case NEL.nonEmpty uncached of           Nothing -> pure $ Just (S.empty, S.fromList cached)           Just uncached' -> runMaybeT $ do-            (bads, goods) <- MaybeT . aurLookup (managerOf ss) $ NES.fromList uncached'+            (bads, goods) <- MaybeT $ aurLookup (managerOf ss) uncached'             pkgs <- lift . traverse (packageBuildable ss) $ toList goods             --- Update Cache ---             let m = M.fromList $ map (pname &&& id) pkgs@@ -94,42 +88,48 @@   case (,) <$> mpb <*> mver of     Nothing        -> pure . Left . PkgName $ aurNameOf ai     Just (pb, ver) -> pure $ Right Buildable-      { name     = PkgName $ aurNameOf ai-      , version  = ver-      , base     = bse-      , provides = providesOf ai ^. to listToMaybe . non (aurNameOf ai) . to (Provides . PkgName)+      { bName     = PkgName $ aurNameOf ai+      , bVersion  = ver+      , bBase     = bse+      , bProvides = providesOf ai ^. to listToMaybe . non (aurNameOf ai) . to (Provides . PkgName)       -- TODO This is a potentially naughty mapMaybe, since deps that fail to       -- parse will be silently dropped. Unfortunately there isn't much to be       -- done - `aurLookup` and `aurRepo` which call this function only report       -- existence errors (i.e. "this package couldn't be found at all").-      , deps       = mapMaybe parseDep $ dependsOf ai ++ makeDepsOf ai-      , pkgbuild   = pb-      , isExplicit = False }+      , bDeps       = mapMaybe parseDep $ dependsOf ai ++ makeDepsOf ai+      , bPkgbuild   = pb+      , bIsExplicit = False }  ---------------- -- AUR PKGBUILDS -----------------aurLink :: Path Unrooted-aurLink = fromUnrootedFilePath "https://aur.archlinux.org"+aurLink :: FilePath+aurLink = "https://aur.archlinux.org"  -- | A package's home URL on the AUR. pkgUrl :: PkgName -> Text-pkgUrl (PkgName pkg) = T.pack . toUnrootedFilePath $ aurLink </> fromUnrootedFilePath "packages" </> fromUnrootedFilePath (T.unpack pkg)+pkgUrl (PkgName pkg) = T.pack $ aurLink </> "packages" </> T.unpack pkg  ------------------- -- SOURCES FROM GIT ------------------- -- | Attempt to clone a package source from the AUR.-clone :: Buildable -> IO (Maybe (Path Absolute))+clone :: Buildable -> IO (Maybe FilePath) clone b = do-  ec <- runProcess . setStderr closed . setStdout closed $ proc "git" [ "clone", "--depth", "1", toUnrootedFilePath url ]+  ec <- runProcess . setStderr closed . setStdout closed+    $ proc "git" [ "clone", "--depth", "1", url ]   case ec of-    (ExitFailure _) -> pure Nothing-    ExitSuccess     -> do+    ExitFailure _ -> pure Nothing+    ExitSuccess   -> do       pwd <- getCurrentDirectory-      pure . Just $ pwd </> (b ^. field @"base" . field @"name" . to (fromUnrootedFilePath . T.unpack))-  where url = aurLink </> (b ^. field @"base" . field @"name" . to (fromUnrootedFilePath . T.unpack)) <.> FileExt "git"+      pure . Just $ pwd </> pathy+  where+    pathy :: FilePath+    pathy = T.unpack . pnName $ bBase b +    url :: FilePath+    url = aurLink </> pathy <.> "git"+ ------------ -- RPC CALLS ------------@@ -143,7 +143,7 @@ aurSearch :: Text -> RIO Env [AurInfo] aurSearch regex = do   ss  <- asks settings-  res <- liftMaybeM (Failure connectionFailure_1) . fmap hush . liftIO $ search (managerOf ss) regex+  res <- liftMaybeM (Failure connectFailure_1) . fmap hush . liftIO $ search (managerOf ss) regex   pure $ sortAurInfo (bool Nothing (Just SortAlphabetically) $ switch ss SortAlphabetically) res  -- | Frontend to the `aur` library. For @-Ai@.@@ -155,11 +155,11 @@     <$> traverseConcurrently Par' (work m) (groupsOf 50 $ NEL.toList pkgs)   where     work :: Manager -> [PkgName] -> RIO Env [AurInfo]-    work m ps = liftIO (info m $ map (^. field @"name") ps) >>= \case-      Left (ConnectionError _) -> throwM (Failure connectionFailure_1)-      Left (FailureResponse _ r) -> do-        let !resp = display . decodeUtf8Lenient . toStrictBytes $ responseBody r+    work m ps = liftIO (info m $ map pnName ps) >>= \case+      Left (NotFound _) -> throwM (Failure connectFailure_1)+      Left BadJSON -> throwM (Failure miscAURFailure_3)+      Left (OtherAurError e) -> do+        let !resp = display $ decodeUtf8Lenient e         logDebug $ "Failed! Server said: " <> resp-        throwM (Failure miscAURFailure_2)-      Left _ -> throwM (Failure miscAURFailure_1)+        throwM (Failure miscAURFailure_1)       Right res -> pure res

@@ -1,5 +1,4 @@-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TupleSections #-}  -- | -- Module    : Aura.Packages.Repository@@ -15,19 +14,18 @@   ) where  import           Aura.Core+import           Aura.IO import           Aura.Languages (provides_1) import           Aura.Pacman (pacmanLines, pacmanOutput) import           Aura.Settings (CommonSwitch(..), Settings(..), shared) import           Aura.Types-import           Aura.Utils (fmapEither, getSelection, traverseEither)-import           Control.Error.Util (hush, note)+import           Aura.Utils import           Control.Scheduler (Comp(..), traverseConcurrently)-import           Data.Generics.Product (field)-import qualified Data.Set.NonEmpty as NES import           Data.Versions import           RIO hiding (try) import qualified RIO.Map as M import qualified RIO.Set as S+import qualified RIO.Text as T import           Text.Megaparsec import           Text.Megaparsec.Char @@ -38,14 +36,17 @@ pacmanRepo :: IO Repository pacmanRepo = do   tv <- newTVarIO mempty+  -- A mutex to ensure that the user will only be prompted for one input at a+  -- time.+  mv <- newMVar () -  let g :: Settings -> NES.NESet PkgName -> IO (Maybe (Set PkgName, Set Package))+  let g :: Settings -> NonEmpty PkgName -> IO (Maybe (Set PkgName, Set Package))       g ss names = do         --- Retrieve cached Packages ---         cache <- readTVarIO tv         let (uncached, cached) = fmapEither (\p -> note p $ M.lookup p cache) $ toList names         --- Lookup uncached Packages ----        bgs <- traverseConcurrently Par' (resolveName ss) uncached+        bgs <- traverseConcurrently Par' (resolveName mv ss) uncached         let (bads, goods) = partitionEithers bgs         (bads', goods') <- traverseEither f goods  -- TODO Should also be made concurrent?         --- Update Cache ---@@ -58,33 +59,46 @@     f (r, p) = fmap (FromRepo . packageRepo r p) <$> mostRecent r  packageRepo :: PkgName -> Provides -> Versioning -> Prebuilt-packageRepo pn pro ver = Prebuilt { name     = pn-                                  , version  = ver-                                  , base     = pn-                                  , provides = pro }+packageRepo pn pro ver = Prebuilt { pName     = pn+                                  , pVersion  = ver+                                  , pBase     = pn+                                  , pProvides = pro }  -- TODO Bind to libalpm /just/ for the @-Ssq@ functionality. These shell -- calls are one of the remaining bottlenecks. -- | If given a virtual package, try to find a real package to install.-resolveName :: Settings -> PkgName -> IO (Either PkgName (PkgName, Provides))-resolveName ss pn = do-  provs <- map PkgName <$> pacmanLines ["-Ssq", "^" <> (pn ^. field @"name") <> "$"]+resolveName :: MVar () -> Settings -> PkgName -> IO (Either PkgName (PkgName, Provides))+resolveName mv ss pn = do+  provs <- map PkgName <$> pacmanLines ["-Ssq", "^" <> escape (pnName pn) <> "$"]   case provs of     [] -> pure $ Left pn-    _  -> Right . (, Provides pn) <$> chooseProvider ss pn provs+    _  -> Right . (, Provides pn) <$> chooseProvider mv ss pn provs+  where+    escape :: Text -> Text+    escape = T.foldl' f "" --- | Choose a providing package, favoring installed packages.+    f :: Text -> Char -> Text+    f acc '+' = acc <> "\\+"+    f acc c   = T.snoc acc c++-- | Choose a providing package, favouring installed packages. -- If `--noconfirm` is provided, it will try to automatically select the provider -- with the same name as the dependency. If that doesn't exist, it will select -- the first available provider.-chooseProvider :: Settings -> PkgName -> [PkgName] -> IO PkgName-chooseProvider _ pn []         = pure pn-chooseProvider _ _ [p]         = pure p-chooseProvider ss pn ps@(a:as) =+chooseProvider :: MVar () -> Settings -> PkgName -> [PkgName] -> IO PkgName+chooseProvider _ _ pn []          = pure pn+chooseProvider _ _ _ [p]          = pure p+chooseProvider mv ss pn ps@(a:as) =   traverseConcurrently Par' isInstalled ps >>= maybe f pure . listToMaybe . catMaybes   where+    f :: IO PkgName     f | shared ss NoConfirm = pure . bool a pn $ pn `elem` ps-      | otherwise = warn ss (provides_1 pn $ langOf ss) >> getSelection (^. field @"name") (a :| as)+      | otherwise = do+          void $ takeMVar mv+          warn ss $ provides_1 pn+          r <- getSelection pnName (a :| as)+          putMVar mv ()+          pure r  -- | The most recent version of a package, if it exists in the respositories. mostRecent :: PkgName -> IO (Either PkgName Versioning)

@@ -32,17 +32,15 @@ import           Aura.Languages import           Aura.Types import           Data.Bifunctor (first)-import           Data.Set.NonEmpty (NESet)-import           Lens.Micro (at, (^?), _2, _Just, _head)-import           Lens.Micro.GHC ()+import           Lens.Micro (_2) import           RIO hiding (first, some, try) import qualified RIO.ByteString as BS import qualified RIO.ByteString.Lazy as BL+import           RIO.FilePath import           RIO.List.Partial ((!!)) import qualified RIO.Map as M import qualified RIO.Set as S import qualified RIO.Text as T-import           System.Path (Absolute, Path, fromAbsoluteFilePath, toFilePath) import           System.Process.Typed import           Text.Megaparsec hiding (single) import           Text.Megaparsec.Char@@ -74,21 +72,21 @@ garbage = L.space space1 (L.skipLineComment "#") (L.skipBlockComment "[" "]")  -- | Default location of the pacman config file: \/etc\/pacman.conf-pacmanConfFile :: Path Absolute-pacmanConfFile = fromAbsoluteFilePath "/etc/pacman.conf"+pacmanConfFile :: FilePath+pacmanConfFile = "/etc/pacman.conf"  -- | Default location of the pacman log flie: \/var\/log\/pacman.log-defaultLogFile :: Path Absolute-defaultLogFile = fromAbsoluteFilePath "/var/log/pacman.log"+defaultLogFile :: FilePath+defaultLogFile = "/var/log/pacman.log"  -- | Default location of the pacman database lock file: \/var\/lib\/pacman\/db.lck-lockFile :: Path Absolute-lockFile = fromAbsoluteFilePath "/var/lib/pacman/db.lck"+lockFile :: FilePath+lockFile = "/var/lib/pacman/db.lck"  -- | Given a filepath to the pacman config, try to parse its contents.-getPacmanConf :: Path Absolute -> IO (Either Failure Config)+getPacmanConf :: FilePath -> IO (Either Failure Config) getPacmanConf fp = do-  file <- decodeUtf8Lenient <$> BS.readFile (toFilePath fp)+  file <- decodeUtf8Lenient <$> BS.readFile fp   pure . first (const (Failure confParsing_1)) $ parse config "pacman config" file  -- | Fetches the @IgnorePkg@ entry from the config, if it's there.@@ -100,19 +98,23 @@ getIgnoredGroups (Config c) = maybe S.empty (S.fromList . map PkgGroup) $ M.lookup "IgnoreGroup" c  -- | Given a `Set` of package groups, yield all the packages they contain.-groupPackages :: NESet PkgGroup -> IO (Set PkgName)+groupPackages :: NonEmpty PkgGroup -> IO (Set PkgName) groupPackages igs = fmap (f . decodeUtf8Lenient) . pacmanOutput $ "-Qg" : asFlag igs   where     f :: Text -> Set PkgName     f = S.fromList . map (PkgName . (!! 1) . T.words) . T.lines  -- | Fetches the @CacheDir@ entry from the config, if it's there.-getCachePath :: Config -> Maybe (Path Absolute)-getCachePath (Config c) = c ^? at "CacheDir" . _Just . _head . to (fromAbsoluteFilePath . T.unpack)+getCachePath :: Config -> Maybe FilePath+getCachePath (Config c) = do+  fp <- T.unpack <$> (M.lookup "CacheDir" c >>= listToMaybe)+  bool Nothing (Just fp) $ isAbsolute fp  -- | Fetches the @LogFile@ entry from the config, if it's there.-getLogFilePath :: Config -> Maybe (Path Absolute)-getLogFilePath (Config c) = c ^? at "LogFile" . _Just . _head . to (fromAbsoluteFilePath . T.unpack)+getLogFilePath :: Config -> Maybe FilePath+getLogFilePath (Config c) = do+  fp <- T.unpack <$> (M.lookup "LogFile" c >>= listToMaybe)+  bool Nothing (Just fp) $ isAbsolute fp  ---------- -- ACTIONS

@@ -11,15 +11,16 @@   ) where  import           Aura.Types+import           RIO+import           RIO.FilePath import qualified RIO.Text as T-import           System.Path  ---  -- | The default location: \/var\/cache\/aura\/pkgbuilds\/-pkgbuildCache :: Path Absolute-pkgbuildCache = fromAbsoluteFilePath "/var/cache/aura/pkgbuilds/"+pkgbuildCache :: FilePath+pkgbuildCache = "/var/cache/aura/pkgbuilds/"  -- | The expected path to a stored PKGBUILD, given some package name.-pkgbuildPath :: PkgName -> Path Absolute-pkgbuildPath (PkgName p) = pkgbuildCache </> fromUnrootedFilePath (T.unpack p) <.> FileExt "pb"+pkgbuildPath :: PkgName -> FilePath+pkgbuildPath (PkgName p) = pkgbuildCache </> T.unpack p <.> "pb"

@@ -1,5 +1,3 @@-{-# LANGUAGE DataKinds #-}- -- | -- Module    : Aura.Pkgbuild.Base -- Copyright : (c) Colin Woodbury, 2012 - 2020@@ -10,16 +8,12 @@  module Aura.Pkgbuild.Editing ( hotEdit ) where +import Aura.IO import Aura.Languages import Aura.Settings import Aura.Types-import Aura.Utils-import Data.Generics.Product (field)-import Lens.Micro ((.~)) import RIO-import RIO.Directory (setCurrentDirectory)-import System.Path (toFilePath)-import System.Path.IO (getCurrentDirectory, getTemporaryDirectory)+import RIO.Directory import System.Process.Typed (proc, runProcess)  ---@@ -29,23 +23,27 @@ -- package building. edit :: (FilePath -> IO a) -> Buildable -> IO Buildable edit f p = do-  writeFileBinary filename $ p ^. field @"pkgbuild" . field @"pkgbuild"+  writeFileBinary filename . pkgbuild $ bPkgbuild p   void $ f filename   newPB <- readFileBinary filename-  pure (p & field @"pkgbuild" .~ Pkgbuild newPB)-    where filename = "PKGBUILD"+  pure (p { bPkgbuild = Pkgbuild newPB})+  where+    filename :: FilePath+    filename = "PKGBUILD"  -- | Allow the user to edit the PKGBUILD if they asked to do so. hotEdit :: Settings -> Buildable -> IO Buildable hotEdit ss b   | not $ switch ss HotEdit = pure b   | otherwise = do-      ans <- liftIO $ optionalPrompt ss (hotEdit_1 $ b ^. field @"name")+      ans <- liftIO $ optionalPrompt ss (hotEdit_1 $ bName b)       bool (pure b) f ans-        where f = do-                here <- getCurrentDirectory-                tmp  <- getTemporaryDirectory-                setCurrentDirectory $ toFilePath tmp-                b' <- edit (runProcess . proc (editorOf ss) . (:[])) b-                setCurrentDirectory $ toFilePath here-                pure b'+        where+          f :: IO Buildable+          f = do+            here <- getCurrentDirectory+            tmp  <- getTemporaryDirectory+            setCurrentDirectory tmp+            b' <- edit (runProcess . proc (editorOf ss) . (:[])) b+            setCurrentDirectory here+            pure b'

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds           #-} {-# LANGUAGE ScopedTypeVariables #-}  -- |@@ -16,7 +15,6 @@  import           Aura.Types (PkgName(..), Pkgbuild(..)) import           Aura.Utils (urlContents)-import           Data.Generics.Product (field) import           Network.HTTP.Client (Manager) import           Network.URI (escapeURIString, isUnescapedInURIComponent) import           RIO@@ -36,7 +34,7 @@ -- | The PKGBUILD of a given package, retrieved from the AUR servers. getPkgbuild :: Manager -> PkgName -> IO (Maybe Pkgbuild) getPkgbuild m p = e $ do-  t <- urlContents m . pkgbuildUrl . T.unpack $ p ^. field @"name"+  t <- urlContents m . pkgbuildUrl . T.unpack $ pnName p   pure $ fmap Pkgbuild t   where     -- TODO Make this less "baby's first Haskell".

@@ -1,5 +1,3 @@-{-# LANGUAGE DataKinds #-}- -- | -- Module    : Aura.Pkgbuild.Records -- Copyright : (c) Colin Woodbury, 2012 - 2020@@ -15,11 +13,8 @@  import Aura.Pkgbuild.Base import Aura.Types-import Data.Generics.Product (field)-import Data.Set.NonEmpty (NESet) import RIO-import System.Path (toFilePath)-import System.Path.IO (createDirectoryIfMissing, doesFileExist)+import RIO.Directory  --- @@ -29,10 +24,10 @@ hasPkgbuildStored = doesFileExist . pkgbuildPath  -- | Write the PKGBUILDs of some `Buildable`s to disk.-storePkgbuilds :: NESet Buildable -> IO ()+storePkgbuilds :: NonEmpty Buildable -> IO () storePkgbuilds bs = do   createDirectoryIfMissing True pkgbuildCache-  traverse_ (\p -> writePkgbuild (p ^. field @"name") (p ^. field @"pkgbuild")) bs+  traverse_ (\p -> writePkgbuild (bName p) (bPkgbuild p)) bs  writePkgbuild :: PkgName -> Pkgbuild -> IO ()-writePkgbuild pn (Pkgbuild pb) = writeFileBinary (toFilePath $ pkgbuildPath pn) pb+writePkgbuild pn (Pkgbuild pb) = writeFileBinary (pkgbuildPath pn) pb

@@ -1,4 +1,5 @@-{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TupleSections #-}  -- | -- Module    : Aura.Pkgbuild.Security@@ -16,13 +17,12 @@  import           Aura.Languages import           Aura.Types (Language, Pkgbuild(..))-import           Control.Error.Util (hush)-import           Data.Generics.Product (typed, types)+import           Aura.Utils (hush) import           Data.Text.Prettyprint.Doc (Doc) import           Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle) import           Language.Bash.Parse (parse) import           Language.Bash.Syntax-import           Language.Bash.Word (Span(..), Word, unquote)+import           Language.Bash.Word import           Lens.Micro (each, (.~), (^..), _Just) import           RIO hiding (Word) import qualified RIO.Map as M@@ -34,6 +34,9 @@ -- either a sign of maintainer negligence or malicious behaviour. data BannedTerm = BannedTerm Text BanCategory deriving (Eq, Ord, Show, Generic) +banCatL :: Lens' BannedTerm BanCategory+banCatL f (BannedTerm t bc) = BannedTerm t <$> f bc+ -- | The reason why the bash term is black-listed. data BanCategory = Downloading                  | ScriptRunning@@ -65,27 +68,89 @@  -- | Extract all `SimpleCommand`s from a parsed bash AST. simpleCommands :: List -> [ShellCommand]-simpleCommands l = l ^.. types @ShellCommand . to p . each-  where p sc@(SimpleCommand _ _) = [sc]-        p sc = sc ^.. types @List . to simpleCommands . each+simpleCommands (List ss) = ss >>= statements >>= p+  where+    p :: ShellCommand -> [ShellCommand]+    p sc@(SimpleCommand _ _) = [sc]+    p sc                     = lists sc >>= simpleCommands +    statements :: Statement -> [ShellCommand]+    statements (Statement ao _) = andor ao++    andor :: AndOr -> [ShellCommand]+    andor (Last pl)   = pipeline pl+    andor (And pl ao) = pipeline pl <> andor ao+    andor (Or pl ao)  = pipeline pl <> andor ao++    pipeline :: Pipeline -> [ShellCommand]+    pipeline (Pipeline _ _ _ cs) = map command cs++    command :: Command -> ShellCommand+    command (Command sc _) = sc++    lists :: ShellCommand -> [List]+    lists (SimpleCommand _ _) = []+    lists (AssignBuiltin _ _) = []+    lists (FunctionDef _ l)   = [l]+    lists (Coproc _ c)        = lists $ command c+    lists (Subshell l)        = [l]+    lists (Group l)           = [l]+    lists (Arith _)           = []+    lists (Cond _)            = []+    lists (For _ _ l)         = [l]+    lists (ArithFor _ l)      = [l]+    lists (Select _ _ l)      = [l]+    lists (Case _ ccs)        = map caseClause ccs+    lists (If l1 l2 ml)       = l1 : l2 : maybeToList ml+    lists (Until l1 l2)       = [l1, l2]+    lists (While l1 l2)       = [l1, l2]++    caseClause :: CaseClause -> List+    caseClause (CaseClause _ l _) = l+ bannedCommand :: ShellCommand -> [(ShellCommand, BannedTerm)] bannedCommand s@(SimpleCommand [] (g:c:_))   | g == [Char 'g', Char 'i', Char 't'] &&     c == [Char 'c', Char 'l', Char 'o', Char 'n', Char 'e'] = [(s, BannedTerm "git" Downloading)] bannedCommand s@(SimpleCommand [] (c:_)) = maybeToList $ (s,) <$> banned c-bannedCommand s@(SimpleCommand as _) = as ^.. each . typed @RValue . to r . each+bannedCommand s@(SimpleCommand as _) = as ^.. each . rValueL . to r . each   where-    r rv@(RValue w) = maybeToList ((s,) <$> (banned w & _Just . typed @BanCategory .~ CleverRedirect)) <> q rv+    r rv@(RValue w) = maybeToList ((s,) <$> (banned w & _Just . banCatL .~ CleverRedirect)) <> q rv     r rv = q rv      q :: RValue -> [(ShellCommand, BannedTerm)]-    q rv = rv ^.. types @Word . each . to p . each . to (s,)+    q rv = map (s,) $ join (rWords rv) >>= p +    p :: Span -> [BannedTerm]     p (CommandSubst str)   = maybeToList (hush $ parse "CommandSubst" str) >>= simpleCommands >>= map snd . bannedCommand     p (ArithSubst str)     = [BannedTerm (T.pack str) StrangeBashism]     p (ProcessSubst _ str) = [BannedTerm (T.pack str) StrangeBashism]-    p sp = sp ^.. types @Word . each . to p . each+    p sp = join (sWords sp) >>= p++    rWords :: RValue -> [Word]+    rWords (RValue w)  = [w]+    rWords (RArray ws) = ws >>= \(mw, w) -> w : maybeToList mw++    sWords :: Span -> [Word]+    sWords (Single w)      = [w]+    sWords (Double w)      = [w]+    sWords (ANSIC w)       = [w]+    sWords (Locale w)      = [w]+    sWords (Backquote w)   = [w]+    sWords (ParamSubst ps) = subWords ps+    sWords _               = []++    subWords :: ParamSubst -> [Word]+    subWords (Bare (Parameter _ mw))                = maybeToList mw+    subWords (Brace _ (Parameter _ mw))             = maybeToList mw+    subWords (Alt _ (Parameter _ mw) _ _ w)         = w : maybeToList mw+    subWords (Substring _ (Parameter _ mw) w1 w2)   = w1 : w2 : maybeToList mw+    subWords (Prefix _ _)                           = []+    subWords (Indices (Parameter _ mw))             = maybeToList mw+    subWords (Length (Parameter _ mw))              = maybeToList mw+    subWords (Delete _ (Parameter _ mw) _ _ w)      = w : maybeToList mw+    subWords (Replace _ (Parameter _ mw) _ _ w1 w2) = w1 : w2 : maybeToList mw+    subWords (LetterCase _ (Parameter _ mw) _ _ w)  = w : maybeToList mw bannedCommand _ = []  ------------@@ -101,3 +166,10 @@   InlinedBash    -> security_8 t   StrangeBashism -> security_9 t   CleverRedirect -> security_10 t++--------+-- UTILS+--------++rValueL :: Lens' Assign RValue+rValueL f (Assign p ao r) = Assign p ao <$> f r

@@ -11,6 +11,7 @@  module Aura.Settings   ( Settings(..)+  , logFuncOfL     -- * Aura Configuration   , BuildConfig(..), BuildSwitch(..)   , switch@@ -29,7 +30,6 @@ import           RIO import qualified RIO.Set as S import qualified RIO.Text as T-import           System.Path (Absolute, Path, fromAbsoluteFilePath, toFilePath)  --- @@ -48,16 +48,16 @@ -- Aura will react to them, but also pass them through to `pacman` -- calls if necessary. data CommonConfig = CommonConfig-  { cachePathOf      :: !(Either (Path Absolute) (Path Absolute))-  , configPathOf     :: !(Either (Path Absolute) (Path Absolute))-  , logPathOf        :: !(Either (Path Absolute) (Path Absolute))+  { cachePathOf      :: !(Either FilePath FilePath)+  , configPathOf     :: !(Either FilePath FilePath)+  , logPathOf        :: !(Either FilePath FilePath)   , commonSwitchesOf :: !(Set CommonSwitch) } deriving (Show, Generic)  instance Flagable CommonConfig where   asFlag (CommonConfig cap cop lfp cs) =-    either (const []) (\p -> ["--cachedir", T.pack $ toFilePath p]) cap-    <> either (const []) (\p -> ["--config", T.pack $ toFilePath p]) cop-    <> either (const []) (\p -> ["--logfile", T.pack $ toFilePath p]) lfp+    either (const []) (\p -> ["--cachedir", T.pack p]) cap+    <> either (const []) (\p -> ["--config", T.pack p]) cop+    <> either (const []) (\p -> ["--logfile", T.pack p]) lfp     <> asFlag cs  -- | Yes/No-style switches that are common to both Aura and Pacman.@@ -84,7 +84,7 @@ -- | Settings unique to the AUR package building process. data BuildConfig = BuildConfig   { makepkgFlagsOf  :: !(Set Makepkg)-  , buildPathOf     :: !(Path Absolute)+  , buildPathOf     :: !FilePath   , buildUserOf     :: !(Maybe User)   , truncationOf    :: !Truncation  -- For `-As`   , buildSwitchesOf :: !(Set BuildSwitch) } deriving (Show)@@ -101,6 +101,7 @@                  | UseCustomizepkg                  | ForceBuilding                  | NoPkgbuildCheck+                 | AsDeps                  deriving (Eq, Ord, Show)  -- | Is some Aura-specific setting turned on for this run?@@ -121,9 +122,13 @@   , ignoresOf      :: !(Set PkgName)   , commonConfigOf :: !CommonConfig   , buildConfigOf  :: !BuildConfig+  , logLevelOf     :: !LogLevel   , logFuncOf      :: !LogFunc }   deriving stock (Generic) +logFuncOfL :: Lens' Settings LogFunc+logFuncOfL f s = (\lf -> s { logFuncOf = lf }) <$> f (logFuncOf s)+ -- | Unless otherwise specified, packages will be built within @/tmp@.-defaultBuildDir :: Path Absolute-defaultBuildDir = fromAbsoluteFilePath "/tmp"+defaultBuildDir :: FilePath+defaultBuildDir = "/tmp"

@@ -0,0 +1,71 @@+-- |+-- Module    : Aura.Shell+-- Copyright : (c) Colin Woodbury, 2012 - 2020+-- License   : GPL3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+-- Interaction with the terminal.++module Aura.Shell where++import           Aura.Types+import           RIO+import qualified RIO.ByteString as B+import qualified RIO.Map as M+import qualified RIO.Text as T+import           System.Process.Typed (proc, runProcess)++---++-- | Code borrowed from `ansi-terminal` library by Max Bolingbroke.+csi :: [Int] -> ByteString -> ByteString+csi args code = "\ESC[" <> B.intercalate ";" (map (encodeUtf8 . textDisplay) args) <> code++-- | Terminal code for raising the cursor.+cursorUpLineCode :: Int -> ByteString+cursorUpLineCode n = csi [n] "F"++-- | This will get the true user name regardless of sudo-ing.+getTrueUser :: Environment -> Maybe User+getTrueUser env | isTrueRoot env  = Just $ User "root"+                | hasRootPriv env = User <$> M.lookup "SUDO_USER" env+                | otherwise       = User <$> M.lookup "USER" env++-- | Is the current user of Aura the true @root@ user, and not just a sudo user?+isTrueRoot :: Environment -> Bool+isTrueRoot env = M.lookup "USER" env == Just "root" && not (M.member "SUDO_USER" env)++-- | Is the user root, or using sudo?+hasRootPriv :: Environment -> Bool+hasRootPriv env = M.member "SUDO_USER" env || isTrueRoot env++-- | `vi` is a sensible default, it should be installed by+-- on any Arch system.+getEditor :: Environment -> FilePath+getEditor = maybe "vi" T.unpack . M.lookup "EDITOR"++-- | This will get the locale variable for translations from the environment+getLocale :: Environment -> Text+getLocale env = fromMaybe "C" . asum $ map (`M.lookup` env) ["LC_ALL", "LC_MESSAGES", "LANG"]++-- | Mark some `Path` as being owned by a `User`.+chown :: MonadIO m => User -> FilePath -> [String] -> m ()+chown (User usr) pth args = void . runProcess $ proc "chown" (args <> [T.unpack usr, pth])++-- | Hide the cursor in a terminal.+hideCursor :: IO ()+hideCursor = B.putStr hideCursorCode++-- | Restore a cursor to visiblity in the terminal.+showCursor :: IO ()+showCursor = B.putStr showCursorCode++hideCursorCode :: ByteString+hideCursorCode = csi [] "?25l"++showCursorCode :: ByteString+showCursorCode = csi [] "?25h"++-- | Raise the cursor by @n@ lines.+raiseCursorBy :: Int -> IO ()+raiseCursorBy = B.putStr . cursorUpLineCode

@@ -1,5 +1,3 @@-{-# LANGUAGE DataKinds        #-}- -- | -- Module    : Aura.State -- Copyright : (c) Colin Woodbury, 2012 - 2020@@ -21,17 +19,18 @@ import           Aura.Cache import           Aura.Colour (red) import           Aura.Core (Env(..), notify, report, warn)+import           Aura.IO import           Aura.Languages import           Aura.Pacman (pacman, pacmanLines) import           Aura.Settings import           Aura.Types-import           Aura.Utils-import           Control.Error.Util (hush)+import           Aura.Utils (hush) import           Data.Aeson-import           Data.Generics.Product (field) import           Data.Versions import           RIO import qualified RIO.ByteString.Lazy as BL+import           RIO.Directory+import           RIO.FilePath import qualified RIO.List as L import           RIO.List.Partial ((!!)) import qualified RIO.Map as M@@ -39,8 +38,6 @@ import qualified RIO.NonEmpty as NEL import qualified RIO.Text as T import           RIO.Time-import           System.Path-import           System.Path.IO (createDirectoryIfMissing, getDirectoryContents) import           Text.Printf (printf)  ---@@ -70,8 +67,8 @@   , _toRemove :: ![PkgName] }  -- | The default location of all saved states: \/var\/cache\/aura\/states-stateCache :: Path Absolute-stateCache = fromAbsoluteFilePath "/var/cache/aura/states"+stateCache :: FilePath+stateCache = "/var/cache/aura/states"  -- | Does a given package have an entry in a particular `PkgState`? inState :: SimplePkg -> PkgState -> Bool@@ -103,7 +100,7 @@ olds old curr = map (uncurry SimplePkg) . M.assocs $ M.difference (pkgsOf old) (pkgsOf curr)  -- | The filepaths of every saved package state.-getStateFiles :: IO [Path Absolute]+getStateFiles :: IO [FilePath] getStateFiles = do   createDirectoryIfMissing True stateCache   L.sort . map (stateCache </>) <$> getDirectoryContents stateCache@@ -113,10 +110,10 @@ saveState :: Settings -> IO () saveState ss = do   state <- currentState-  let filename = stateCache </> fromUnrootedFilePath (dotFormat (timeOf state)) <.> FileExt "json"+  let filename = stateCache </> dotFormat (timeOf state) <.> "json"   createDirectoryIfMissing True stateCache-  BL.writeFile (toFilePath filename) $ encode state-  notify ss . saveState_1 $ langOf ss+  BL.writeFile filename $ encode state+  notify ss saveState_1  dotFormat :: ZonedTime -> String dotFormat (ZonedTime t _) = L.intercalate "." items@@ -134,7 +131,7 @@ restoreState :: RIO Env () restoreState =   liftIO getStateFiles >>= maybe (throwM $ Failure restoreState_2) f . NEL.nonEmpty-  where f :: NonEmpty (Path Absolute) -> RIO Env ()+  where f :: NonEmpty FilePath -> RIO Env ()         f sfs = do           ss  <- asks settings           let pth = either id id . cachePathOf $ commonConfigOf ss@@ -146,25 +143,24 @@               Cache cache <- liftIO $ cacheContents pth               let StateDiff rein remo = compareStates past curr                   (okay, nope)        = L.partition (`M.member` cache) rein-              traverse_ (report red restoreState_1 . fmap (^. field @"name")) $ NEL.nonEmpty nope+              traverse_ (report red restoreState_1 . fmap spName) $ NEL.nonEmpty nope               reinstallAndRemove (mapMaybe (`M.lookup` cache) okay) remo -selectState :: NonEmpty (Path Absolute) -> IO (Path Absolute)-selectState = getSelection (T.pack . toFilePath)+selectState :: NonEmpty FilePath -> IO FilePath+selectState = getSelection T.pack  -- | Given a `FilePath` to a package state file, attempt to read and parse -- its contents. As of Aura 2.0, only state files in JSON format are accepted.-readState :: Path Absolute -> IO (Maybe PkgState)-readState = fmap decode . BL.readFile . toFilePath+readState :: FilePath -> IO (Maybe PkgState)+readState = fmap decode . BL.readFile  -- | `reinstalling` can mean true reinstalling, or just altering. reinstallAndRemove :: [PackagePath] -> [PkgName] -> RIO Env ()-reinstallAndRemove [] [] = asks settings >>= \ss ->-  liftIO (warn ss . reinstallAndRemove_1 $ langOf ss)+reinstallAndRemove [] [] = asks settings >>= \ss -> warn ss reinstallAndRemove_1 reinstallAndRemove down remo   | null remo = reinstall   | null down = remove   | otherwise = reinstall *> remove   where     remove    = liftIO . pacman $ "-R" : asFlag remo-    reinstall = liftIO . pacman $ "-U" : map (T.pack . toFilePath . path) down+    reinstall = liftIO . pacman $ "-U" : map (T.pack . ppPath) down

@@ -1,10 +1,7 @@-{-# LANGUAGE DataKinds                  #-} {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE DerivingStrategies         #-}-{-# LANGUAGE DuplicateRecordFields      #-} {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiWayIf                 #-}  {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -22,7 +19,7 @@   , Dep(..), parseDep, renderedDep   , Buildable(..)   , Prebuilt(..)-  , SimplePkg(..), simplepkg, simplepkg'+  , SimplePkg(..), simplepkg, simplepkg', bToSP, pToSP     -- * Typeclasses   , Flagable(..)     -- * Package Building@@ -37,28 +34,22 @@   , PkgName(..)   , PkgGroup(..)   , Provides(..)-  , PackagePath(..)+  , PackagePath, packagePath, ppPath   , Pkgbuild(..)   , Environment   , User(..)   ) where -import           Control.Error.Util (hush)+import           Aura.Utils import           Data.Aeson (FromJSONKey, ToJSONKey)-import           Data.Bifunctor (Bifunctor(..)) import           Data.Bitraversable-import           Data.Generics.Product (field, super)-import           Data.Semigroup.Foldable (Foldable1(..))-import           Data.Set.NonEmpty (NESet)-import qualified Data.Set.NonEmpty as NES import           Data.Text.Prettyprint.Doc hiding (list, space) import           Data.Text.Prettyprint.Doc.Render.Terminal-import           Data.These (These(..)) import           Data.Versions hiding (Traversal') import           Lens.Micro import           RIO hiding (try)+import           RIO.FilePath import qualified RIO.Text as T-import           System.Path (Absolute, Path, takeFileName, toUnrootedFilePath) import           Text.Megaparsec import           Text.Megaparsec.Char @@ -79,56 +70,57 @@  -- | The name of a `Package`. pname :: Package -> PkgName-pname (FromRepo pb) = pb ^. field @"name"-pname (FromAUR b)   = b  ^. field @"name"+pname (FromRepo pb) = pName pb+pname (FromAUR b)   = bName b  -- | Other names which allow this `Package` to be satisfied as a dependency. pprov :: Package -> Provides-pprov (FromRepo pb) = pb ^. field @"provides"-pprov (FromAUR b)   = b  ^. field @"provides"+pprov (FromRepo pb) = pProvides pb+pprov (FromAUR b)   = bProvides b  -- | The version of a `Package`. pver :: Package -> Versioning-pver (FromRepo pb) = pb ^. field @"version"-pver (FromAUR b)   = b  ^. field @"version"+pver (FromRepo pb) = pVersion pb+pver (FromAUR b)   = bVersion b -dividePkgs :: NESet Package -> These (NESet Prebuilt) (NESet Buildable)-dividePkgs = bimap NES.fromList NES.fromList . partNonEmpty f . NES.toList+dividePkgs :: NonEmpty Package -> These (NonEmpty Prebuilt) (NonEmpty Buildable)+dividePkgs = partNonEmpty f   where     f :: Package -> These Prebuilt Buildable     f (FromRepo p) = This p     f (FromAUR b)  = That b --- TODO Contribute this upstream.--- | Partition a `NonEmpty` based on some function.-partNonEmpty :: (a -> These b c) -> NonEmpty a -> These (NonEmpty b) (NonEmpty c)-partNonEmpty f = foldMap1 (bimap pure pure . f)- -- TODO Figure out how to do this more generically. instance Ord Package where   compare (FromAUR a) (FromAUR b)   = compare a b   compare (FromRepo a) (FromRepo b) = compare a b-  compare (FromAUR a) (FromRepo b)  = compare (a ^. super @SimplePkg) (b ^. super @SimplePkg)-  compare (FromRepo a) (FromAUR b)  = compare (a ^. super @SimplePkg) (b ^. super @SimplePkg)+  compare (FromAUR a) (FromRepo b)  = compare (bToSP a) (pToSP b)+  compare (FromRepo a) (FromAUR b)  = compare (pToSP a) (bToSP b)  -- | A `Package` from the AUR that's buildable in some way on the user's machine.-data Buildable = Buildable { name       :: !PkgName-                           , version    :: !Versioning-                           , base       :: !PkgName-                           , provides   :: !Provides-                           , deps       :: ![Dep]-                           , pkgbuild   :: !Pkgbuild-                           , isExplicit :: !Bool } deriving (Eq, Ord, Show, Generic)+data Buildable = Buildable+  { bName       :: !PkgName+  , bVersion    :: !Versioning+  , bBase       :: !PkgName+  , bProvides   :: !Provides+  , bDeps       :: ![Dep]+  , bPkgbuild   :: !Pkgbuild+  , bIsExplicit :: !Bool }+  deriving (Eq, Ord, Show, Generic)  -- | A prebuilt `Package` from the official Arch repositories.-data Prebuilt = Prebuilt { name     :: !PkgName-                         , version  :: !Versioning-                         , base     :: !PkgName-                         , provides :: !Provides } deriving (Eq, Ord, Show, Generic)+data Prebuilt = Prebuilt+  { pName     :: !PkgName+  , pVersion  :: !Versioning+  , pBase     :: !PkgName+  , pProvides :: !Provides }+  deriving (Eq, Ord, Show, Generic)  -- | A dependency on another package.-data Dep = Dep { name   :: !PkgName-               , demand :: !VersionDemand } deriving (Eq, Ord, Show, Generic)+data Dep = Dep+  { dName   :: !PkgName+  , dDemand :: !VersionDemand }+  deriving (Eq, Ord, Show, Generic)  -- | Parse a dependency entry as it would appear in a PKGBUILD: --@@ -142,17 +134,18 @@         n   = PkgName <$> takeWhile1P Nothing (\c -> c /= '<' && c /= '>' && c /= '=')         v   = do           end <- atEnd-          if | end       -> pure Anything-             | otherwise -> choice [ char '<'    *> fmap LessThan versioning'-                                   , string ">=" *> fmap AtLeast  versioning'-                                   , char '>'    *> fmap MoreThan versioning'-                                   , char '='    *> fmap MustBe   versioning'-                                   , pure Anything ]+          if end+            then pure Anything+            else choice [ char '<'    *> fmap LessThan versioning'+                        , string ">=" *> fmap AtLeast  versioning'+                        , char '>'    *> fmap MoreThan versioning'+                        , char '='    *> fmap MustBe   versioning'+                        , pure Anything ]  -- | Renders the `Dep` into a form that @pacman -T@ understands. The dual of -- `parseDep`. renderedDep :: Dep -> Text-renderedDep (Dep n ver) = (n ^. field @"name") <> asT ver+renderedDep (Dep n ver) = pnName n <> asT ver   where     asT :: VersionDemand -> Text     asT (LessThan v) = "<"  <> prettyV v@@ -170,11 +163,11 @@                    deriving (Eq, Ord)  instance Show VersionDemand where-    show (LessThan v) = T.unpack $ "<"  <> prettyV v-    show (AtLeast  v) = T.unpack $ ">=" <> prettyV v-    show (MoreThan v) = T.unpack $ ">"  <> prettyV v-    show (MustBe   v) = T.unpack $ "="  <> prettyV v-    show Anything     = "Anything"+  show (LessThan v) = T.unpack $ "<"  <> prettyV v+  show (AtLeast  v) = T.unpack $ ">=" <> prettyV v+  show (MoreThan v) = T.unpack $ ">"  <> prettyV v+  show (MustBe   v) = T.unpack $ "="  <> prettyV v+  show Anything     = "Anything"  -- | Attempt to zoom into the `Versioning` hiding within a `VersionDemand`. _VersionDemand :: Traversal' VersionDemand Versioning@@ -189,26 +182,35 @@  -- | A package name with its version number. data SimplePkg = SimplePkg-  { name    :: !PkgName-  , version :: !Versioning }+  { spName    :: !PkgName+  , spVersion :: !Versioning }   deriving (Eq, Ord, Show, Generic) +bToSP :: Buildable -> SimplePkg+bToSP b = SimplePkg (bName b) (bVersion b)++pToSP :: Prebuilt -> SimplePkg+pToSP p = SimplePkg (pName p) (pVersion p)+ -- | Attempt to create a `SimplePkg` from filepaths like --   @\/var\/cache\/pacman\/pkg\/linux-3.2.14-1-x86_64.pkg.tar.xz@ simplepkg :: PackagePath -> Maybe SimplePkg-simplepkg (PackagePath t) = uncurry SimplePkg <$> bitraverse hush hush (parse n "name" t', parse v "version" t')-  where t' = T.pack . toUnrootedFilePath $ takeFileName t+simplepkg (PackagePath t) =+  uncurry SimplePkg <$> bitraverse hush hush (parse n "name" t', parse v "version" t')+  where+    t' :: Text+    t' = T.pack $ takeFileName t -        n :: Parsec Void Text PkgName-        n = PkgName . T.pack <$> manyTill anySingle (try finished)+    n :: Parsec Void Text PkgName+    n = PkgName . T.pack <$> manyTill anySingle (try finished) -        -- | Assumes that a version number will never start with a letter,-        -- and that a package name section (i.e. abc-def-ghi) will never start-        -- with a number.-        finished = char '-' *> lookAhead digitChar-        v    = manyTill anySingle (try finished) *> ver-        ver  = try (fmap Ideal semver' <* post) <|> try (fmap General version' <* post) <|> fmap Complex mess'-        post = char '-' *> (string "x86_64" <|> string "any") *> string ".pkg.tar.xz"+    -- | Assumes that a version number will never start with a letter,+    -- and that a package name section (i.e. abc-def-ghi) will never start+    -- with a number.+    finished = char '-' *> lookAhead digitChar+    v    = manyTill anySingle (try finished) *> ver+    ver  = try (fmap Ideal semver' <* post) <|> try (fmap General version' <* post) <|> fmap Complex mess'+    post = char '-' *> (string "x86_64" <|> string "any") *> string ".pkg.tar.xz"  -- | Attempt to create a `SimplePkg` from text like: --     xchat 2.8.8-19@@ -221,19 +223,28 @@ --   * \/var\/cache\/pacman\/pkg\/linux-3.2.14-1-x86_64.pkg.tar.xz --   * \/var\/cache\/pacman\/pkg\/wine-1.4rc6-1-x86_64.pkg.tar.xz --   * \/var\/cache\/pacman\/pkg\/ruby-1.9.3_p125-4-x86_64.pkg.tar.xz-newtype PackagePath = PackagePath { path :: Path Absolute } deriving (Eq, Generic)+newtype PackagePath = PackagePath { ppPath :: FilePath }+  deriving (Eq, Generic)  -- | If they have the same package names, compare by their versions. -- Otherwise, do raw comparison of the path string. instance Ord PackagePath where-  compare a b | nameA /= nameB = compare (path a) (path b)+  compare a b | nameA /= nameB = compare (ppPath a) (ppPath b)               | otherwise      = compare verA verB-    where (nameA, verA) = f a-          (nameB, verB) = f b-          f = ((^? _Just . field @"name") &&& (^? _Just . field @"version")) . simplepkg+    where+      (nameA, verA) = f a+      (nameB, verB) = f b +      f :: PackagePath -> (Maybe PkgName, Maybe Versioning)+      f = (fmap spName &&& fmap spVersion) . simplepkg++-- | Smart constructor for `PackagePath`.+packagePath :: FilePath -> Maybe PackagePath+packagePath fp = bool Nothing (Just $ PackagePath fp) $ isAbsolute fp+ -- | The contents of a PKGBUILD file.-newtype Pkgbuild = Pkgbuild { pkgbuild :: ByteString } deriving (Eq, Ord, Show, Generic)+newtype Pkgbuild = Pkgbuild { pkgbuild :: ByteString }+  deriving (Eq, Ord, Show, Generic)  -- | All human languages available for text output. data Language = English@@ -252,10 +263,11 @@               | Indonesia               | Chinese               | Esperanto+              | Dutch                 deriving (Eq, Enum, Bounded, Ord, Show)  -- | The various ways that dependency resolution can fail.-data DepError = NonExistant PkgName+data DepError = NonExistant PkgName PkgName               | VerConflict (Doc AnsiStyle)               | Ignored (Doc AnsiStyle)               | BrokenProvides PkgName Provides PkgName@@ -273,18 +285,20 @@ type Environment = Map Text Text  -- | The name of a user account on a Linux system.-newtype User = User { user :: Text } deriving (Eq, Show, Generic)+newtype User = User { user :: Text }+  deriving (Eq, Show, Generic)  -- | The name of an Arch Linux package.-newtype PkgName = PkgName { name :: Text }+newtype PkgName = PkgName { pnName :: Text }   deriving stock (Eq, Ord, Show, Generic)   deriving newtype (Flagable, ToJSONKey, FromJSONKey, IsString)  -- | A group that a `Package` could belong too, like @base@, @base-devel@, etc.-newtype PkgGroup = PkgGroup { group :: Text }+newtype PkgGroup = PkgGroup { pgGroup :: Text }   deriving stock (Eq, Ord, Show, Generic)   deriving newtype (Flagable)  -- | The dependency which some package provides. May not be the same name -- as the package itself (e.g. cronie provides cron).-newtype Provides = Provides { provides :: PkgName } deriving (Eq, Ord, Show, Generic)+newtype Provides = Provides { provides :: PkgName }+  deriving (Eq, Ord, Show, Generic)

@@ -9,52 +9,37 @@ module Aura.Utils   ( -- * Strings     Pattern(..)-  , replaceByPatt, searchLines+  , searchLines     -- * Network   , urlContents-    -- * Shell-  , csi, cursorUpLineCode, hideCursor, showCursor, raiseCursorBy-  , getTrueUser, getEditor, getLocale-  , hasRootPriv, isTrueRoot-  , chown-    -- * File IO-  , ifFile-    -- * Output-  , putStrLnA-  , putText-  , putTextLn-  , colourCheck-  , entrify-    -- * User Input-  , optionalPrompt-  , getSelection-    -- * Misc.-  , maybe'+    -- * Semigroupoids+  , foldMap1+  , fold1+    -- * Errors+  , hush+  , note+    -- * Compactable   , fmapEither   , traverseEither+    -- * These+  , These(..)+  , these+    -- * Misc.+  , maybe'   , groupsOf+  , nes+  , partNonEmpty   ) where -import           Aura.Colour-import           Aura.Languages (whitespace, yesNoMessage, yesPattern)-import           Aura.Settings-import           Aura.Types (Environment, Language, User(..))-import           Data.Text.Prettyprint.Doc-import           Data.Text.Prettyprint.Doc.Render.Terminal+import           Data.Bifunctor import           Network.HTTP.Client import           Network.HTTP.Types.Status (statusCode) import           RIO-import qualified RIO.ByteString as B import qualified RIO.ByteString.Lazy as BL import qualified RIO.List as L-import           RIO.List.Partial (maximum)-import qualified RIO.Map as M+import qualified RIO.NonEmpty as NEL+import qualified RIO.Set as S import qualified RIO.Text as T-import           RIO.Text.Partial (breakOn)-import           System.Path (Absolute, Path, toFilePath)-import           System.Path.IO (doesFileExist)-import           System.Process.Typed (proc, runProcess)-import           Text.Printf (printf)  --- @@ -64,43 +49,10 @@ -- | For regex-like find-and-replace in some `Text`. data Pattern = Pattern { _pattern :: Text, _target :: Text } --- | Replaces a (p)attern with a (t)arget in a line if possible.-replaceByPatt :: [Pattern] -> Text -> Text-replaceByPatt [] l = l-replaceByPatt (Pattern p t : ps) l = case breakOn p l of-  -- No match.-  (_, "")    -> replaceByPatt ps l-  -- Matched. The matched pattern is still present at the head of `rest`,-  -- so we need to drop it first.-  (cs, rest) -> replaceByPatt ps (cs <> t <> T.drop (T.length p) rest)- -- | Find lines which contain some given `Text`. searchLines :: Text -> [Text] -> [Text] searchLines pat = filter (T.isInfixOf pat) --------- IO--------- | Given a number of selections, allows the user to choose one.-getSelection :: Foldable f => (a -> Text) -> f a -> IO a-getSelection f choiceLabels = do-  let quantity = length choiceLabels-      valids   = map tshow [1..quantity]-      pad      = show . length . show $ quantity-      choices  = zip valids $ toList choiceLabels-  traverse_ (\(l,v) -> printf ("%" <> pad <> "s. %s\n") l (f v)) choices-  BL.putStr ">> "-  hFlush stdout-  userChoice <- decodeUtf8Lenient <$> B.getLine-  case userChoice `lookup` choices of-    Just valid -> pure valid-    Nothing    -> getSelection f choiceLabels  -- Ask again.---- | If a file exists, it performs action `t` on the argument.--- | If the file doesn't exist, it performs `f` and returns the argument.-ifFile :: MonadIO m => (a -> m a) -> m b -> Path Absolute -> a -> m a-ifFile t f file x = liftIO (doesFileExist file) >>= bool (f $> x) (t x)- ---------- -- NETWORK ----------@@ -112,121 +64,9 @@     f res | statusCode (responseStatus res) == 200 = Just . BL.toStrict $ responseBody res           | otherwise = Nothing ------------ SHELL------------ | Code borrowed from `ansi-terminal` library by Max Bolingbroke.-csi :: [Int] -> ByteString -> ByteString-csi args code = "\ESC[" <> B.intercalate ";" (map (encodeUtf8 . textDisplay) args) <> code---- | Terminal code for raising the cursor.-cursorUpLineCode :: Int -> ByteString-cursorUpLineCode n = csi [n] "F"---- | This will get the true user name regardless of sudo-ing.-getTrueUser :: Environment -> Maybe User-getTrueUser env | isTrueRoot env  = Just $ User "root"-                | hasRootPriv env = User <$> M.lookup "SUDO_USER" env-                | otherwise       = User <$> M.lookup "USER" env---- | Is the current user of Aura the true @root@ user, and not just a sudo user?-isTrueRoot :: Environment -> Bool-isTrueRoot env = M.lookup "USER" env == Just "root" && not (M.member "SUDO_USER" env)---- | Is the user root, or using sudo?-hasRootPriv :: Environment -> Bool-hasRootPriv env = M.member "SUDO_USER" env || isTrueRoot env---- | `vi` is a sensible default, it should be installed by--- on any Arch system.-getEditor :: Environment -> FilePath-getEditor = maybe "vi" T.unpack . M.lookup "EDITOR"---- | This will get the locale variable for translations from the environment-getLocale :: Environment -> Text-getLocale env = fromMaybe "C" . asum $ map (`M.lookup` env) ["LC_ALL", "LC_MESSAGES", "LANG"]---- | Mark some `Path` as being owned by a `User`.-chown :: MonadIO m => User -> Path Absolute -> [String] -> m ()-chown (User usr) pth args = void . runProcess $ proc "chown" (args <> [T.unpack usr, toFilePath pth])---- | Hide the cursor in a terminal.-hideCursor :: IO ()-hideCursor = B.putStr hideCursorCode---- | Restore a cursor to visiblity in the terminal.-showCursor :: IO ()-showCursor = B.putStr showCursorCode--hideCursorCode :: ByteString-hideCursorCode = csi [] "?25l"--showCursorCode :: ByteString-showCursorCode = csi [] "?25h"---- | Raise the cursor by @n@ lines.-raiseCursorBy :: Int -> IO ()-raiseCursorBy = B.putStr . cursorUpLineCode--------------------- CUSTOM OUTPUT-------------------- | Print a `Doc` with Aura flair after performing a `colourCheck`.-putStrLnA :: Settings -> Doc AnsiStyle -> IO ()-putStrLnA ss d = putStrA ss $ d <> hardline---- | Will remove all colour annotations if the user specified @--color=never@.-putStrA :: Settings -> Doc AnsiStyle -> IO ()-putStrA ss d = B.putStr . encodeUtf8 . dtot $ "aura >>=" <+> colourCheck ss d---- | Strip colours from a `Doc` if @--color=never@ is specified,--- or if the output target isn't a terminal.-colourCheck :: Settings -> Doc ann -> Doc ann-colourCheck ss | shared ss (Colour Never)  = unAnnotate-               | shared ss (Colour Always) = id-               | isTerminal ss = id-               | otherwise = unAnnotate--putText :: Text -> IO ()-putText = B.putStr . encodeUtf8--putTextLn :: Text -> IO ()-putTextLn = BL.putStrLn . BL.fromStrict . encodeUtf8--------------- PROMPTS------------yesNoPrompt :: Settings -> Doc AnsiStyle -> IO Bool-yesNoPrompt ss msg = do-  putStrA ss . yellow $ msg <+> yesNoMessage (langOf ss) <> " "-  hFlush stdout-  response <- decodeUtf8Lenient <$> B.getLine-  pure $ isAffirmative (langOf ss) response---- | An empty response emplies "yes".-isAffirmative :: Language -> Text -> Bool-isAffirmative l t = T.null t || elem (T.toCaseFold t) (yesPattern l)---- | Doesn't prompt when `--noconfirm` is used.-optionalPrompt :: Settings -> (Language -> Doc AnsiStyle) -> IO Bool-optionalPrompt ss msg | shared ss NoConfirm = pure True-                      | otherwise           = yesNoPrompt ss (msg $ langOf ss)- ------- -- MISC ---------- | Format two lists into two nice rows a la `-Qi` or `-Si`.-entrify :: Settings -> [Text] -> [Doc AnsiStyle] -> Doc AnsiStyle-entrify ss fs es = vsep $ zipWith combine fs' es-  where fs' = padding ss fs-        combine f e = annotate bold (pretty f) <+> ":" <+> e---- | Right-pads strings according to the longest string in the group.-padding :: Settings -> [Text] -> [Text]-padding ss fs = map (T.justifyLeft longest ws) fs-  where ws      = whitespace $ langOf ss-        longest = maximum $ map T.length fs- -- | `maybe` with the function at the end. maybe' :: b -> Maybe a -> (a -> b) -> b maybe' zero m f = maybe zero f m@@ -255,3 +95,53 @@     go bs = xs : go rest       where         (xs, rest) = L.splitAt n bs++nes :: Set a -> Maybe (NonEmpty a)+nes = NEL.nonEmpty . S.toList++hush :: Either a b -> Maybe b+hush = either (const Nothing) Just++note :: a -> Maybe b -> Either a b+note a = maybe (Left a) Right++-- | Borrowed from semigroupoids.+foldMap1 :: Semigroup m => (a -> m) -> NonEmpty a -> m+foldMap1 f (a :| [])     = f a+foldMap1 f (a :| b : bs) = f a <> foldMap1 f (b :| bs)++-- | Borrowed from semigroupoids.+fold1 :: Semigroup m => NonEmpty m -> m+fold1 = foldMap1 id++-- | Partition a `NonEmpty` based on some function.+partNonEmpty :: (a -> These b c) -> NonEmpty a -> These (NonEmpty b) (NonEmpty c)+partNonEmpty f = foldMap1 (bimap pure pure . f)++--------------------------------------------------------------------------------+-- These++data These a b = This a | That b | These a b++instance (Semigroup a, Semigroup b) => Semigroup (These a b) where+  This x <> This y = This (x <> y)+  This x <> These z y = These (x <> z) y+  This x <> That y = These x y++  That x <> That y = That (x <> y)+  That x <> This y = These y x+  That x <> These y z = These y (x <> z)++  These w x <> This y = These (w <> y) x+  These w x <> That y = These w (x <> y)+  These w x <> These y z = These (w <> y) (x <> z)++instance Bifunctor These where+  bimap f _ (This x)    = This (f x)+  bimap _ g (That y)    = That (g y)+  bimap f g (These x y) = These (f x) (g y)++these :: (a -> t) -> (b -> t) -> (a -> b -> t) -> These a b -> t+these f _ _ (This a)    = f a+these _ g _ (That b)    = g b+these _ _ h (These a b) = h a b

@@ -8,8 +8,8 @@ import           Data.Versions import           RIO import qualified RIO.Map as M+import           RIO.Partial -- import           Language.Bash.Pretty (prettyText)-import           System.Path import           Test.Tasty import           Test.Tasty.HUnit import           Text.Megaparsec@@ -45,7 +45,7 @@     ]   , testGroup "Aura.Types"     [ testCase "simplepkg"-      $ simplepkg (PackagePath $ fromAbsoluteFilePath "/var/cache/pacman/pkg/linux-is-cool-3.2.14-1-x86_64.pkg.tar.xz")+      $ simplepkg (fromJust $ packagePath "/var/cache/pacman/pkg/linux-is-cool-3.2.14-1-x86_64.pkg.tar.xz")       @?= Just (SimplePkg "linux-is-cool" . Ideal $ SemVer 3 2 14 [[Digits 1]] [])     , testCase "simplepkg'"       $ simplepkg' "xchat 2.8.8-19" @?= Just (SimplePkg "xchat" . Ideal $ SemVer 2 8 8 [[Digits 19]] [])