arch-hs 0.8.0.0 → 0.9.0.0

raw patch · 21 files changed

+776/−802 lines, 21 filesdep +optparse-simpledep −optparse-applicativenew-component:exe:arch-hs-syncPVP ok

version bump matches the API change (PVP)

Dependencies added: optparse-simple

Dependencies removed: optparse-applicative

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• README.md +9/−202
• app/Args.hs +33/−80
• app/Main.hs +10/−30
• arch-hs.cabal +22/−10
• data/NAME_PRESET.json +4/−2
• diff/Args.hs +39/−0
• diff/Diff.hs +1/−61
• diff/Main.hs +3/−9
• src/Distribution/ArchHs/Name.hs +17/−4
• src/Distribution/ArchHs/OptionReader.hs +0/−112
• src/Distribution/ArchHs/Options.hs +215/−0
• src/Distribution/ArchHs/Utils.hs +24/−1
• submit/Main.hs +0/−73
• submit/Submit.hs +0/−218
• sync/Args.hs +81/−0
• sync/Check.hs +44/−0
• sync/Main.hs +84/−0
• sync/Submit.hs +104/−0
• sync/Submit/CSV.hs +37/−0
• sync/Utils.hs +35/−0

@@ -3,6 +3,20 @@ `arch-hs` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.9.0.0++* Remove `arch-hs-submit` executable++* Add `arch-hs-sync` executable, which has two commands:+  * `arch-hs-sync submit` - the same as `arch-hs-submit` previously+  * `arch-hs-sync check` - check version inconsistencies between [community] and Hackage++* Improve CLI options: +  * values of `--skip` and `--flag` are no longer separated by comma+  * the options can be set many times, for example: `arch-hs -f packageA:flagA:true -f packageB:flagB:false`++* Update name preset+ ## 0.8.0.0  * Fix the bug that unable to run with dependency-free packages

