aura 2.0.0 → 2.0.2

raw patch · 36 files changed

+1205/−898 lines, 36 filesdep +fused-effectsdep +nonempty-containersdep +schedulerdep −arraydep −asyncdep −freer-simpledep ~aeson-prettydep ~algebraic-graphsdep ~aurPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: fused-effects, nonempty-containers, scheduler, these, unliftio

Dependencies removed: array, async, freer-simple, mtl, non-empty-containers, throttled, witherable

Dependency ranges changed: aeson-pretty, algebraic-graphs, aur, base, bytestring, compactable, containers, directory, errors, filepath, generic-lens, http-client, http-client-tls, language-bash, megaparsec, microlens, microlens-ghc, mwc-random, network-uri, optparse-applicative, paths, pretty-simple, prettyprinter, prettyprinter-ansi-terminal, stm, tasty, text, time, transformers, typed-process, versions

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• README.md +2/−1
• aura.cabal +123/−153
• doc/aura.8 +2/−0
• exec/Flags.hs +63/−61
• exec/Settings.hs +2/−2
• exec/aura.hs +39/−31
• lib/Aura/Build.hs +32/−28
• lib/Aura/Cache.hs +8/−5
• lib/Aura/Colour.hs +1/−1
• lib/Aura/Commands/A.hs +61/−51
• lib/Aura/Commands/B.hs +7/−4
• lib/Aura/Commands/C.hs +69/−58
• lib/Aura/Commands/L.hs +32/−23
• lib/Aura/Commands/O.hs +13/−11
• lib/Aura/Core.hs +84/−55
• lib/Aura/Dependencies.hs +103/−79
• lib/Aura/Diff.hs +3/−3
• lib/Aura/Install.hs +88/−81
• lib/Aura/Languages.hs +113/−33
• lib/Aura/Languages/Fields.hs +21/−2
• lib/Aura/Logo.hs +4/−4
• lib/Aura/MakePkg.hs +21/−18
• lib/Aura/Packages/AUR.hs +61/−32
• lib/Aura/Packages/Repository.hs +44/−24
• lib/Aura/Pacman.hs +35/−26
• lib/Aura/Pkgbuild/Base.hs +3/−2
• lib/Aura/Pkgbuild/Editing.hs +5/−4
• lib/Aura/Pkgbuild/Fetch.hs +4/−4
• lib/Aura/Pkgbuild/Records.hs +6/−5
• lib/Aura/Pkgbuild/Security.hs +7/−4
• lib/Aura/Settings.hs +32/−28
• lib/Aura/State.hs +30/−22
• lib/Aura/Types.hs +53/−24
• lib/Aura/Utils.hs +11/−6
• test/Test.hs +19/−13

@@ -1,5 +1,9 @@ # Aura Changelog +## 2.0.2++- Bug fixes and performance improvements.+ ## 2.0.0  This is a large update representing about a month of full-time effort. Aura is now

@@ -75,7 +75,7 @@   Aura code demonstrates:   * Parser Combinators (`megaparsec`)   * CLI Flag Handling (`optparse-applicative`)-  * Extensible Effects (`freer-simple`)+  * Extensible Effects (`fused-effects`)   * Concurrency (`async`)   * Shell Interaction (`shelly`) @@ -215,6 +215,7 @@ |------------|-------------------------------------------------| | Chinese    | Kai Zhang                                       | | Croatian   | Denis Kasak and "stranac"                       |+| Esperanto  | Zachary "Ghosy" Matthews                        | | French     | Ma Jiehong and Fabien Dubosson                  | | German     | Lukas Niederbremer and Jonas Platte             | | Indonesian | "pak tua Greg"                                  |

@@ -1,167 +1,137 @@-cabal-version: 1.12+cabal-version:      2.2+name:               aura+version:            2.0.2+synopsis:+  A secure package manager for Arch Linux and the AUR, written in Haskell. --- This file has been generated from package.yaml by hpack version 0.30.0.------ see: https://github.com/sol/hpack------ hash: 30037d712654f7ee468436f48905a4a11e991740c708a85dc56a37bf656e0f38+description:+  Aura is a package manager for Arch Linux written in Haskell. It connects to+  both the official Arch repostitories and to the AUR, allowing easy control of+  all packages on an Arch system. It allows /all/ pacman operations and provides+  /new/ custom ones for dealing with AUR packages. This differs from some other+  AUR package managers. -name:           aura-version:        2.0.0-synopsis:       A secure package manager for Arch Linux and the AUR, written in Haskell.-description:    aura is a package manager for Arch Linux written in Haskell. It connects to both the official Arch repostitories and to the AUR, allowing easy control of all packages on an Arch system. It allows /all/ pacman operations and provides /new/ custom ones for dealing with AUR packages. This differs from some other AUR package managers.-category:       System-homepage:       https://github.com/aurapm/aura-author:         Colin Woodbury-maintainer:     colin@fosskers.ca-license:        GPL-3-license-file:   LICENSE-build-type:     Simple+category:           System+homepage:           https://github.com/aurapm/aura+author:             Colin Woodbury+maintainer:         colin@fosskers.ca+license:            GPL-3.0-only+license-file:       LICENSE+build-type:         Simple extra-source-files:-    README.md-    CHANGELOG.md-    doc/aura.8-    doc/completions/bashcompletion.sh-    doc/completions/_aura+  README.md+  CHANGELOG.md+  doc/aura.8+  doc/completions/bashcompletion.sh+  doc/completions/_aura +common commons+  default-language:   Haskell2010+  default-extensions: NoImplicitPrelude+  ghc-options:+    -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns+    -Wredundant-constraints -Widentities -Wpartial-fields -Wcompat+    -funclutter-valid-hole-fits++  build-depends:+    , base          >=4.12 && <5+    , base-prelude  >=1.2  && <1.4+    , bytestring    ^>=0.10+    , containers    ^>=0.6+    , microlens     ^>=0.4+    , paths         ^>=0.2+    , text          ^>=1.2+    , versions      ^>=3.5++common libexec+  build-depends:+    , errors                       ^>=2.3+    , fused-effects                >=0.4 && <0.6+    , http-client                  >=0.5 && <0.7+    , nonempty-containers          ^>=0.3+    , prettyprinter                ^>=1.2+    , prettyprinter-ansi-terminal  ^>=1.1+    , transformers                 ^>=0.5+    , typed-process                ^>=0.2+ library+  import:          commons, libexec+  hs-source-dirs:  lib   exposed-modules:-      Aura.Build-      Aura.Cache-      Aura.Colour-      Aura.Commands.A-      Aura.Commands.B-      Aura.Commands.C-      Aura.Commands.L-      Aura.Commands.O-      Aura.Core-      Aura.Dependencies-      Aura.Diff-      Aura.Install-      Aura.Languages-      Aura.Languages.Fields-      Aura.Logo-      Aura.MakePkg-      Aura.Packages.AUR-      Aura.Packages.Repository-      Aura.Pacman-      Aura.Pkgbuild.Base-      Aura.Pkgbuild.Editing-      Aura.Pkgbuild.Fetch-      Aura.Pkgbuild.Records-      Aura.Pkgbuild.Security-      Aura.Settings-      Aura.State-      Aura.Types-      Aura.Utils-  hs-source-dirs:-      lib-  default-extensions: NoImplicitPrelude-  ghc-options: -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-binds -Wunused-imports -Wunused-matches+    Aura.Build+    Aura.Cache+    Aura.Colour+    Aura.Commands.A+    Aura.Commands.B+    Aura.Commands.C+    Aura.Commands.L+    Aura.Commands.O+    Aura.Core+    Aura.Dependencies+    Aura.Diff+    Aura.Install+    Aura.Languages+    Aura.Languages.Fields+    Aura.Logo+    Aura.MakePkg+    Aura.Packages.AUR+    Aura.Packages.Repository+    Aura.Pacman+    Aura.Pkgbuild.Base+    Aura.Pkgbuild.Editing+    Aura.Pkgbuild.Fetch+    Aura.Pkgbuild.Records+    Aura.Pkgbuild.Security+    Aura.Settings+    Aura.State+    Aura.Types+    Aura.Utils+   build-depends:-      aeson >=1.2 && <1.5-    , aeson-pretty >=0.8 && <0.9-    , algebraic-graphs >=0.1 && <0.2-    , array >=0.5 && <0.6-    , async >=2.1 && <2.3-    , aur >=6.0.1 && <7-    , base >=4.8 && <4.12-    , base-prelude >=1.2 && <1.4-    , bytestring-    , compactable >=0.1 && <0.2-    , containers-    , directory-    , errors >=2.3 && <2.4-    , filepath-    , freer-simple >=1.1 && <1.2-    , generic-lens >=1.0.0.1 && <1.1-    , http-client >=0.5 && <0.6-    , http-types >=0.9 && <0.13-    , language-bash >=0.8 && <0.9-    , megaparsec >=6.4 && <6.6-    , microlens >=0.4 && <0.5-    , microlens-ghc >=0.4 && <0.5-    , mtl >=2.2 && <2.3-    , mwc-random >=0.14 && <0.15-    , network-uri >=2.6 && <2.7-    , non-empty-containers >=0.1 && <0.2-    , paths >=0.2 && <0.3-    , pretty-simple >=2.1 && <2.2-    , prettyprinter >=1.2 && <1.3-    , prettyprinter-ansi-terminal >=1.1 && <1.2-    , semigroupoids >=5.2 && <5.4-    , stm-    , text >=1.2 && <1.3-    , throttled >=1.1 && <1.2-    , time-    , transformers-    , typed-process >=0.2 && <0.3-    , versions >=3.4 && <3.5-    , witherable >=0.2 && <0.3-  default-language: Haskell2010+    , aeson             >=1.2  && <1.5+    , aeson-pretty      ^>=0.8+    , algebraic-graphs  >=0.1  && <0.5+    , aur               ^>=6.2+    , compactable       ^>=0.1+    , directory         ^>=1.3+    , filepath          ^>=1.4+    , generic-lens      ^>=1.1+    , http-types        >=0.9  && <0.13+    , language-bash     ^>=0.8+    , megaparsec        ^>=7+    , microlens-ghc     ^>=0.4+    , mwc-random        ^>=0.14+    , network-uri       ^>=2.6+    , scheduler         >=1.1  && <1.5+    , semigroupoids     >=5.2  && <5.4+    , stm               ^>=2.5+    , these             ^>=1.0+    , time              ^>=1.8+    , unliftio          ^>=0.2  executable aura-  main-is: aura.hs+  import:         commons, libexec+  main-is:        aura.hs   other-modules:-      Flags-      Settings-      Paths_aura-  hs-source-dirs:-      exec-  default-extensions: NoImplicitPrelude-  ghc-options: -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-binds -Wunused-imports -Wunused-matches -threaded -O2 -with-rtsopts=-N+    Flags+    Settings++  hs-source-dirs: exec+  ghc-options:    -threaded -O2 -with-rtsopts=-N   build-depends:-      aura-    , base >=4.8 && <4.12-    , base-prelude >=1.2 && <1.4-    , bytestring-    , containers-    , errors >=2.3 && <2.4-    , freer-simple >=1.1 && <1.2-    , http-client >=0.5 && <0.6-    , http-client-tls >=0.3 && <0.4-    , language-bash >=0.8 && <0.9-    , microlens >=0.4 && <0.5-    , non-empty-containers >=0.1 && <0.2-    , optparse-applicative >=0.14 && <0.15-    , paths >=0.2 && <0.3-    , pretty-simple >=2.1 && <2.2-    , prettyprinter >=1.2 && <1.3-    , prettyprinter-ansi-terminal >=1.1 && <1.2-    , text >=1.2 && <1.3-    , transformers-    , typed-process >=0.2 && <0.3-    , versions >=3.4 && <3.5-  default-language: Haskell2010+    , aura+    , http-client-tls       ^>=0.3+    , optparse-applicative  ^>=0.14+    , pretty-simple         >=2.1  && <2.3  test-suite aura-test-  type: exitcode-stdio-1.0-  main-is: Test.hs-  hs-source-dirs:-      test-  default-extensions: NoImplicitPrelude-  ghc-options: -Widentities -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wname-shadowing -Wpartial-fields -Wredundant-constraints -Wunused-binds -Wunused-imports -Wunused-matches -threaded -with-rtsopts=-N+  import:         commons+  type:           exitcode-stdio-1.0+  main-is:        Test.hs+  hs-source-dirs: test+  ghc-options:    -threaded -with-rtsopts=-N   build-depends:-      aura-    , base >=4.8 && <4.12-    , base-prelude >=1.2 && <1.4-    , bytestring-    , containers-    , errors >=2.3 && <2.4-    , freer-simple >=1.1 && <1.2-    , http-client >=0.5 && <0.6-    , language-bash >=0.8 && <0.9-    , megaparsec >=6.4 && <6.6-    , microlens >=0.4 && <0.5-    , non-empty-containers >=0.1 && <0.2-    , paths >=0.2 && <0.3-    , pretty-simple >=2.1 && <2.2-    , prettyprinter >=1.2 && <1.3-    , prettyprinter-ansi-terminal >=1.1 && <1.2-    , tasty >=0.11 && <2.0-    , tasty-hunit >=0.9 && <0.11-    , text >=1.2 && <1.3-    , transformers-    , typed-process >=0.2 && <0.3-    , versions >=3.4 && <3.5-  default-language: Haskell2010+    , aura+    , megaparsec+    , tasty        >=0.11 && <1.3+    , tasty-hunit  >=0.9  && <0.11

@@ -415,3 +415,5 @@ ( Chinese    ) Kai Zhang .P ( Japanese   ) Onoue Takuro+.P+( Esperanto  ) Zachary "Ghosy" Matthews

@@ -2,24 +2,24 @@  module Flags   ( Program(..), opts-  , PacmanOp(..), SyncOp(..), MiscOp(..)+  , PacmanOp( Sync ), SyncOp( SyncUpgrade ), MiscOp   , AuraOp(..), _AurSync, _AurIgnore, _AurIgnoreGroup-  , AurSwitch(..), AurOp(..), BackupOp(..), CacheOp(..), LogOp(..), OrphanOp(..)+  , AurOp(..), BackupOp(..), CacheOp(..), LogOp(..), OrphanOp(..)   ) where  import           Aura.Cache (defaultPackageCache)-import           Aura.Pacman (pacmanConfFile, defaultLogFile)+import           Aura.Pacman (defaultLogFile, pacmanConfFile) import           Aura.Settings import           Aura.Types-import           BasePrelude hiding (Version, option, log, exp)+import           BasePrelude hiding (Version, exp, log, option) import qualified Data.List.NonEmpty as NEL import qualified Data.Set as S-import           Data.Set.NonEmpty (NonEmptySet)+import           Data.Set.NonEmpty (NESet) import qualified Data.Set.NonEmpty as NES import qualified Data.Text as T import           Lens.Micro import           Options.Applicative-import           System.Path (Path, Absolute, toFilePath, fromAbsoluteFilePath)+import           System.Path (Absolute, Path, fromAbsoluteFilePath, toFilePath)  --- @@ -35,13 +35,13 @@   , _language  :: Maybe Language } deriving (Show)  -- | Inherited operations that are fed down to Pacman.-data PacmanOp = Database (Either DatabaseOp (NonEmptySet PkgName))+data PacmanOp = Database (Either DatabaseOp (NESet PkgName))               | Files    (S.Set FilesOp)               | Query    (Either QueryOp (S.Set QueryFilter, S.Set PkgName))-              | Remove   (S.Set RemoveOp) (NonEmptySet PkgName)+              | Remove   (S.Set RemoveOp) (NESet PkgName)               | Sync     (Either SyncOp (S.Set PkgName)) (S.Set SyncSwitch)-              | TestDeps (NonEmptySet T.Text)-              | Upgrade  (S.Set UpgradeSwitch) (NonEmptySet PkgName)+              | TestDeps (NESet T.Text)+              | Upgrade  (S.Set UpgradeSwitch) (NESet PkgName)               deriving (Show)  instance Flagable PacmanOp where@@ -57,8 +57,8 @@   asFlag (Upgrade s ps)           = "-U" : asFlag s ++ asFlag ps  data DatabaseOp = DBCheck-                | DBAsDeps     (NonEmptySet T.Text)-                | DBAsExplicit (NonEmptySet T.Text)+                | DBAsDeps     (NESet T.Text)+                | DBAsExplicit (NESet T.Text)                 deriving (Show)  instance Flagable DatabaseOp where@@ -66,7 +66,7 @@   asFlag (DBAsDeps ps)     = "--asdeps" : asFlag ps   asFlag (DBAsExplicit ps) = "--asexplicit" : asFlag ps -data FilesOp = FilesList  (NonEmptySet T.Text)+data FilesOp = FilesList  (NESet T.Text)              | FilesOwns   T.Text              | FilesSearch T.Text              | FilesRegex@@ -76,19 +76,19 @@  instance Flagable FilesOp where   asFlag (FilesList fs)       = "--list" : asFlag fs-  asFlag (FilesOwns f)        = ["--owns", T.unpack f]-  asFlag (FilesSearch f)      = ["--search", T.unpack f]+  asFlag (FilesOwns f)        = ["--owns", f]+  asFlag (FilesSearch f)      = ["--search", f]   asFlag FilesRegex           = ["--regex"]   asFlag FilesRefresh         = ["--refresh"]   asFlag FilesMachineReadable = ["--machinereadable"] -data QueryOp = QueryChangelog (NonEmptySet T.Text)-             | QueryGroups    (NonEmptySet T.Text)-             | QueryInfo      (NonEmptySet T.Text)-             | QueryCheck     (NonEmptySet T.Text)-             | QueryList      (NonEmptySet T.Text)-             | QueryOwns      (NonEmptySet T.Text)-             | QueryFile      (NonEmptySet T.Text)+data QueryOp = QueryChangelog (NESet T.Text)+             | QueryGroups    (NESet T.Text)+             | QueryInfo      (NESet T.Text)+             | QueryCheck     (NESet T.Text)+             | QueryList      (NESet T.Text)+             | QueryOwns      (NESet T.Text)+             | QueryFile      (NESet T.Text)              | QuerySearch     T.Text              deriving (Show) @@ -100,7 +100,7 @@   asFlag (QueryList ps)      = "--list" : asFlag ps   asFlag (QueryOwns ps)      = "--owns" : asFlag ps   asFlag (QueryFile ps)      = "--file" : asFlag ps-  asFlag (QuerySearch t)     = ["--search", T.unpack t]+  asFlag (QuerySearch t)     = ["--search", t]  data QueryFilter = QueryDeps                  | QueryExplicit@@ -131,20 +131,20 @@   asFlag RemoveUnneeded  = ["--unneeded"]  data SyncOp = SyncClean-            | SyncGroups   (NonEmptySet T.Text)-            | SyncInfo     (NonEmptySet T.Text)+            | SyncGroups   (NESet T.Text)+            | SyncInfo     (NESet T.Text)             | SyncList      T.Text             | SyncSearch    T.Text             | SyncUpgrade  (S.Set T.Text)-            | SyncDownload (NonEmptySet T.Text)+            | SyncDownload (NESet T.Text)             deriving (Show)  instance Flagable SyncOp where   asFlag SyncClean         = ["--clean"]   asFlag (SyncGroups gs)   = "--groups" : asFlag gs   asFlag (SyncInfo ps)     = "--info" : asFlag ps-  asFlag (SyncList r)      = ["--list", T.unpack r]-  asFlag (SyncSearch s)    = ["--search", T.unpack s]+  asFlag (SyncList r)      = ["--list", r]+  asFlag (SyncSearch s)    = ["--search", s]   asFlag (SyncUpgrade ps)  = "--sysupgrade" : asFlag ps   asFlag (SyncDownload ps) = "--downloadonly" : asFlag ps @@ -155,8 +155,8 @@  instance Flagable SyncSwitch where   asFlag SyncRefresh          = ["--refresh"]-  asFlag (SyncIgnore ps)      = ["--ignore", intercalate "," $ asFlag ps ]-  asFlag (SyncIgnoreGroup gs) = ["--ignoregroup" , intercalate "," $ asFlag gs ]+  asFlag (SyncIgnore ps)      = ["--ignore", T.intercalate "," $ asFlag ps ]+  asFlag (SyncIgnoreGroup gs) = ["--ignoregroup" , T.intercalate "," $ asFlag gs ]  data UpgradeSwitch = UpgradeAsDeps                    | UpgradeAsExplicit@@ -167,8 +167,8 @@ instance Flagable UpgradeSwitch where   asFlag UpgradeAsDeps           = ["--asdeps"]   asFlag UpgradeAsExplicit       = ["--asexplicit"]-  asFlag (UpgradeIgnore ps)      = ["--ignore", intercalate "," $ asFlag ps ]-  asFlag (UpgradeIgnoreGroup gs) = ["--ignoregroup" , intercalate "," $ asFlag gs ]+  asFlag (UpgradeIgnore ps)      = ["--ignore", T.intercalate "," $ asFlag ps ]+  asFlag (UpgradeIgnoreGroup gs) = ["--ignoregroup", T.intercalate "," $ asFlag gs ]  -- | Flags common to several Pacman operations. data MiscOp = MiscArch    (Path Absolute)@@ -189,14 +189,14 @@             deriving (Eq, Ord, Show)  instance Flagable MiscOp where-  asFlag (MiscArch p)            = ["--arch", toFilePath p]-  asFlag (MiscAssumeInstalled p) = ["--assume-installed", T.unpack p]-  asFlag (MiscColor c)           = ["--color", T.unpack c]-  asFlag (MiscDBPath p)          = ["--dbpath", toFilePath p]-  asFlag (MiscGpgDir p)          = ["--gpgdir", toFilePath p]-  asFlag (MiscHookDir p)         = ["--hookdir", toFilePath p]-  asFlag (MiscPrintFormat s)     = ["--print-format", T.unpack s]-  asFlag (MiscRoot p)            = ["--root", toFilePath p]+  asFlag (MiscArch p)            = ["--arch", T.pack $ toFilePath p]+  asFlag (MiscAssumeInstalled p) = ["--assume-installed", p]+  asFlag (MiscColor c)           = ["--color", c]+  asFlag (MiscDBPath p)          = ["--dbpath", T.pack $ toFilePath p]+  asFlag (MiscGpgDir p)          = ["--gpgdir", T.pack $ toFilePath p]+  asFlag (MiscHookDir p)         = ["--hookdir", T.pack $ toFilePath p]+  asFlag (MiscPrintFormat s)     = ["--print-format", s]+  asFlag (MiscRoot p)            = ["--root", T.pack $ toFilePath p]   asFlag MiscConfirm             = ["--confirm"]   asFlag MiscDBOnly              = ["--dbonly"]   asFlag MiscNoDeps              = ["--nodeps"]@@ -206,9 +206,9 @@   asFlag MiscVerbose             = ["--verbose"]  -- | Operations unique to Aura.-data AuraOp = AurSync (Either AurOp (NonEmptySet PkgName)) (S.Set AurSwitch)+data AuraOp = AurSync (Either AurOp (NESet PkgName)) (S.Set AurSwitch)             | Backup  (Maybe  BackupOp)-            | Cache   (Either CacheOp (NonEmptySet PkgName))+            | Cache   (Either CacheOp (NESet PkgName))             | Log     (Maybe  LogOp)             | Orphans (Maybe  OrphanOp)             | Version@@ -218,14 +218,14 @@  _AurSync :: Traversal' AuraOp (S.Set AurSwitch) _AurSync f (AurSync o s) = AurSync o <$> f s-_AurSync _ x = pure x+_AurSync _ x             = pure x -data AurOp = AurDeps     (NonEmptySet PkgName)-           | AurInfo     (NonEmptySet PkgName)-           | AurPkgbuild (NonEmptySet PkgName)+data AurOp = AurDeps     (NESet PkgName)+           | AurInfo     (NESet PkgName)+           | AurPkgbuild (NESet PkgName)            | AurSearch    T.Text            | AurUpgrade  (S.Set PkgName)-           | AurJson     (NonEmptySet PkgName)+           | AurJson     (NESet PkgName)            deriving (Show)  data AurSwitch = AurIgnore      (S.Set PkgName)@@ -234,19 +234,19 @@  _AurIgnore :: Traversal' AurSwitch (S.Set PkgName) _AurIgnore f (AurIgnore s) = AurIgnore <$> f s-_AurIgnore _ x = pure x+_AurIgnore _ x             = pure x  _AurIgnoreGroup :: Traversal' AurSwitch (S.Set PkgGroup) _AurIgnoreGroup f (AurIgnoreGroup s) = AurIgnoreGroup <$> f s-_AurIgnoreGroup _ x = pure x+_AurIgnoreGroup _ x                  = pure x  data BackupOp = BackupClean Word | BackupRestore | BackupList deriving (Show)  data CacheOp = CacheBackup (Path Absolute) | CacheClean Word | CacheCleanNotSaved | CacheSearch T.Text deriving (Show) -data LogOp = LogInfo (NonEmptySet PkgName) | LogSearch T.Text deriving (Show)+data LogOp = LogInfo (NESet PkgName) | LogSearch T.Text deriving (Show) -data OrphanOp = OrphanAbandon | OrphanAdopt (NonEmptySet PkgName) deriving (Show)+data OrphanOp = OrphanAbandon | OrphanAdopt (NESet PkgName) deriving (Show)  opts :: ParserInfo Program opts = info (program <**> helper) (fullDesc <> header "Aura - Package manager for Arch Linux and the AUR.")@@ -263,7 +263,7 @@ aursync :: Parser AuraOp aursync = bigA *>   (AurSync-   <$> (fmap (Right . NES.fromNonEmpty . fmap (PkgName . T.toLower) . NES.toNonEmpty) someArgs <|> fmap Left mods)+   <$> (fmap (Right . NES.fromList . fmap (PkgName . T.toLower) . NES.toList) someArgs <|> fmap Left mods)    <*> (S.fromList <$> many switches)   )   where bigA    = flag' () (long "aursync" <> short 'A' <> help "Install packages from the AUR.")@@ -365,6 +365,7 @@         no  = flag' NeededOnly (long "needed"    <> hidden <> help "Don't rebuild/reinstall up-to-date packages.")         dbg = flag' Debug      (long "debug"     <> hidden <> help "Print useful debugging info.")         clr = Colour . f <$> strOption (long "color" <> metavar "WHEN" <> hidden <> help "Colourize the output.")+        f :: String -> ColourMode         f "never"  = Never         f "always" = Always         f _        = Auto@@ -474,20 +475,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 (NonEmptySet PkgName)-somePkgs = NES.fromNonEmpty . fromJust . NEL.nonEmpty . map PkgName <$> some (argument str (metavar "PACKAGES"))+somePkgs :: Parser (NESet PkgName)+somePkgs = NES.fromList . fromJust . NEL.nonEmpty . map PkgName <$> some (argument str (metavar "PACKAGES"))  -- | Same as `someArgs`, but the help message "brief display" won't show PACKAGES.-somePkgs' :: Parser (NonEmptySet PkgName)-somePkgs' = NES.fromNonEmpty . fromJust . NEL.nonEmpty . map PkgName <$> some (argument str (metavar "PACKAGES" <> hidden))+somePkgs' :: Parser (NESet PkgName)+somePkgs' = NES.fromList . fromJust . NEL.nonEmpty . map PkgName <$> some (argument str (metavar "PACKAGES" <> hidden))  -- | One or more arguments.-someArgs :: Parser (NonEmptySet T.Text)-someArgs = NES.fromNonEmpty . fromJust . NEL.nonEmpty <$> some (argument str (metavar "PACKAGES"))+someArgs :: Parser (NESet T.Text)+someArgs = NES.fromList . fromJust . NEL.nonEmpty <$> some (argument str (metavar "PACKAGES"))  -- | Same as `someArgs`, but the help message "brief display" won't show PACKAGES.-someArgs' :: Parser (NonEmptySet T.Text)-someArgs' = NES.fromNonEmpty . fromJust . NEL.nonEmpty <$> some (argument str (metavar "PACKAGES" <> hidden))+someArgs' :: Parser (NESet T.Text)+someArgs' = NES.fromList . fromJust . NEL.nonEmpty <$> some (argument str (metavar "PACKAGES" <> hidden))  -- | Zero or more arguments. manyArgs :: Parser (S.Set T.Text)@@ -512,4 +513,5 @@                 , ( "serbian",    Serbian ),    ( "српски",    Serbian )                 , ( "norwegian",  Norwegian ),  ( "norsk",     Norwegian )                 , ( "indonesian", Indonesia )-                , ( "chinese",    Chinese ),    ( "中文",       Chinese ) ]+                , ( "chinese",    Chinese ),    ( "中文",       Chinese )+                , ( "esperanto",  Esperanto ) ]