@@ -87,66 +87,7 @@ ⓘ Loading community.db from libalpm ⓘ Start running... ⓘ Solved:-Cabal                                       ✔ [community]-ChasingBottoms                              ✔ [community]-Diff                                        ✔ [community]-HUnit                                       ✔ [community]-QuickCheck                                  ✔ [community]-StateVar                                    ✔ [community]-adjunctions                                 ✔ [community]-aeson                                       ✔ [community]-ansi-terminal                               ✔ [community]-ansi-wl-pprint                              ✔ [community]-assoc                                       ✔ [community]-async                                       ✔ [community]-attoparsec                                  ✔ [community]-base-compat                                 ✔ [community]-base-compat-batteries                       ✔ [community]-base-orphans                                ✔ [community]-base16-bytestring                           ✔ [community]-base64-bytestring                           ✔ [community]-bifunctors                                  ✔ [community]-binary                                      ✔ [community]-blaze-builder                               ✔ [community]-blaze-html                                  ✔ [community]-blaze-markup                                ✔ [community]-bytestring                                  ✔ [community]-bytestring-handle                           ✔ [community]-cabal-doctest                               ✔ [community]-call-stack                                  ✔ [community]-case-insensitive                            ✔ [community]-charset                                     ✔ [community]-clock                                       ✔ [community]-code-page                                   ✔ [community]-colour                                      ✔ [community]-comonad                                     ✔ [community]-concurrent-output                           ✔ [community]-conduit                                     ✔ [community]-conduit-extra                               ✔ [community]-constraints                                 ✔ [community]-containers                                  ✔ [community]-contravariant                               ✔ [community]-data-default                                ✔ [community]-data-default-instances-containers           ✔ [community]-data-default-instances-dlist                ✔ [community]-data-default-instances-old-locale           ✔ [community]-data-fix                                    ✔ [community]-deepseq                                     ✔ [community]-directory                                   ✔ [community]-distributive                                ✔ [community]-dlist                                       ✔ [community]-doctest                                     ✔ [community]-exceptions                                  ✔ [community]-filepath                                    ✔ [community]-fingertree                                  ✔ [community]-foldl                                       ✔ [community]-free                                        ✔ [community]-generic-deriving                            ✔ [community]-ghc                                         ✔ [community]-ghc-boot                                    ✔ [community]-ghc-paths                                   ✔ [community]-ghci                                        ✔ [community]-gi-cairo                                    ✔ [community]+... gi-gdk                                      ✘  ├─Cabal (Setup)                            ✔ [community]  ├─bytestring (Lib)                         ✔ [community]@@ -227,138 +168,7 @@  ├─haskell-gi-overloading (Lib)             ✔ [community]  ├─text (Lib)                               ✔ [community]  └─transformers (Lib)                       ✔ [community]-hashable                                    ✔ [community]-hashable-time                               ✔ [community]-haskell-gi                                  ✔ [community]-haskell-gi-base                             ✔ [community]-haskell-src-exts                            ✔ [community]-hedgehog                                    ✔ [community]-hpc                                         ✔ [community]-hspec                                       ✔ [community]-hspec-core                                  ✔ [community]-hspec-discover                              ✔ [community]-hspec-expectations                          ✔ [community]-hspec-meta                                  ✔ [community]-indexed-traversable                         ✔ [community]-integer-logarithms                          ✔ [community]-invariant                                   ✔ [community]-kan-extensions                              ✔ [community]-lens                                        ✔ [community]-libxml                                      ✔ [community]-lifted-async                                ✔ [community]-lifted-base                                 ✔ [community]-logging-facade                              ✔ [community]-logict                                      ✔ [community]-math-functions                              ✔ [community]-mmorph                                      ✔ [community]-mockery                                     ✔ [community]-monad-control                               ✔ [community]-mono-traversable                            ✔ [community]-mtl                                         ✔ [community]-mwc-random                                  ✔ [community]-nanospec                                    ✔ [community]-network                                     ✔ [community]-optparse-applicative                        ✔ [community]-parallel                                    ✔ [community]-parsec                                      ✔ [community]-parsers                                     ✔ [community]-pcre-light                                  ✔ [community]-pgp-wordlist                                ✔ [community]-pretty                                      ✔ [community]-pretty-show                                 ✔ [community]-prettyprinter                               ✔ [community]-prettyprinter-ansi-terminal                 ✔ [community]-primitive                                   ✔ [community]-process                                     ✔ [community]-profunctors                                 ✔ [community]-quickcheck-classes-base                     ✔ [community]-quickcheck-instances                        ✔ [community]-quickcheck-io                               ✔ [community]-quickcheck-unicode                          ✔ [community]-random                                      ✔ [community]-reducers                                    ✔ [community]-reflection                                  ✔ [community]-regex-base                                  ✔ [community]-regex-posix                                 ✔ [community]-regex-tdfa                                  ✔ [community]-resourcet                                   ✔ [community]-safe                                        ✔ [community]-scientific                                  ✔ [community]-semigroupoids                               ✔ [community]-setenv                                      ✔ [community]-silently                                    ✔ [community]-smallcheck                                  ✔ [community]-split                                       ✔ [community]-splitmix                                    ✔ [community]-stm                                         ✔ [community]-streaming-commons                           ✔ [community]-strict                                      ✔ [community]-stringbuilder                               ✔ [community]-syb                                         ✔ [community]-tagged                                      ✔ [community]-tar                                         ✔ [community]-tasty                                       ✔ [community]-tasty-ant-xml                               ✔ [community]-tasty-expected-failure                      ✔ [community]-tasty-golden                                ✔ [community]-tasty-hedgehog                              ✔ [community]-tasty-hunit                                 ✔ [community]-tasty-quickcheck                            ✔ [community]-tasty-smallcheck                            ✔ [community]-tasty-th                                    ✔ [community]-template-haskell                            ✔ [community]-temporary                                   ✔ [community]-terminal-size                               ✔ [community]-test-framework                              ✔ [community]-test-framework-hunit                        ✔ [community]-test-framework-quickcheck2                  ✔ [community]-text                                        ✔ [community]-tf-random                                   ✔ [community]-th-abstraction                              ✔ [community]-these                                       ✔ [community]-time                                        ✔ [community]-time-compat                                 ✔ [community]-transformers-base                           ✔ [community]-transformers-compat                         ✔ [community]-tree-diff                                   ✔ [community]-trifecta                                    ✔ [community]-typed-process                               ✔ [community]-unix                                        ✔ [community]-unix-compat                                 ✔ [community]-unliftio                                    ✔ [community]-unliftio-core                               ✔ [community]-unordered-containers                        ✔ [community]-utf8-string                                 ✔ [community]-uuid-types                                  ✔ [community]-vector                                      ✔ [community]-vector-algorithms                           ✔ [community]-vector-th-unbox                             ✔ [community]-wcwidth                                     ✔ [community]-wl-pprint-annotated                         ✔ [community]-xdg-basedir                                 ✔ [community]-xml                                         ✔ [community]-xml-conduit                                 ✔ [community]-xml-types                                   ✔ [community]-zlib                                        ✔ [community]-array                                       ✔ [community]-transformers                                ✔ [community]-semigroups                                  ✔ [community]-void                                        ✔ [community]-integer-gmp                                 ✔ [community]-hsc2hs                                      ✔ [community]-type-equality                               ✔ [community]-data-default-class                          ✔ [community]-old-locale                                  ✔ [community]-ghc-boot-th                                 ✔ [community]-terminfo                                    ✔ [community]-haskell-gi-overloading                      ✔ [community]-happy                                       ✔ [community]-erf                                         ✔ [community]-simple-reflect                              ✔ [community]-haskell-lexer                               ✔ [community]-unbounded-delays                            ✔ [community]-hostname                                    ✔ [community]-extensible-exceptions                       ✔ [community]+...  ⓘ Recommended package order: 1. gi-glib@@ -516,12 +326,13 @@ ### Extra Cabal Files  ```-$ arch-hs -e ~/TARGET/TARGET.cabal TARGET+$ arch-hs -e ~/TARGET TARGET ```  **For Testing Purposes Only** -Using `-e` can include extra `.cabal` files as supplementary. Useful when the `TARGET` hasn't been released to hackage.+Using `-e` can include extra `.cabal` files as supplementary.+Useful when the `TARGET` hasn't been released to hackage.  ### Trace @@ -555,10 +366,6 @@  ### Alpm -```-$ arch-hs --alpm TARGET-```- See [Alpm Support](#Alpm-Support).  ### Force@@ -698,9 +505,9 @@  `arch-hs-diff` does not require hackage db, it downloads cabal files from hackage server instead.  -## Submit+## Sync -For hackage distribution maintainers only.+For hackage distribution maintainers only, see `arch-hs-sync --help` for details.  ## Limitations @@ -724,8 +531,8 @@ ```  This flag is enabled by default in `arch-hs` Arch Linux package.-Compiled with `alpm`, `arch-hs` can accept runtime flag `--alpm`.-**That said, if you want to use alpm to boost `arch-hs`, you need compile `arch-hs` with cabal flag `alpm`, and pass `--aplm` to `arch-hs` when running.**+Compiled with `alpm`, `arch-hs` uses alpm to load pacman databases by default.+In this case, the CLI flag `--no-alpm-community` and `--no-alpm-files` can be used to disable this feature. > When `alpm` is enabled, `arch-hs` will lose the capability of specifying the path of `community.db` and directory of files db.  

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} @@ -8,26 +7,19 @@   ) where -import qualified Data.Map.Strict as Map import Distribution.ArchHs.Internal.Prelude-import Distribution.ArchHs.OptionReader+import Distribution.ArchHs.Options import Distribution.ArchHs.Types--#ifndef ALPM-import Distribution.ArchHs.CommunityDB (defaultCommunityDBPath)-import Distribution.ArchHs.FilesDB (defaultFilesDBDir)-#endif+import Distribution.ArchHs.Utils (archHsVersion)  data Options = Options-  { optHackagePath :: FilePath,-#ifndef ALPM-    optCommunityDBPath :: FilePath,-    optFilesDBPath :: FilePath,-#endif+  { optHackage :: HackageDBOptions,+    optCommunityDB :: CommunityDBOptions,+    optFilesDB :: FilesDBOptions,     optOutputDir :: FilePath,     optFlags :: FlagAssignments,     optSkip :: [String],-    optExtraCabalPath :: [FilePath],+    optExtraCabalDirs :: [FilePath],     optAur :: Bool,     optStdoutTrace :: Bool,     optFileTrace :: FilePath,@@ -35,42 +27,15 @@     optForce :: Bool,     optMetaDir :: FilePath,     optJson :: FilePath,-#ifdef ALPM-    optAlpm :: Bool,-#endif     optTarget :: PackageName   }-  deriving stock (Show)  cmdOptions :: Parser Options cmdOptions =   Options-    <$> strOption-      ( long "hackage"-          <> metavar "PATH"-          <> short 'h'-          <> help "Path to hackage index tarball"-          <> showDefault-          <> value ""-      )-#ifndef ALPM-      <*> strOption-        ( long "community"-            <> metavar "PATH"-            <> short 'c'-            <> help "Path to community.db"-            <> showDefault-            <> value defaultCommunityDBPath-        )-      <*> strOption-        ( long "files"-            <> metavar "PATH"-            <> short 'f'-            <> help "Path of dir that includes core.files, extra.files and community.files"-            <> showDefault-            <> value defaultFilesDBDir-        )-#endif+    <$> hackageDBOptionsParser+      <*> communityDBOptionsParser+      <*> filesDBOptionsParser       <*> strOption         ( long "output"             <> metavar "PATH"@@ -78,29 +43,22 @@             <> help "Output path to generated PKGBUILD files (empty means dry run)"             <> value ""         )-      <*> option-        optFlagReader-        ( long "flags"-            <> metavar "package_name:flag_name:true|false,..."-            <> short 'f'-            <> help "Flag assignments for packages - e.g. inline-c:gsl-example:true (separated by ',')"-            <> value Map.empty-        )-      <*> option-        optSkippedReader-        ( long "skip"-            <> metavar "component_name,..."-            <> short 's'-            <> help "Skip a runnable component (executable, test suit, or benchmark) in dependency calculation"-            <> value []+      <*> optFlagAssignmentParser+      <*> many+        ( strOption+            ( long "skip"+                <> metavar "component_name"+                <> short 's'+                <> help "Skip a runnable component (executable, test suit, or benchmark) in dependency calculation"+            )         )-      <*> option-        optExtraCabalReader-        ( long "extra"-            <> metavar "PATH_1,..."-            <> short 'e'-            <> help "Extra cabal files' path - e.g. /home/berberman/arch-hs/arch-hs.cabal"-            <> value []+      <*> many+        ( strOption+            ( long "extra"+                <> metavar "PATH_1,..."+                <> short 'e'+                <> help "Paths to directories that contain extra cabal files to include - e.g. /home/berberman/arch-hs"+            )         )       <*> switch         ( long "aur"@@ -137,20 +95,15 @@             <> help "Path to json output (empty means do not write output as json to file)"             <> value ""         )-#ifdef ALPM-      <*> switch-        ( long "alpm"-            <> help "Use libalpm to parse community db"-        )-#endif       <*> argument optPackageNameReader (metavar "TARGET")  runArgsParser :: IO Options-runArgsParser =-  execParser $-    info-      (cmdOptions <**> helper)-      ( fullDesc-          <> progDesc "Try to reach the TARGET QAQ."-          <> header "arch-hs - a program generating PKGBUILD for hackage packages."-      )+runArgsParser = do+  (x, ()) <-+    simpleOptions+      archHsVersion+      "arch-hs - generate PKGBUILD for Haskell packages in Hackage"+      "arch-hs is a CLI tool automating the PKGBUILD generation for Haskell packages, with dependency resolving and template filling"+      cmdOptions+      empty+  pure x

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -30,6 +29,7 @@ import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.Local import Distribution.ArchHs.Name+import Distribution.ArchHs.Options import Distribution.ArchHs.PP import qualified Distribution.ArchHs.PkgBuild as N import Distribution.ArchHs.Types@@ -309,43 +309,23 @@      when optUusi $ printInfo "You passed --uusi, uusi will become makedepends of each package" -    hackagePath <- if null optHackagePath then lookupHackagePath else return optHackagePath--    printInfo $ "Loading hackage from" <+> pretty hackagePath--    hackage <- loadHackageDB hackagePath+    hackage <- loadHackageDBFromOptions optHackage -    let isExtraEmpty = null optExtraCabalPath+    let isExtraEmpty = null optExtraCabalDirs+    optExtraCabal <- mapM findCabalFile optExtraCabalDirs      unless isExtraEmpty $-      printInfo $ "You added" <+> hsep (punctuate comma $ pretty . takeFileName <$> optExtraCabalPath) <+> "as extra cabal file(s), starting parsing right now"+      printInfo $ "You added" <+> hsep (punctuate comma $ pretty . takeFileName <$> optExtraCabal) <+> "as extra cabal file(s), starting parsing right now" -    parsedExtra <- mapM parseCabalFile optExtraCabalPath+    parsedExtra <- mapM parseCabalFile optExtraCabal      let newHackage = foldr insertDB hackage parsedExtra -#ifdef ALPM-    let src = T.pack $ if optAlpm then "libalpm" else defaultCommunityDBPath-    printInfo $ "Loading community.db from " <> pretty src-    community <- if optAlpm then loadCommunityDBFFI else loadCommunityDB defaultCommunityDBPath-#else-    printInfo $ "Loading community.db from" <+> pretty optCommunityDBPath-    community <- loadCommunityDB optCommunityDBPath-#endif+    community <- loadCommunityDBFromOptions optCommunityDB      printInfo "Start running..." -    empty <- newIORef Set.empty--    let loadF db = do-#ifdef ALPM-          printInfo $ "Loading" <+> ppDBKind db <+> "files from libalpm"-          if optAlpm then loadFilesDBFFI db else loadFilesDB db defaultFilesDBDir-#else-          printInfo $ "Loading" <+> ppDBKind db <+> "files from" <+> pretty optFilesDBPath-          loadFilesDB db optFilesDBPath--#endif+    ref <- newIORef Set.empty      manager <- newTlsManager @@ -355,9 +335,9 @@       optFlags       optStdoutTrace       optFileTrace-      empty+      ref       manager-      (app optTarget optOutputDir optAur optSkip optUusi optForce optMetaDir optJson loadF)+      (app optTarget optOutputDir optAur optSkip optUusi optForce optMetaDir optJson (loadFilesDBFromOptions optFilesDB))       & printAppResult  -----------------------------------------------------------------------------

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               arch-hs-version:            0.8.0.0+version:            0.9.0.0 synopsis:           Distribute hackage packages to archlinux description:   @arch-hs@ is a command-line program, which simplifies the process of producing@@ -39,9 +39,9 @@     , aeson                        ^>=1.5.4     , algebraic-graphs             ^>=0.5     , arch-web                     ^>=0.1.0-    , base                         >=4.12   && <5+    , base                         >=4.12    && <5     , bytestring-    , Cabal                        >=3.2    && <3.5+    , Cabal                        >=3.2     && <3.5     , conduit                      ^>=1.3.2     , conduit-extra                ^>=1.3.5     , containers@@ -56,7 +56,7 @@     , microlens                    ^>=0.4.11     , microlens-th                 ^>=0.4.3     , neat-interpolation           ^>=0.5.1-    , optparse-applicative         ^>=0.16.0+    , optparse-simple              ^>=0.1.1.3     , polysemy     , prettyprinter                ^>=1.7.0     , prettyprinter-ansi-terminal  ^>=1.1.2@@ -95,6 +95,7 @@ library   import:          common-options   hs-source-dirs:  src+  autogen-modules: Paths_arch_hs   exposed-modules:     Distribution.ArchHs.Aur     Distribution.ArchHs.CommunityDB@@ -105,14 +106,16 @@     Distribution.ArchHs.Internal.Prelude     Distribution.ArchHs.Local     Distribution.ArchHs.Name-    Distribution.ArchHs.OptionReader+    Distribution.ArchHs.Options     Distribution.ArchHs.PkgBuild     Distribution.ArchHs.PkgDesc     Distribution.ArchHs.PP     Distribution.ArchHs.Types     Distribution.ArchHs.Utils -  other-modules:   Distribution.ArchHs.Internal.NamePresetLoader+  other-modules:+    Distribution.ArchHs.Internal.NamePresetLoader+    Paths_arch_hs  executable arch-hs   import:         common-options@@ -129,14 +132,23 @@   import:         common-options   hs-source-dirs: diff   main-is:        Main.hs-  other-modules:  Diff+  other-modules:+    Args+    Diff+   build-depends:  arch-hs   ghc-options:    -threaded -rtsopts -with-rtsopts=-N -executable arch-hs-submit+executable arch-hs-sync   import:         common-options-  hs-source-dirs: submit+  hs-source-dirs: sync   main-is:        Main.hs-  other-modules:  Submit+  other-modules:+    Args+    Check+    Submit+    Submit.CSV+    Utils+   build-depends:  arch-hs   ghc-options:    -threaded -rtsopts -with-rtsopts=-N

@@ -6,12 +6,14 @@   "c2hs": "c2hs",   "haskell-cabal": "Cabal",   "cabal-install": "cabal-install",+  "cabal-plan": "cabal-plan",   "cgrep": "cgrep",   "clash-ghc": "clash-ghc",   "cryptol": "cryptol",   "darcs": "darcs",   "dhall": "dhall",   "dhall-bash": "dhall-bash",+  "dhall-docs": "dhall-docs",   "dhall-json": "dhall-json",   "dhall-lsp-server": "dhall-lsp-server",   "dhall-yaml": "dhall-yaml",@@ -45,6 +47,7 @@   "haskell-lexer": "haskell-lexer",   "haskell-listlike": "ListLike",   "haskell-lsp0": "haskell-lsp",+  "haskell-lsp0-types": "haskell-lsp-types",   "haskell-missingh": "MissingH",   "haskell-monadlib": "monadLib",   "haskell-monadrandom": "MonadRandom",@@ -53,8 +56,6 @@   "haskell-hsyaml": "HsYAML",   "haskell-hsyaml-aeson": "HsYAML-aeson",   "haskell-libbf": "libBF",-  "haskell-lsp": "haskell-lsp",-  "haskell-lsp-types": "haskell-lsp-types",   "haskell-memotrie": "MemoTrie",   "haskell-monadprompt": "MonadPrompt",   "haskell-rsa": "RSA",@@ -69,6 +70,7 @@   "haskell-src-meta": "haskell-src-meta",   "haskell-statevar": "StateVar",   "haskell-stmonadtrans": "STMonadTrans",+  "haskell-stream": "Stream",   "haskell-unixutils": "Unixutils",   "haskell-x11": "X11",   "haskell-x11-xft": "X11-xft",

@@ -0,0 +1,39 @@+module Args+  ( Options (..),+    cmdOptions,+    runArgsParser,+  )+where++import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Options+import Distribution.ArchHs.Types+import Distribution.ArchHs.Utils (archHsVersion)++data Options = Options+  { optFlags :: FlagAssignments,+    optCommunityDB :: CommunityDBOptions,+    optPackageName :: PackageName,+    optVersionA :: Version,+    optVersionB :: Version+  }++cmdOptions :: Parser Options+cmdOptions =+  Options+    <$> optFlagAssignmentParser+    <*> communityDBOptionsParser+    <*> argument optPackageNameReader (metavar "TARGET")+    <*> argument optVersionReader (metavar "VERSION_A")+    <*> argument optVersionReader (metavar "VERSION_B")++runArgsParser :: IO Options+runArgsParser = do+  (x, ()) <-+    simpleOptions+      archHsVersion+      "arch-hs-diff - create diff between different versions of package description"+      "arch-hs-diff is a CLI tool that shows the differences of package description between two versions of a package, and remind us if some required packages in community repo can't satisfy the version constraints, or they are non-existent"+      cmdOptions+      empty+  pure x