@@ -1,6 +1,6 @@ {- -Copyright 2012 - 2018 Colin Woodbury <colin@fosskers.ca>+Copyright 2012 - 2019 Colin Woodbury <colin@fosskers.ca>  This file is part of Aura. @@ -51,7 +51,7 @@   environment <- lift (M.fromList . map (bimap T.pack T.pack) <$> getEnvironment)   manager     <- lift $ newManager tlsManagerSettings   isTerm      <- lift $ hIsTerminalDevice stdout-  fromGroups  <- lift . maybe (pure S.empty) groupPackages . NES.fromSet $ getIgnoredGroups confFile <> igg+  fromGroups  <- lift . maybe (pure S.empty) groupPackages . NES.nonEmptySet $ getIgnoredGroups confFile <> igg   let language = checkLang lng environment   bu <- failWith (Failure whoIsBuildUser_1) $ buildUserOf bc <|> getTrueUser environment   pure Settings { managerOf      = manager

@@ -1,9 +1,12 @@+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE MonoLocalBinds    #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DataKinds, FlexibleContexts, MonoLocalBinds, TypeApplications #-}+{-# LANGUAGE TypeApplications  #-}  {- -Copyright 2012 - 2018 Colin Woodbury <colin@fosskers.ca>+Copyright 2012 - 2019 Colin Woodbury <colin@fosskers.ca>  This file is part of Aura. @@ -43,14 +46,17 @@ import           Aura.Core import           Aura.Languages import           Aura.Logo+import           Aura.Packages.AUR (aurRepo)+import           Aura.Packages.Repository (pacmanRepo) import           Aura.Pacman import           Aura.Settings import           Aura.Types import           BasePrelude hiding (Version)-import           Control.Monad.Freer-import           Control.Monad.Freer.Error-import           Control.Monad.Freer.Reader-import qualified Data.Set as S+import           Control.Effect (Carrier, Member)+import           Control.Effect.Error (Error, runError)+import           Control.Effect.Lift (Lift, runM, sendM)+import           Control.Effect.Reader (Reader, asks, runReader)+import           Data.Set (Set) import qualified Data.Set.NonEmpty as NES import qualified Data.Text as T import qualified Data.Text.IO as T@@ -66,37 +72,39 @@ ---  auraVersion :: T.Text-auraVersion = "2.0.0"+auraVersion = "2.0.2"  main :: IO () main = do   options   <- execParser opts   esettings <- getSettings options+  repos     <- (<>) <$> pacmanRepo <*> aurRepo   case esettings of     Left err -> T.putStrLn . dtot . ($ English) $ failure err-    Right ss -> execute ss options >>= exit ss+    Right ss -> execute ss repos options >>= exit ss -execute :: Settings -> Program -> IO (Either (Doc AnsiStyle) ())-execute ss p = first (($ langOf ss) . failure) <$> (runM . runReader ss . runError . executeOpts $ _operation p)+execute :: Settings -> Repository -> Program -> IO (Either (Doc AnsiStyle) ())+execute ss r p = first (($ langOf ss) . failure) <$> (runM . runReader (Env r ss) . runError . executeOpts $ _operation p)  exit :: Settings -> Either (Doc AnsiStyle) () -> IO a exit ss (Left e)  = scold ss e *> exitFailure exit _  (Right _) = exitSuccess -executeOpts :: Either (PacmanOp, S.Set MiscOp) AuraOp -> Eff '[Error Failure, Reader Settings, IO] ()+executeOpts :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  Either (PacmanOp, Set MiscOp) AuraOp -> m () executeOpts ops = do-  ss <- ask+  ss <- asks settings   when (shared ss Debug) $ do-    pPrintNoColor ops-    pPrintNoColor (buildConfigOf ss)-    pPrintNoColor (commonConfigOf ss)-  let p (ps, ms) = liftEitherM . pacman $+    sendM @IO . pPrintNoColor $ ops+    sendM @IO . pPrintNoColor $ buildConfigOf ss+    sendM @IO . pPrintNoColor $ commonConfigOf ss+  let p (ps, ms) = liftEitherM . sendM . pacman $         asFlag ps         ++ foldMap asFlag ms         ++ asFlag (commonConfigOf ss)         ++ bool [] ["--quiet"] (switch ss LowVerbosity)   case ops of-    Left o@(Sync (Left (SyncUpgrade _)) _, _) -> sudo (send $ B.saveState ss) *> p o+    Left o@(Sync (Left (SyncUpgrade _)) _, _) -> sudo (sendM $ B.saveState ss) *> p o     Left o -> p o     Right (AurSync o _) ->       case o of@@ -109,10 +117,10 @@         Left (AurJson ps)     -> A.aurJson ps     Right (Backup o) ->       case o of-        Nothing              -> sudo . send $ B.saveState ss-        Just (BackupClean n) -> sudo . send $ B.cleanStates ss n+        Nothing              -> sudo . sendM $ B.saveState ss+        Just (BackupClean n) -> sudo . sendM $ B.cleanStates ss n         Just BackupRestore   -> sudo B.restoreState-        Just BackupList      -> send B.listStates+        Just BackupList      -> sendM B.listStates     Right (Cache o) ->       case o of         Right ps                -> sudo $ C.downgradePackages ps@@ -124,23 +132,23 @@       case o of         Nothing            -> L.viewLogFile         Just (LogInfo ps)  -> L.logInfoOnPkg ps-        Just (LogSearch s) -> ask >>= send . flip L.searchLogFile s+        Just (LogSearch s) -> asks settings >>= sendM . flip L.searchLogFile s     Right (Orphans o) ->       case o of-        Nothing               -> send O.displayOrphans-        Just OrphanAbandon    -> sudo $ send orphans >>= traverse_ removePkgs . NES.fromSet+        Nothing               -> sendM O.displayOrphans+        Just OrphanAbandon    -> sudo $ sendM orphans >>= traverse_ removePkgs . NES.nonEmptySet         Just (OrphanAdopt ps) -> O.adoptPkg ps-    Right Version   -> send $ getVersionInfo >>= animateVersionMsg ss auraVersion+    Right Version   -> sendM $ versionInfo >>= animateVersionMsg ss auraVersion     Right Languages -> displayOutputLanguages     Right ViewConf  -> viewConfFile -displayOutputLanguages :: (Member (Reader Settings) r, Member IO r) => Eff r ()+displayOutputLanguages :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) => m () displayOutputLanguages = do-  ss <- ask-  send . notify ss . displayOutputLanguages_1 $ langOf ss-  send $ traverse_ print [English ..]+  ss <- asks settings+  sendM . notify ss . displayOutputLanguages_1 $ langOf ss+  sendM $ traverse_ print [English ..] -viewConfFile :: (Member (Reader Settings) r, Member IO r) => Eff r ()+viewConfFile :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) => m () viewConfFile = do-  pth <- asks (either id id . configPathOf . commonConfigOf)-  send . void . runProcess @IO $ proc "less" [toFilePath pth]+  pth <- asks (either id id . configPathOf . commonConfigOf . settings)+  sendM . void . runProcess @IO $ proc "less" [toFilePath pth]

@@ -1,9 +1,12 @@+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE MonoLocalBinds    #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts, TypeApplications, MonoLocalBinds, DataKinds #-}+{-# LANGUAGE TypeApplications  #-}  -- | -- Module    : Aura.Build--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -23,9 +26,11 @@ import           Aura.Types import           Aura.Utils import           BasePrelude-import           Control.Monad.Freer-import           Control.Monad.Freer.Error-import           Control.Monad.Freer.Reader+import           Control.Compactable (traverseMaybe)+import           Control.Effect (Carrier, Member)+import           Control.Effect.Error (Error, throwError)+import           Control.Effect.Lift (Lift, sendM)+import           Control.Effect.Reader (Reader, asks) import           Control.Monad.Trans.Class (lift) import           Control.Monad.Trans.Except import qualified Data.ByteString.Lazy.Char8 as BL@@ -33,17 +38,16 @@ import qualified Data.List.NonEmpty as NEL import           Data.Semigroup.Foldable (fold1) import qualified Data.Set as S-import           Data.Set.NonEmpty (NonEmptySet)+import           Data.Set.NonEmpty (NESet) import qualified Data.Set.NonEmpty as NES import qualified Data.Text as T-import           Data.Witherable (wither) import           Lens.Micro ((^.)) import           System.Directory (setCurrentDirectory) import           System.IO (hFlush, stdout) import           System.Path import           System.Path.IO import           System.Process.Typed-import           System.Random.MWC (GenIO, uniform, createSystemRandom)+import           System.Random.MWC (GenIO, createSystemRandom, uniform)  --- @@ -51,35 +55,35 @@ srcPkgStore = fromAbsoluteFilePath "/var/cache/aura/src"  -- | Expects files like: \/var\/cache\/pacman\/pkg\/*.pkg.tar.xz-installPkgFiles :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) =>-  NonEmptySet PackagePath -> Eff r ()+installPkgFiles :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  NESet PackagePath -> m () installPkgFiles files = do-  ss <- ask-  send $ checkDBLock ss-  liftEitherM . pacman $ ["-U"] <> map (toFilePath . path) (toList files) <> asFlag (commonConfigOf ss)+  ss <- asks settings+  sendM $ checkDBLock ss+  liftEitherM . sendM . pacman $ ["-U"] <> map (T.pack . toFilePath . path) (toList files) <> asFlag (commonConfigOf ss)  -- | All building occurs within temp directories, -- or in a location specified by the user with flags.-buildPackages :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) =>-  NonEmptySet Buildable -> Eff r (NonEmptySet PackagePath)+buildPackages :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  NESet Buildable -> m (NESet PackagePath) buildPackages bs = do-  g <- send createSystemRandom-  wither (build g) (toList bs) >>= maybe bad (pure . fold1) . NEL.nonEmpty+  g <- sendM createSystemRandom+  traverseMaybe (build g) (toList bs) >>= maybe bad (pure . fold1) . NEL.nonEmpty   where bad = throwError $ Failure buildFail_10  -- | Handles the building of Packages. Fails nicely. -- Assumed: All dependencies are already installed.-build :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) =>-  GenIO -> Buildable -> Eff r (Maybe (NonEmptySet PackagePath))+build :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  GenIO -> Buildable -> m (Maybe (NESet PackagePath)) build g p = do-  ss     <- ask-  send $ notify ss (buildPackages_1 (p ^. field @"name") (langOf ss)) *> hFlush stdout-  result <- send $ build' ss g p+  ss     <- asks settings+  sendM $ notify ss (buildPackages_1 (p ^. field @"name") (langOf ss)) *> hFlush stdout+  result <- sendM $ build' ss g 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 (NonEmptySet PackagePath))+build' :: Settings -> GenIO -> Buildable -> IO (Either Failure (NESet PackagePath)) build' ss g b = do   let pth = buildPathOf $ buildConfigOf ss   createDirectoryIfMissing True pth@@ -92,7 +96,7 @@     lift . setCurrentDirectory $ toFilePath bs     lift $ overwritePkgbuild ss b     pNames <- ExceptT $ makepkg ss usr-    paths  <- lift . fmap NES.fromNonEmpty . traverse (moveToCachePath ss) $ NES.toNonEmpty pNames+    paths  <- lift . fmap NES.fromList . traverse (moveToCachePath ss) $ NES.toList pNames     lift . when (S.member AllSource . makepkgFlagsOf $ buildConfigOf ss) $       makepkgSource usr >>= traverse_ moveToSourcePath     pure paths@@ -123,11 +127,11 @@  -- | Inform the user that building failed. Ask them if they want to -- continue installing previous packages that built successfully.-buildFail :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => Failure -> Eff r (Maybe a)+buildFail :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) => Failure -> m (Maybe a) buildFail (Failure err) = do-  ss <- ask-  send . scold ss . err $ langOf ss-  response <- send $ optionalPrompt ss buildFail_6+  ss <- asks settings+  sendM . scold ss . err $ langOf ss+  response <- sendM $ optionalPrompt ss buildFail_6   bool (throwError $ Failure buildFail_5) (pure Nothing) response  -- | Moves a file to the pacman package cache and returns its location.

@@ -1,9 +1,11 @@+{-# LANGUAGE DataKinds         #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections, TypeApplications, DataKinds #-}+{-# LANGUAGE TupleSections     #-}+{-# LANGUAGE TypeApplications  #-}  -- | -- Module    : Aura.Cache--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -25,11 +27,12 @@ import           Data.Generics.Product (field) import qualified Data.Map.Strict as M import qualified Data.Set as S-import           Data.Set.NonEmpty (NonEmptySet)+import           Data.Set.NonEmpty (NESet) import qualified Data.Set.NonEmpty as NES import qualified Data.Text as T import           Lens.Micro ((^.))-import           System.Path (Path, Absolute, (</>), toFilePath, fromAbsoluteFilePath)+import           System.Path+    (Absolute, Path, fromAbsoluteFilePath, toFilePath, (</>)) import           System.Path.IO (getDirectoryContents)  ---@@ -54,7 +57,7 @@ cacheContents pth = cache . map (PackagePath . (pth </>)) <$> getDirectoryContents pth  -- | All packages from a given `S.Set` who have a copy in the cache.-pkgsInCache :: Settings -> NonEmptySet PkgName -> IO (S.Set PkgName)+pkgsInCache :: Settings -> NESet PkgName -> IO (S.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

@@ -1,6 +1,6 @@ -- | -- Module    : Aura.Colour--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --

@@ -1,9 +1,15 @@-{-# LANGUAGE FlexibleContexts, TypeApplications, MonoLocalBinds, DataKinds #-}-{-# LANGUAGE ViewPatterns, MultiWayIf, OverloadedStrings #-}+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE MonoLocalBinds    #-}+{-# LANGUAGE MultiWayIf        #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-}+{-# LANGUAGE ViewPatterns      #-}  -- | -- Module    : Aura.Commands.A--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -32,14 +38,15 @@ import           Aura.Utils import           BasePrelude hiding ((<+>)) import           Control.Error.Util (hush)-import           Control.Monad.Freer-import           Control.Monad.Freer.Error-import           Control.Monad.Freer.Reader+import           Control.Effect (Carrier, Member)+import           Control.Effect.Error (Error)+import           Control.Effect.Lift (Lift, sendM)+import           Control.Effect.Reader (Reader, asks) import           Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder) import           Data.Generics.Product (field) import qualified Data.List.NonEmpty as NEL import qualified Data.Set as S-import           Data.Set.NonEmpty (NonEmptySet)+import           Data.Set.NonEmpty (NESet) import qualified Data.Set.NonEmpty as NES import qualified Data.Text as T import qualified Data.Text.IO as T@@ -47,19 +54,19 @@ import           Data.Text.Lazy.Builder (toLazyText) import           Data.Text.Prettyprint.Doc import           Data.Text.Prettyprint.Doc.Render.Terminal-import           Data.Versions (Versioning, versioning, prettyV)-import           Lens.Micro ((^.), (^..), each)+import           Data.Versions (Versioning, prettyV, versioning)+import           Lens.Micro (each, (^.), (^..)) import           Lens.Micro.Extras (view) import           Linux.Arch.Aur  ---  -- | The result of @-Au@.-upgradeAURPkgs :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => S.Set PkgName -> Eff r ()+upgradeAURPkgs :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) => S.Set PkgName -> m () upgradeAURPkgs pkgs = do-  ss <- ask-  send . notify ss . upgradeAURPkgs_1 $ langOf ss-  send (foreigns ss) >>= traverse_ (upgrade pkgs) . NES.fromSet+  ss <- asks settings+  sendM . notify ss . upgradeAURPkgs_1 $ langOf ss+  sendM (foreigns ss) >>= traverse_ (upgrade pkgs) . NES.nonEmptySet  -- | Foreign packages to consider for upgrading, after "ignored packages" have -- been taken into consideration.@@ -67,10 +74,10 @@ foreigns ss = S.filter (notIgnored . view (field @"name")) <$> foreignPackages   where notIgnored p = not . S.member p $ ignoresOf ss -upgrade :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) =>-  S.Set PkgName -> NonEmptySet SimplePkg -> Eff r ()+upgrade :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) => +  S.Set PkgName -> NESet SimplePkg -> m () upgrade pkgs fs = do-  ss        <- ask+  ss        <- asks settings   toUpgrade <- possibleUpdates fs   let !names = map (PkgName . aurNameOf . fst) toUpgrade   auraFirst <- auraCheck names@@ -78,44 +85,44 @@     Just a  -> auraUpgrade a     Nothing -> do       devel <- develPkgCheck-      send . notify ss . upgradeAURPkgs_2 $ langOf ss-      if | null toUpgrade && null devel -> send . warn ss . upgradeAURPkgs_3 $ langOf ss+      sendM . notify ss . upgradeAURPkgs_2 $ langOf ss+      if | null toUpgrade && null devel -> sendM . warn ss . upgradeAURPkgs_3 $ langOf ss          | otherwise -> do              reportPkgsToUpgrade toUpgrade (toList devel)-             send . unless (switch ss DryRun) $ saveState ss-             traverse_ I.install . NES.fromSet $ S.fromList names <> pkgs <> devel+             sendM . unless (switch ss DryRun) $ saveState ss+             traverse_ I.install . NES.nonEmptySet $ S.fromList names <> pkgs <> devel -possibleUpdates :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) =>-  NonEmptySet SimplePkg -> Eff r [(AurInfo, Versioning)]-possibleUpdates (NES.toNonEmpty -> pkgs) = do+possibleUpdates :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) => +  NESet SimplePkg -> m [(AurInfo, Versioning)]+possibleUpdates (NES.toList -> pkgs) = do   aurInfos <- aurInfo $ fmap (^. field @"name") pkgs   let !names  = map aurNameOf aurInfos       aurPkgs = NEL.filter (\(SimplePkg (PkgName n) _) -> n `elem` names) pkgs   pure . filter isntMostRecent . zip aurInfos $ aurPkgs ^.. each . field @"version"  -- | Is there an update for Aura that we could apply first?-auraCheck :: (Member (Reader Settings) r, Member IO r) => [PkgName] -> Eff r (Maybe PkgName)+auraCheck :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) => [PkgName] -> m (Maybe PkgName) auraCheck ps = join <$> traverse f auraPkg   where f a = do-          ss <- ask-          bool Nothing (Just a) <$> send (optionalPrompt ss auraCheck_1)+          ss <- asks settings+          bool Nothing (Just a) <$> sendM (optionalPrompt ss auraCheck_1)         auraPkg | "aura" `elem` ps     = Just "aura"                 | "aura-bin" `elem` ps = Just "aura-bin"                 | otherwise            = Nothing -auraUpgrade :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => PkgName -> Eff r ()+auraUpgrade :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) => PkgName -> m () auraUpgrade = I.install . NES.singleton -develPkgCheck :: (Member (Reader Settings) r, Member IO r) => Eff r (S.Set PkgName)-develPkgCheck = ask >>= \ss ->-  if switch ss RebuildDevel then send develPkgs else pure S.empty+develPkgCheck :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) => m (S.Set PkgName)+develPkgCheck = asks settings >>= \ss ->+  if switch ss RebuildDevel then sendM develPkgs else pure S.empty  -- | The result of @-Ai@.-aurPkgInfo :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => NonEmptySet PkgName -> Eff r ()-aurPkgInfo = aurInfo . NES.toNonEmpty >=> traverse_ displayAurPkgInfo+aurPkgInfo :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) => NESet PkgName -> m ()+aurPkgInfo = aurInfo . NES.toList >=> traverse_ displayAurPkgInfo -displayAurPkgInfo :: (Member (Reader Settings) r, Member IO r) => AurInfo -> Eff r ()-displayAurPkgInfo ai = ask >>= \ss -> send . T.putStrLn $ renderAurPkgInfo ss ai <> "\n"+displayAurPkgInfo :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) => AurInfo -> m ()+displayAurPkgInfo ai = asks settings >>= \ss -> sendM . T.putStrLn $ renderAurPkgInfo ss ai <> "\n"  renderAurPkgInfo :: Settings -> AurInfo -> T.Text renderAurPkgInfo ss ai = dtot . colourCheck ss $ entrify ss fields entries@@ -135,17 +142,18 @@                     , maybe "(null)" pretty $ aurDescriptionOf ai ]  -- | The result of @-As@.-aurPkgSearch :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => T.Text -> Eff r ()+aurPkgSearch :: (Monad m, Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  T.Text -> m () aurPkgSearch regex = do-  ss <- ask-  db <- S.map (^. field @"name" . field @"name") <$> send foreignPackages+  ss <- asks settings+  db <- S.map (^. field @"name" . field @"name") <$> sendM 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-  send $ traverse_ (T.putStrLn . renderSearch ss regex) results+  sendM $ traverse_ (T.putStrLn . renderSearch ss regex) results  renderSearch :: Settings -> T.Text -> (AurInfo, Bool) -> T.Text renderSearch ss r (i, e) = searchResult@@ -163,33 +171,35 @@             Nothing -> green . pretty $ aurVersionOf i  -- | The result of @-Ap@.-displayPkgbuild :: (Member (Reader Settings) r, Member IO r) => NonEmptySet PkgName -> Eff r ()+displayPkgbuild :: (Monad m, Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) =>+  NESet PkgName -> m () displayPkgbuild ps = do-  man <- asks managerOf-  pbs <- catMaybes <$> traverse (send . getPkgbuild @IO man) (toList ps)-  send . traverse_ (T.putStrLn . strictText) $ pbs ^.. each . field @"pkgbuild"+  man <- asks (managerOf . settings)+  pbs <- catMaybes <$> traverse (sendM . getPkgbuild @IO man) (toList ps)+  sendM . traverse_ (T.putStrLn . strictText) $ pbs ^.. each . field @"pkgbuild"  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 :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => NonEmptySet PkgName -> Eff r ()+aurJson :: (Carrier sig m , Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  NESet PkgName -> m () aurJson ps = do-  m <- asks managerOf-  infos <- liftMaybeM (Failure connectionFailure_1) . info m . (^.. each . field @"name") $ toList ps+  m <- asks (managerOf . settings)+  infos <- liftMaybeM (Failure connectionFailure_1) . fmap hush . sendM . info m . (^.. each . field @"name") $ toList ps   let json = map (toStrict . toLazyText . encodePrettyToTextBuilder) infos-  send $ traverse_ T.putStrLn json+  sendM $ traverse_ T.putStrLn json  ------------ -- REPORTING -------------reportPkgsToUpgrade :: (Member (Reader Settings) r, Member IO r) =>-  [(AurInfo, Versioning)] -> [PkgName] -> Eff r ()+reportPkgsToUpgrade :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) =>+  [(AurInfo, Versioning)] -> [PkgName] -> m () reportPkgsToUpgrade ups pns = do-  ss <- ask-  send . notify ss . reportPkgsToUpgrade_1 $ langOf ss-  send $ putDoc (colourCheck ss . vcat $ map f ups' <> map g devels) >> T.putStrLn "\n"+  ss <- asks settings+  sendM . notify ss . reportPkgsToUpgrade_1 $ langOf ss+  sendM $ putDoc (colourCheck ss . vcat $ map f ups' <> map g devels) >> T.putStrLn "\n"   where devels   = pns ^.. each . field @"name"         ups'     = map (second prettyV) ups         nLen     = maximum $ map (T.length . aurNameOf . fst) ups <> map T.length devels

@@ -1,9 +1,12 @@-{-# LANGUAGE MultiWayIf, ViewPatterns, TupleSections #-}-{-# LANGUAGE FlexibleContexts, MonoLocalBinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds   #-}+{-# LANGUAGE MultiWayIf       #-}+{-# LANGUAGE TupleSections    #-}+{-# LANGUAGE ViewPatterns     #-}  -- | -- Module    : Aura.Commands.B--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -23,7 +26,7 @@ import           Aura.Utils (optionalPrompt) import           BasePrelude import qualified Data.Text as T-import           System.Path (toFilePath, takeFileName, toUnrootedFilePath)+import           System.Path (takeFileName, toFilePath, toUnrootedFilePath) import           System.Path.IO (removeFile)  ---

@@ -1,9 +1,14 @@-{-# LANGUAGE FlexibleContexts, TypeApplications, MonoLocalBinds, DataKinds #-}-{-# LANGUAGE OverloadedStrings, MultiWayIf #-}+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE MonoLocalBinds    #-}+{-# LANGUAGE MultiWayIf        #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-}  -- | -- Module    : Aura.Commands.C--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -27,126 +32,132 @@ import           Aura.Types import           Aura.Utils import           BasePrelude-import           Control.Monad.Freer-import           Control.Monad.Freer.Error-import           Control.Monad.Freer.Reader+import           Control.Effect (Carrier, Member)+import           Control.Effect.Error (Error, throwError)+import           Control.Effect.Lift (Lift, sendM)+import           Control.Effect.Reader (Reader, asks) import           Data.Generics.Product (field) import           Data.List.NonEmpty (nonEmpty) import qualified Data.Map.Strict as M import qualified Data.Set as S-import           Data.Set.NonEmpty (NonEmptySet)+import           Data.Set.NonEmpty (NESet) import qualified Data.Set.NonEmpty as NES import qualified Data.Text as T import           Lens.Micro ((^?), _Just) import           System.Path-import           System.Path.IO (doesDirectoryExist, removeFile, copyFile)+import           System.Path.IO (copyFile, doesDirectoryExist, removeFile)  ---  -- | Interactive. Gives the user a choice as to exactly what versions -- they want to downgrade to.-downgradePackages :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) =>-  NonEmptySet PkgName -> Eff r ()+downgradePackages :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  NESet PkgName -> m () downgradePackages pkgs = do-  ss    <- ask+  ss    <- asks settings   let cachePath = either id id . cachePathOf $ commonConfigOf ss-  reals <- send $ pkgsInCache ss pkgs+  reals <- sendM $ pkgsInCache ss pkgs   traverse_ (report red reportBadDowngradePkgs_1) . nonEmpty . toList $ NES.toSet pkgs S.\\ reals   unless (null reals) $ do-    cache   <- send $ cacheContents cachePath+    cache   <- sendM $ cacheContents cachePath     choices <- traverse (getDowngradeChoice cache) $ toList reals-    liftEitherM . pacman $ "-U" : asFlag (commonConfigOf ss) <> map (toFilePath . path) choices+    liftEitherM . sendM . pacman $ "-U" : asFlag (commonConfigOf ss) <> map (T.pack . toFilePath . path) choices  -- | For a given package, get a choice from the user about which version of it to -- downgrade to.-getDowngradeChoice :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) =>-  Cache -> PkgName -> Eff r PackagePath+getDowngradeChoice :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  Cache -> PkgName -> m PackagePath getDowngradeChoice cache pkg =   case nonEmpty $ getChoicesFromCache cache pkg of     Nothing      -> throwError . Failure $ reportBadDowngradePkgs_2 pkg     Just choices -> do-      ss <- ask-      send . notify ss . getDowngradeChoice_1 pkg $ langOf ss-      send $ getSelection (T.pack . toFilePath . path) choices+      ss <- asks settings+      sendM . notify ss . getDowngradeChoice_1 pkg $ langOf ss+      sendM $ getSelection (T.pack . toFilePath . path) choices  getChoicesFromCache :: Cache -> PkgName -> [PackagePath] getChoicesFromCache (Cache cache) p = sort . M.elems $ M.filterWithKey (\(SimplePkg pn _) _ -> p == pn) cache  -- | Print all package filenames that match a given `T.Text`.-searchCache :: (Member (Reader Settings) r, Member IO r) => T.Text -> Eff r ()+searchCache :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) => T.Text -> m () searchCache ps = do-  ss <- ask-  matches <- send $ cacheMatches ss ps-  send . traverse_ (putStrLn . toFilePath . path) $ sort matches+  ss <- asks settings+  matches <- sendM $ cacheMatches ss ps+  sendM . traverse_ (putStrLn . toFilePath . path) $ sort matches  -- | The destination folder must already exist for the back-up to begin.-backupCache :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => Path Absolute -> Eff r ()+backupCache :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  Path Absolute -> m () backupCache dir = do-  exists <- send $ doesDirectoryExist dir+  exists <- sendM $ doesDirectoryExist dir   if | not exists -> throwError $ Failure backupCache_3      | otherwise  -> confirmBackup dir >>= backup dir -confirmBackup :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => Path Absolute -> Eff r Cache+confirmBackup :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  Path Absolute -> m Cache confirmBackup dir = do-  ss    <- ask-  cache <- send . cacheContents . either id id . cachePathOf $ commonConfigOf ss-  send . notify ss $ backupCache_4 (toFilePath dir) (langOf ss)-  send . notify ss $ backupCache_5 (M.size $ _cache cache) (langOf ss)-  okay  <- send $ optionalPrompt ss backupCache_6+  ss    <- asks settings+  cache <- sendM . cacheContents . either id id . cachePathOf $ commonConfigOf ss+  sendM . notify ss $ backupCache_4 (toFilePath dir) (langOf ss)+  sendM . notify ss $ backupCache_5 (M.size $ _cache cache) (langOf ss)+  okay  <- sendM $ optionalPrompt ss backupCache_6   bool (throwError $ Failure backupCache_7) (pure cache) okay -backup :: (Member (Reader Settings) r, Member IO r) => Path Absolute -> Cache -> Eff r ()+backup :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) =>+  Path Absolute -> Cache -> m () backup dir (Cache cache) = do-  ss <- ask-  send . notify ss . backupCache_8 $ langOf ss-  send $ putStrLn ""  -- So that the cursor can rise at first.+  ss <- asks settings+  sendM . notify ss . backupCache_8 $ langOf ss+  sendM $ putStrLn ""  -- 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 :: (Member (Reader Settings) r, Member IO r) => Path Absolute -> [PackagePath] -> Int -> Eff r ()+copyAndNotify :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) =>+  Path Absolute -> [PackagePath] -> Int -> m () copyAndNotify _ [] _ = pure () copyAndNotify dir (PackagePath p : ps) n = do-  ss <- ask-  send $ raiseCursorBy 1-  send . warn ss . copyAndNotify_1 n $ langOf ss-  send $ copyFile p dir+  ss <- asks settings+  sendM $ raiseCursorBy 1+  sendM . warn ss . copyAndNotify_1 n $ langOf ss+  sendM $ copyFile p dir   copyAndNotify dir ps $ n + 1  -- | Keeps a certain number of package files in the cache according to -- a number provided by the user. The rest are deleted.-cleanCache :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => Word -> Eff r ()+cleanCache :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  Word -> m () cleanCache toSave-  | toSave == 0 = ask >>= \ss -> send (warn ss . cleanCache_2 $ langOf ss) >> liftEitherM (pacman ["-Scc"])+  | toSave == 0 = asks settings >>= \ss -> sendM (warn ss . cleanCache_2 $ langOf ss) >> (liftEitherM . sendM . pacman $ ["-Scc"])   | otherwise   = do-      ss <- ask-      send . warn ss . cleanCache_3 toSave $ langOf ss-      okay <- send $ optionalPrompt ss cleanCache_4+      ss <- asks settings+      sendM . warn ss . cleanCache_3 toSave $ langOf ss+      okay <- sendM $ optionalPrompt ss cleanCache_4       bool (throwError $ Failure cleanCache_5) (clean (fromIntegral toSave)) okay -clean :: (Member (Reader Settings) r, Member IO r) => Int -> Eff r ()+clean :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) => Int -> m () clean toSave = do-  ss <- ask-  send . notify ss . cleanCache_6 $ langOf ss+  ss <- asks settings+  sendM . notify ss . cleanCache_6 $ langOf ss   let cachePath = either id id . cachePathOf $ commonConfigOf ss-  (Cache cache) <- send $ cacheContents cachePath+  (Cache cache) <- sendM $ cacheContents cachePath   let !files    = M.elems cache       grouped   = take toSave . reverse <$> groupByName files       toRemove  = files \\ fold grouped-  send $ traverse_ removeFile $ map path toRemove+  sendM $ traverse_ removeFile $ map path toRemove  -- | Only package files with a version not in any PkgState will be -- removed.-cleanNotSaved :: (Member (Reader Settings) r, Member IO r) => Eff r ()+cleanNotSaved :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) => m () cleanNotSaved = do-  ss <- ask-  send . notify ss . cleanNotSaved_1 $ langOf ss-  sfs <- send getStateFiles-  states <- fmap catMaybes . send $ traverse readState sfs+  ss <- asks settings+  sendM . notify ss . cleanNotSaved_1 $ langOf ss+  sfs <- sendM getStateFiles+  states <- fmap catMaybes . sendM $ traverse readState sfs   let cachePath = either id id . cachePathOf $ commonConfigOf ss-  (Cache cache)  <- send $ cacheContents cachePath+  (Cache cache)  <- sendM $ cacheContents cachePath   let duds = M.filterWithKey (\p _ -> any (inState p) states) cache-  prop <- send . optionalPrompt ss $ cleanNotSaved_2 $ M.size duds-  when prop . send . traverse_ removeFile . map path $ M.elems duds+  prop <- sendM . optionalPrompt ss $ cleanNotSaved_2 $ M.size duds+  when prop . sendM . traverse_ removeFile . map path $ M.elems duds  -- | Typically takes the contents of the package cache as an argument. groupByName :: [PackagePath] -> [[PackagePath]]

@@ -1,10 +1,13 @@-{-# LANGUAGE FlexibleContexts, MonoLocalBinds #-}-{-# LANGUAGE TypeApplications, DataKinds #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MonoLocalBinds        #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE TypeApplications      #-}  -- | -- Module    : Aura.Commands.L--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -16,20 +19,21 @@   , logInfoOnPkg   ) where -import           Aura.Colour (red, dtot)-import           Aura.Core (report)+import           Aura.Colour (dtot, red)+import           Aura.Core (Env(..), report) import           Aura.Languages import           Aura.Settings import           Aura.Types (PkgName(..)) import           Aura.Utils import           BasePrelude hiding (FilePath) import           Control.Compactable (fmapEither)-import           Control.Monad.Freer-import           Control.Monad.Freer.Reader+import           Control.Effect (Carrier, Member)+import           Control.Effect.Lift (Lift, sendM)+import           Control.Effect.Reader (Reader, asks) import qualified Data.ByteString.Char8 as BS import           Data.Generics.Product (field) import qualified Data.List.NonEmpty as NEL-import           Data.Set.NonEmpty (NonEmptySet)+import           Data.Set.NonEmpty (NESet) import qualified Data.Text as T import           Data.Text.Encoding as T import           Data.Text.Encoding.Error (lenientDecode)@@ -44,13 +48,17 @@ -- | The contents of the Pacman log file. newtype Log = Log [T.Text] -data LogEntry = LogEntry { _pkgName :: PkgName, _firstInstall :: T.Text, _upgrades :: Word, _recent :: [T.Text] }+data LogEntry = LogEntry+  { name         :: PkgName+  , firstInstall :: T.Text+  , upgrades     :: Word+  , recent       :: [T.Text] }  -- | Pipes the pacman log file through a @less@ session.-viewLogFile :: (Member (Reader Settings) r, Member IO r) => Eff r ()+viewLogFile :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) => m () viewLogFile = do-  pth <- asks (toFilePath . either id id . logPathOf . commonConfigOf)-  send . void . runProcess @IO $ proc "less" [pth]+  pth <- asks (toFilePath . either id id . logPathOf . commonConfigOf . settings)+  sendM . void . runProcess @IO $ proc "less" [pth]  -- | Print all lines in the log file which contain a given `T.Text`. searchLogFile :: Settings -> T.Text -> IO ()@@ -60,27 +68,28 @@   traverse_ T.putStrLn $ searchLines input logFile  -- | The result of @-Li@.-logInfoOnPkg :: (Member (Reader Settings) r, Member IO r) => NonEmptySet PkgName -> Eff r ()+logInfoOnPkg :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) => NESet PkgName -> m () logInfoOnPkg pkgs = do-  ss <- ask+  ss <- asks settings   let pth = toFilePath . either id id . logPathOf $ commonConfigOf ss-  logFile <- Log . map (T.decodeUtf8With lenientDecode) . BS.lines <$> send (BS.readFile pth)+  logFile <- Log . map (T.decodeUtf8With lenientDecode) . BS.lines <$> sendM (BS.readFile pth)   let (bads, goods) = fmapEither (logLookup logFile) $ toList pkgs   traverse_ (report red reportNotInLog_1) $ NEL.nonEmpty bads-  send . traverse_ T.putStrLn $ map (renderEntry ss) goods+  sendM . traverse_ T.putStrLn $ map (renderEntry ss) goods  logLookup :: Log -> PkgName -> Either PkgName LogEntry logLookup (Log lns) p = case matches of   []    -> Left p-  (h:t) -> Right $ LogEntry p-                   (T.take 16 $ T.tail h)-                   (fromIntegral . length $ filter (T.isInfixOf " upgraded ") t)-                   (reverse . take 5 $ reverse t)+  (h:t) -> Right $+    LogEntry { name = p+             , 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  renderEntry :: Settings -> LogEntry -> T.Text renderEntry ss (LogEntry (PkgName pn) fi us rs) =-  dtot . colourCheck ss $ entrify ss fields entries <> hardline <> recent <> hardline+  dtot . colourCheck ss $ entrify ss fields entries <> hardline <> recents <> hardline   where fields  = logLookUpFields $ langOf ss         entries = map pretty [ pn, fi, T.pack (show us), "" ]-        recent  = vsep $ map pretty rs+        recents = vsep $ map pretty rs

@@ -1,10 +1,12 @@+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE MonoLocalBinds    #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts, MonoLocalBinds #-}-{-# LANGUAGE TypeApplications, DataKinds #-}+{-# LANGUAGE TypeApplications  #-}  -- | -- Module    : Aura.Commands.O--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -12,16 +14,16 @@  module Aura.Commands.O ( displayOrphans, adoptPkg ) where -import           Aura.Core (orphans, sudo, liftEitherM)+import           Aura.Core (Env(..), liftEitherM, orphans, sudo) import           Aura.Pacman (pacman)-import           Aura.Settings (Settings) import           Aura.Types import           BasePrelude-import           Control.Monad.Freer-import           Control.Monad.Freer.Error-import           Control.Monad.Freer.Reader+import           Control.Effect (Carrier, Member)+import           Control.Effect.Error (Error)+import           Control.Effect.Reader (Reader)+import           Control.Effect.Lift (Lift, sendM) import           Data.Generics.Product (field)-import           Data.Set.NonEmpty (NonEmptySet)+import           Data.Set.NonEmpty (NESet) import qualified Data.Text.IO as T import           Lens.Micro.Extras (view) @@ -32,5 +34,5 @@ displayOrphans = orphans >>= traverse_ (T.putStrLn . view (field @"name"))  -- | Identical to @-D --asexplicit@.-adoptPkg :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => NonEmptySet PkgName -> Eff r ()-adoptPkg pkgs = sudo . liftEitherM . pacman $ ["-D", "--asexplicit"] <> asFlag pkgs+adoptPkg :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) => NESet PkgName -> m ()+adoptPkg pkgs = sudo . liftEitherM . sendM . pacman $ ["-D", "--asexplicit"] <> asFlag pkgs

@@ -1,9 +1,14 @@-{-# LANGUAGE FlexibleContexts, MonoLocalBinds, TypeApplications, DataKinds #-}-{-# LANGUAGE MultiWayIf, OverloadedStrings #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE MonoLocalBinds      #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}  -- | -- Module    : Aura.Core--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -11,14 +16,16 @@  module Aura.Core   ( -- * Types-    Repository(..)+    Env(..)+  , Repository(..)   , liftEither, liftEitherM   , liftMaybe, liftMaybeM     -- * User Privileges   , sudo, trueRoot     -- * Querying the Package Database   , foreignPackages, orphans, develPkgs-  , isSatisfied, isInstalled+  , Unsatisfied(..), Satisfied(..)+  , areSatisfied, isInstalled   , checkDBLock     -- * Misc. Package Handling   , removePkgs, partitionPkgs, packageBuildable@@ -35,22 +42,25 @@ import           Aura.Utils import           BasePrelude hiding ((<>)) import           Control.Compactable (fmapEither)-import           Control.Monad.Freer-import           Control.Monad.Freer.Error-import           Control.Monad.Freer.Reader+import           Control.Effect (Carrier, Member)+import           Control.Effect.Error (Error, throwError)+import           Control.Effect.Lift (Lift, sendM)+import           Control.Effect.Reader (Reader, asks) import           Control.Monad.Trans.Maybe import qualified Data.ByteString.Lazy.Char8 as BL import           Data.Generics.Product (field) import qualified Data.List.NonEmpty as NEL+import           Data.Map.Strict (Map) import           Data.Semigroup+import           Data.Set (Set) import qualified Data.Set as S-import           Data.Set.NonEmpty (NonEmptySet)+import           Data.Set.NonEmpty (NESet) import qualified Data.Set.NonEmpty as NES import qualified Data.Text as T import qualified Data.Text.IO as T import           Data.Text.Prettyprint.Doc import           Data.Text.Prettyprint.Doc.Render.Terminal-import           Data.Versions (prettyV)+import           Data.These (These(..)) import           Lens.Micro ((^.)) import           Lens.Micro.Extras (view) import           System.Path.IO (doesFileExist)@@ -61,28 +71,39 @@ -- TYPES -------- +-- | The complete Aura runtime environment. `Repository` has internal caches+-- instantiated in `IO`, while `Settings` is mostly static and derived from+-- command-line arguments.+data Env = Env { repository :: !Repository, settings :: !Settings }+ -- | 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.-newtype Repository = Repository { repoLookup :: Settings -> NonEmptySet PkgName -> IO (Maybe (S.Set PkgName, S.Set Package)) }+-- 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)) } +-- NOTE The `repoCache` value passed to the combined `Repository` constructor is+-- irrelevant, and only sits there for typechecking purposes. Each `Repository`+-- is expected to leverage its own cache within its `repoLookup` function. instance Semigroup Repository where-  a <> b = Repository $ \ss ps -> runMaybeT $-    MaybeT (repoLookup a ss ps) >>= \(bads, goods) -> case NES.fromSet bads of-      Nothing    -> pure (bads, goods)+  a <> b = Repository (repoCache a) $ \ss ps -> runMaybeT $ do+    items@(bads, goods) <- MaybeT $ repoLookup a ss ps+    case NES.nonEmptySet bads of+      Nothing    -> pure items       Just bads' -> second (goods <>) <$> MaybeT (repoLookup b ss bads')  --------------------------------- -- Functions common to `Package`s ------------------------------------ | 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 `NonEmptySet`s--- will itself be non-empty.-partitionPkgs :: NonEmpty (NonEmptySet Package) -> ([Prebuilt], [NonEmptySet Buildable])+-- | 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+-- non-empty.+partitionPkgs :: NonEmpty (NESet Package) -> ([Prebuilt], [NESet Buildable]) partitionPkgs = bimap fold f . unzip . map g . toList   where g = fmapEither toEither . toList-        f = mapMaybe (fmap NES.fromNonEmpty . NEL.nonEmpty)+        f = mapMaybe (fmap NES.fromList . NEL.nonEmpty)         toEither (FromAUR b)  = Right b         toEither (FromRepo b) = Left b @@ -93,45 +114,46 @@ ----------- -- THE WORK -------------- | Lift a common return type into the `Eff` world. Usually used after a `pacman` call.-liftEither :: Member (Error a) r => Either a b -> Eff r b+-- | Lift a common return type into the `fused-effects` world. Usually used+-- after a `pacman` call.+liftEither :: (Carrier sig m, Member (Error a) sig) => Either a b -> m b liftEither = either throwError pure  -- | Like `liftEither`, but the `Either` can be embedded in something else, -- usually a `Monad`.-liftEitherM :: (Member (Error a) r, Member m r) => m (Either a b) -> Eff r b-liftEitherM = send >=> liftEither+liftEitherM :: (Carrier sig m, Member (Error a) sig) => m (Either a b) -> m b+liftEitherM m = m >>= liftEither  -- | Like `liftEither`, but for `Maybe`.-liftMaybe :: Member (Error a) r => a -> Maybe b -> Eff r b+liftMaybe :: (Carrier sig m, Member (Error a) sig) => a -> Maybe b -> m b liftMaybe a = maybe (throwError a) pure  -- | Like `liftEitherM`, but for `Maybe`.-liftMaybeM :: (Member (Error a) r, Member m r) => a -> m (Maybe b) -> Eff r b-liftMaybeM a m = send m >>= liftMaybe a+liftMaybeM :: (Carrier sig m, Member (Error a) sig) => a -> m (Maybe b) -> m b+liftMaybeM a m = m >>= liftMaybe a  -- | Action won't be allowed unless user is root, or using sudo.-sudo :: (Member (Reader Settings) r, Member (Error Failure) r) => Eff r a -> Eff r a-sudo action = asks (hasRootPriv . envOf) >>= bool (throwError $ Failure mustBeRoot_1) action+sudo :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig) => m a -> m a+sudo action = asks (hasRootPriv . envOf . settings) >>= bool (throwError $ Failure mustBeRoot_1) action  -- | Stop the user if they are the true root. Building as root isn't allowed -- since makepkg v4.2.-trueRoot :: (Member (Reader Settings) r, Member (Error Failure) r) => Eff r a -> Eff r a-trueRoot action = ask >>= \ss ->+trueRoot :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig) => m a -> m a+trueRoot action = asks settings >>= \ss ->   if not (isTrueRoot $ envOf ss) && buildUserOf (buildConfigOf ss) /= Just (User "root")     then action else throwError $ Failure trueRoot_3  -- | A list of non-prebuilt packages installed on the system. -- `-Qm` yields a list of sorted values.-foreignPackages :: IO (S.Set SimplePkg)+foreignPackages :: IO (Set SimplePkg) foreignPackages = S.fromList . mapMaybe (simplepkg' . strictText) . BL.lines <$> pacmanOutput ["-Qm"]  -- | Packages marked as a dependency, yet are required by no other package.-orphans :: IO (S.Set PkgName)+orphans :: IO (Set PkgName) orphans = S.fromList . map (PkgName . strictText) . BL.lines <$> pacmanOutput ["-Qqdt"]  -- | Any package whose name is suffixed by git, hg, svn, darcs, cvs, or bzr.-develPkgs :: IO (S.Set PkgName)+develPkgs :: IO (Set PkgName) develPkgs = S.filter isDevelPkg . S.map (^. field @"name") <$> foreignPackages   where isDevelPkg (PkgName pkg) = any (`T.isSuffixOf` pkg) suffixes         suffixes = ["-git", "-hg", "-svn", "-darcs", "-cvs", "-bzr"]@@ -139,25 +161,32 @@ -- | 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", T.unpack (pkg ^. field @"name")]+isInstalled pkg = bool Nothing (Just pkg) <$> pacmanSuccess ["-Qq", pkg ^. field @"name"]  -- | An @-Rsu@ call.-removePkgs :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => NonEmptySet PkgName -> Eff r ()+removePkgs :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  NESet PkgName -> m () removePkgs pkgs = do-  pacOpts <- asks commonConfigOf-  liftEitherM . pacman $ ["-Rsu"] <> asFlag pkgs <> asFlag pacOpts+  pacOpts <- asks (commonConfigOf . settings)+  liftEitherM . sendM . pacman $ ["-Rsu"] <> asFlag pkgs <> asFlag pacOpts --- | True if a dependency is satisfied by an installed package.--- `asT` renders the `VersionDemand` into the specific form that `pacman -T`--- understands. See `man pacman` for more info.-isSatisfied :: Dep -> IO Bool-isSatisfied (Dep n ver) = pacmanSuccess $ map T.unpack ["-T", (n ^. field @"name") <> asT ver]-  where asT (LessThan v) = "<"  <> prettyV v-        asT (AtLeast  v) = ">=" <> prettyV v-        asT (MoreThan v) = ">"  <> prettyV v-        asT (MustBe   v) = "="  <> prettyV v-        asT Anything     = ""+-- | Depedencies which are not installed, or otherwise provided by some+-- installed package.+newtype Unsatisfied = Unsatisfied (NESet Dep) +-- | The opposite of `Unsatisfied`.+newtype Satisfied = Satisfied (NESet 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 ds = do+  unsats <- S.fromList . mapMaybe parseDep <$> unsat+  pure . bimap Unsatisfied Satisfied $ NES.partition (\d -> S.member d unsats) ds+  where+    unsat :: IO [T.Text]+    unsat = pacmanLines $ "-T" : map renderedDep (toList ds)+ -- | Block further action until the database is free. checkDBLock :: Settings -> IO () checkDBLock ss = do@@ -182,9 +211,9 @@  -- | Report a message with multiple associated items. Usually a list of -- naughty packages.-report :: (Member (Reader Settings) r, Member IO r) =>-  (Doc AnsiStyle -> Doc AnsiStyle) -> (Language -> Doc AnsiStyle) -> NonEmpty PkgName -> Eff r ()+report :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) =>+  (Doc AnsiStyle -> Doc AnsiStyle) -> (Language -> Doc AnsiStyle) -> NonEmpty PkgName -> m () report c msg pkgs = do-  ss <- ask-  send . putStrLnA ss . c . msg $ langOf ss-  send . T.putStrLn . dtot . colourCheck ss . vsep . map (cyan . pretty . view (field @"name")) $ toList pkgs+  ss <- asks settings+  sendM . putStrLnA ss . c . msg $ langOf ss+  sendM . T.putStrLn . dtot . colourCheck ss . vsep . map (cyan . pretty . view (field @"name")) $ toList pkgs

@@ -1,9 +1,17 @@-{-# LANGUAGE FlexibleContexts, MonoLocalBinds, TupleSections, MultiWayIf #-}-{-# LANGUAGE TypeApplications, DataKinds #-}+{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE DeriveGeneric    #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase       #-}+{-# LANGUAGE MonoLocalBinds   #-}+{-# LANGUAGE MultiWayIf       #-}+{-# LANGUAGE PatternSynonyms  #-}+{-# LANGUAGE RankNTypes       #-}+{-# LANGUAGE TupleSections    #-}+{-# LANGUAGE TypeApplications #-}  -- | -- Module    : Aura.Dependencies--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -12,111 +20,128 @@ module Aura.Dependencies ( resolveDeps ) where  import           Algebra.Graph.AdjacencyMap+import           Algebra.Graph.AdjacencyMap.Algorithm (scc)+import qualified Algebra.Graph.NonEmpty.AdjacencyMap as NAM+import           Algebra.Graph.ToGraph (isAcyclic) import           Aura.Core import           Aura.Languages import           Aura.Settings import           Aura.Types+import           Aura.Utils (maybe') import           BasePrelude-import           Control.Concurrent.STM.TQueue-import           Control.Concurrent.STM.TVar-import           Control.Concurrent.Throttled (throttleMaybe_)-import           Control.Error.Util (note, hush)-import           Control.Monad.Freer-import           Control.Monad.Freer.Error-import           Control.Monad.Freer.Reader-import           Control.Monad.Trans.Class (lift)-import           Control.Monad.Trans.Maybe+import           Control.Effect (Carrier, Member)+import           Control.Effect.Error (Error, throwError)+import           Control.Effect.Lift (Lift, sendM)+import           Control.Effect.Reader (Reader, asks)+import           Control.Error.Util (note) import           Data.Generics.Product (field) import qualified Data.List.NonEmpty as NEL+import           Data.Map.Strict (Map) import qualified Data.Map.Strict as M+import           Data.Semigroup.Foldable (foldMap1)+import           Data.Set (Set) import qualified Data.Set as S-import           Data.Set.NonEmpty (NonEmptySet)+import           Data.Set.NonEmpty (pattern IsEmpty, pattern IsNonEmpty, NESet) import qualified Data.Set.NonEmpty as NES import qualified Data.Text as T+import           Data.These (these) import           Data.Versions-import           Data.Witherable (wither) import           Lens.Micro-import           System.IO (stdout, hFlush)+import           UnliftIO.Exception (catchAny, throwString)  --- --- | To signal if one of the STM actions below wrote a new value to the--- shared Map.-data Wrote = WroteNothing | WroteNew+-- | The results of dependency resolution.+data Resolution = Resolution+  { toInstall :: Map PkgName Package+  , satisfied :: Set PkgName }+  deriving (Generic)  -- | 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 :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) =>-  Repository -> NonEmptySet Package -> Eff r (NonEmpty (NonEmptySet Package))+resolveDeps :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  Repository -> NESet Package -> m (NonEmpty (NESet Package)) resolveDeps repo ps = do-  ss <- ask-  tv <- send $ newTVarIO M.empty-  ts <- send $ newTVarIO S.empty-  liftMaybeM (Failure connectionFailure_1) $ resolveDeps' ss repo tv ts ps-  m  <- send $ readTVarIO tv-  s  <- send $ readTVarIO ts-  unless (length ps == length m) $ send (putStr "\n")+  ss <- asks settings+  Resolution m s <- liftMaybeM (Failure connectionFailure_1) . sendM $+    (Just <$> resolveDeps' ss repo ps) `catchAny` (const $ pure Nothing)+  unless (length ps == length m) $ sendM (putStr "\n")   let de = conflicts ss m s   unless (null de) . throwError . Failure $ missingPkg_2 de   either throwError pure $ sortInstall m --- | An empty list signals success.-resolveDeps' :: Settings -> Repository -> TVar (M.Map PkgName Package) -> TVar (S.Set PkgName) -> NonEmptySet Package -> IO (Maybe ())-resolveDeps' ss repo tv ts ps = hush <$> throttleMaybe_ h ps+-- | Solve dependencies for a set of `Package`s assumed to not be+-- installed/satisfied.+resolveDeps' :: Settings -> Repository -> NESet Package -> IO Resolution+resolveDeps' ss repo ps = resolve (Resolution mempty mempty) ps   where-    -- | Handles determining whether further work should be done. It won't-    -- continue to `j` if this `Package` has already been analysed.-    h :: TQueue Package -> Package -> IO (Maybe ())-    h tq p = do-      w <- atomically $ do-        let pn = pname p-        m <- readTVar tv-        case M.lookup pn m of-          Just _  -> pure WroteNothing-          Nothing -> modifyTVar' tv (M.insert pn p) $> WroteNew-      case w of-        WroteNothing -> pure $ Just ()-        WroteNew     -> case p of-          FromRepo _ -> pure $ Just ()-          FromAUR b  -> readTVarIO tv >>= j tq b+    -- | 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')+      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 -    -- | Check for the existance of dependencies, as well as for any version conflicts-    -- they might introduce.-    j :: TQueue Package -> Buildable -> M.Map PkgName Package -> IO (Maybe ())-    j tq b m = do-      s <- readTVarIO ts-      (ds, sd) <- fmap partitionEithers . wither (satisfied m s) $ b ^. field @"deps"-      atomically $ modifyTVar' ts (<> S.fromList sd)-      case NEL.nonEmpty $ ds ^.. each . field @"name" of-        Nothing -> pure $ Just ()-        Just deps' -> do-          putStr "." *> hFlush stdout-          runMaybeT $ MaybeT (repoLookup repo ss $ NES.fromNonEmpty deps') >>= \(_, goods) ->-            unless (null goods) (lift . atomically $ traverse_ (writeTQueue tq) goods)+    -- | All dependencies from all potential `Buildable`s.+    allDeps :: NESet Buildable -> Set Dep+    allDeps = foldMap1 (S.fromList . (^.. field @"deps" . each)) -    satisfied :: M.Map PkgName Package -> S.Set PkgName -> Dep -> IO (Maybe (Either Dep PkgName))-    satisfied m s d | M.member dn m || S.member dn s = pure Nothing-                    | otherwise = Just . bool (Left d) (Right dn) <$> isSatisfied d-      where dn = d ^. field @"name"+    -- | 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 -conflicts :: Settings -> M.Map PkgName Package -> S.Set PkgName -> [DepError]+    -- | Consider only "unsatisfied" deps.+    satisfy :: Resolution -> NESet Buildable -> IO Resolution+    satisfy r bs = maybe' (pure r) (NES.nonEmptySet . 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)++        f :: NESet Dep -> Set PkgName+        f = S.map (^. field @"name") . NES.toSet++    -- 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+      repoLookup repo ss names >>= \case+        Nothing -> throwString "AUR Connection Error"+        Just (_, IsEmpty) -> throwString "Non-existant deps"+        Just (_, IsNonEmpty goods) -> resolve r goods++conflicts :: Settings -> Map PkgName Package -> Set PkgName -> [DepError] conflicts ss m s = foldMap f m-  where pm = M.fromList $ foldr (\p acc -> (pprov p ^. field @"provides" . to PkgName, p) : acc) [] m-        f (FromRepo _) = []-        f (FromAUR b)  = flip mapMaybe (b ^. field @"deps") $ \d ->-          let dn = d ^. field @"name"-          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+  where+    pm :: Map PkgName Package+    pm = M.fromList $ foldr (\p acc -> (pprov p ^. field @"provides", p) : acc) [] m -sortInstall :: M.Map PkgName Package -> Either Failure (NonEmpty (NonEmptySet Package))+    f :: Package -> [DepError]+    f (FromRepo _) = []+    f (FromAUR b)  = flip mapMaybe (b ^. field @"deps") $ \d ->+      let dn = d ^. field @"name"+      -- 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++sortInstall :: Map PkgName Package -> Either Failure (NonEmpty (NESet Package)) sortInstall m = case cycles depGraph of-  [] -> note (Failure missingPkg_3) . NEL.nonEmpty . mapMaybe NES.fromSet $ batch depGraph-  cs -> Left . Failure . missingPkg_4 $ map (map pname . vertexList) cs+  [] -> note (Failure missingPkg_3) . NEL.nonEmpty . mapMaybe NES.nonEmptySet $ 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@@ -124,18 +149,17 @@         connected = edges $ foldMap f elems         singles   = overlays $ map vertex elems -cycles :: Ord a => AdjacencyMap a -> [AdjacencyMap a]-cycles x = [ induce (`S.member` c) x | c <- cs ]-  where cs = filter (\c -> S.size c > 1) $ vertexList (scc x)+cycles :: Ord a => AdjacencyMap a -> [NAM.AdjacencyMap a]+cycles = filter (not . isAcyclic) . vertexList . scc  -- | Find the vertices that have no dependencies. -- O(n) complexity.-leaves :: Ord a => AdjacencyMap a -> S.Set a+leaves :: Ord a => AdjacencyMap a -> Set a leaves x = S.filter (null . flip postSet x) $ vertexSet x  -- | Split a graph into batches of mutually independent vertices. -- Probably O(m * n * log(n)) complexity.-batch :: Ord a => AdjacencyMap a -> [S.Set a]+batch :: Ord a => AdjacencyMap a -> [Set a] batch g | isEmpty g = []         | otherwise = ls : batch (induce (`S.notMember` ls) g)   where ls = leaves g

@@ -1,6 +1,6 @@ -- | -- Module    : Aura.Diff--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -10,8 +10,8 @@  import Aura.Settings import BasePrelude hiding (diff)-import System.Path (Path, Absolute, toFilePath)-import System.Process.Typed (runProcess, proc)+import System.Path (Absolute, Path, toFilePath)+import System.Process.Typed (proc, runProcess)  --- 

@@ -1,9 +1,15 @@-{-# LANGUAGE OverloadedStrings, MultiWayIf, ViewPatterns #-}-{-# LANGUAGE FlexibleContexts, MonoLocalBinds, TypeApplications, DataKinds #-}+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE MonoLocalBinds    #-}+{-# LANGUAGE MultiWayIf        #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-}+{-# LANGUAGE ViewPatterns      #-}  -- | -- Module    : Aura.Install--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -22,8 +28,7 @@ import           Aura.Dependencies (resolveDeps) import           Aura.Diff (diff) import           Aura.Languages-import           Aura.Packages.AUR (aurLookup, aurRepo)-import           Aura.Packages.Repository (pacmanRepo)+import           Aura.Packages.AUR (aurLookup) import           Aura.Pacman (pacman, pacmanSuccess) import           Aura.Pkgbuild.Base import           Aura.Pkgbuild.Records@@ -33,23 +38,23 @@ import           Aura.Utils (optionalPrompt) import           BasePrelude hiding (FilePath, diff) import           Control.Compactable (fmapEither)-import           Control.Concurrent.STM.TQueue-import           Control.Concurrent.Throttled (throttle)-import           Control.Monad.Freer-import           Control.Monad.Freer.Error-import           Control.Monad.Freer.Reader+import           Control.Effect (Carrier, Member)+import           Control.Effect.Error (Error, throwError)+import           Control.Effect.Lift (Lift, sendM)+import           Control.Effect.Reader (Reader, asks)+import           Control.Scheduler (Comp(..), traverseConcurrently) import qualified Data.ByteString.Lazy.Char8 as BL-import           Data.Generics.Product (field, super, HasField'(..))+import           Data.Generics.Product (HasField'(..), field, super) import qualified Data.List.NonEmpty as NEL import qualified Data.Map.Strict as M import           Data.Semigroup.Foldable (fold1) import qualified Data.Set as S-import           Data.Set.NonEmpty (NonEmptySet)+import           Data.Set.NonEmpty (NESet) import qualified Data.Set.NonEmpty as NES import qualified Data.Text.IO as T import           Language.Bash.Pretty (prettyText) import           Language.Bash.Syntax (ShellCommand)-import           Lens.Micro ((^.), (^..), each)+import           Lens.Micro (each, (^.), (^..)) import           Lens.Micro.Extras (view) import           System.Directory (setCurrentDirectory) import           System.IO (hFlush, stdout)@@ -57,74 +62,73 @@  --- -repository :: Repository-repository = pacmanRepo <> aurRepo- -- | High level 'install' command. Handles installing -- dependencies.-install :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) =>-  NonEmptySet PkgName -> Eff r ()+install :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  NESet PkgName -> m () install pkgs = do-  ss <- ask+  ss <- asks settings   if | not $ switch ss DeleteMakeDeps -> install' pkgs      | otherwise -> do -- `-a` was used.-         orphansBefore <- send orphans+         orphansBefore <- sendM orphans          install' pkgs-         orphansAfter <- send orphans-         let makeDeps = NES.fromSet (orphansAfter S.\\ orphansBefore)-         traverse_ (\mds -> send (notify ss . removeMakeDepsAfter_1 $ langOf ss) *> removePkgs mds) makeDeps+         orphansAfter <- sendM orphans+         let makeDeps = NES.nonEmptySet (orphansAfter S.\\ orphansBefore)+         traverse_ (\mds -> sendM (notify ss . removeMakeDepsAfter_1 $ langOf ss) *> removePkgs mds) makeDeps -install' :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) =>-  NonEmptySet PkgName -> Eff r ()+install' :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  NESet PkgName -> m () install' pkgs = do-  ss       <- ask+  rpstry   <- asks repository+  ss       <- asks settings   unneeded <- bool               (pure S.empty)-              (S.fromList . catMaybes <$> send (throttle (const isInstalled) pkgs >>= atomically . flushTQueue))+              (S.fromList . catMaybes <$> sendM (traverseConcurrently Par' isInstalled $ toList pkgs))               $ shared ss NeededOnly   let !pkgs' = NES.toSet pkgs-  if | shared ss NeededOnly && unneeded == pkgs' -> send . warn ss . install_2 $ langOf ss+  if | shared ss NeededOnly && unneeded == pkgs' -> sendM . warn ss . install_2 $ langOf ss      | otherwise -> do          let (ignored, notIgnored) = S.partition (`S.member` ignoresOf ss) pkgs'          installAnyway <- confirmIgnored ignored-         case NES.fromSet $ (notIgnored <> installAnyway) S.\\ unneeded of-           Nothing        -> send . warn ss . install_2 $ langOf ss+         case NES.nonEmptySet $ (notIgnored <> installAnyway) S.\\ unneeded of+           Nothing        -> sendM . warn ss . install_2 $ langOf ss            Just toInstall -> do              traverse_ (report yellow reportUnneededPackages_1) . NEL.nonEmpty $ toList unneeded-             (nons, toBuild) <- liftMaybeM (Failure connectionFailure_1) $ aurLookup (managerOf ss) toInstall+             (nons, toBuild) <- liftMaybeM (Failure connectionFailure_1) . sendM $ aurLookup (managerOf ss) toInstall              pkgbuildDiffs toBuild              traverse_ (report red reportNonPackages_1) . NEL.nonEmpty $ toList nons-             case NES.fromSet $ S.map (\b -> b { isExplicit = True }) toBuild of+             case NES.nonEmptySet $ S.map (\b -> b { isExplicit = True }) toBuild of                Nothing       -> throwError $ Failure install_2                Just toBuild' -> do-                 send $ notify ss (install_5 $ langOf ss) *> hFlush stdout-                 allPkgs <- depsToInstall repository toBuild'+                 sendM $ 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 <- send $ optionalPrompt ss install_3+                   continue <- sendM $ optionalPrompt ss install_3                    if | not continue -> throwError $ Failure install_4                       | otherwise    -> do                           traverse_ repoInstall $ NEL.nonEmpty repoPkgs                           let !mbuildPkgs = NEL.nonEmpty buildPkgs-                          traverse_ (send . storePkgbuilds . fold1) mbuildPkgs+                          traverse_ (sendM . storePkgbuilds . fold1) mbuildPkgs                           traverse_ buildAndInstall mbuildPkgs  -- | Determine if a package's PKGBUILD might contain malicious bash code.-analysePkgbuild :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => Buildable -> Eff r ()+analysePkgbuild :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  Buildable -> m () analysePkgbuild b = do-  ss <- ask+  ss <- asks settings   let f = do-        yes <- send $ optionalPrompt ss security_6+        yes <- sendM $ optionalPrompt ss security_6         when yes . throwError $ Failure security_7   case parsedPB $ b ^. field @"pkgbuild" of-    Nothing -> send (warn ss (security_1 (b ^. field @"name") $ langOf ss)) *> f+    Nothing -> sendM (warn ss (security_1 (b ^. field @"name") $ langOf ss)) *> f     Just l  -> case bannedTerms l of       []  -> pure ()       bts -> do-        send $ scold ss (security_5 (b ^. field @"name") $ langOf ss)-        send $ traverse_ (displayBannedTerms ss) bts+        sendM $ scold ss (security_5 (b ^. field @"name") $ langOf ss)+        sendM $ traverse_ (displayBannedTerms ss) bts         f  displayBannedTerms :: Settings -> (ShellCommand, BannedTerm) -> IO ()@@ -135,7 +139,7 @@  -- | Give anything that was installed as a dependency the /Install Reason/ of -- "Installed as a dependency for another package".-annotateDeps :: NonEmptySet Buildable -> IO ()+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 @@ -143,62 +147,65 @@ -- 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 :: [NonEmptySet Buildable] -> [NonEmptySet Buildable]-uniquePkgBase bs = mapMaybe (NES.fromSet . S.filter (\b -> (b ^. field @"name") `S.member` goods) . NES.toSet) bs+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 -confirmIgnored :: (Member (Reader Settings) r, Member IO r) => S.Set PkgName -> Eff r (S.Set PkgName)+confirmIgnored :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) =>+  S.Set PkgName -> m (S.Set PkgName) confirmIgnored (toList -> ps) = do-  ss <- ask-  S.fromList <$> filterM (send . optionalPrompt ss . confirmIgnored_1) ps+  ss <- asks settings+  S.fromList <$> filterM (sendM . optionalPrompt ss . confirmIgnored_1) ps -depsToInstall :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) =>-  Repository -> NonEmptySet Buildable -> Eff r (NonEmpty (NonEmptySet Package))+depsToInstall :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  Repository -> NESet Buildable -> m (NonEmpty (NESet Package)) depsToInstall repo bs = do-  ss <- ask-  traverse (send . packageBuildable ss) (NES.toNonEmpty bs) >>= resolveDeps repo . NES.fromNonEmpty+  ss <- asks settings+  traverse (sendM . packageBuildable ss) (NES.toList bs) >>= resolveDeps repo . NES.fromList -repoInstall :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => NonEmpty Prebuilt -> Eff r ()+repoInstall :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  NonEmpty Prebuilt -> m () repoInstall ps = do-  pacOpts <- asks (asFlag . commonConfigOf)-  liftEitherM . pacman $ ["-S", "--asdeps"] <> pacOpts <> asFlag (ps ^.. each . field @"name")+  pacOpts <- asks (asFlag . commonConfigOf . settings)+  liftEitherM . sendM . pacman $ ["-S", "--asdeps"] <> pacOpts <> asFlag (ps ^.. each . field @"name") -buildAndInstall :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) =>-  NonEmpty (NonEmptySet Buildable) -> Eff r ()+buildAndInstall :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  NonEmpty (NESet Buildable) -> m () buildAndInstall bss = do-  pth   <- asks (either id id . cachePathOf . commonConfigOf)-  cache <- send $ cacheContents pth+  pth   <- asks (either id id . cachePathOf . commonConfigOf . settings)+  cache <- sendM $ cacheContents pth   traverse_ (f cache) bss   where f (Cache cache) bs = do-          ss <- ask+          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.fromNonEmpty) $ NEL.nonEmpty ps-          traverse_ installPkgFiles $ built <> (NES.fromNonEmpty <$> NEL.nonEmpty cached)-          send $ annotateDeps bs+                _                                       -> Left b+          built <- traverse (buildPackages . NES.fromList) $ NEL.nonEmpty ps+          traverse_ installPkgFiles $ built <> (NES.fromList <$> NEL.nonEmpty cached)+          sendM $ annotateDeps bs  ------------ -- REPORTING ------------ -- | Display dependencies. The result of @-Ad@.-displayPkgDeps :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) =>-  NonEmptySet PkgName -> Eff r ()+displayPkgDeps :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  NESet PkgName -> m () displayPkgDeps ps = do-  ss <- ask-  let f = depsToInstall repository >=> reportDeps (switch ss LowVerbosity) . partitionPkgs-  (_, goods) <- liftMaybeM (Failure connectionFailure_1) $ aurLookup (managerOf ss) ps-  traverse_ f $ NES.fromSet goods-  where reportDeps True  = send . uncurry reportListOfDeps+  rpstry <- asks repository+  ss <- asks settings+  let f = depsToInstall rpstry >=> reportDeps (switch ss LowVerbosity) . partitionPkgs+  (_, goods) <- liftMaybeM (Failure connectionFailure_1) . sendM $ aurLookup (managerOf ss) ps+  traverse_ f $ NES.nonEmptySet goods+  where reportDeps True  = sendM . uncurry reportListOfDeps         reportDeps False = uncurry reportPkgsToInstall -reportPkgsToInstall :: (Member (Reader Settings) r, Member IO r) =>-   [Prebuilt] -> [NonEmptySet Buildable] -> Eff r ()+reportPkgsToInstall :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) =>+  [Prebuilt] -> [NESet Buildable] -> m () reportPkgsToInstall rps bps = do   let (explicits, ds) = partition isExplicit $ foldMap toList bps   f reportPkgsToInstall_1 rps@@ -206,24 +213,24 @@   f reportPkgsToInstall_2 explicits   where f m xs = traverse_ (report green m) . NEL.nonEmpty . sort $ xs ^.. each . field @"name" -reportListOfDeps :: [Prebuilt] -> [NonEmptySet Buildable] -> IO ()+reportListOfDeps :: [Prebuilt] -> [NESet Buildable] -> IO () reportListOfDeps rps bps = f rps *> f (foldMap toList bps)   where f :: HasField' "name" s PkgName => [s] -> IO ()         f = traverse_ T.putStrLn . sort . (^.. each . field' @"name" . field' @"name") -pkgbuildDiffs :: (Member (Reader Settings) r, Member IO r) => S.Set Buildable -> Eff r ()-pkgbuildDiffs ps = ask >>= check+pkgbuildDiffs :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) => S.Set Buildable -> m ()+pkgbuildDiffs ps = asks settings >>= check     where check ss | not $ switch ss DiffPkgbuilds = pure ()                    | otherwise = traverse_ displayDiff ps-          displayDiff :: (Member (Reader Settings) r, Member IO r) => Buildable -> Eff r ()+          displayDiff :: (Carrier sig m, Member (Reader Env) sig, Member (Lift IO) sig) => Buildable -> m ()           displayDiff p = do-            ss <- ask+            ss <- asks settings             let pn   = p ^. field @"name"                 lang = langOf ss-            isStored <- send $ hasPkgbuildStored pn+            isStored <- sendM $ hasPkgbuildStored pn             if not isStored-               then send . warn ss $ reportPkgbuildDiffs_1 pn lang-               else send $ do+               then sendM . warn ss $ reportPkgbuildDiffs_1 pn lang+               else sendM $ do                  setCurrentDirectory "/tmp"                  let new = "/tmp/new.pb"                  BL.writeFile new $ p ^. field @"pkgbuild" . field @"pkgbuild"

@@ -1,11 +1,14 @@-{-# LANGUAGE LambdaCase, ViewPatterns, OverloadedStrings #-}-{-# LANGUAGE TypeApplications, DataKinds #-}+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-}+{-# LANGUAGE ViewPatterns      #-} {-# OPTIONS_HADDOCK prune #-} {-# OPTIONS_GHC -fno-warn-missing-export-lists #-}  -- | -- Module    : Aura.Languages.Fields--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -27,6 +30,7 @@ "pak tua Greg"                                | Indonesia Kai Zhang                                     | Chinese Onoue Takuro                                  | Japanese+Zachary "Ghosy" Matthews                      | Esperanto -}  module Aura.Languages where@@ -36,7 +40,7 @@ import           Aura.Types import           BasePrelude hiding ((<+>)) import           Data.Generics.Product (field)-import qualified Data.Map.Strict as Map (Map, (!), fromList, toList, mapWithKey)+import qualified Data.Map.Strict as Map (Map, fromList, mapWithKey, toList, (!)) import qualified Data.Text as T import           Data.Text.Prettyprint.Doc import           Data.Text.Prettyprint.Doc.Render.Terminal@@ -60,26 +64,28 @@     , (Indonesia,  "\"pak tua Greg\"")     , (Chinese,    "Kai Zhang")     , (Japanese,   "Onoue Takuro")+    , (Esperanto,  "Zachary Matthews")     ]  -- These need updating! Or removing... languageNames :: Language -> Map.Map Language T.Text-languageNames = Map.fromList . zip [ Japanese, Polish, Croatian, Swedish, German, Spanish, Portuguese, French, Russian, Italian, Serbian, Norwegian, Indonesia, Chinese ] . \case-    Japanese   -> [ "日本語", "ポーランド語", "クロアチア語", "スウェーデン語", "ドイツ語", "スペイン語", "ポルトガル語", "フランス語", "ロシア語", "イタリア語", "セルビア語", "ノルウェー語", "インドネシア語", "中国語" ]-    Polish     -> [ "Japanese", "polski", "chorwacki", "szwedzki", "niemiecki", "hiszpański", "portugalski", "francuski", "rosyjski", "", "", "", "Indonesian", "Chinese" ]-    Croatian   -> [ "Japanese", "poljski", "hrvatski", "švedski", "njemački", "španjolski", "portugalski", "francuski", "ruski", "talijanski", "srpski", "norveški", "Indonesian", "Chinese" ]-    Swedish    -> [ "Japanese", "Polska", "Kroatiska", "Svenska", "Tyska", "Spanska", "Portugisiska", "Franska", "Ryska", "Italienska", "Serbiska", "Norska", "Indonesian", "Chinese" ]-    German     -> [ "Japanisch", "Polnisch", "Kroatisch", "Schwedisch", "Deutsch", "Spanisch", "Portugiesisch", "Französisch", "Russisch", "Italienisch", "Serbisch", "Norwegisch", "Indonesisch", "Chinese" ]-    Spanish    -> [ "Japanese", "Polaco", "Croata", "Sueco", "Alemán", "Español", "Portugués", "Francés", "Ruso", "Italiano", "Serbio", "Noruego", "Indonesio", "Chinese" ]-    Portuguese -> [ "Japonês", "Polonês", "Croata", "Sueco", "Alemão", "Espanhol", "Português", "Francês", "Russo", "Italiano", "Sérvio", "Norueguês", "Indonésio", "Chinês" ]-    French     -> [ "Japanese", "Polonais", "Croate", "Suédois", "Allemand", "Espagnol", "Portugais", "Français", "Russe", "Italien", "Serbe", "Norvégien", "Indonesian", "Chinese" ]-    Russian    -> [ "Японский", "Польский", "Хорватский", "Шведский", "Немецкий", "Испанский", "Португальский", "Французский", "Русский", "Итальянский", "Сербский", "Норвежский", "Индонезийский", "Китайский" ]-    Italian    -> [ "Giapponese", "Polacco", "Croato", "Svedese", "Tedesco", "Spagnolo", "Portoghese", "Francese", "Russo", "Italiano", "", "", "Indonesian", "Chinese" ]-    Serbian    -> [ "Japanese", "Пољски", "Хрватски", "Шведски", "Немачки", "Шпански", "Португалски", "Француски", "Руски", "Италијански", "Српски", "", "Indonesian", "Chinese" ]-    Norwegian  -> [ "Japanese", "Polsk", "Kroatisk", "Svensk", "Tysk", "Spansk", "Portugisisk", "Fransk", "Russisk", "Italiensk", "Serbisk", "Norsk", "Indonesian", "Chinese" ]-    Indonesia  -> [ "Japanese", "Polandia", "Kroasia", "Swedia", "Jerman", "Spanyol", "Portugis", "Prancis", "Rusia", "Italia", "Serbia", "Norwegia", "Indonesian", "Chinese" ]-    Chinese    -> [ "日语", "波兰语", "克罗地亚语", "瑞典语", "德语", "西班牙语", "葡萄牙语", "法语", "俄语", "意大利语", "塞尔维亚语", "挪威语", "印度尼西亚语", "中文" ]-    _          -> [ "Japanese", "Polish", "Croatian", "Swedish", "German", "Spanish", "Portuguese", "French", "Russian", "Italian", "Serbian", "Norwegian", "Indonesian", "Chinese" ]+languageNames = Map.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", "", "", "Indonesian", "Chinese", "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" ]  translatorMsgTitle :: Language -> T.Text translatorMsgTitle = \case@@ -97,6 +103,7 @@     Norwegian  -> "Aura Oversettere:"     Indonesia  -> "Penerjemah Aura:"     Chinese    -> "Aura 的翻译者："+    Esperanto  -> "Tradukistoj de Aura:"     _          -> "Aura Translators:"  translatorMsg :: Language -> [T.Text]@@ -114,7 +121,7 @@  whitespace :: Language -> Char whitespace Japanese = '　'  -- \12288-whitespace _ = ' '          -- \32+whitespace _        = ' '   -- \32  langFromLocale :: T.Text -> Language langFromLocale = T.take 2 >>> \case@@ -132,6 +139,7 @@     "nb" -> Norwegian     "id" -> Indonesia     "zh" -> Chinese+    "eo" -> Esperanto     _    -> English  ----------------------@@ -151,6 +159,7 @@     Russian    -> "База данных пакетов заблокирована. Нажмите \"Ввод\", когда она разблокируется, чтобы продолжить."     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"     _          -> "The package database is locked. Press enter when it's unlocked to continue."  trueRoot_3 :: Language -> Doc AnsiStyle@@ -162,6 +171,7 @@     Russian    -> "С версии makepkg v4.2 сборка от имени root более невозможна."     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."     _          -> "As of makepkg v4.2, building as root is no longer possible."  mustBeRoot_1 :: Language -> Doc AnsiStyle@@ -180,6 +190,7 @@     Norwegian  -> "Du må bruke " <> sudo <> " for det."     Indonesia  -> "Anda harus menggunakan " <> sudo <> " untuk melakukannya."     Chinese    -> "除非是根用户，否则不能执行此操作。"+    Esperanto  -> "Vi ne povas fari ĉi tiun operacion, sen " <> sudo <> "."     _          -> "You cannot perform this operation without using sudo."  -----------------------@@ -201,6 +212,7 @@     Norwegian  -> "Bygger " <> p <> "..."     Indonesia  -> "Membangun " <> p <> "..."     Chinese    -> p <> " 正在构建中..."+    Esperanto  -> "Muntanta" <> p <> "..."     _          -> "Building " <> p <> "..."  buildFail_5 :: Language -> Doc AnsiStyle@@ -219,6 +231,7 @@     Norwegian  -> "Bygging feilet."     Indonesia  -> "Proses gagal."     Chinese    -> "构建失败。"+    Esperanto  -> "Muntado paneis"     _          -> "Building failed."  -- NEEDS TRANSLATION@@ -237,6 +250,7 @@     Indonesia  -> "Apakah anda tetap ingin melanjutkan?"     Chinese    -> "你仍然希望继续吗？"     Swedish    -> "Vill du fortsätta ändå?"+    Esperanto  -> "Ĉu vi volas daŭrigi?"     _          -> "Would you like to continue anyway?"  -- NEEDS TRANSLATION@@ -251,6 +265,7 @@     Russian    -> "Не удалось получить сценарии сборки для " <> p <> "."     Chinese    -> "无法获得 " <> p <> " 的构建脚本。"     Swedish    -> "Kunde inte hämta byggskript för " <> p <> "."+    Esperanto  -> "Paneis akiri muntaj skriptoj de " <> p <> "."     _          -> "Failed to obtain build scripts for " <> p <> "."  buildFail_8 :: Language -> Doc AnsiStyle@@ -258,19 +273,23 @@     Japanese   -> "makepkgは失敗しました。"     Portuguese -> "Ocorreu um erro ao executar makepkg"     Russian    -> "Произошла ошибка makepkg."+    Esperanto  -> "Paneo de makepkg okazis."     _          -> "There was a makepkg failure."  buildFail_9 :: Language -> Doc AnsiStyle buildFail_9 = \case-  _ -> "Failed to detect any built package files (*.pkg.tar.xz)."+  Esperanto -> "Paneis detekti ĉiujn dosierojn de pakaĵoj (*.pkg.tar.xz)."+  _         -> "Failed to detect any built package files (*.pkg.tar.xz)."  buildFail_10 :: Language -> Doc AnsiStyle buildFail_10 = \case-  _ -> "Every package failed to build."+  Esperanto -> "Ĉiuj pakaĵoj paneis munti."+  _         -> "Every package failed to build."  buildFail_11 :: Language -> Doc AnsiStyle buildFail_11 = \case   Japanese   -> "作成は失敗しました。エラーを見ますか？"+  Esperanto  -> "Muntado paneis. Ĉu vi volas vidi la eraron?"   _          -> "Building failed. Would you like to see the error?"  ------------------------------@@ -293,6 +312,7 @@     Norwegian  -> "Avhengigheten " <> p <> " krever versjon " <> d <>", men den nyeste versjonen er " <> r <> "."     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 <> "."     _          -> "The package " <> prnt <> " depends on version " <> d <> " of " <> p <> ", but the most recent version is " <> r <> "."  getRealPkgConflicts_2 :: PkgName -> Language -> Doc AnsiStyle@@ -311,6 +331,7 @@     Norwegian  -> p <> " er en ignorert pakke! Sjekk din `pacman.conf`-fil."     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."     _          -> p <> " is an ignored package! See your `pacman.conf` file."  missingPkg_2 :: [DepError] -> Language -> Doc AnsiStyle@@ -322,19 +343,22 @@ depError l (NonExistant (PkgName s)) = case l of   Portuguese -> "A dependência " <> bt s <> " não foi encontrada."   Russian    -> "Зависимость " <> bt s <> " не найдена."+  Esperanto  -> "La dependeco " <> bt s <> " ne povis troviĝi."   _          -> "The dependency " <> bt s <> " couldn't be found."-depError l (BrokenProvides (PkgName pkg) (Provides pro) (PkgName n)) = case l of+depError l (BrokenProvides (PkgName pkg) (Provides (PkgName pro)) (PkgName n)) = case l of   Russian    -> "Пакету " <> bt pkg <> " требуется " <> bt n <> ", предоставляющий " <> bt pro <> "."+  Esperanto  -> "La pakaĵo, " <> bt pkg <> " bezonas " <> bt n <> ", kiu donas " <> bt pro <> "."   _          -> "The package " <> bt pkg <> " needs " <> bt n <> ", which provides " <> bt pro <> "."  missingPkg_3 :: Language -> Doc AnsiStyle missingPkg_3 = \case-  _ -> "There was an error reorganizing the dependency graph. If you see this, something is very wrong."+  Esperanto  -> "Eraro okazis kiam reorganizi la grafeo de dependeco. Io estas erarega."+  _          -> "There was an error reorganizing the dependency graph. If you see this, something is very wrong." -missingPkg_4 :: [[PkgName]] -> Language -> Doc AnsiStyle+missingPkg_4 :: [NonEmpty PkgName] -> Language -> Doc AnsiStyle missingPkg_4 pns = \case   _ -> vsep $ "The following dependency cycles were detected:" : pns'-  where pns' = map (hsep . map pretty . intersperse "=>" . map (view (field @"name"))) pns+  where pns' = map (hsep . map pretty . intersperse "=>" . map (view (field @"name")) . toList) pns  ----------------- -- aura functions@@ -355,6 +379,7 @@     Norwegian  -> "Følgende språk er tilgjengelig:"     Indonesia  -> "Berikut ini adalah bahasa yang tersedia:"     Chinese    -> "以下语言是可用的："+    Esperanto  -> "La sekvaj lingvo estas disponebla:"     _          -> "The following languages are available:"  ----------------------------@@ -375,6 +400,7 @@     Indonesia  -> "Pemutakhiran aura tersedia. Mutakhirkan aura dulu?"     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?"     _          -> "Aura update available. Update it first?"  install_2 :: Language -> Doc AnsiStyle@@ -393,6 +419,7 @@     Norwegian  -> "Ingen gyldige pakker er valgte."     Indonesia  -> "Tidak ada paket valid yang dispesifikkan."     Chinese    -> "没有指定有效的包。"+    Esperanto  -> "Ne validajn pakaĵojn specifis"     _          -> "No valid packages specified."  install_3 :: Language -> Doc AnsiStyle@@ -411,6 +438,7 @@     Norwegian  -> "Fortsett?"     Indonesia  -> "Lanjut?"     Chinese    -> "继续？"+    Esperanto  -> "Ĉu daŭrigi?"     _          -> "Continue?"  install_4 :: Language -> Doc AnsiStyle@@ -429,6 +457,7 @@     Norwegian  -> "Installasjonen ble avbrutt manuelt."     Indonesia  -> "Instalasi dibatalkan secara paksa."     Chinese    -> "手动安装已中止。"+    Esperanto  -> "Instalon ĉesigi permane"     _          -> "Installation manually aborted."  install_5 :: Language -> Doc AnsiStyle@@ -447,6 +476,7 @@     Norwegian  -> "Bestemmer avhengigheter..."     Indonesia  -> "Menentukan dependensi..."     Chinese    -> "确定依赖中..."+    Esperanto  -> "Difinas dependecojn..."     _          -> "Determining dependencies..."  -- 2014 December  7 @ 14:45 - NEEDS TRANSLATIONS@@ -459,6 +489,7 @@     Russian    -> p <> " отмечен как игнорируемый. Всё равно установить?"     Chinese    -> p <> " 已被标记为忽略。仍然安装？"     Swedish    -> p <> " är markerad som ignorerad. Vill du installera ändå?"+    Esperanto  -> p <> " estas markita kiel malatenta. Ĉu instali?"     _          -> p <> " is marked as Ignored. Install anyway?"  -- NEEDS UPDATE TO REFLECT CHANGED ENGLISH@@ -478,6 +509,7 @@     Norwegian  -> "Det følgende er ikke AUR-pakker:"     Indonesia  -> "Paket berikut ini bukan merupakan paket AUR:"     Chinese    -> "以下软件不是 AUR 包："+    Esperanto  -> "La sekvaj ne estas pakaĵoj de la AUR:"     _          -> "The following are not AUR packages:"  -- NEEDS TRANSLATION@@ -491,6 +523,7 @@     Spanish    -> "Los siguientes paquetes ya están instalados:"     Chinese    -> "以下包已被安装："     Swedish    -> "Följande paket är redan installerade:"+    Esperanto  -> "La sekvaj pakaĵoj jam instaliĝas:"     _          -> "The following packages are already installed:"  reportPkgsToInstall_1 :: Language -> Doc AnsiStyle@@ -509,6 +542,7 @@     Norwegian  -> "Avhengigheter fra depotet:"     Indonesia  -> "Dependensi dari repositori:"     Chinese    -> "仓库依赖："+    Esperanto  -> "Dependecoj de deponejo:"     _          -> "Repository dependencies:"  -- NEEDS AN UPDATE@@ -527,6 +561,7 @@     Indonesia  -> "AUR Paket:"     Chinese    -> "AUR 包："     Swedish    -> "AUR Paket:"+    Esperanto  -> "Pakaĵoj de AUR:"     _          -> "AUR Packages:"  reportPkgsToInstall_3 :: Language -> Doc AnsiStyle@@ -543,6 +578,7 @@     Italian    -> "Dipendenze in AUR:"     Serbian    -> "Зависности из AUR-а:"     Norwegian  -> "Avhengigheter fra AUR:"+    Esperanto  -> "Dependencoj de AUR:"     _          -> "AUR dependencies:"  -- NEEDS TRANSLATION@@ -562,6 +598,7 @@     Indonesia  -> p <> " tidak mempunyai PKGBUILD yang tersimpan untuk saat ini."     Chinese    -> p <> " 还没有保存的 PKGBUILD。"     Swedish    -> p <> " har ännu ingen PKGBUILD."+    Esperanto  -> p <> " ne havas PKGBUILD jam."     _          -> p <> " has no stored PKGBUILD yet."  -- NEEDS TRANSLATION@@ -581,6 +618,7 @@     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@@ -600,6 +638,7 @@     Indonesia  -> "Perubahan PKGBUILD " <> p <> ":"     Chinese    -> p <> " 的 PKGBUILD 变化："     Swedish    -> "Förändringar i PKGBUILD för " <> p <> ":"+    Esperanto  -> p <> " PKGBUILD ŝanĝoj:"     _          -> p <> " PKGBUILD changes:"  -- NEEDS TRANSLATION@@ -619,6 +658,7 @@     Norwegian  -> "AUR-pakker å oppgradere:"     Indonesia  -> "Paket AUR yang akan ditingkatkan:"     Chinese    -> "要升级的 AUR 包："+    Esperanto  -> "Pakaĵoj de AUR ĝisdatigi:"     _          -> "AUR Packages to upgrade:"  -- NEEDS UPDATING@@ -638,6 +678,7 @@     Norwegian  -> "Følgende pakker har ingen versjoner i cache, og kan derfor ikke bli nedgradert:"     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:"     _          -> "The following have no versions in the cache, and thus can’t be downgraded:"  reportBadDowngradePkgs_2 :: PkgName -> Language -> Doc AnsiStyle@@ -660,6 +701,7 @@     Norwegian  -> "Henter pakkeinformasjon..."     Indonesia  -> "Mengambil informasi paket..."     Chinese    -> "正在获取包信息..."+    Esperanto  -> "Venigas informacion de pakaĵoj..."     _          -> "Fetching package information..."  upgradeAURPkgs_2 :: Language -> Doc AnsiStyle@@ -678,6 +720,7 @@     Norwegian  -> "Sammenligner pakkeversjoner..."     Indonesia  -> "Membandingkan versi paket..."     Chinese    -> "正在比较包的版本..."+    Esperanto  -> "Komparas versiojn de pakaĵoj..."     _          -> "Comparing package versions..."  upgradeAURPkgs_3 :: Language -> Doc AnsiStyle@@ -696,6 +739,7 @@     Norwegian  -> "Ingen pakkeoppgradering fra AUR nødvendig."     Indonesia  -> "Tidak ada peningkatan AUR yang dibutuhkan."     Chinese    -> "没有需要升级的 AUR 包。"+    Esperanto  -> "Ne ĝisdatigoj de pakaĵoj de AUR necesas."     _          -> "No AUR package upgrades necessary."  removeMakeDepsAfter_1 :: Language -> Doc AnsiStyle@@ -714,6 +758,7 @@     Norwegian  -> "Fjerner unødvendige make-avhengigheter..."     Indonesia  -> "Menghapus dependensi `make` yang tidak dibutuhkan..."     Chinese    -> "移除不需要的 make 依赖..."+    Esperanto  -> "Forigas nenecesajn dependecojn de make..."     _          -> "Removing unneeded make dependencies..."  ----------------------------@@ -736,6 +781,7 @@     Indonesia  -> s <> " paket akan tetap sama. Hapus yang lainnya?"     Chinese    -> s <> " 个包的状态将会保留。删除其它的？"     Swedish    -> s <> " paket kommer att bevaras. Ta bort resten?"+    Esperanto  -> s <> " statoj de pakaĵoj teniĝas. Ĉu forigi la ceteron?"     _          -> s <> " package states will be kept. Remove the rest?"  -- NEEDS TRANSLATION@@ -755,19 +801,22 @@     Indonesia  -> "Tidak ada paket yang dihapus."     Chinese    -> "没有删除任何包。"     Swedish    -> "Inga paket togs bort."+    Esperanto  -> "Ne statojn de pakaĵoj forigis."     _          -> "No package states were removed."  cleanStates_4 :: Int -> Language -> Doc AnsiStyle cleanStates_4 n = \case-  Japanese -> "現在のパッケージ状態記録：" <> pretty n <> "個。"-  Russian  -> "У вас сейчас " <+> pretty n <+> pluralRussian " сохраненное состояние пакета" " сохраненных состояний пакета" " сохраненных состояний пакетов." n-  _        -> "You currently have" <+> pretty n <+> "saved package states."+  Japanese  -> "現在のパッケージ状態記録：" <> pretty n <> "個。"+  Russian   -> "У вас сейчас " <+> pretty n <+> pluralRussian " сохраненное состояние пакета" " сохраненных состояний пакета" " сохраненных состояний пакетов." n+  Esperanto -> "Vi havas " <+> pretty n <+> " konservajn statojn de pakaĵoj."+  _         -> "You currently have" <+> pretty n <+> "saved package states."  cleanStates_5 :: T.Text -> Language -> Doc AnsiStyle cleanStates_5 t = \case-  Japanese -> "一番最近に保存されたのは：" <> pretty t-  Russian  -> "Последнее сохраненное:" <+> pretty t-  _        -> "Mostly recently saved:" <+> pretty t+  Japanese  -> "一番最近に保存されたのは：" <> pretty t+  Russian   -> "Последнее сохраненное:" <+> pretty t+  Esperanto -> "Lastaj konservaj:" <+> pretty t+  _         -> "Mostly recently saved:" <+> pretty t  cleanStates_6 :: Int -> Language -> Doc AnsiStyle cleanStates_6 n = \case@@ -777,6 +826,7 @@ readState_1 = \case     Portuguese -> "O arquivo de estado não pôde ser interpretado. É um arquivo JSON válido?"     Russian    -> "Это состояние не распознано. Это корректный JSON?"+    Esperanto  -> "Tiu statdosiero paneis sintake analizi. Ĉu ĝi estas valida JSON?"     _          -> "That state file failed to parse. Is it legal JSON?"  ----------------------------@@ -798,6 +848,7 @@     Norwegian  -> "Hvilken versjon av " <> p <> " vil du ha?"     Indonesia  -> "Versi dari paket " <> p <> " mana yang anda inginkan?"     Chinese    -> "你希望安装 " <> p <> " 的哪个版本？"+    Esperanto  -> "Kiu versio de " <> p <> " vi volas?"     _          -> "What version of " <> p <> " do you want?"  backupCache_3 :: Language -> Doc AnsiStyle@@ -816,6 +867,7 @@     Norwegian  -> "Spesifisert backup-plass finnes ikke."     Indonesia  -> "Lokasi `backup` tidak ada."     Chinese    -> "备份位置不存在。"+    Esperanto  -> "La savkopia loko ne ekzistas."     _          -> "The backup location does not exist."  backupCache_4 :: FilePath -> Language -> Doc AnsiStyle@@ -834,6 +886,7 @@     Norwegian  -> "Tar backup på cache til " <> dir     Indonesia  -> "Melakukan `backup` pada direktori " <> dir     Chinese    -> "正在将缓存备份到 " <> dir+    Esperanto  -> "Enarkivigas la kaŝdosieron al " <> dir     _          -> "Backing up cache to " <> dir  backupCache_5 :: Int -> Language -> Doc AnsiStyle@@ -852,6 +905,7 @@     Norwegian  -> "Pakker som blir tatt backup på: " <> n     Indonesia  -> "Jumlah paket yang di-`backup`: " <> n     Chinese    -> "将要备份的包文件：" <> n+    Esperanto  -> "La dosierojn de la pakaĵoj enarkivigi: " <> n     _          -> "Package files to backup: " <> n  backupCache_6 :: Language -> Doc AnsiStyle@@ -870,6 +924,7 @@     Norwegian  -> "Fortsett med backup?"     Indonesia  -> "Lanjutkan dengan `backup`?"     Chinese    -> "开始备份？"+    Esperanto  -> "Ĉu daŭrigu enarkivigi?"     _          -> "Proceed with backup?"  backupCache_7 :: Language -> Doc AnsiStyle@@ -888,6 +943,7 @@     Norwegian  -> "Backup ble avbrutt manuelt."     Indonesia  -> "Proses `backup` dibatalkan secara paksa."     Chinese    -> "手动备份已中止。"+    Esperanto  -> "Enarkivigadon ĉesigis permane."     _          -> "Backup manually aborted."  backupCache_8 :: Language -> Doc AnsiStyle@@ -906,6 +962,7 @@     Norwegian  -> "Tar backup. Dette kan ta en stund..."     Indonesia  -> "Melakukan `backup`. Proses ini akan berjalan untuk beberapa menit..."     Chinese    -> "正在备份中。可能需要几分钟的时间..."+    Esperanto  -> "Enarkiviganta. Ĉi tiu eble daŭros dum kelkaj tagoj..."     _          -> "Backing up. This may take a few minutes..."  copyAndNotify_1 :: Int -> Language -> Doc AnsiStyle@@ -924,6 +981,7 @@     Norwegian  -> "Kopierer #[" <> n <> "]"     Indonesia  -> "Menyalin #[" <> n <> "]"     Chinese    -> "正在复制 #[" <> n <> "]"+    Esperanto  -> "Kopianta #[" <> n <> "]"     _          -> "Copying #[" <> n <> "]"  cleanCache_2 :: Language -> Doc AnsiStyle@@ -942,6 +1000,7 @@     Norwegian  -> "Dette vil slette HELE pakke-cachen."     Indonesia  -> "Akan menghapus SEMUA `cache` paket"     Chinese    -> "这将会删除全部的包缓存。"+    Esperanto  -> "Ĉi tiu forigos la TUTAN kaŝmemoron de pakaĵoj."     _          -> "This will delete the ENTIRE package cache."  cleanCache_3 :: Word -> Language -> Doc AnsiStyle@@ -960,6 +1019,7 @@     Norwegian  -> s <> " av hver pakkefil blir beholdt."     Indonesia  -> s <> " berkas dari tiap paket akan disimpan."     Chinese    -> "每个包文件将会保存 " <> s <> " 个版本。"+    Esperanto  -> s <> " de ĉiu dosiero de pakaĵo teniĝos."     _          -> s <> " of each package file will be kept."  cleanCache_4 :: Language -> Doc AnsiStyle@@ -978,6 +1038,7 @@     Norwegian  -> "Resten vil bli slettet. Er det OK?"     Indonesia  -> "Selainnya akan dihapus. Ikhlas kan?"     Chinese    -> "其余的将会被删除。确定？"+    Esperanto  -> "La cetero foriĝos. Ĉu bone?"     _          -> "The rest will be deleted. Okay?"  cleanCache_5 :: Language -> Doc AnsiStyle@@ -996,6 +1057,7 @@     Norwegian  -> "Cache-rensing ble avbrutt manuelt."     Indonesia  -> "Pembersihan `cache` dibatalkan secara paksa."     Chinese    -> "手动清理缓存已中止。"+    Esperanto  -> "Puriganta Kaŝmemoro ĉesis permane."     _          -> "Cache cleaning manually aborted."  cleanCache_6 :: Language -> Doc AnsiStyle@@ -1014,6 +1076,7 @@     Norwegian  -> "Renser pakke-cache..."     Indonesia  -> "Membersihkan `cache` paket..."     Chinese    -> "正在清理包缓存..."+    Esperanto  -> "Purigas Kaŝmemoron de pakaĵoj..."     _          -> "Cleaning package cache..."  -- NEEDS TRANSLATION@@ -1032,6 +1095,7 @@     Indonesia  -> "Menentukan berkas paket yang tidak dibutuhkan..."     Chinese    -> "正在确定不需要的包文件..."     Swedish    -> "Beräknar onödiga paketfiler..."+    Esperanto  -> "Decidas nebezonajn dosierojn de pakaĵoj..."     _          -> "Determining unneeded package files..."  -- NEEDS TRANSLATION@@ -1050,6 +1114,7 @@     Indonesia  -> s <> " berkas paket yang tidak dibutuhkan ditemukan. Hapus?"     Chinese    -> "发现了 " <> s <> " 个不需要的包文件。是否删除？"     Swedish    -> s <> " oanvända paket hittades. Ta bort?"+    Esperanto  -> s <> " nebezonajn dosierojn de pakaĵoj trovis. Ĉu forigi"     _          -> s <> " unneeded package files found. Delete?"  ----------------------------@@ -1077,6 +1142,7 @@     Norwegian  -> "Følgende har ikke vist seg i loggen:"     Indonesia  -> "Tidak terlihat pada berkas log:"     Chinese    -> "这些没有在日志文件中出现："+    Esperanto  -> "Ĉi tiuj ne enestis la protokolajn dosierojn:"     _          -> "These have not appeared in the log file:"  -------------------------------@@ -1120,6 +1186,7 @@     Norwegian  -> "Utdatert!"     Indonesia  -> "Ketinggalan Zaman!"     Chinese    -> "过期！"+    Esperanto  -> "Neĝisdata!"     _          -> "Out of Date!" outOfDateMsg Nothing = green . \case     Japanese   -> "最新"@@ -1136,6 +1203,7 @@     Norwegian  -> "Oppdatert"     Indonesia  -> "Mutakhir"     Chinese    -> "最新"+    Esperanto  -> "Ĝisdata"     _          -> "Up to Date"  -- NEEDS TRANSLATION@@ -1154,6 +1222,7 @@     Indonesia  -> "Tak dipelihara!"     Chinese    -> "孤包！"     Swedish    -> "Föräldralös!"+    Esperanto  -> "Orfita!"     _          -> "Orphaned!"  -----------------------@@ -1176,6 +1245,7 @@     Indonesia  -> "Kondisi paket tersimpan."     Chinese    -> "已保存包状态。"     Swedish    -> "Det lokala pakettillståndet har sparats."+    Esperanto  -> "Konservita stato de pakaĵo."     _          -> "Saved package state."  -- NEEDS TRANSLATION@@ -1195,6 +1265,7 @@     Indonesia  -> "Versi yang diturunkan tidak tersedia untuk: "     Chinese    -> "请求的降级版本对以下包不可用："     Swedish    -> "Den begärda nedgraderingen finns inte tillgänglig för:"+    Esperanto  -> "Petitajn malpromociajn versiojn ne estas disponebla de:"     _          -> "Requested downgrade versions not available for:"  restoreState_2 :: Language -> Doc AnsiStyle@@ -1204,6 +1275,7 @@     Russian    -> "Нет сохраненных состояний для восстановления. (Используйте -B для сохранения текущего состояния)"     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)"     _          -> "No saved states to be restored. (Use -B to save the current state)"  -- NEEDS TRANSLATION@@ -1223,6 +1295,7 @@     Indonesia  -> "Tidak ada paket yang diubah."     Chinese    -> "没有包需要改变。"     Swedish    -> "Inga paket behöver ändras."+    Esperanto  -> "Ne pakaĵoj devas ŝanĝiĝi."     _          -> "No packages need changing."  --------------------------------------@@ -1232,6 +1305,7 @@ whoIsBuildUser_1 = \case     Portuguese -> "Não foi possível determinal o usuário que executará a compilação."     Russian    -> "Не удается определить, от имени какого пользователя производить сборку."+    Esperanto  -> "Ne povas decidi, per kiu konto de uzanto munti."     _          -> "Can't determine which user account to build with."  ------------------------@@ -1254,12 +1328,14 @@     Indonesia  -> "Mohon periksa masukan anda."     Chinese    -> "请检查你的输入。"     Swedish    -> "Var god dubbelkolla indata."+    Esperanto  -> "Bonvolu kontroli vian enigon."     _          -> "Please check your input."  confParsing_1 :: Language -> Doc AnsiStyle confParsing_1 = \case     Portuguese -> "Não foi possível interpretar o arquivo pacman.conf ."     Russian    -> "Не удается распознать формат вашего файла pacman.conf."+    Esperanto  -> "Ne kapablas sintaske analizi vian dosieron, pacman.conf."     _          -> "Unable to parse your pacman.conf file."  provides_1 :: PkgName -> Doc AnsiStyle@@ -1285,6 +1361,7 @@     Norwegian  -> "Vil du endre PKGBUILD for " <> p <> "?"     Indonesia  -> "Apakah anda ingin menyunting PKGBUILD untuk paket " <> p <> "?"     Chinese    -> "你希望编辑 " <> p <> " 的 PKGBUILD 文件吗？"+    Esperanto  -> "Ĉu vi volas redakti la PKGBUILD de " <> p <> "?"     _          -> "Would you like to edit the PKGBUILD of " <> p <> "?"  customizepkg_1 :: Language -> Doc AnsiStyle@@ -1302,6 +1379,7 @@     Indonesia  -> customizepkg <+> "tidak terinstal."     Chinese    -> customizepkg <+> " 没有被安装。"     Swedish    -> customizepkg <+> "är inte installerad"+    Esperanto  -> customizepkg <+> "ne estas instalita."     _          -> customizepkg <+> "isn't installed."  ------------------------------@@ -1361,6 +1439,7 @@     Portuguese -> "[S/n]"     French     -> "[O/n]"     Russian    -> "[Д/н]"+    Esperanto  -> "[J/n]"     _          -> "[Y/n]"  yesPattern :: Language -> [T.Text]@@ -1374,6 +1453,7 @@     Portuguese -> ["s", "sim"]     French     -> ["o", "oui"]     Russian    -> ["д", "да"]+    Esperanto  -> ["j", "jes"]     _          -> ["y", "yes"]  ----------------------

@@ -1,10 +1,11 @@-{-# LANGUAGE LambdaCase, OverloadedStrings #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK prune #-} {-# OPTIONS_GHC -fno-warn-missing-export-lists #-}  -- | -- Module    : Aura.Languages.Fields--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -32,6 +33,7 @@     Serbian    -> "Пакет"     Norwegian  -> "Pakke"     Indonesia  -> "Paket"+    Esperanto  -> "Pakaĵo"     _          -> "Package"  firstInstall :: Language -> T.Text@@ -49,6 +51,7 @@     Serbian    -> "Прва инсталација"     Norwegian  -> "Første installasjon"     Indonesia  -> "Versi sistem"+    Esperanto  -> "Unua Instalo"     _          -> "First Install"  upgrades :: Language -> T.Text@@ -66,6 +69,7 @@     Serbian    -> "Ажурирања"     Norwegian  -> "Oppgraderinger"     Indonesia  -> "Tingkatkan"+    Esperanto  -> "Noveldonoj"     _          -> "Upgrades"  recentActions :: Language -> T.Text@@ -83,6 +87,7 @@     Serbian    -> "Недавне радње"     Norwegian  -> "Nylige hendelser"     Indonesia  -> "Aksi sekarang"+    Esperanto  -> "Ĵusaj Agoj"     _          -> "Recent Actions"  repository :: Language -> T.Text@@ -100,6 +105,7 @@     Serbian    -> "Ризница"     Norwegian  -> "Depot"     Indonesia  -> "Lumbung"+    Esperanto  -> "Deponejo"     _          -> "Repository"  name :: Language -> T.Text@@ -117,6 +123,7 @@     Serbian    -> "Име"     Norwegian  -> "Navn"     Indonesia  -> "Nama"+    Esperanto  -> "Nomo"     _          -> "Name"  version :: Language -> T.Text@@ -134,6 +141,7 @@     Serbian    -> "Верзија"     Norwegian  -> "Versjon"     Indonesia  -> "Versi"+    Esperanto  -> "Versio"     _          -> "Version"  aurStatus :: Language -> T.Text@@ -149,6 +157,7 @@     Italian    -> "Stato in AUR"     Serbian    -> "Статус у AUR-у"     Indonesia  -> "Status AUR"+    Esperanto  -> "Stato en AUR"     _          -> "AUR Status"  -- NEEDS TRANSLATION@@ -161,6 +170,7 @@     Russian    -> "Ответственный"     Norwegian  -> "Vedlikeholder"     Indonesia  -> "Pemelihara"+    Esperanto  -> "Daŭriganto"     _          -> "Maintainer"  projectUrl :: Language -> T.Text@@ -178,6 +188,7 @@     Serbian    -> "Страница пројекта"     Norwegian  -> "Prosjekt-URL"     Indonesia  -> "URL Proyek"+    Esperanto  -> "URL de Projekto"     _          -> "Project URL"  aurUrl :: Language -> T.Text@@ -192,6 +203,7 @@     Italian    -> "URL AUR"     Serbian    -> "Страница у AUR-у"     Indonesia  -> "URL AUR"+    Esperanto  -> "URL en AUR"     _          -> "AUR URL"  license :: Language -> T.Text@@ -209,6 +221,7 @@     Serbian    -> "Лиценца"     Norwegian  -> "Lisens"     Indonesia  -> "Lisensi"+    Esperanto  -> "Permesilo"     _          -> "License"  dependsOn :: Language -> T.Text@@ -224,6 +237,7 @@     Italian    -> "Dipende da"     Norwegian  -> "Er avhengig av"     Indonesia  -> "Bergantung pada"+    Esperanto  -> "Dependi de"     _          -> "Depends On"  buildDeps :: Language -> T.Text@@ -235,6 +249,7 @@     French     -> "Dépendances de compilation"     Russian    -> "Зависимости сборки"     Indonesia  -> "Dependensi bangun"+    Esperanto  -> "Muntaj Dependecoj"     _          -> "Build Deps"  votes :: Language -> T.Text@@ -252,12 +267,14 @@     Serbian    -> "Гласови"     Norwegian  -> "Stemmer"     Indonesia  -> "Suara"+    Esperanto  -> "Balotiloj"     _          -> "Votes"  popularity :: Language -> T.Text popularity = \case     Japanese   -> "人気"     Portuguese -> "Popularidade"+    Esperanto  -> "Populareco"     _          -> "Popularity"  description :: Language -> T.Text@@ -275,6 +292,7 @@     Serbian    -> "Опис"     Norwegian  -> "Beskrivelse"     Indonesia  -> "Deskripsi"+    Esperanto  -> "Priskribo"     _          -> "Description"  makeDeps :: Language -> T.Text@@ -287,4 +305,5 @@     French     -> "Dépendances de compilation"     Russian    -> "Зависимости Make"     Indonesia  -> "Dependensi bangun"+    Esperanto  -> "Make Dependecoj"     _          -> "Make Deps"

@@ -2,7 +2,7 @@  -- | -- Module    : Aura.Logo--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -10,7 +10,7 @@  module Aura.Logo ( animateVersionMsg ) where -import           Aura.Colour (yellow, dtot)+import           Aura.Colour (dtot, yellow) import           Aura.Languages (translatorMsg) import           Aura.Pacman (verMsgPad) import           Aura.Settings@@ -19,7 +19,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import           Data.Text.Prettyprint.Doc-import           System.IO (stdout, hFlush)+import           System.IO (hFlush, stdout)  --- @@ -29,7 +29,7 @@ animateVersionMsg ss auraVersion verMsg = do   when (isTerminal ss) $ do     hideCursor-    traverse_ (T.putStrLn . padString (fromIntegral verMsgPad)) verMsg  -- Version message+    traverse_ (T.putStrLn . padString verMsgPad) verMsg  -- Version message     raiseCursorBy 7  -- Initial reraising of the cursor.     drawPills 3     traverse_ T.putStrLn $ renderPacmanHead ss 0 Open  -- Initial rendering of head.

@@ -1,8 +1,9 @@-{-# LANGUAGE OverloadedStrings, TupleSections #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections     #-}  -- | -- Module    : Aura.State--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -17,16 +18,17 @@ import           Aura.Languages import           Aura.Settings import           Aura.Types-import           Aura.Utils (strictText, optionalPrompt)+import           Aura.Utils (optionalPrompt, strictText) import           BasePrelude import           Control.Error.Util (note) import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.List.NonEmpty as NEL-import           Data.Set.NonEmpty (NonEmptySet)+import           Data.Set.NonEmpty (NESet) import qualified Data.Set.NonEmpty as NES import qualified Data.Text as T import           Lens.Micro ((^.), _2)-import           System.Path (Path, Absolute, fromAbsoluteFilePath, (</>), toFilePath)+import           System.Path+    (Absolute, Path, fromAbsoluteFilePath, toFilePath, (</>)) import           System.Path.IO (getCurrentDirectory, getDirectoryContents) import           System.Process.Typed @@ -41,19 +43,20 @@  -- | Given the current user name, build the package of whatever -- directory we're in.-makepkg :: Settings -> User -> IO (Either Failure (NonEmptySet (Path Absolute)))+makepkg :: Settings -> User -> IO (Either Failure (NESet (Path Absolute))) makepkg ss usr = make ss usr (proc cmd $ opts <> colour) >>= g-  where (cmd, opts) = runStyle usr . foldMap asFlag . makepkgFlagsOf $ buildConfigOf ss-        g (ExitSuccess, _, fs)   = pure . note (Failure buildFail_9) . fmap NES.fromNonEmpty $ NEL.nonEmpty fs-        g (ExitFailure _, se, _) = do-          unless (switch ss DontSuppressMakepkg) $ do-            showError <- optionalPrompt ss buildFail_11-            when showError $ BL.putStrLn se-          pure . Left $ Failure buildFail_8-        colour | shared ss (Colour Never)  = ["--nocolor"]-               | shared ss (Colour Always) = []-               | isTerminal ss = []-               | otherwise = ["--nocolor"]+  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 (ExitFailure _, se, _) = do+      unless (switch ss DontSuppressMakepkg) $ do+        showError <- optionalPrompt ss buildFail_11+        when showError $ BL.putStrLn se+      pure . Left $ Failure buildFail_8+    colour | shared ss (Colour Never)  = ["--nocolor"]+           | shared ss (Colour Always) = []+           | isTerminal ss = []+           | otherwise = ["--nocolor"]  -- | Actually build the package, guarding on exceptions. -- Yields the filepaths of the built package tarballs.@@ -71,7 +74,7 @@ -- | Make a source package. See `man makepkg` and grep for `--allsource`. makepkgSource :: User -> IO [Path Absolute] makepkgSource usr = do-  runProcess $ proc cmd opts+  void . runProcess $ proc cmd opts   pwd <- getCurrentDirectory   filter (T.isSuffixOf ".src.tar.gz" . T.pack . toFilePath) . map (pwd </>) <$> getDirectoryContents pwd     where (cmd, opts) = runStyle usr ["--allsource"]

@@ -1,14 +1,19 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts, TypeApplications, MonoLocalBinds, DataKinds #-}+{-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE DataKinds             #-} {-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MonoLocalBinds        #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE TypeApplications      #-}  -- | -- Module    : Aura.Packages.AUR--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> ----- Module for connecting to the AUR servers, downloading PKGBUILDs and package sources.+-- Module for connecting to the AUR servers, downloading PKGBUILDs and package+-- sources.  module Aura.Packages.AUR   ( -- * Batch Querying@@ -28,22 +33,25 @@ import           Aura.Settings import           Aura.Types import           BasePrelude hiding (head)-import           Control.Concurrent.STM.TQueue-import           Control.Concurrent.Throttled (throttle)-import           Control.Error.Util (hush)-import           Control.Monad.Freer-import           Control.Monad.Freer.Error-import           Control.Monad.Freer.Reader+import           Control.Compactable (fmapEither)+import           Control.Concurrent.STM.TVar (modifyTVar')+import           Control.Error.Util (hush, note)+import           Control.Effect (Carrier, Member)+import           Control.Effect.Error (Error)+import           Control.Effect.Lift (Lift, sendM)+import           Control.Effect.Reader (Reader, asks) import           Control.Monad.Trans.Class (lift) import           Control.Monad.Trans.Maybe+import           Control.Scheduler (Comp(..), traverseConcurrently) import           Data.Generics.Product (field)-import           Data.List.NonEmpty (head)+import qualified Data.List.NonEmpty as NEL+import qualified Data.Map.Strict as M import qualified Data.Set as S-import           Data.Set.NonEmpty (NonEmptySet)+import           Data.Set.NonEmpty (NESet) import qualified Data.Set.NonEmpty as NES import qualified Data.Text as T import           Data.Versions (versioning)-import           Lens.Micro ((^.), (^..), each, to)+import           Lens.Micro (each, non, to, (^.), (^..)) import           Linux.Arch.Aur import           Network.HTTP.Client (Manager) import           System.Path@@ -53,20 +61,39 @@ ---  -- | Attempt to retrieve info about a given `S.Set` of packages from the AUR.-aurLookup :: Manager -> NonEmptySet PkgName -> IO (Maybe (S.Set PkgName, S.Set Buildable))-aurLookup m names = runMaybeT $ MaybeT (info m (foldMap (\(PkgName pn) -> [pn]) names)) >>= \infos -> do-  badsgoods <- lift $ throttle (\_ a -> buildable m a) infos >>= atomically . flushTQueue+aurLookup :: Manager -> NESet PkgName -> IO (Maybe (S.Set PkgName, S.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)  -- | Yield fully realized `Package`s from the AUR.-aurRepo :: Repository-aurRepo = Repository $ \ss ps -> runMaybeT $ do-  (bads, goods) <- MaybeT $ aurLookup (managerOf ss) ps-  pkgs <- lift . traverse (packageBuildable ss) $ toList goods-  pure (bads, S.fromList pkgs)+aurRepo :: IO Repository+aurRepo = do+  tv <- newTVarIO mempty +  -- 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 (S.Set PkgName, S.Set Package))+      f ss ps = do+        --- Retrieve cached Packages ---+        cache <- readTVarIO tv+        let (uncached, cached) = fmapEither (\p -> note p $ M.lookup p cache) $ toList ps+        --- Lookup uncached Packages ---+        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'+            pkgs <- lift . traverse (packageBuildable ss) $ toList goods+            --- Update Cache ---+            let m = M.fromList $ map (pname &&& id) pkgs+            liftIO . atomically $ modifyTVar' tv (<> m)+            pure (bads, S.fromList $ cached <> pkgs)++  pure $ Repository tv f+ buildable :: Manager -> AurInfo -> IO (Either PkgName Buildable) buildable m ai = do   let !bse = PkgName $ pkgBaseOf ai@@ -78,11 +105,11 @@       { name     = PkgName $ aurNameOf ai       , version  = ver       , base     = bse-      , provides = list (Provides $ aurNameOf ai) (Provides . head) $ providesOf ai-      -- 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").+      , provides = 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 }@@ -121,15 +148,17 @@                      _ -> \x y -> compare (aurVotesOf y) (aurVotesOf x)  -- | Frontend to the `aur` library. For @-As@.-aurSearch :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => T.Text -> Eff r [AurInfo]+aurSearch :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  T.Text -> m [AurInfo] aurSearch regex = do-  ss  <- ask-  res <- liftMaybeM (Failure connectionFailure_1) $ search (managerOf ss) regex+  ss  <- asks settings+  res <- liftMaybeM (Failure connectionFailure_1) . fmap hush . sendM $ search (managerOf ss) regex   pure $ sortAurInfo (bool Nothing (Just SortAlphabetically) $ switch ss SortAlphabetically) res  -- | Frontend to the `aur` library. For @-Ai@.-aurInfo :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => NonEmpty PkgName -> Eff r [AurInfo]+aurInfo :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  NonEmpty PkgName -> m [AurInfo] aurInfo pkgs = do-  m   <- asks managerOf-  res <- liftMaybeM (Failure connectionFailure_1) . info m . map (^. field @"name") $ toList pkgs+  m   <- asks (managerOf . settings)+  res <- liftMaybeM (Failure connectionFailure_1) . fmap hush . sendM . info m . map (^. field @"name") $ toList pkgs   pure $ sortAurInfo (Just SortAlphabetically) res

@@ -1,9 +1,12 @@-{-# LANGUAGE OverloadedStrings, TupleSections, DuplicateRecordFields #-}-{-# LANGUAGE TypeApplications, DataKinds #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE TupleSections         #-}+{-# LANGUAGE TypeApplications      #-}  -- | -- Module    : Aura.Packages.Repository--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -16,18 +19,20 @@  import           Aura.Core import           Aura.Languages (provides_1)-import           Aura.Pacman (pacmanOutput)-import           Aura.Settings (Settings, CommonSwitch(..), shared)+import           Aura.Pacman (pacmanLines, pacmanOutput)+import           Aura.Settings (CommonSwitch(..), Settings, shared) import           Aura.Types import           Aura.Utils (getSelection, strictText) import           BasePrelude hiding (try)+import           Control.Compactable (fmapEither) import           Control.Compactable (traverseEither)-import           Control.Concurrent.STM.TQueue-import           Control.Concurrent.Throttled (throttle)+import           Control.Concurrent.STM.TVar (modifyTVar') import           Control.Error.Util (hush, note)-import qualified Data.ByteString.Lazy.Char8 as BL+import           Control.Scheduler (Comp(..), traverseConcurrently) import           Data.Generics.Product (field)+import qualified Data.Map.Strict as M import qualified Data.Set as S+import qualified Data.Set.NonEmpty as NES import qualified Data.Text as T import           Data.Versions import           Lens.Micro ((^.))@@ -38,14 +43,28 @@  -- | Repository package source. -- We expect no matches to be found when the package is actually an AUR package.-pacmanRepo :: Repository-pacmanRepo = Repository $ \ss names -> do-  bgs <- throttle (const $ resolveName ss) names >>= atomically . flushTQueue-  let (bads, goods) = partitionEithers bgs-  (bads', goods') <- traverseEither f goods-  pure $ Just (S.fromList $ bads <> bads', S.fromList goods')-  where f (r, p) = fmap (FromRepo . packageRepo r p) <$> mostRecentVersion r+pacmanRepo :: IO Repository+pacmanRepo = do+  tv <- newTVarIO mempty +  let g :: Settings -> NES.NESet PkgName -> IO (Maybe (S.Set PkgName, S.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+        let (bads, goods) = partitionEithers bgs+        (bads', goods') <- traverseEither f goods  -- TODO Should also be made concurrent?+        --- Update Cache ---+        let m = M.fromList $ map (pname &&& id) goods'+        atomically $ modifyTVar' tv (<> m)+        pure $ Just (S.fromList $ bads <> bads', S.fromList $ cached <> goods')++  pure $ Repository tv g+  where+    f (r, p) = fmap (FromRepo . packageRepo r p) <$> mostRecent r+ packageRepo :: PkgName -> Provides -> Versioning -> Prebuilt packageRepo pn pro ver = Prebuilt { name     = pn                                   , version  = ver@@ -57,10 +76,10 @@ -- | 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 . strictText) . BL.lines <$> pacmanOutput ["-Ssq", "^" <> T.unpack (pn ^. field @"name") <> "$"]+  provs <- map PkgName <$> pacmanLines ["-Ssq", "^" <> (pn ^. field @"name") <> "$"]   case provs of     [] -> pure $ Left pn-    _  -> Right . (, Provides $ pn ^. field @"name") <$> chooseProvider ss pn provs+    _  -> Right . (, Provides pn) <$> chooseProvider ss pn provs  -- | Choose a providing package, favoring installed packages. -- If `--noconfirm` is provided, it will try to automatically select the provider@@ -70,21 +89,22 @@ chooseProvider _ pn []         = pure pn chooseProvider _ _ [p]         = pure p chooseProvider ss pn ps@(a:as) =-  throttle (const isInstalled) ps >>= atomically . flushTQueue >>= maybe f pure . listToMaybe . catMaybes-  where f | shared ss NoConfirm = pure . bool a pn $ pn `elem` ps-          | otherwise = warn ss (provides_1 pn) >> getSelection (^. field @"name") (a :| as)+  traverseConcurrently Par' isInstalled ps >>= maybe f pure . listToMaybe . catMaybes+  where+    f | shared ss NoConfirm = pure . bool a pn $ pn `elem` ps+      | otherwise = warn ss (provides_1 pn) >> getSelection (^. field @"name") (a :| as)  -- | The most recent version of a package, if it exists in the respositories.-mostRecentVersion :: PkgName -> IO (Either PkgName Versioning)-mostRecentVersion p@(PkgName s) = note p . extractVersion . strictText <$> pacmanOutput ["-Si", T.unpack s]+mostRecent :: PkgName -> IO (Either PkgName Versioning)+mostRecent p@(PkgName s) = note p . extractVersion . strictText <$> pacmanOutput ["-Si", s]  -- | Parses the version number of a package from the result of a -- @pacman -Si@ call. extractVersion :: T.Text -> Maybe Versioning extractVersion = hush . parse p "extractVersion"   where p = do-          takeWhile1P Nothing (/= '\n') *> newline-          takeWhile1P Nothing (/= '\n') *> newline+          void $ takeWhile1P Nothing (/= '\n') *> newline+          void $ takeWhile1P Nothing (/= '\n') *> newline           string "Version" *> space1 *> char ':' *> space1 *> v         v = choice [ try (fmap Ideal semver'    <* string "Description")                    , try (fmap General version' <* string "Description")

@@ -1,9 +1,12 @@-{-# LANGUAGE MultiWayIf, OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts, MonoLocalBinds #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE MonoLocalBinds    #-}+{-# LANGUAGE MultiWayIf        #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns      #-}  -- | -- Module    : Aura.Pacman--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -13,7 +16,7 @@ module Aura.Pacman   ( -- * Calling Pacman     pacman-  , pacmanOutput, pacmanSuccess+  , pacmanOutput, pacmanSuccess, pacmanLines     -- * Paths   , lockFile   , pacmanConfFile@@ -26,7 +29,7 @@   , getIgnoredPkgs, getIgnoredGroups   , groupPackages     -- * Misc.-  , getVersionInfo+  , versionInfo   , verMsgPad   ) where @@ -37,8 +40,9 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.Map.Strict as M+import           Data.Set (Set) import qualified Data.Set as S-import           Data.Set.NonEmpty (NonEmptySet)+import           Data.Set.NonEmpty (NESet) import qualified Data.Text as T import           Data.Text.Encoding (decodeUtf8With) import           Data.Text.Encoding.Error (lenientDecode)@@ -46,9 +50,9 @@ import qualified Data.Text.Lazy.Encoding as TL import           Lens.Micro import           Lens.Micro.GHC ()-import           System.Path (Path, Absolute, fromAbsoluteFilePath, toFilePath)+import           System.Path (Absolute, Path, fromAbsoluteFilePath, toFilePath) import           System.Process.Typed-import           Text.Megaparsec+import           Text.Megaparsec hiding (single) import           Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L @@ -68,7 +72,7 @@ pair = L.lexeme garbage $ do   n <- takeWhile1P Nothing (/= ' ')   space-  char '='+  void $ char '='   space   rest <- T.words <$> takeWhile1P Nothing (/= '\n')   pure (n, rest)@@ -96,18 +100,21 @@   pure . first (const (Failure confParsing_1)) $ parse config "pacman config" file  -- | Fetches the @IgnorePkg@ entry from the config, if it's there.-getIgnoredPkgs :: Config -> S.Set PkgName+getIgnoredPkgs :: Config -> Set PkgName getIgnoredPkgs (Config c) = maybe S.empty (S.fromList . map PkgName) $ M.lookup "IgnorePkg" c  -- | Fetches the @IgnoreGroup@ entry from the config, if it's there.-getIgnoredGroups :: Config -> S.Set PkgGroup+getIgnoredGroups :: Config -> Set PkgGroup 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 :: NonEmptySet PkgGroup -> IO (S.Set PkgName)-groupPackages igs | null igs  = pure S.empty-                  | otherwise = fmap f . pacmanOutput $ "-Qg" : asFlag igs-  where f = S.fromList . map (PkgName . strictText . (!! 1) . BL.words) . BL.lines+groupPackages :: NESet PkgGroup -> IO (Set PkgName)+groupPackages igs+  | null igs  = pure S.empty+  | otherwise = fmap f . pacmanOutput $ "-Qg" : asFlag igs+  where+    f :: BL.ByteString -> Set PkgName+    f = S.fromList . map (PkgName . strictText . (!! 1) . BL.words) . BL.lines  -- | Fetches the @CacheDir@ entry from the config, if it's there. getCachePath :: Config -> Maybe (Path Absolute)@@ -121,25 +128,27 @@ -- ACTIONS ---------- -- | Run a pacman action that may fail. Will never throw an IO exception.-pacman :: [String] -> IO (Either Failure ())-pacman args = do+pacman :: [T.Text] -> IO (Either Failure ())+pacman (map T.unpack -> args) = do   ec <- runProcess $ proc "pacman" args   pure . bool (Left $ Failure pacmanFailure_1) (Right ()) $ ec == ExitSuccess  -- | Run some `pacman` process, but only care about whether it succeeded.-pacmanSuccess :: [String] -> IO Bool-pacmanSuccess = fmap (== ExitSuccess) . runProcess . setStderr closed . setStdout closed . proc "pacman"+pacmanSuccess :: [T.Text] -> IO Bool+pacmanSuccess = fmap (== ExitSuccess) . runProcess . setStderr closed . setStdout closed . proc "pacman" . map T.unpack  -- | Runs pacman silently and returns only the stdout.-pacmanOutput :: [String] -> IO BL.ByteString-pacmanOutput = fmap (^. _2) . readProcess . proc "pacman"+pacmanOutput :: [T.Text] -> IO BL.ByteString+pacmanOutput = fmap (^. _2) . readProcess . proc "pacman" . map T.unpack +-- | Runs pacman silently and returns the stdout as UTF8-decoded `Text` lines.+pacmanLines :: [T.Text] -> IO [T.Text]+pacmanLines s = T.lines . TL.toStrict . TL.decodeUtf8With lenientDecode <$> pacmanOutput s+ -- | Yields the lines given by `pacman -V` with the pacman image stripped.-getVersionInfo :: IO [T.Text]-getVersionInfo = do-  out <- pacmanOutput ["-V"]-  pure . map (TL.toStrict . TL.drop verMsgPad . TL.decodeUtf8With lenientDecode) $ BL.lines out+versionInfo :: IO [T.Text]+versionInfo = map (T.drop verMsgPad) <$> pacmanLines ["-V"]  -- | The amount of whitespace before text in the lines given by `pacman -V`-verMsgPad :: Int64+verMsgPad :: Int verMsgPad = 23

@@ -2,7 +2,7 @@  -- | -- Module    : Aura.Pkgbuild.Base--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> @@ -14,7 +14,8 @@  import           Aura.Types import qualified Data.Text as T-import           System.Path (Path, Absolute, FileExt(..), fromAbsoluteFilePath, fromUnrootedFilePath, (</>), (<.>))+import           System.Path (Absolute, FileExt(..), Path, fromAbsoluteFilePath,+                              fromUnrootedFilePath, (<.>), (</>))  --- 

@@ -1,9 +1,10 @@+{-# LANGUAGE DataKinds         #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications, DataKinds #-}+{-# LANGUAGE TypeApplications  #-}  -- | -- Module    : Aura.Pkgbuild.Base--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -18,11 +19,11 @@ import           BasePrelude import qualified Data.ByteString.Lazy.Char8 as BL import           Data.Generics.Product (field)-import           Lens.Micro ((^.), (.~))+import           Lens.Micro ((.~), (^.)) import           System.Directory (setCurrentDirectory) import           System.Path (toFilePath) import           System.Path.IO (getCurrentDirectory, getTemporaryDirectory)-import           System.Process.Typed (runProcess, proc)+import           System.Process.Typed (proc, runProcess)  --- 

@@ -1,10 +1,11 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications, DataKinds #-}+{-# LANGUAGE TypeApplications    #-}  -- | -- Module    : Aura.State--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -19,7 +20,6 @@ import           Aura.Utils (urlContents) import           BasePrelude import           Control.Exception (SomeException, catch)-import           Control.Monad.Trans (MonadIO, liftIO) import           Data.Generics.Product (field) import qualified Data.Text as T import           Lens.Micro ((^.))

@@ -1,8 +1,9 @@-{-# LANGUAGE TypeApplications, DataKinds #-}+{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE TypeApplications #-}  -- | -- Module    : Aura.Pkgbuild.Records--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -18,10 +19,10 @@ import           BasePrelude import qualified Data.ByteString.Lazy.Char8 as BL import           Data.Generics.Product (field)-import           Data.Set.NonEmpty (NonEmptySet)+import           Data.Set.NonEmpty (NESet) import           Lens.Micro ((^.)) import           System.Path (toFilePath)-import           System.Path.IO (doesFileExist, createDirectoryIfMissing)+import           System.Path.IO (createDirectoryIfMissing, doesFileExist)  --- @@ -31,7 +32,7 @@ hasPkgbuildStored = doesFileExist . pkgbuildPath  -- | Write the PKGBUILDs of some `Buildable`s to disk.-storePkgbuilds :: NonEmptySet Buildable -> IO ()+storePkgbuilds :: NESet Buildable -> IO () storePkgbuilds bs = do   createDirectoryIfMissing True pkgbuildCache   traverse_ (\p -> writePkgbuild (p ^. field @"name") (p ^. field @"pkgbuild")) bs

@@ -1,8 +1,11 @@-{-# LANGUAGE OverloadedStrings, TupleSections, TypeApplications, DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections     #-}+{-# LANGUAGE TypeApplications  #-}  -- | -- Module    : Aura.Pkgbuild.Security--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -15,7 +18,7 @@   ) where  import           Aura.Languages-import           Aura.Types (Pkgbuild(..), Language)+import           Aura.Types (Language, Pkgbuild(..)) import           Aura.Utils (strictText) import           BasePrelude hiding (Last, Word) import           Control.Error.Util (hush)@@ -26,7 +29,7 @@ import           Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle) import           Language.Bash.Parse (parse) import           Language.Bash.Syntax-import           Language.Bash.Word (Word, unquote, Span(..))+import           Language.Bash.Word (Span(..), Word, unquote) import           Lens.Micro  ---

@@ -1,9 +1,9 @@+{-# LANGUAGE DeriveGeneric     #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DeriveGeneric #-}  -- | -- Module    : Aura.Settings--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -27,8 +27,9 @@ import           Aura.Types import           BasePrelude import qualified Data.Set as S+import qualified Data.Text as T import           Network.HTTP.Client (Manager)-import           System.Path (Path, Absolute, toFilePath, fromAbsoluteFilePath)+import           System.Path (Absolute, Path, fromAbsoluteFilePath, toFilePath)  --- @@ -46,27 +47,28 @@ -- | Flags that are common to both Aura and Pacman. -- 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))-                                 , commonSwitchesOf :: !(S.Set CommonSwitch) } deriving (Show, Generic)+data CommonConfig = CommonConfig+  { cachePathOf      :: !(Either (Path Absolute) (Path Absolute))+  , configPathOf     :: !(Either (Path Absolute) (Path Absolute))+  , logPathOf        :: !(Either (Path Absolute) (Path Absolute))+  , commonSwitchesOf :: !(S.Set CommonSwitch) } deriving (Show, Generic)  instance Flagable CommonConfig where   asFlag (CommonConfig cap cop lfp cs) =-    either (const []) (\p -> ["--cachedir", toFilePath p]) cap-    ++ either (const []) (\p -> ["--config", toFilePath p]) cop-    ++ either (const []) (\p -> ["--logfile", toFilePath p]) lfp-    ++ asFlag 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+    <> asFlag cs  -- | Yes/No-style switches that are common to both Aura and Pacman. -- Aura acts on them first, then passes them down to @pacman@ if necessary. data CommonSwitch = NoConfirm | NeededOnly | Debug | Colour ColourMode deriving (Eq, Ord, Show)  instance Flagable CommonSwitch where-  asFlag NoConfirm    = ["--noconfirm"]-  asFlag NeededOnly   = ["--needed"]-  asFlag Debug        = ["--debug"]-  asFlag (Colour m)   = "--color" : asFlag m+  asFlag NoConfirm  = ["--noconfirm"]+  asFlag NeededOnly = ["--needed"]+  asFlag Debug      = ["--debug"]+  asFlag (Colour m) = "--color" : asFlag m  -- | Matches Pacman's colour options. `Auto` will ensure that text will only be coloured -- when the output target is a terminal.@@ -78,11 +80,12 @@   asFlag Auto   = ["auto"]  -- | Settings unique to the AUR package building process.-data BuildConfig = BuildConfig { makepkgFlagsOf  :: !(S.Set Makepkg)-                               , buildPathOf     :: !(Path Absolute)-                               , buildUserOf     :: !(Maybe User)-                               , truncationOf    :: !Truncation  -- For `-As`-                               , buildSwitchesOf :: !(S.Set BuildSwitch) } deriving (Show)+data BuildConfig = BuildConfig+  { makepkgFlagsOf  :: !(S.Set Makepkg)+  , buildPathOf     :: !(Path Absolute)+  , buildUserOf     :: !(Maybe User)+  , truncationOf    :: !Truncation  -- For `-As`+  , buildSwitchesOf :: !(S.Set BuildSwitch) } deriving (Show)  -- | Extra options for customizing the build process. data BuildSwitch = DeleteMakeDeps@@ -107,14 +110,15 @@ shared ss c = S.member c . commonSwitchesOf $ commonConfigOf ss  -- | The global settings as set by the user with command-line flags.-data Settings = Settings { managerOf      :: !Manager-                         , envOf          :: !Environment-                         , langOf         :: !Language-                         , editorOf       :: !FilePath-                         , isTerminal     :: !Bool-                         , ignoresOf      :: !(S.Set PkgName)-                         , commonConfigOf :: !CommonConfig-                         , buildConfigOf  :: !BuildConfig }+data Settings = Settings+  { managerOf      :: !Manager+  , envOf          :: !Environment+  , langOf         :: !Language+  , editorOf       :: !FilePath+  , isTerminal     :: !Bool+  , ignoresOf      :: !(S.Set PkgName)+  , commonConfigOf :: !CommonConfig+  , buildConfigOf  :: !BuildConfig }  -- | Unless otherwise specified, packages will be built within @/tmp@. defaultBuildDir :: Path Absolute

@@ -1,9 +1,12 @@+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE MonoLocalBinds    #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts, TypeApplications, MonoLocalBinds, DataKinds #-}+{-# LANGUAGE TypeApplications  #-}  -- | -- Module    : Aura.State--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -21,17 +24,19 @@  import           Aura.Cache import           Aura.Colour (red)-import           Aura.Core (warn, notify, liftEitherM, report)+import           Aura.Core (Env(..), liftEitherM, notify, report, warn) import           Aura.Languages-import           Aura.Pacman (pacmanOutput, pacman)+import           Aura.Pacman (pacman, pacmanOutput) import           Aura.Settings import           Aura.Types import           Aura.Utils-import           BasePrelude hiding (Version, mapMaybe)+import           BasePrelude hiding (Version)+import           Control.Compactable (fmapMaybe)+import           Control.Effect (Carrier, Member)+import           Control.Effect.Error (Error, throwError)+import           Control.Effect.Lift (Lift, sendM)+import           Control.Effect.Reader (Reader, asks) import           Control.Error.Util (hush)-import           Control.Monad.Freer-import           Control.Monad.Freer.Error-import           Control.Monad.Freer.Reader import           Data.Aeson import           Data.Aeson.Types (typeMismatch) import qualified Data.ByteString.Lazy as BL@@ -42,7 +47,6 @@ import qualified Data.Text as T import           Data.Time import           Data.Versions-import           Data.Witherable (mapMaybe) import           Lens.Micro ((^.)) import           System.Path import           System.Path.IO (createDirectoryIfMissing, getDirectoryContents)@@ -61,7 +65,7 @@     <$> v .: "time"     <*> v .: "pinned"     <*> fmap f (v .: "packages")-    where f = mapMaybe (hush . versioning)+    where f = fmapMaybe (hush . versioning)   parseJSON invalid = typeMismatch "PkgState" invalid  data StateDiff = StateDiff { _toAlter :: [SimplePkg], _toRemove :: [PkgName] }@@ -128,17 +132,19 @@           mnths = [ "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ]  -- | Does its best to restore a state chosen by the user.-restoreState :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) => Eff r ()-restoreState = send getStateFiles >>= maybe (throwError $ Failure restoreState_2) f . nonEmpty-  where f sfs = do-          ss  <- ask+restoreState :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) => m ()+restoreState =+  sendM getStateFiles >>= maybe (throwError $ Failure restoreState_2) f . nonEmpty+  where f :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) => NonEmpty (Path Absolute) -> m ()+        f sfs = do+          ss  <- asks settings           let pth = either id id . cachePathOf $ commonConfigOf ss-          mpast  <- send $ selectState sfs >>= readState+          mpast  <- sendM $ selectState sfs >>= readState           case mpast of             Nothing   -> throwError $ Failure readState_1             Just past -> do-              curr <- send currentState-              Cache cache <- send $ cacheContents pth+              curr <- sendM currentState+              Cache cache <- sendM $ cacheContents pth               let StateDiff rein remo = compareStates past curr                   (okay, nope)        = partition (`M.member` cache) rein               traverse_ (report red restoreState_1 . fmap (^. field @"name")) $ nonEmpty nope@@ -153,12 +159,14 @@ readState = fmap decode . BL.readFile . toFilePath  -- | `reinstalling` can mean true reinstalling, or just altering.-reinstallAndRemove :: (Member (Reader Settings) r, Member (Error Failure) r, Member IO r) =>-  [PackagePath] -> [PkgName] -> Eff r ()-reinstallAndRemove [] [] = ask >>= \ss -> send (warn ss . reinstallAndRemove_1 $ langOf ss)+reinstallAndRemove :: (Carrier sig m, Member (Reader Env) sig, Member (Error Failure) sig, Member (Lift IO) sig) =>+  [PackagePath] -> [PkgName] -> m ()+reinstallAndRemove [] [] = asks settings >>= \ss ->+  sendM (warn ss . reinstallAndRemove_1 $ langOf ss) reinstallAndRemove down remo   | null remo = reinstall   | null down = remove   | otherwise = reinstall *> remove-  where remove    = liftEitherM . pacman $ "-R" : asFlag remo-        reinstall = liftEitherM . pacman $ "-U" : map (toFilePath . path) down+  where+    remove    = liftEitherM . sendM . pacman $ "-R" : asFlag remo+    reinstall = liftEitherM . sendM . pacman $ "-U" : map (T.pack . toFilePath . path) down

@@ -1,12 +1,19 @@-{-# LANGUAGE OverloadedStrings, MultiWayIf #-}-{-# LANGUAGE DataKinds, TypeApplications, DuplicateRecordFields #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE DerivingStrategies, GeneralizedNewtypeDeriving, DeriveGeneric #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE DuplicateRecordFields      #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE MultiWayIf                 #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TypeApplications           #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}+ -- | -- Module    : Aura.Types--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -14,8 +21,8 @@  module Aura.Types   ( -- * Package Types-    Package(..), pname, pprov, pver-  , Dep(..), parseDep+    Package(..), pname, pprov, pver, dividePkgs+  , Dep(..), parseDep, renderedDep   , Buildable(..)   , Prebuilt(..)   , SimplePkg(..), simplepkg, simplepkg'@@ -35,27 +42,28 @@   , Provides(..)   , PackagePath(..)   , Pkgbuild(..)-  , Environment(..)+  , Environment   , User(..)-    -- * Misc.-  , list   ) where  import           BasePrelude hiding (try) import           Control.Error.Util (hush)-import           Data.Aeson (ToJSONKey, FromJSONKey)+import           Data.Aeson (FromJSONKey, ToJSONKey) import           Data.Bitraversable import qualified Data.ByteString.Lazy as BL import           Data.Generics.Product (field, super)-import           Data.List.NonEmpty (nonEmpty) import qualified Data.Map.Strict as M+import           Data.Semigroup.Foldable (Foldable1(..))+import           Data.Set.NonEmpty (NESet)+import qualified Data.Set.NonEmpty as NES import qualified Data.Text as T-import           Data.Text.Prettyprint.Doc hiding (space, list)+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           GHC.Generics (Generic) import           Lens.Micro-import           System.Path (Path, Absolute, takeFileName, toUnrootedFilePath)+import           System.Path (Absolute, Path, takeFileName, toUnrootedFilePath) import           Text.Megaparsec import           Text.Megaparsec.Char @@ -63,10 +71,10 @@  -- | Types whose members can be converted to CLI flags. class Flagable a where-  asFlag :: a -> [String]+  asFlag :: a -> [T.Text]  instance Flagable T.Text where-  asFlag t = [T.unpack t]+  asFlag t = [t]  instance (Foldable f, Flagable a) => Flagable (f a) where   asFlag = foldMap asFlag@@ -89,6 +97,18 @@ pver (FromRepo pb) = pb ^. field @"version" pver (FromAUR b)   = b  ^. field @"version" +dividePkgs :: NESet Package -> These (NESet Prebuilt) (NESet Buildable)+dividePkgs = bimap NES.fromList NES.fromList . partNonEmpty f . NES.toList+  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@@ -134,6 +154,18 @@                                    , char '='    *> fmap MustBe   versioning'                                    , pure Anything ] +-- | Renders the `Dep` into a form that @pacman -T@ understands. The dual of+-- `parseDep`.+renderedDep :: Dep -> T.Text+renderedDep (Dep n ver) = (n ^. field @"name") <> asT ver+  where+    asT :: VersionDemand -> T.Text+    asT (LessThan v) = "<"  <> prettyV v+    asT (AtLeast  v) = ">=" <> prettyV v+    asT (MoreThan v) = ">"  <> prettyV v+    asT (MustBe   v) = "="  <> prettyV v+    asT Anything     = ""+ -- | The versioning requirement of some package's dependency. data VersionDemand = LessThan Versioning                    | AtLeast  Versioning@@ -170,13 +202,13 @@   where t' = T.pack . toUnrootedFilePath $ takeFileName t          n :: Parsec Void T.Text PkgName-        n = PkgName . T.pack <$> manyTill anyChar (try finished)+        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 anyChar (try finished) *> ver+        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" @@ -221,6 +253,7 @@               | Norwegian               | Indonesia               | Chinese+              | Esperanto                 deriving (Eq, Enum, Bounded, Ord, Show)  -- | The various ways that dependency resolution can fail.@@ -251,8 +284,4 @@  -- | 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 :: T.Text } deriving (Eq, Ord, Show, Generic)---- | Similar to `maybe` and `either`, but not quite the same.-list :: b -> (NonEmpty a -> b) -> [a] -> b-list def f as = maybe def f $ nonEmpty as+newtype Provides = Provides { provides :: PkgName } deriving (Eq, Ord, Show, Generic)

@@ -2,7 +2,7 @@  -- | -- Module    : Aura.Utils--- Copyright : (c) Colin Woodbury, 2012 - 2018+-- Copyright : (c) Colin Woodbury, 2012 - 2019 -- License   : GPL3 -- Maintainer: Colin Woodbury <colin@fosskers.ca> --@@ -29,14 +29,15 @@     -- * User Input   , optionalPrompt   , getSelection+    -- * Misc.+  , maybe'   ) where  import           Aura.Colour import           Aura.Languages (whitespace, yesNoMessage, yesPattern) import           Aura.Settings-import           Aura.Types (Language, Environment(..), User(..))+import           Aura.Types (Environment, Language, User(..)) import           BasePrelude hiding (Version, (<+>))-import           Control.Monad.Trans (MonadIO) import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as L import qualified Data.Map.Strict as M@@ -49,10 +50,10 @@ import           Data.Text.Prettyprint.Doc.Render.Terminal import           Network.HTTP.Client import           Network.HTTP.Types.Status (statusCode)-import           System.IO (stdout, hFlush)-import           System.Path (Path, Absolute, toFilePath)+import           System.IO (hFlush, stdout)+import           System.Path (Absolute, Path, toFilePath) import           System.Path.IO (doesFileExist)-import           System.Process.Typed (runProcess, proc)+import           System.Process.Typed (proc, runProcess)  --- @@ -222,3 +223,7 @@ 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

@@ -32,12 +32,21 @@ suite conf pb = testGroup "Unit Tests"   [ testGroup "Aura.Core"     [ testCase "parseDep - python2" $ parseDep "python2" @?= Just (Dep "python2" Anything)-    , testCase "parseDep - python2-lxml>=3.1.0"-      $ parseDep "python2-lxml>=3.1.0" @?= Just (Dep "python2-lxml" . AtLeast . Ideal $ SemVer 3 1 0 [] [])-    , testCase "parseDep - foobar>1.2.3"-      $ parseDep "foobar>1.2.3" @?= Just (Dep "foobar" . MoreThan . Ideal $ SemVer 1 2 3 [] [])-    , testCase "parseDep - foobar=1.2.3"-      $ parseDep "foobar=1.2.3" @?= Just (Dep "foobar" . MustBe . Ideal $ SemVer 1 2 3 [] [])+    , testCase "parseDep - python2-lxml>=3.1.0" $ do+        let pn = "python2-lxml>=3.1.0"+            p = parseDep pn+        p @?= Just (Dep "python2-lxml" . AtLeast . Ideal $ SemVer 3 1 0 [] [])+        fmap renderedDep p @?= Just pn+    , testCase "parseDep - foobar>1.2.3" $ do+        let pn = "foobar>1.2.3"+            p = parseDep pn+        p @?= Just (Dep "foobar" . MoreThan . Ideal $ SemVer 1 2 3 [] [])+        fmap renderedDep p @?= Just pn+    , testCase "parseDep - foobar=1.2.3" $ do+        let pn = "foobar=1.2.3"+            p = parseDep pn+        p @?= Just (Dep "foobar" . MustBe . Ideal $ SemVer 1 2 3 [] [])+        fmap renderedDep p @?= Just pn     ]   , testGroup "Aura.Types"     [ testCase "simplepkg"@@ -57,13 +66,10 @@     ]   , testGroup "Aura.Languages"     [ testCase "Language names are complete" $ do-        case [minBound..maxBound] :: [Language] of-          [] -> assertFailure "No languages found"-          lang:restOfLangs -> do-            let names = languageNames lang-            for_ restOfLangs $ \otherLang -> do-              let otherNames = languageNames otherLang-              assertEqual ("Language name maps for " ++ show lang ++ " and " ++ show otherLang ++ " have different size") (M.size names) (M.size otherNames)+        let languages = [minBound..maxBound] :: [Language]+        for_ languages $ \lang -> do+          let names = languageNames lang+          assertEqual ("Language name map for " ++ show lang ++ " has incorrect number of items") (length languages - 1) (M.size names)     ]   , testGroup "Aura.Pkgbuild.Security"     [ testCase "Parsing - aura.PKGBUILD" $ do