@@ -1,11 +1,8 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-}  module Diff   ( diffCabal,-    Options (..),-    runArgsParser,   ) where @@ -17,7 +14,6 @@ import Distribution.ArchHs.Core (evalConditionTree) import Distribution.ArchHs.Exception import Distribution.ArchHs.Internal.Prelude-import Distribution.ArchHs.OptionReader import Distribution.ArchHs.PP import Distribution.ArchHs.Types import Distribution.ArchHs.Utils@@ -29,62 +25,6 @@ import Distribution.Utils.ShortText (fromShortText) import Network.HTTP.Client -#ifndef ALPM-import Distribution.ArchHs.CommunityDB (defaultCommunityDBPath)-#endif--data Options = Options-  { optFlags :: FlagAssignments,-#ifdef ALPM-    optAlpm          :: Bool,-#else-    optCommunityDBPath :: FilePath,-#endif-    optPackageName :: PackageName,-    optVersionA :: Version,-    optVersionB :: Version-  }--cmdOptions :: Parser Options-cmdOptions =-  Options-    <$> option-      optFlagReader-      ( long "flags"-          <> metavar "package_name:flag_name:true|false,..."-          <> short 'f'-          <> help "Flag assignments for packages - e.g. inline-c:gsl-example:true (separated by ',')"-          <> value Map.empty-      )-#ifndef ALPM-    <*> strOption-      ( long "community"-          <> metavar "PATH"-          <> short 'c'-          <> help "Path to community.db"-          <> showDefault-          <> value defaultCommunityDBPath-      )-#else-      <*> switch-        ( long "alpm"-            <> help "Use libalpm to parse community db"-        )-#endif-    <*> argument optPackageNameReader (metavar "TARGET")-    <*> argument optVersionReader (metavar "VERSION_A")-    <*> argument optVersionReader (metavar "VERSION_B")--runArgsParser :: IO Options-runArgsParser =-  execParser $-    info-      (cmdOptions <**> helper)-      ( fullDesc-          <> progDesc "Try to reach the TARGET QAQ."-          <> header "arch-hs-diff - a program creating diff between different versions of a cabal file."-      )- -----------------------------------------------------------------------------  --  Duplicated from Core.hs with modifications.@@ -126,7 +66,7 @@ collectTestDeps :: Members [FlagAssignmentsEnv, Trace, DependencyRecord] r => GenericPackageDescription -> [UnqualComponentName] -> Sem r (VersionedComponentList, VersionedComponentList) collectTestDeps = collectComponentialDeps condTestSuites -collectSubLibDeps :: Members [FlagAssignmentsEnv,Trace, DependencyRecord] r => GenericPackageDescription -> [UnqualComponentName] -> Sem r (VersionedComponentList, VersionedComponentList)+collectSubLibDeps :: Members [FlagAssignmentsEnv, Trace, DependencyRecord] r => GenericPackageDescription -> [UnqualComponentName] -> Sem r (VersionedComponentList, VersionedComponentList) collectSubLibDeps = collectComponentialDeps condSubLibraries  collectSetupDeps :: Member Trace r => GenericPackageDescription -> Sem r VersionedList

@@ -4,13 +4,14 @@  module Main (main) where +import Args import Control.Monad (unless) import qualified Data.Map as Map import Data.Text.Prettyprint.Doc.Render.Terminal import Diff-import Distribution.ArchHs.CommunityDB import Distribution.ArchHs.Exception import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Options import Distribution.ArchHs.PP import Distribution.ArchHs.Types import GHC.IO.Encoding (setLocaleEncoding, utf8)@@ -28,14 +29,7 @@       printInfo "You assigned flags:"       putDoc $ prettyFlagAssignments optFlags <> line -#ifdef ALPM-    let src = if optAlpm then "libalpm" else defaultCommunityDBPath-    printInfo $ "Loading community.db from" <+> pretty src-    community <- if optAlpm then loadCommunityDBFFI else loadCommunityDB defaultCommunityDBPath-#else-    printInfo $ "Loading community.db from" <+> pretty optCommunityDBPath-    community <- loadCommunityDB optCommunityDBPath-#endif+    community <- loadCommunityDBFromOptions optCommunityDB      manager <- newTlsManager 

@@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}  -- | Copyright: (c) 2020-2021 berberman -- SPDX-License-Identifier: MIT@@ -45,6 +46,7 @@     toArchLinuxName,     toHackageName,     isHaskellPackage,+    isGHCLibs,   ) where @@ -52,6 +54,7 @@ import Data.String (IsString, fromString) import Distribution.ArchHs.Internal.NamePresetLoader import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Local import Distribution.ArchHs.Types  -- | The representation of a package name.@@ -151,11 +154,21 @@ toHackageName :: HasMyName n => n -> PackageName toHackageName = mToHackageName . toHackageRep --- | Judge if a package in archlinux community repo is haskell package.+-- | Check if a package in archlinux community repo is haskell package. -- -- i.e. it is in @preset@ or has @haskell-@ prefix. -- Attention: There is no guarantee that the package exists in hackage. isHaskellPackage :: ArchLinuxName -> Bool-isHaskellPackage name =-  let rep = toArchLinuxRep name-   in (rep `elem` communityListP || "haskell-" `isPrefixOf` unsafeUnMyName rep)+isHaskellPackage (toArchLinuxRep -> rep) =+  (rep `elem` communityListP || "haskell-" `isPrefixOf` unsafeUnMyName rep)++-- | Check if a package is GHC or GHC Libs++--- >>> isGHCLibs "ghc"+-- True+--- >>> isGHCLibs "text"+-- True+--- >>> isGHCLibs "arch-hs"+-- False+isGHCLibs :: PackageName -> Bool+isGHCLibs name = name == "ghc" || name `elem` ghcLibList

@@ -1,112 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- | Copyright: (c) 2020-2021 berberman--- SPDX-License-Identifier: MIT--- Maintainer: berberman <berberman@yandex.com>--- Stability: experimental--- Portability: portable--- This module defines input patterns used in executables' cli.--- "Options.Applicative" is re-exported.-module Distribution.ArchHs.OptionReader-  ( optFlagReader,-    optSkippedReader,-    optExtraCabalReader,-    optVersionReader,-    optPackageNameReader,-    module Options.Applicative,-  )-where--import qualified Data.Map.Strict as Map-import Data.Void (Void)-import Distribution.ArchHs.Internal.Prelude-import Options.Applicative-import System.FilePath (takeExtension)-import qualified Text.Megaparsec as M-import qualified Text.Megaparsec.Char as M--readFlag :: [(String, String, Bool)] -> Map.Map PackageName FlagAssignment-readFlag list =-  Map.map toAssignment $-    foldr (\(name, fname, fvalue) acc -> Map.insertWith (<>) (mkPackageName name) [(mkFlagName fname, fvalue)] acc) Map.empty list-  where-    toAssignment = foldr (\(fname, fvalue) acc -> insertFlagAssignment fname fvalue acc) (mkFlagAssignment [])---- | Read a set of package name with flag assignments.------ >>> f ""--- >>> f "package_name:flag_name:true"--- Right (fromList [(PackageName "package_name",fromList [(FlagName "flag_name",(1,True))])])--- >>> f "package_name:flag_name_1:true,package_name:flag_name_2:false"--- Right (fromList [(PackageName "package_name",fromList [(FlagName "flag_name_1",(1,True)),(FlagName "flag_name_2",(1,False))])])--- >>> f "package_name_1:flag_name_1:false,package_name_2:flag_name_2:true"--- Right (fromList [(PackageName "package_name_1",fromList [(FlagName "flag_name_1",(1,False))]),(PackageName "package_name_2",fromList [(FlagName "flag_name_2",(1,True))])])--- >>> f "zzz"--- Left "1:4:\n  |\n1 | zzz\n  |    ^\nunexpected end of input\nexpecting ':'\n"-optFlagReader :: ReadM (Map.Map PackageName FlagAssignment)-optFlagReader =-  eitherReader-    ( \s -> case M.parse optFlagParser "" s of-        Right x -> Right x-        Left err -> Left $ M.errorBundlePretty err-    )--optFlagParser :: M.Parsec Void String (Map.Map PackageName FlagAssignment)-optFlagParser =-  readFlag-    <$> ( do-            pkg <- M.manyTill M.anySingle $ M.single ':'-            flg <- M.manyTill M.anySingle $ M.single ':'-            b <- bool-            return (pkg, flg, b)-        )-    `M.sepBy` ","-  where-    bool = do-      s <- M.string "true" <|> M.string "false"-      case s of-        "true" -> return True-        "false" -> return False-        _ -> fail $ "unknown bool: " <> s---- | Read skipped components.--- This never fails, i.e. the return value will be 'Right'.--- >>> f ""--- Right [""]--- >>> f "component_1,component_2"--- Right ["component_1","component_2"]-optSkippedReader :: ReadM [String]-optSkippedReader = eitherReader $ Right . splitOn ","---- | Read extra cabal files.------ >>> f ""--- Left "Unexpected file name: "--- >>> f "a.cabal"--- Right ["a.cabal"]--- >>> f "a.cabal,b.cabal"--- Right ["a.cabal","b.cabal"]--- >>> f "a.what,b.cabal"--- Left "Unexpected file name: a.what"-optExtraCabalReader :: ReadM [FilePath]-optExtraCabalReader = eitherReader $ \x ->-  let split = splitOn "," x-      check = map (\e -> if takeExtension e == ".cabal" then (e, True) else (e, False)) split-      failed = map fst . filter (not . snd) $ check-      successful = map fst . filter snd $ check-   in if failed /= [] then Left ("Unexpected file name: " <> intercalate ", " failed) else Right successful---- | Read a 'Version'--- This function calls 'simpleParsec'.-optVersionReader :: ReadM Version-optVersionReader =-  eitherReader-    ( \s -> case simpleParsec s of-        Just v -> Right v-        _ -> Left $ "Failed to parse version: " <> s-    )---- | Read a 'PackageName'--- This function never fails, because it just wraps the input string with 'mkPackageName'.-optPackageNameReader :: ReadM PackageName-optPackageNameReader = eitherReader $ Right . mkPackageName

@@ -0,0 +1,215 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Copyright: (c) 2020-2021 berberman+-- SPDX-License-Identifier: MIT+-- Maintainer: berberman <berberman@yandex.com>+-- Stability: experimental+-- Portability: portable+-- This module contains CLI parsers used in executables.+-- "Options.Applicative.Simple" is re-exported.+module Distribution.ArchHs.Options+  ( -- * Load Community DB+    CommunityDBOptions (..),+    communityDBOptionsParser,++    -- * Load files DB+    FilesDBOptions (..),+    filesDBOptionsParser,++    -- * Load Hackage DB+    HackageDBOptions (..),+    hackageDBOptionsParser,++    -- * Parse flags+    optFlagAssignmentParser,+    optFlagReader,++    -- * Readers+    optPackageNameReader,+    optVersionReader,+    module Options.Applicative.Simple,+  )+where++import qualified Data.Map.Strict as Map+import Distribution.ArchHs.CommunityDB+import Distribution.ArchHs.FilesDB+import Distribution.ArchHs.Hackage+import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.PP+import Distribution.ArchHs.Types+import Options.Applicative.Simple++-----------------------------------------------------------------------------++-- | Parsed options for loading [community]+newtype CommunityDBOptions = CommunityDBOptions+  { loadCommunityDBFromOptions :: IO CommunityDB+  }++-- | CLI options parser of 'CommunityDBOptions'+--+-- When alpm is enabled, it reads a flag @no-alpm-community@;+-- otherwise it reads a string option @community@.+communityDBOptionsParser :: Parser CommunityDBOptions++#ifndef ALPM+communityDBOptionsParser =+  CommunityDBOptions+    <$> fmap+      ( \s ->+          do+            printInfo $ "Loading community.db from" <+> pretty s+            loadCommunityDB s+      )+      ( strOption $+          long "community"+            <> metavar "PATH"+            <> short 'c'+            <> help "Path to community.db"+            <> showDefault+            <> value defaultCommunityDBPath+      )+#else+communityDBOptionsParser =+  CommunityDBOptions+    <$> fmap+      ( \b ->+          do+            let src = if b then "libalpm" else defaultCommunityDBPath+            printInfo $ "Loading community.db from" <+> pretty src+            if b+              then loadCommunityDBFFI+              else loadCommunityDB defaultCommunityDBPath+      )+      ( flag+          True+          False+          ( long "no-alpm-community"+              <> help "Do not use libalpm to parse community db"+          )+      )+#endif+-----------------------------------------------------------------------------++-- | Parsed options for loading 'FilesDB'+newtype FilesDBOptions = FilesDBOptions+  { loadFilesDBFromOptions :: DBKind -> IO FilesDB+  }++-- | CLI options parser of 'CommunityDBOptions'+--+-- When alpm is enabled, it reads a flag @no-alpm-files@;+-- otherwise it reads a string option @files@.+filesDBOptionsParser :: Parser FilesDBOptions++#ifndef ALPM+filesDBOptionsParser =+  FilesDBOptions+    <$> fmap+      ( \s db ->+          do+            printInfo $+              "Loading" <+> ppDBKind db <+> "files from" <+> pretty s+            loadFilesDB db s+      )+      ( strOption $+          long "files"+            <> metavar "PATH"+            <> short 'f'+            <> help+              "Path of dir that includes core.files, extra.files and community.files"+            <> showDefault+            <> value defaultFilesDBDir+      )+#else+filesDBOptionsParser =+  FilesDBOptions+    <$> fmap+      ( \b db ->+          do+            let src = if b then "libalpm" else defaultFilesDBDir+            printInfo $+              "Loading" <+> ppDBKind db <+> "files from" <+> pretty src+            if b then loadFilesDBFFI db else loadFilesDB db defaultFilesDBDir+      )+      ( flag+          True+          False+          ( long "no-alpm-files"+              <> help "Do not use libalpm to parse files db"+          )+      )+#endif+-----------------------------------------------------------------------------++-- | Parsed options for loading 'HackageDB'+newtype HackageDBOptions = HackageDBOptions+  { loadHackageDBFromOptions :: IO HackageDB+  }++-- | CLI options parser that reads a string option @hackage@.+hackageDBOptionsParser :: Parser HackageDBOptions+hackageDBOptionsParser =+  HackageDBOptions+    <$> fmap+      ( \s ->+          do+            hackagePath <- if null s then lookupHackagePath else pure s+            printInfo $ "Loading hackage from" <+> pretty hackagePath+            loadHackageDB hackagePath+      )+      ( strOption $+          long "hackage"+            <> metavar "PATH"+            <> short 'h'+            <> help "Path to hackage index tarball"+            <> showDefault+            <> value ""+      )++-----------------------------------------------------------------------------++-- | Read a flag assignment like @package_name:flag_name:true|false@+optFlagReader :: ReadM (String, String, Bool)+optFlagReader = eitherReader $ \s -> case splitOn ":" s of+  [name, fname, fvalue] -> case fvalue of+    "true" -> Right (name, fname, True)+    "false" -> Right (name, fname, False)+    _ -> Left "Unknown boolean value, it should be 'true' or 'false'"+  _ -> Left "Failed to parse flag assignment"++-- | CLI options parser of flag assignments+optFlagAssignmentParser :: Parser (Map.Map PackageName FlagAssignment)+optFlagAssignmentParser =+  fmap toFlagAssignment <$> many $+    option optFlagReader $+      long "flag"+        <> metavar "package_name:flag_name:true|false"+        <> short 'f'+        <> help "A sinlge flag assignment for a package - e.g. inline-c:gsl-example:true"++toFlagAssignment :: [(String, String, Bool)] -> Map.Map PackageName FlagAssignment+toFlagAssignment xs =+  Map.map toAssignment $+    foldr (\(name, fname, fvalue) acc -> Map.insertWith (<>) (mkPackageName name) [(mkFlagName fname, fvalue)] acc) Map.empty xs+  where+    toAssignment = foldr (\(fname, fvalue) acc -> insertFlagAssignment fname fvalue acc) (mkFlagAssignment [])++-----------------------------------------------------------------------------++-- | Read a 'Version'+-- This function calls 'simpleParsec'.+optVersionReader :: ReadM Version+optVersionReader =+  eitherReader+    ( \s -> case simpleParsec s of+        Just v -> Right v+        _ -> Left $ "Failed to parse version: " <> s+    )++-- | Read a 'PackageName'+-- This function never fails, because it just wraps the input string with 'mkPackageName'.+optPackageNameReader :: ReadM PackageName+optPackageNameReader = eitherReader $ Right . mkPackageName

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-}  -- | Copyright: (c) 2020-2021 berberman@@ -7,7 +8,8 @@ -- Portability: portable -- Miscellaneous functions used crossing modules. module Distribution.ArchHs.Utils-  ( getPkgName,+  ( findCabalFile,+    getPkgName,     getPkgName',     getPkgVersion,     dependencyTypeToKind,@@ -36,6 +38,7 @@     noDiff,     mapDiff,     unDiff,+    archHsVersion,   ) where @@ -54,7 +57,23 @@ import Distribution.Types.PkgconfigName import Distribution.Utils.ShortText (fromShortText) import GHC.Stack (callStack, prettyCallStack)+import Options.Applicative.Simple (simpleVersion)+import qualified Paths_arch_hs as Path+import System.Directory (listDirectory)+import System.FilePath (takeExtension) +-- | Find a cabal file in @dir@,+-- throws error if nothing or more than one files are found+findCabalFile :: FilePath -> IO FilePath+findCabalFile dir =+  listDirectory dir+    >>= ( \case+            [x] -> pure $ dir </> x+            [] -> fail $ "Unable to find any cabal file in directory " <> dir+            xs -> fail $ "Found more than one cabal files" <> show xs <> "in directory " <> dir+        )+      . filter (\x -> takeExtension x == ".cabal")+ -- | Extract the package name from a 'ExeDependency'. unExe :: ExeDependency -> PackageName unExe (ExeDependency name _ _) = name@@ -212,3 +231,7 @@ unDiff (First x) = x unDiff (Second x) = x unDiff (Both x _) = x++-- | The version of arch-hs+archHsVersion :: String+archHsVersion = $(simpleVersion Path.version)

@@ -1,73 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--module Main (main) where--import Control.Monad (unless)-import Distribution.ArchHs.CommunityDB-import Distribution.ArchHs.Exception-import Distribution.ArchHs.Hackage-import Distribution.ArchHs.Internal.Prelude-import Distribution.ArchHs.PP-import Distribution.ArchHs.Types-import GHC.IO.Encoding (setLocaleEncoding, utf8)-import Network.HTTP.Client (Manager)-import Network.HTTP.Client.TLS (newTlsManager)-import Submit-import System.Directory (doesFileExist)-import System.Environment (lookupEnv)--main :: IO ()-main = printHandledIOException $-  do-    setLocaleEncoding utf8-    Options {..} <- runArgsParser--    token <- lookupEnv "HACKAGE_API_TOKEN"--    when (null token) $-      printWarn "You didn't set HACKAGE_API_TOKEN, dry run only."--    let hasOutput = not $ null optOutput-    when hasOutput $ do-      printInfo $ "Output will be dumped to" <+> pretty optOutput-      exist <- doesFileExist optOutput-      when exist $-        printWarn $ "File" <+> pretty optOutput <+> "already existed" <+> "overwrite it"-    printInfo "Start running..."-    unless (optUpload || hasOutput) $-      printWarn "Run diff and check only"--#ifdef ALPM-    let src = if optAlpm then "libalpm" else defaultCommunityDBPath-    printInfo $ "Loading community.db from" <+> pretty src-    community <- if optAlpm then loadCommunityDBFFI else loadCommunityDB defaultCommunityDBPath-#else-    printInfo $ "Loading community.db from" <+> pretty optCommunityDBPath-    community <- loadCommunityDB optCommunityDBPath-#endif--    hackagePath <- if null optHackagePath then lookupHackagePath else return optHackagePath--    printInfo $ "Loading hackage from" <+> pretty hackagePath--    hackage <- loadHackageDB hackagePath--    manager <- newTlsManager--    runSubmit community hackage manager (submit token optOutput optUpload) & printAppResult--runSubmit ::-  CommunityDB ->-  HackageDB ->-  Manager ->-  Sem '[CommunityEnv, HackageEnv, Reader Manager, WithMyErr, Embed IO, Final IO] a ->-  IO (Either MyException a)-runSubmit community hackage manager =-  runFinal-    . embedToFinal-    . errorToIOFinal-    . runReader manager-    . runReader hackage-    . runReader community

@@ -1,218 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}--module Submit-  ( Options (..),-    runArgsParser,-    submit,-  )-where--import Control.Monad (unless)-import Data.Algorithm.Diff (getGroupedDiff)-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy as LBS-import qualified Data.Map.Strict as Map-import Data.Maybe (fromJust)-import qualified Data.Text as T-import Data.Void (Void)-import Distribution.ArchHs.Exception-import Distribution.ArchHs.Hackage-import Distribution.ArchHs.Internal.Prelude-import Distribution.ArchHs.Local-import Distribution.ArchHs.Name-import Distribution.ArchHs.PP-import Distribution.ArchHs.Types-import Distribution.ArchHs.Utils (filterFirstDiff, filterSecondDiff, mapDiff, noDiff)-import Network.HTTP.Client-import Options.Applicative hiding (header)-import qualified Options.Applicative-import qualified Text.Megaparsec as M-import Text.Megaparsec.Char as M--#ifndef ALPM-import Distribution.ArchHs.CommunityDB (defaultCommunityDBPath)-#endif--data Options = Options-  { optHackagePath :: FilePath,-#ifndef ALPM-    optCommunityDBPath :: FilePath,-#else-    optAlpm :: Bool,-#endif-    optOutput :: FilePath,-    optUpload :: Bool-  }--cmdOptions :: Parser Options-cmdOptions =-  Options-    <$> strOption-      ( long "hackage"-          <> metavar "PATH"-          <> short 'h'-          <> help "Path to hackage index tarball"-          <> showDefault-          <> value ""-      )-#ifndef ALPM-    <*> strOption-      ( long "community"-          <> metavar "PATH"-          <> short 'c'-          <> help "Path to community.db"-          <> showDefault-          <> value defaultCommunityDBPath-      )-#else-      <*> switch-        ( long "alpm"-            <> help "Use libalpm to parse community db"-        )-#endif-    <*> Options.Applicative.option-      str-      ( long "output"-          <> metavar "PATH"-          <> short 'o'-          <> help "Output path of generated .csv file"-          <> value ""-      )-    <*> switch-      ( long "upload"-          <> short 'u'-          <> help "Upload to hackage"-      )--runArgsParser :: IO Options-runArgsParser =-  execParser $-    info-      (cmdOptions <**> helper)-      ( fullDesc-          <> progDesc "Try to reach the TARGET QAQ."-          <> Options.Applicative.header "arch-hs-submit - a program submitting haskell packages in community to hackage arch distro."-      )--type DistroRecord = (String, String, String)--type DistroCSV = [DistroRecord]--renderDistroCSV :: DistroCSV -> String-renderDistroCSV = init . unlines . fmap (\(a, b, c) -> wrap a <> "," <> wrap b <> "," <> wrap c)-  where-    wrap x = "\"" <> x <> "\""--distroCSVParser :: M.Parsec Void String DistroCSV-distroCSVParser = M.sepBy distroRecordParser newline--distroRecordParser :: M.Parsec Void String DistroRecord-distroRecordParser =-  (M.between (M.char '"') (M.char '"') (M.many $ M.noneOf (",\"\n" :: String)) `M.sepBy` M.char ',') >>= \case-    [a, b, c] -> return (a, b, c)-    _ -> fail "Failed to parse record"--parseDistroCSV :: String -> DistroCSV-parseDistroCSV s = case M.parse distroCSVParser "DistroCSV" s of-  Left err -> fail $ M.errorBundlePretty err-  Right x -> x--genCSV :: Members [CommunityEnv, HackageEnv, Embed IO] r => Sem r DistroCSV-genCSV = do-  communityDb <- ask @CommunityDB-  notLinked <- getAndPrintNotLinked--  let communityPackages = Map.toList communityDb-      inHackage = (`notElem` notLinked)-      fields =-        communityPackages-          ^.. each-            . filtered (((&&) <$> inHackage <*> isHaskellPackage) . (^. _1))-          <&> (_1 <<%~ toHackageName)-          & sortBy (\x y -> (x ^. _2 . _1) `compare` (y ^. _2 . _1))-      prefix = "https://www.archlinux.org/packages/community/x86_64/"-      processField (archLinuxName, (hackageName, version)) =-        let archLinuxName' =-              if hackageName `elem` ghcLibList || hackageName == "ghc"-                then "ghc"-                else unArchLinuxName archLinuxName-         in (unPackageName hackageName, version, prefix <> archLinuxName')-  return $ processField <$> fields--submit :: Members [HackageEnv, CommunityEnv, WithMyErr, Reader Manager, Embed IO] r => Maybe String -> FilePath -> Bool -> Sem r ()-submit token output upload = do-  csv <- genCSV-  let v = renderDistroCSV csv-  embed $-    unless (null output) $ do-      printInfo $ "Write file" <> colon <+> pretty output-      writeFile output v-  check csv-  manager <- ask-  interceptHttpException $-    when ((not . null) token && upload) $ do-      printInfo "Uploading..."-      initialRequest <- parseRequest "https://hackage.haskell.org/distro/Arch/packages"-      let req =-            initialRequest-              { method = "PUT",-                requestBody = RequestBodyBS . BS.pack $ v,-                requestHeaders =-                  [ ("Authorization", "X-ApiKey " <> BS.pack (fromJust token)),-                    ("Content-Type", "text/csv")-                  ]-              }-      result <- httpLbs req manager-      printInfo $ "Status" <> colon <+> viaShow (responseStatus result)-      printInfo "ResponseBody:"-      printInfo . pretty . decodeUtf8 . LBS.toStrict $ responseBody result--check :: Members [HackageEnv, WithMyErr, Reader Manager, Embed IO] r => DistroCSV -> Sem r ()-check community = do-  printInfo "Checking generated csv file..."--  req <- interceptHttpException $ parseRequest "https://hackage.haskell.org/distro/Arch/packages.csv"-  printInfo "Downloading csv from hackage..."-  manager <- ask-  result <- interceptHttpException $ httpLbs req manager-  let bs = responseBody result-      hackage = parseDistroCSV . T.unpack . decodeUtf8 . LBS.toStrict $ bs--  let diff = getGroupedDiff hackage community-      diffOld = filterFirstDiff diff >>= (ppDiffColored . mapDiff (fmap ppRecord))-      diffNew = filterSecondDiff diff >>= (ppDiffColored . mapDiff (fmap ppRecord))-      ppRecord (name, version, url) = "(" <> name <> ", " <> version <> ", " <> url <> ")"-      j g x = if null x then "[]" else g x-  embed . putDoc . annMagneta $ "Diff" <> colon <> line-  embed . putDoc . indent 2 $-    if noDiff diff-      then "[]"-      else-        j cat diffOld-          <> splitLine-          <> j cat diffNew-          <> line--  embed . putDoc $-    "Found"-      <+> pretty (length hackage)-      <+> "packages with submitted distribution information in hackage, and"-      <+> pretty (length community)-      <+> "haskell packages in"-      <+> ppCommunity-      <> dot-      <> line--getAndPrintNotLinked :: Members [CommunityEnv, HackageEnv, Embed IO] r => Sem r [ArchLinuxName]-getAndPrintNotLinked = do-  communityHaskellPackages <- filter isHaskellPackage . Map.keys <$> ask @CommunityDB-  hackagePackages <- Map.keys <$> ask @HackageDB-  let result = filter (\x -> toHackageName x `notElem` hackagePackages) communityHaskellPackages--  unless (null result) $-    printWarn $ "Following packages in" <+> ppCommunity <+> "are not linked to hackage:"--  embed . putStr . unlines $ unArchLinuxName <$> result-  return result

@@ -0,0 +1,81 @@+module Args+  ( CommonOptions (..),+    SubmitOptions (..),+    CheckOptions (..),+    Mode (..),+    runArgsParser,+  )+where++import Distribution.ArchHs.Options+import Distribution.ArchHs.Utils (archHsVersion)++-----------------------------------------------------------------------------++data CommonOptions = CommonOptions+  { optHackage :: HackageDBOptions,+    optCommunityDB :: CommunityDBOptions+  }++commonOptionsParser :: Parser CommonOptions+commonOptionsParser =+  CommonOptions <$> hackageDBOptionsParser <*> communityDBOptionsParser++-----------------------------------------------------------------------------++data SubmitOptions = SubmitOptions+  { optOutput :: FilePath,+    optUpload :: Bool+  }++submitOptionsParser :: Parser SubmitOptions+submitOptionsParser =+  SubmitOptions+    <$> option+      str+      ( long "output"+          <> metavar "PATH"+          <> short 'o'+          <> help "Output path of generated .csv file"+          <> value ""+      )+    <*> switch+      ( long "upload"+          <> short 'u'+          <> help "Upload to hackage"+      )++-----------------------------------------------------------------------------++newtype CheckOptions = CheckOptions+  { optShowGHCLibs :: Bool+  }++checkOptionsParser :: Parser CheckOptions+checkOptionsParser =+  CheckOptions+    <$> switch (long "show-ghc-libs" <> help "Include GHC and GHC libs")++-----------------------------------------------------------------------------++data Mode = Submit CommonOptions SubmitOptions | Check CommonOptions CheckOptions++runArgsParser :: IO Mode+runArgsParser =+  snd <$> do+    simpleOptions+      archHsVersion+      "arch-hs-sync - sync metadata of Haskell packages between [community] and Hackage"+      "arch-hs-sync is designed to be used by Hackage distribution maintainers"+      (pure ())+      $ do+        addCommand+          "submit"+          "submit distribution information to Hackage"+          id+          (Submit <$> commonOptionsParser <*> submitOptionsParser)+        addCommand+          "check"+          "check inconsistencies of Haskell packages version"+          id+          (Check <$> commonOptionsParser <*> checkOptionsParser)

@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}++module Check (check) where++import Data.Maybe (maybeToList)+import Distribution.ArchHs.Exception+import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Name (isGHCLibs)+import Distribution.ArchHs.PP+import Distribution.ArchHs.Types+import Distribution.Package (packageName, packageVersion)+import Utils++check :: Members [HackageEnv, CommunityEnv, WithMyErr, Embed IO] r => Bool -> Sem r ()+check includeGHC = do+  linked <- linkedHaskellPackages+  let result =+        [ annMagneta (pretty (unArchLinuxName archName))+            <+> "in"+            <+> ppCommunity+            <+> "has version"+            <+> (if isHackageNewer then annRed else annGreen) (viaPretty archVersion)+            <> comma+            <+> "but linked"+            <+> annMagneta (pretty (unPackageName hackageName))+            <+> "in"+            <+> annCyan "Hackage"+            <+> "has"+            <+> (if isHackageNewer then "a newer" else "an older")+            <+> "version"+            <+> (if isHackageNewer then annGreen else annRed) (viaPretty hackageVersion)+          | (archName, rawArchVersion, cabal) <- linked,+            let hackageName = packageName cabal+                hackageVersion = packageVersion cabal,+            archVersion <- maybeToList $ simpleParsec rawArchVersion,+            includeGHC || not (isGHCLibs hackageName),+            archVersion /= hackageVersion,+            let isHackageNewer = hackageVersion > archVersion+        ]+  if (null result)+    then printSuccess "Finished checking"+    else do+      printWarn $ "Finished checking with inconsistenc(ies):"+      embed $ putDoc $ vcat result <> line

@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}++module Main (main) where++import Args+import Check+import Control.Monad (unless)+import Distribution.ArchHs.Exception+import Distribution.ArchHs.Hackage+import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Options+import Distribution.ArchHs.PP+import Distribution.ArchHs.Types+import Network.HTTP.Client+import Network.HTTP.Client.TLS (newTlsManager)+import Submit+import System.Directory (doesFileExist)+import System.Environment (lookupEnv)++main :: IO ()+main = runArgsParser >>= runMode++runCheck ::+  CommunityDB ->+  HackageDB ->+  Bool ->+  IO (Either MyException ())+runCheck community hackage includeGHC=+  ( runFinal+      . embedToFinal @IO+      . errorToIOFinal+      . runReader hackage+      . runReader community+  )+    (check includeGHC)++runSubmit ::+  CommunityDB ->+  HackageDB ->+  Manager ->+  Maybe String ->+  FilePath ->+  Bool ->+  IO (Either MyException ())+runSubmit community hackage manager token output upload =+  ( runFinal+      . embedToFinal @IO+      . errorToIOFinal+      . runReader manager+      . runReader hackage+      . runReader community+  )+    (submit token output upload)++runMode :: Mode -> IO ()+runMode = \case+  Submit CommonOptions {..} SubmitOptions {..} -> do+    community <- loadCommunityDBFromOptions optCommunityDB+    hackage <- loadHackageDBFromOptions optHackage++    token <- lookupEnv "HACKAGE_API_TOKEN"++    when (null token) $+      printWarn "You didn't set HACKAGE_API_TOKEN, dry run only."++    let hasOutput = not $ null optOutput+    when hasOutput $ do+      printInfo $ "Output will be dumped to" <+> pretty optOutput+      exist <- doesFileExist optOutput+      when exist $+        printWarn $ "File" <+> pretty optOutput <+> "already existed" <+> "overwrite it"++    printInfo "Start running..."+    unless (optUpload || hasOutput) $+      printWarn "Run diff and check only"++    manager <- newTlsManager+    runSubmit community hackage manager token optOutput optUpload & printAppResult+  Check CommonOptions {..} CheckOptions {..} -> do+    community <- loadCommunityDBFromOptions optCommunityDB+    hackage <- loadHackageDBFromOptions optHackage+    runCheck community hackage optShowGHCLibs & printAppResult

@@ -0,0 +1,104 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++module Submit (submit) where++import Control.Monad (unless)+import Data.Algorithm.Diff (getGroupedDiff)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as LBS+import Data.List (sortOn)+import Data.Maybe (fromJust)+import qualified Data.Text as T+import Distribution.ArchHs.Exception+import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Name (isGHCLibs)+import Distribution.ArchHs.PP+import Distribution.ArchHs.Types+import Distribution.ArchHs.Utils+import Distribution.Package (packageName)+import Network.HTTP.Client+import Submit.CSV+import Utils++-- | Generate Distro CSV from Community DB+genCSV :: Members [CommunityEnv, HackageEnv, WithMyErr, Embed IO] r => Sem r DistroCSV+genCSV = do+  linked <- linkedHaskellPackages+  pure $+    sortOn+      (\x -> x ^. _1)+      [ (unPackageName hackageName, version, prefix <> tweakedName)+        | (archLinuxName, version, packageName -> hackageName) <- linked,+          let tweakedName =+                if isGHCLibs hackageName+                  then "ghc"+                  else unArchLinuxName archLinuxName+              prefix = "https://www.archlinux.org/packages/community/x86_64/"+      ]++-- | Check and submit distro CSV to Hackage+submit :: Members [HackageEnv, CommunityEnv, WithMyErr, Reader Manager, Embed IO] r => Maybe String -> FilePath -> Bool -> Sem r ()+submit token output upload = do+  csv <- genCSV+  let v = renderDistroCSV csv+  embed $+    unless (null output) $ do+      printInfo $ "Write file" <> colon <+> pretty output+      writeFile output v+  check csv+  manager <- ask+  interceptHttpException $+    when ((not . null) token && upload) $ do+      printInfo "Uploading..."+      initialRequest <- parseRequest "https://hackage.haskell.org/distro/Arch/packages"+      let req =+            initialRequest+              { method = "PUT",+                requestBody = RequestBodyBS . BS.pack $ v,+                requestHeaders =+                  [ ("Authorization", "X-ApiKey " <> BS.pack (fromJust token)),+                    ("Content-Type", "text/csv")+                  ]+              }+      result <- httpLbs req manager+      printInfo $ "Status" <> colon <+> viaShow (responseStatus result)+      printInfo "ResponseBody:"+      printInfo . pretty . decodeUtf8 . LBS.toStrict $ responseBody result++-- | Download Distro CSV from Hackage and print differences from @community@+check :: Members [HackageEnv, WithMyErr, Reader Manager, Embed IO] r => DistroCSV -> Sem r ()+check community = do+  printInfo "Checking generated csv file..."++  req <- interceptHttpException $ parseRequest "https://hackage.haskell.org/distro/Arch/packages.csv"+  printInfo "Downloading csv from hackage..."+  manager <- ask+  result <- interceptHttpException $ httpLbs req manager+  let bs = responseBody result+      hackage = parseDistroCSV . T.unpack . decodeUtf8 . LBS.toStrict $ bs++  let diff = getGroupedDiff hackage community+      diffOld = filterFirstDiff diff >>= (ppDiffColored . mapDiff (fmap ppRecord))+      diffNew = filterSecondDiff diff >>= (ppDiffColored . mapDiff (fmap ppRecord))+      ppRecord (name, version, url) = "(" <> name <> ", " <> version <> ", " <> url <> ")"+      j g x = if null x then "[]" else g x+  embed . putDoc . annMagneta $ "Diff" <> colon <> line+  embed . putDoc . indent 2 $+    if noDiff diff+      then "[]"+      else+        j cat diffOld+          <> splitLine+          <> j cat diffNew+          <> line++  embed . putDoc $+    "Found"+      <+> pretty (length hackage)+      <+> "packages with submitted distribution information in hackage, and"+      <+> pretty (length community)+      <+> "haskell packages in"+      <+> ppCommunity+      <> dot+      <> line

@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Submit.CSV+  ( DistroRecord,+    DistroCSV,+    renderDistroCSV,+    parseDistroCSV,+  )+where++import Data.Void (Void)+import qualified Text.Megaparsec as M+import qualified Text.Megaparsec.Char as M++type DistroRecord = (String, String, String)++type DistroCSV = [DistroRecord]++renderDistroCSV :: DistroCSV -> String+renderDistroCSV = init . unlines . fmap (\(a, b, c) -> wrap a <> "," <> wrap b <> "," <> wrap c)+  where+    wrap x = "\"" <> x <> "\""++distroCSVParser :: M.Parsec Void String DistroCSV+distroCSVParser = M.sepBy distroRecordParser M.newline++distroRecordParser :: M.Parsec Void String DistroRecord+distroRecordParser =+  (M.between (M.char '"') (M.char '"') (M.many $ M.noneOf (",\"\n" :: String)) `M.sepBy` M.char ',') >>= \case+    [a, b, c] -> return (a, b, c)+    _ -> fail "Failed to parse record"++parseDistroCSV :: String -> DistroCSV+parseDistroCSV s = case M.parse distroCSVParser "DistroCSV" s of+  Left err -> fail $ M.errorBundlePretty err+  Right x -> x

@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Utils+  ( linkedHaskellPackages,+  )+where++import Control.Monad (unless)+import qualified Data.Map.Strict as Map+import Distribution.ArchHs.Exception+import Distribution.ArchHs.Hackage+import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Name+import Distribution.ArchHs.PP+import Distribution.ArchHs.Types++linkedHaskellPackages ::+  Members [CommunityEnv, HackageEnv, WithMyErr, Embed IO] r =>+  Sem r ([(ArchLinuxName, ArchLinuxVersion, GenericPackageDescription)])+linkedHaskellPackages = do+  communityHaskellPackages <- filter (isHaskellPackage . fst) . Map.toList <$> ask @CommunityDB+  hackagePackages <- Map.keys <$> ask @HackageDB+  let go xs ys ((name, version) : pkgs) =+        let hName = toHackageName name+         in if hName `elem` hackagePackages+              then getLatestCabal hName >>= \cabal -> go ((name, version, cabal) : xs) ys pkgs+              else go xs (name : ys) pkgs+      go xs ys [] = pure (xs, ys)+  (linked, unlinked) <- go [] [] communityHaskellPackages+  embed $+    unless (null unlinked) $ do+      printWarn $ "Following packages in" <+> ppCommunity <+> "are not linked to hackage:"+      putStrLn . unlines $ unArchLinuxName <$> unlinked+  pure linked