arch-hs 0.10.2.0 → 0.11.0.0

raw patch · 20 files changed

+503/−117 lines, 20 filesdep ~Cabaldep ~aesondep ~algebraic-graphsnew-component:exe:arch-hs-rdepchecknew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: Cabal, aeson, algebraic-graphs, megaparsec, polysemy, template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• arch-hs.cabal +21/−10
• cbits/clib.c +60/−29
• cbits/clib.h +8/−3
• data/NAME_PRESET.json +19/−5
• diff/Main.hs +0/−1
• rdepcheck/Args.hs +37/−0
• rdepcheck/Check.hs +116/−0
• rdepcheck/Main.hs +51/−0
• src/Distribution/ArchHs/CommunityDB.hs +77/−30
• src/Distribution/ArchHs/Compat.hs +13/−0
• src/Distribution/ArchHs/Core.hs +1/−1
• src/Distribution/ArchHs/Exception.hs +3/−1
• src/Distribution/ArchHs/Internal/NamePresetLoader.hs +1/−1
• src/Distribution/ArchHs/Local.hs +1/−0
• src/Distribution/ArchHs/PkgBuild.hs +1/−1
• src/Distribution/ArchHs/PkgDesc.hs +43/−30
• src/Distribution/ArchHs/Types.hs +32/−1
• sync/Main.hs +4/−2
• sync/Utils.hs +2/−2

@@ -3,9 +3,22 @@ `arch-hs` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.11.0.0++- Add `arch-hs-rdepcheck`++- Support Cabal 3.6++- Fix datasubdir generation++- Update dependency versions++- Update name preset+ ## 0.10.2.0  - Don't treat special licenses as custom licenses+ - Add `--datasubdir` to template  ## 0.10.1.0

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               arch-hs-version:            0.10.2.0+version:            0.11.0.0 synopsis:           Distribute hackage packages to archlinux description:   @arch-hs@ is a command-line program, which simplifies the process of producing@@ -23,7 +23,7 @@   CHANGELOG.md   README.md -tested-with:        GHC ==8.10.7 || ==9.0.2+tested-with:        GHC ==8.10.7 || ==9.0.2 || ==9.2.3  source-repository head   type:     git@@ -36,12 +36,12 @@  common common-options   build-depends:-    , aeson                        >=1.5.4   && <2.1-    , algebraic-graphs             >=0.5     && <0.7+    , aeson                        >=1.5.4    && <2.2+    , algebraic-graphs             >=0.5      && <0.8     , arch-web                     ^>=0.1.1-    , base                         >=4.12    && <5+    , base                         >=4.12     && <5     , bytestring-    , Cabal                        >=3.2     && <3.5+    , Cabal                        >=3.2      && <3.7     , conduit                      ^>=1.3.2     , conduit-extra                ^>=1.3.5     , containers@@ -52,18 +52,18 @@     , hackage-db                   ^>=2.1.0     , http-client     , http-client-tls-    , megaparsec                   ^>=9.0.0 || ^>=9.1.0 || ^>=9.2.0+    , megaparsec                   ^>=9.0.0   || ^>=9.1.0  || ^>=9.2.0 || ^>=9.3.0     , microlens                    ^>=0.4.11     , microlens-th                 ^>=0.4.3     , neat-interpolation           ^>=0.5.1     , optparse-simple              ^>=0.1.1.3-    , polysemy                     >=1.5.0   && <1.7.2+    , polysemy                     >=1.5.0    && <1.9.1     , prettyprinter                ^>=1.7.0     , prettyprinter-ansi-terminal  ^>=1.1.2-    , servant-client               >=0.18.2  && <0.20+    , servant-client               >=0.18.2   && <0.20     , split                        ^>=0.2.3     , tar-conduit                  ^>=0.3.2-    , template-haskell             ^>=2.16.0 || ^>=2.17.0+    , template-haskell             ^>=2.16.0  || ^>=2.17.0 || ^>=2.18.0     , text    ghc-options:@@ -150,6 +150,17 @@     Submit     Submit.CSV     Utils++  build-depends:  arch-hs+  ghc-options:    -threaded -rtsopts -with-rtsopts=-N++executable arch-hs-rdepcheck+  import:         common-options+  hs-source-dirs: rdepcheck+  main-is:        Main.hs+  other-modules:+    Args+    Check    build-depends:  arch-hs   ghc-options:    -threaded -rtsopts -with-rtsopts=-N

@@ -4,7 +4,20 @@ #include <libgen.h> #include <string.h> -void query_community(callback_t callback) {+void dispatch_list(community_list_callback_t callback, const char *name,+                   const char *key, alpm_list_t *src) {+  if (src == NULL)+    return;+  alpm_list_t *l;+  for (l = src; l; l = alpm_list_next(l)) {+    alpm_depend_t *dep = l->data;+    const char *d_ver = dep->version;+    callback(name, key, dep->name, d_ver == NULL ? "" : d_ver);+  }+}++void query_community(community_pkg_callback_t pkg_callback,+                     community_list_callback_t list_callback) {   alpm_errno_t err;   alpm_handle_t *handle;   handle = alpm_initialize("/", "/var/lib/pacman", &err);@@ -17,6 +30,16 @@   for (i = pkgs; i; i = alpm_list_next(i)) {     const char *name = alpm_pkg_get_name(i->data);     const char *ver = alpm_pkg_get_version(i->data);+    const char *desc = alpm_pkg_get_desc(i->data);+    const char *url = alpm_pkg_get_url(i->data);+    alpm_list_t *depends = alpm_pkg_get_depends(i->data);+    alpm_list_t *makedepends = alpm_pkg_get_makedepends(i->data);+    alpm_list_t *checkdepends = alpm_pkg_get_checkdepends(i->data);+    alpm_list_t *provides = alpm_pkg_get_provides(i->data);+    alpm_list_t *conflicts = alpm_pkg_get_conflicts(i->data);+    alpm_list_t *replaces = alpm_pkg_get_replaces(i->data);+    alpm_list_t *optdepends = alpm_pkg_get_optdepends(i->data);+    pkg_callback(name, ver, desc, url);     if (strcmp(name, "ghc") == 0 || strcmp(name, "ghc-libs") == 0) {       alpm_list_t *v, *provides;       provides = alpm_pkg_get_provides(i->data);@@ -24,41 +47,49 @@         alpm_depend_t *d = v->data;         const char *d_name = d->name;         const char *d_ver = d->version;-        callback(d_name, d_ver);+        // promote+        pkg_callback(d_name, d_ver, "", "");       }-    } else-      callback(name, ver);+    }++    dispatch_list(list_callback, name, "depends", depends);+    dispatch_list(list_callback, name, "makedepends", makedepends);+    dispatch_list(list_callback, name, "checkdepends", checkdepends);+    dispatch_list(list_callback, name, "provides", provides);+    dispatch_list(list_callback, name, "conflicts", conflicts);+    dispatch_list(list_callback, name, "replaces", replaces);+    dispatch_list(list_callback, name, "optdepends", optdepends);   }   alpm_release(handle); } -void query_files(const char *dbname, callback_t callback) {-    alpm_errno_t err;-    alpm_handle_t *handle;-    handle = alpm_initialize("/", "/var/lib/pacman", &err);-    alpm_option_set_dbext(handle, ".files");-    alpm_db_t *db = alpm_register_syncdb(handle, dbname, ALPM_SIG_USE_DEFAULT);-    alpm_list_t *pkg, *pkgs = NULL;+void query_files(const char *dbname, file_callback_t callback) {+  alpm_errno_t err;+  alpm_handle_t *handle;+  handle = alpm_initialize("/", "/var/lib/pacman", &err);+  alpm_option_set_dbext(handle, ".files");+  alpm_db_t *db = alpm_register_syncdb(handle, dbname, ALPM_SIG_USE_DEFAULT);+  alpm_list_t *pkg, *pkgs = NULL; -    pkgs = alpm_db_get_pkgcache(db);+  pkgs = alpm_db_get_pkgcache(db); -    for (pkg = pkgs; pkg; pkg = alpm_list_next(pkg)) {-        const char *pkg_name = alpm_pkg_get_name(pkg->data);-        alpm_filelist_t *pkg_files = alpm_pkg_get_files(pkg->data);-        for (size_t file_num = 0; file_num < pkg_files->count; file_num++) {-            alpm_file_t *file = pkg_files->files + file_num;-            char *path = file->name;-            if (strncmp("usr/lib/", path, 8) != 0)-                continue;-            size_t n = strlen(path);-            if (path[n - 3] != '.')-                continue;-            if (!((path[n - 2] == 's' && path[n - 1] == 'o') ||-                  (path[n - 2] == 'p' && path[n - 1] == 'c')))-                continue;+  for (pkg = pkgs; pkg; pkg = alpm_list_next(pkg)) {+    const char *pkg_name = alpm_pkg_get_name(pkg->data);+    alpm_filelist_t *pkg_files = alpm_pkg_get_files(pkg->data);+    for (size_t file_num = 0; file_num < pkg_files->count; file_num++) {+      alpm_file_t *file = pkg_files->files + file_num;+      char *path = file->name;+      if (strncmp("usr/lib/", path, 8) != 0)+        continue;+      size_t n = strlen(path);+      if (path[n - 3] != '.')+        continue;+      if (!((path[n - 2] == 's' && path[n - 1] == 'o') ||+            (path[n - 2] == 'p' && path[n - 1] == 'c')))+        continue; -            callback(pkg_name, basename(path));-        }+      callback(pkg_name, basename(path));     }-    alpm_release(handle);+  }+  alpm_release(handle); }

@@ -1,10 +1,15 @@ #ifndef CLIB_H #define CLIB_H -typedef void callback_t(const char *, const char *);+typedef void file_callback_t(const char *pkg_name, const char *file_path);+typedef void community_pkg_callback_t(const char *pkg_name, const char *version,+                                      const char *desc, const char *url);+typedef void community_list_callback_t(const char *pkg_name, const char *key,+                                       const char *dependent_pkg_name,+                                       const char *dependent_pkg_version); -void query_community(callback_t callback);+void query_community(community_pkg_callback_t pkg_callback, community_list_callback_t list_callback); -void query_files(const char *dbname, callback_t callback);+void query_files(const char *dbname, file_callback_t callback);  #endif

@@ -1,12 +1,16 @@ {   "agda": "Agda",   "alex": "alex",+  "allure": "Allure",+  "arbtt": "arbtt",   "arch-hs": "arch-hs",   "bnfc": "BNFC",+  "bustle": "bustle",   "c2hs": "c2hs",   "haskell-cabal": "Cabal",   "cabal-install": "cabal-install",   "cabal-plan": "cabal-plan",+  "cbor-tool": "cbor-tool",   "cgrep": "cgrep",   "clash-ghc": "clash-ghc",   "cryptol": "cryptol",@@ -19,7 +23,10 @@   "dhall-yaml": "dhall-yaml",   "git-annex": "git-annex",   "git-repair": "git-repair",+  "glirc": "glirc",   "happy": "happy",+  "haskell-boolean": "Boolean",+  "haskell-boundedchan": "BoundedChan",   "haskell-chasingbottoms": "ChasingBottoms",   "haskell-ci": "haskell-ci",   "haskell-configfile": "ConfigFile",@@ -36,39 +43,43 @@   "haskell-gi-base": "haskell-gi-base",   "haskell-gi-overloading": "haskell-gi-overloading",   "haskell-glob": "Glob",-  "haskell-gtk": "gtk3",   "haskell-graphscc": "GraphSCC",   "haskell-hopenpgp": "hOpenPGP",+  "haskell-hstringtemplate": "HStringTemplate",   "haskell-htf": "HTF",   "haskell-http": "HTTP",   "haskell-hunit": "HUnit",   "haskell-ifelse": "IfElse",+  "haskell-iospec": "IOSpec",   "haskell-juicypixels": "JuicyPixels",   "haskell-language-server": "haskell-language-server",   "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",   "haskell-onetuple": "OneTuple",   "haskell-only": "Only",   "haskell-hsopenssl": "HsOpenSSL",+  "haskell-hsopenssl-x509-system": "HsOpenSSL-x509-system",   "haskell-hsyaml": "HsYAML",   "haskell-hsyaml-aeson": "HsYAML-aeson",+  "haskell-lambdahack": "LambdaHack",   "haskell-libbf": "libBF",   "haskell-memotrie": "MemoTrie",   "haskell-monadprompt": "MonadPrompt",+  "haskell-numinstances": "NumInstances",   "haskell-rsa": "RSA",   "haskell-puremd5": "pureMD5",   "haskell-quickcheck": "QuickCheck",+  "haskell-quickcheck-safe": "QuickCheck-safe",   "haskell-ranged-sets": "Ranged-sets",   "haskell-safesemaphore": "SafeSemaphore",   "haskell-sha": "SHA",   "haskell-smtlib": "smtLib",   "haskell-src": "haskell-src",   "haskell-src-exts": "haskell-src-exts",+  "haskell-src-exts-simple": "haskell-src-exts-simple",   "haskell-src-exts-util": "haskell-src-exts-util",   "haskell-src-meta": "haskell-src-meta",   "haskell-statevar": "StateVar",@@ -85,10 +96,12 @@   "hlint": "hlint",   "hoogle": "hoogle",   "hopenpgp-tools": "hopenpgp-tools",+  "hslua-cli": "hslua-cli",   "idris": "idris",+  "ihaskell": "ihaskell",+  "mighttpd2": "mighttpd2",   "misfortune": "misfortune",-  "pandoc": "pandoc",-  "pandoc-citeproc": "pandoc-citeproc",+  "pandoc-cli": "pandoc-cli",   "pandoc-crossref": "pandoc-crossref",   "postgrest": "postgrest",   "shellcheck": "ShellCheck",@@ -102,5 +115,6 @@   "xmobar": "xmobar",   "xmonad": "xmonad",   "xmonad-contrib": "xmonad-contrib",+  "xmonad-extras": "xmonad-extras",   "xmonad-utils": "xmonad-utils" }

@@ -7,7 +7,6 @@ import Args import Control.Monad (unless) import qualified Data.Map as Map-import Data.Text.Prettyprint.Doc.Render.Terminal import Diff import Distribution.ArchHs.Core (subsumeGHCVersion) import Distribution.ArchHs.Exception

@@ -0,0 +1,37 @@+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,+    optHackage :: HackageDBOptions,+    optPackageName :: PackageName+  }++cmdOptions :: Parser Options+cmdOptions =+  Options+    <$> optFlagAssignmentParser+    <*> communityDBOptionsParser+    <*> hackageDBOptionsParser+    <*> argument optPackageNameReader (metavar "TARGET")++runArgsParser :: IO Options+runArgsParser = do+  (x, ()) <-+    simpleOptions+      archHsVersion+      "arch-hs-rdepcheck - check the version of a dependent Haskell package"+      "arch-hs-rdepcheck is a CLI tool that shows all reverse dependencies of a Haskell package in [community], giving the version range how it is depended on"+      cmdOptions+      empty+  pure x

@@ -0,0 +1,116 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}++module Check (check) where++import Control.Monad (forM_, unless)+import Data.List (find)+import qualified Data.Map.Strict as Map+import Data.Maybe (catMaybes)+import Distribution.ArchHs.CommunityDB+import Distribution.ArchHs.Core+import Distribution.ArchHs.Exception+import Distribution.ArchHs.Hackage+import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Name+import Distribution.ArchHs.PP+import Distribution.ArchHs.PkgDesc+import Distribution.ArchHs.Types++data DepSrc = Check | Make | Run+  deriving stock (Show, Eq, Ord)++instance Pretty DepSrc where+  pretty = \case+    Check -> "CheckDepends"+    Make -> "MakeDepends"+    Run -> "Depends"++check ::+  Members+    [ CommunityEnv,+      HackageEnv,+      KnownGHCVersion,+      FlagAssignmentsEnv,+      Trace,+      DependencyRecord,+      WithMyErr,+      Embed IO+    ]+    r =>+  PackageName ->+  Sem r ()+check target = do+  let aTarget = toArchLinuxName target+  exists <- isInCommunity aTarget+  unless exists $ throw $ PkgNotFound target+  reverseDeps <-+    ( \xs ->+        [ (desc, [Make | md] <> [Check | cd] <> [Run | d])+          | ( _,+              desc@PkgDesc+                { _name = isHaskellPackage -> isHs,+                  _makeDepends = flip containsDep aTarget -> md,+                  _checkDepends = flip containsDep aTarget -> cd,+                  _depends = flip containsDep aTarget -> d+                }+              ) <-+              xs,+            isHs,+            md || cd || d+        ]+      )+      . Map.toList+      <$> ask @CommunityDB+  forM_ reverseDeps $ \(PkgDesc {..}, src) -> do+    eCabal <-+      try @MyException $+        getCabal (toHackageName _name) =<< case simpleParsec _version of+          Just v -> pure v+          _ -> throw $ VersionNoParse _version+    case eCabal of+      Right cabal -> do+        result <- getDepVersion cabal target src+        embed . putDoc $+          vsep+            ( annMagneta "Reverse dependency" <> colon+                <+> pretty (unArchLinuxName _name)+                : [indent 2 $ pretty s <> colon <+> viaPretty r | (s, r) <- result]+            )+            <> line+      Left e ->+        printWarn $ "Skip" <+> pretty (unArchLinuxName _name) <> colon <+> viaShow e++getDepVersion ::+  Members+    [ KnownGHCVersion,+      FlagAssignmentsEnv,+      DependencyRecord,+      Trace+    ]+    r =>+  GenericPackageDescription ->+  PackageName ->+  [DepSrc] ->+  Sem r [(DepSrc, VersionRange)]+getDepVersion cabal name src = do+  (libDeps, libToolsDeps, _) <- collectLibDeps id cabal+  (subLibDeps, subLibToolsDeps, _) <- collectSubLibDeps id cabal []+  (exeDeps, exeToolsDeps, _) <- collectExeDeps id cabal []+  (testDeps, testToolsDeps, _) <- collectTestDeps id cabal []+  setupDeps <- collectSetupDeps id cabal+  let flatten = mconcat . fmap snd+      deps = libDeps <> concatMap flatten [exeDeps, subLibDeps]+      makeOrCheckDeps = libToolsDeps <> setupDeps <> concatMap flatten [subLibToolsDeps, exeToolsDeps, testDeps, testToolsDeps]+  pure $+    catMaybes+      [ case s of+          Check -> f makeOrCheckDeps+          Make -> f makeOrCheckDeps+          Run -> f deps+        | s <- src,+          let f xs = (_1 .~ s) <$> find ((== name) . fst) xs+      ]

@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Main (main) where++import Args+import Check+import Control.Monad (unless)+import qualified Data.Map.Strict as Map+import Distribution.ArchHs.Core+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 GHC.IO.Encoding (setLocaleEncoding)+import GHC.IO.Encoding.UTF8 (utf8)++main :: IO ()+main = printHandledIOException $+  do+    setLocaleEncoding utf8+    Options {..} <- runArgsParser+    let isFlagEmpty = Map.null optFlags++    unless isFlagEmpty $ do+      printInfo "You assigned flags:"+      putDoc $ prettyFlagAssignments optFlags <> line++    hackage <- loadHackageDBFromOptions optHackage+    community <- loadCommunityDBFromOptions optCommunityDB++    printInfo "Start running..."+    runCheck hackage community optFlags (subsumeGHCVersion $ check optPackageName) & printAppResult++runCheck ::+  HackageDB ->+  CommunityDB ->+  FlagAssignments ->+  Sem '[HackageEnv, CommunityEnv, FlagAssignmentsEnv, Trace, DependencyRecord, WithMyErr, Embed IO, Final IO] a ->+  IO (Either MyException a)+runCheck community flags manager =+  runFinal+    . embedToFinal+    . errorToIOFinal+    . evalState Map.empty+    . ignoreTrace+    . runReader manager+    . runReader flags+    . runReader community

@@ -13,6 +13,7 @@     loadCommunityDB,     isInCommunity,     versionInCommunity,+    getPkgDesc, #ifdef ALPM     loadCommunityDBFFI, #endif@@ -29,40 +30,80 @@ import Distribution.ArchHs.Name import Distribution.ArchHs.PkgDesc import Distribution.ArchHs.Types-import Distribution.ArchHs.Utils+import Data.Maybe (mapMaybe)  -----------------------------------------------------------------------------  #ifdef ALPM {-# LANGUAGE ForeignFunctionInterface #-}-import qualified Data.Sequence as Seq-import Data.Foldable (toList)+ import Data.IORef (IORef, modifyIORef', newIORef, readIORef)+import Distribution.ArchHs.Utils (extractFromEVR) import Foreign.C.String (CString, peekCString) import Foreign.Ptr (FunPtr, freeHaskellFunPtr)  foreign import ccall "wrapper"-  wrap :: (CString -> CString -> IO ()) -> IO (FunPtr (CString -> CString -> IO ()))+  wrap :: (CString -> CString -> CString -> CString -> IO ()) -> IO (FunPtr (CString -> CString -> CString -> CString -> IO ()))  foreign import ccall "clib.h query_community"-  query_community :: FunPtr (CString -> CString -> IO ()) -> IO ()+  query_community :: FunPtr (CString -> CString -> CString -> CString -> IO ()) -> FunPtr (CString -> CString -> CString -> CString -> IO ()) -> IO () -callback :: IORef (Seq.Seq (ArchLinuxName, ArchLinuxVersion)) -> CString -> CString -> IO ()-callback ref x y = do-  x' <- peekCString x-  y' <- peekCString y-  modifyIORef' ref (Seq.|> (ArchLinuxName x', extractFromEVR y'))+type RawPkgSet = IORef (Map.Map ArchLinuxName ((ArchLinuxVersion, String, String), IORef (Map.Map String [(ArchLinuxName, Maybe ArchLinuxVersion)]))) +pkgCallback :: RawPkgSet -> CString -> CString -> CString -> CString -> IO ()+pkgCallback ref name version desc url = do+  name' <- peekCString name+  version' <- peekCString version+  desc' <- peekCString desc+  url' <- peekCString url+  m <- newIORef Map.empty+  modifyIORef' ref (Map.insert (ArchLinuxName name') ((extractFromEVR version', desc', url'), m))++listCallback :: RawPkgSet -> CString -> CString -> CString -> CString -> IO ()+listCallback ref name key dm dv = do+  name' <- peekCString name+  key' <- peekCString key+  dm' <- peekCString dm+  dv' <- peekCString dv+  s <- snd . (\r -> r Map.! ArchLinuxName name') <$> readIORef ref+  modifyIORef' s (Map.insertWith (++) key' [(ArchLinuxName dm', if null dv' then Nothing else Just (extractFromEVR dv'))])+ -- | The same purpose as 'loadCommunity' but use alpm to query community db instead. loadCommunityDBFFI :: IO CommunityDB loadCommunityDBFFI = do-  ref <- newIORef Seq.empty-  callbackW <- wrap $ callback ref-  query_community callbackW-  freeHaskellFunPtr callbackW-  Map.fromList . toList <$> readIORef ref+  ref <- newIORef Map.empty+  pkgCallbackW <- wrap $ pkgCallback ref+  listCallbackW <- wrap $ listCallback ref+  query_community pkgCallbackW listCallbackW+  freeHaskellFunPtr pkgCallbackW+  freeHaskellFunPtr listCallbackW+  s <- readIORef ref+  re <-+    mapM+      ( \(name, ((ver, desc, url), r)) -> do+          l <- readIORef r+          let f (Just xs) = uncurry PkgDependent <$> xs+              f Nothing = []+          pure+            ( name,+              PkgDesc+                { _name = name,+                  _version = ver,+                  _desc = desc,+                  _url = if null url then Nothing else Just url,+                  _depends = f $ l Map.!? "depends",+                  _provides = f $ l Map.!? "provides",+                  _conflicts = f $ l Map.!? "conflicts",+                  _optDepends = f $ l Map.!? "optdepends",+                  _makeDepends = f $ l Map.!? "makedepends",+                  _checkDepends = f $ l Map.!? "checkdepends",+                  _replaces = f $ l Map.!? "replaces"+                }+            )+      )+      $ Map.toList s+  pure $ Map.fromList re #endif- -----------------------------------------------------------------------------  -- | Default path to @community.db@.@@ -72,7 +113,7 @@ loadCommunityDBC ::   (MonadResource m, PrimMonad m, MonadThrow m) =>   FilePath ->-  ConduitT i (ArchLinuxName, ArchLinuxVersion) m ()+  ConduitT i (ArchLinuxName, PkgDesc) m () loadCommunityDBC path = do   sourceFileBS path .| Zlib.ungzip .| Tar.untarChunks .| Tar.withEntries action   where@@ -80,17 +121,18 @@       when (Tar.headerFileType header == Tar.FTNormal) $ do         x <- mconcat <$> sinkList         let txt = T.unpack . decodeUtf8 $ x-            provided r = r Map.! "PROVIDES"-            parseProvidedTerm t = let s = splitOn "=" t in (s ^. ix 0, s ^. ix 1)-            result = case runDescFieldsParser (Tar.headerFilePath header) txt of-                    Right r -> case head $ r Map.! "NAME" of-                      "ghc" -> parseProvidedTerm <$> provided r-                      "ghc-libs" -> parseProvidedTerm <$> provided r-                      _ -> [(head $ r Map.! "NAME", extractFromEVR . head $ r Map.! "VERSION")]-                    -- Drop it if failed to parse-                    Left _ -> []--        yieldMany $ result & each . _1 %~ ArchLinuxName+            parsed = runDescParser (Tar.headerFilePath header) txt+            result = case parsed of+              Right desc ->+                desc+                  : ( if _name desc == ArchLinuxName "ghc"+                        || _name desc == ArchLinuxName "ghc-libs"+                        then mapMaybe promoteDependent (_provides desc)+                        else []+                    )+              -- Drop it if failed to parse+              Left _ -> []+        yieldMany $ (\desc -> (_name desc, desc)) <$> result  -- | Load @community.db@ from @path@. -- @desc@ files in the db will be parsed by @descParser@.@@ -107,7 +149,12 @@ -- | Get the version of a package in archlinux community repo. -- If the package does not exist, 'PkgNotFound' will be thrown. versionInCommunity :: (HasMyName n, Members [CommunityEnv, WithMyErr] r) => n -> Sem r ArchLinuxVersion-versionInCommunity name =+versionInCommunity name = _version <$> getPkgDesc name++-- | Get the pkgdesc a package in archlinux community repo.+-- If the package does not exist, 'PkgNotFound' will be thrown.+getPkgDesc :: (HasMyName n, Members [CommunityEnv, WithMyErr] r) => n -> Sem r PkgDesc+getPkgDesc name =   ask @CommunityDB >>= \db -> case db Map.!? toArchLinuxName name of-    Just x -> return x+    Just x -> pure x     _ -> throw $ PkgNotFound name

@@ -4,11 +4,17 @@ module Distribution.ArchHs.Compat   ( pattern PkgFlag,     PkgFlag,+    licenseFile,   ) where +import Data.Maybe (listToMaybe) import Distribution.Types.ConfVar import Distribution.Types.Flag+import Distribution.Types.PackageDescription (PackageDescription, licenseFiles)+#if MIN_VERSION_Cabal(3,6,0)+import Distribution.Utils.Path (getSymbolicPath)+#endif  pattern PkgFlag :: FlagName -> ConfVar {-# COMPLETE PkgFlag #-}@@ -19,4 +25,11 @@ #else type PkgFlag = Flag pattern PkgFlag x = Flag x+#endif++licenseFile :: PackageDescription -> Maybe FilePath+#if MIN_VERSION_Cabal(3,6,0)+licenseFile = fmap getSymbolicPath . listToMaybe . licenseFiles+#else+licenseFile = listToMaybe . licenseFiles #endif

@@ -342,7 +342,7 @@       _makeDepends = (if uusi then " 'uusi'" else "") <> depsToString _depName makeDepends       _url = getUrl cabal       wrap s = " '" <> s <> "'"-      _licenseFile = licenseFiles cabal ^? ix 0+      _licenseFile = licenseFile cabal       _enableUusi = uusi   return PkgBuild {..} 

@@ -38,14 +38,16 @@   | CyclicExist [PackageName]   | NetworkException ClientError   | TargetDisappearException PackageName+  | VersionNoParse String  instance Show MyException where   show (PkgNotFound name) = "Unable to find \"" <> unPackageName (toHackageName name) <> "\""-  show (VersionNotFound name version) = "Unable to find \"" <> unPackageName (toHackageName name) <> "\" " <> prettyShow version+  show (VersionNotFound name version) = "Unable to find \"" <> unPackageName (toHackageName name) <> "\" " <> prettyShow version <> " in Hackage DB"   show (TargetExist name provider) = "Target \"" <> unPackageName name <> "\" has been provided by " <> show provider   show (CyclicExist c) = "Graph contains a cycle \"" <> show (fmap unPackageName c) <> "\""   show (NetworkException e) = show e   show (TargetDisappearException name) = "Target \"" <> unPackageName name <> "\" is discarded during the dependency resolving"+  show (VersionNoParse v) = "String \"" <> v <> "\" can not be parsed to Cabal version"  -- | Catch 'CE.IOException' and print it. printHandledIOException :: IO () -> IO ()

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskellQuotes #-}  module Distribution.ArchHs.Internal.NamePresetLoader (loadNamePreset) where 

@@ -51,6 +51,7 @@           "directory",           "exceptions",           "filepath",+          "ghc-bignum",           "ghc-boot",           "ghc-boot-th",           "ghc-compact",

@@ -170,7 +170,7 @@     cd $$_hkgname-$$pkgver      runhaskell Setup configure -O --enable-shared --enable-executable-dynamic --disable-library-vanilla \-      --prefix=/usr --docdir=/usr/share/doc/$$pkgname --datasubdir=$pkgname --enable-tests \+      --prefix=/usr --docdir=/usr/share/doc/$$pkgname --datasubdir=$$pkgname --enable-tests \       --dynlibdir=/usr/lib --libsubdir=\$$compiler/site-local/\$$pkgid \       --ghc-option=-optl-Wl\,-z\,relro\,-z\,now \       --ghc-option='-pie' $flags

@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE RecordWildCards #-} @@ -16,36 +14,23 @@     descFieldsParser,     runDescFieldsParser,     runDescParser,+    promoteDependent,+    containsDep,   ) where +import Control.Monad (void) import qualified Data.Map.Strict as Map import Data.Void (Void) import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Types+import Distribution.ArchHs.Utils (extractFromEVR) import Text.Megaparsec import Text.Megaparsec.Char  -- | A parser takes 'String' as input, without user state. type DescParser = Parsec Void String --- | Package description file of a installed system package,--- which lies in @repo.db@ file.-data PkgDesc = PkgDesc-  { _name :: String,-    _version :: String,-    _desc :: String,-    _url :: Maybe String,-    _license :: Maybe String,-    _provides :: [String],-    _optDepends :: [String],-    _replaces :: [String],-    _conflicts :: [String],-    _depends :: [String],-    _makeDepends :: [String]-  }-  deriving stock (Show, Eq, Generic)-  deriving anyclass (NFData)- -- Common fields {- fieldList =   [ "FILENAME",@@ -68,6 +53,30 @@     "CONFLICTS"   ] -} +-- | Promote a versioned dependent to package description+promoteDependent :: PkgDependent -> Maybe PkgDesc+promoteDependent PkgDependent {..} =+  ( \ver ->+      PkgDesc+        { _name = _pdName,+          _version = ver,+          _desc = "",+          _url = Nothing,+          _provides = [],+          _optDepends = [],+          _replaces = [],+          _conflicts = [],+          _makeDepends = [],+          _depends = [],+          _checkDepends = []+        }+  )+    <$> _pdVersion++-- | Check if a name is in 'PkgDependentList'+containsDep :: PkgDependentList -> ArchLinuxName -> Bool+containsDep deps name = name `elem` (_pdName <$> deps)+ -- | Parse fields of @desc@. descFieldsParser :: DescParser (Map.Map String [String]) descFieldsParser =@@ -81,7 +90,7 @@         )     `manyTill` eof   where-    sep = () <$ char '%'+    sep = void $ char '%'     line = manyTill anySingle newline  -- | Parse a desc file.@@ -89,20 +98,24 @@ descParser =   descFieldsParser     >>= ( \fields -> do-            _name <- lookupSingle fields "NAME"-            _version <- lookupSingle fields "VERSION"+            _name <- ArchLinuxName <$> lookupSingle fields "NAME"+            _version <- extractFromEVR <$> lookupSingle fields "VERSION"             _desc <- lookupSingle fields "DESC"             _url <- lookupSingleMaybe fields "URL"-            _license <- lookupSingleMaybe fields "LICENSE"-            _depends <- lookupList fields "DEPENDS"-            _makeDepends <- lookupList fields "MAKEDEPENDS"-            _provides <- lookupList fields "PROVIDES"-            _optDepends <- lookupList fields "OPTDEPENDS"-            _replaces <- lookupList fields "REPLACES"-            _conflicts <- lookupList fields "CONFLICTS"+            _depends <- toDepList =<< lookupList fields "DEPENDS"+            _makeDepends <- toDepList =<< lookupList fields "MAKEDEPENDS"+            _provides <- toDepList =<< lookupList fields "PROVIDES"+            _optDepends <- toDepList =<< lookupList fields "OPTDEPENDS"+            _replaces <- toDepList =<< lookupList fields "REPLACES"+            _conflicts <- toDepList =<< lookupList fields "CONFLICTS"+            _checkDepends <- toDepList =<< lookupList fields "CHECKDEPENDS"             return PkgDesc {..}         )   where+    toDepList = mapM $ \t -> case splitOn "=" t of+      [name, version] -> pure $ PkgDependent (ArchLinuxName name) (Just version)+      [name] -> pure $ PkgDependent (ArchLinuxName name) Nothing+      _ -> fail $ "Unable to parse dep list " <> t     lookupSingle fields f = case Map.lookup f fields of       (Just x) -> case x of         (e : _) -> return e

@@ -17,6 +17,9 @@     ComponentPkgList,     ArchLinuxName (..),     SystemDependency (..),+    PkgDependent (..),+    PkgDependentList,+    PkgDesc (..),     ArchLinuxVersion,     CommunityDB,     HackageEnv,@@ -64,11 +67,39 @@   deriving stock (Show, Read, Eq, Ord, Generic)   deriving anyclass (NFData) +-- | Arch Linux dependency type for @depends@, @replaces@, @conflicts@,.etc in 'PkgDesc'+data PkgDependent = PkgDependent+  { _pdName :: ArchLinuxName,+    _pdVersion :: Maybe ArchLinuxVersion+  }+  deriving stock (Show, Eq, Ord, Generic)+  deriving anyclass (NFData)++-- | A list of 'PkgDependent'+type PkgDependentList = [PkgDependent]++-- | Package description file of a installed system package, retrieved from @repo.db@ file.+data PkgDesc = PkgDesc+  { _name :: ArchLinuxName,+    _version :: ArchLinuxVersion,+    _desc :: String,+    _url :: Maybe String,+    _provides :: PkgDependentList,+    _optDepends :: PkgDependentList,+    _replaces :: PkgDependentList,+    _conflicts :: PkgDependentList,+    _depends :: PkgDependentList,+    _makeDepends :: PkgDependentList,+    _checkDepends :: PkgDependentList+  }+  deriving stock (Show, Eq, Ord, Generic)+  deriving anyclass (NFData)+ -- | Version of packages in archlinux community repo type ArchLinuxVersion = String  -- | Representation of @cummunity.db@-type CommunityDB = Map ArchLinuxName ArchLinuxVersion+type CommunityDB = Map ArchLinuxName PkgDesc  -- | Reader effect of 'HackageDB' type HackageEnv = Reader HackageDB

@@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}  module Main (main) where @@ -72,7 +73,8 @@       printInfo $ "Output will be dumped to" <+> pretty optOutput       exist <- doesFileExist optOutput       when exist $-        printWarn $ "File" <+> pretty optOutput <+> "already existed" <+> "overwrite it"+        printWarn $+          "File" <+> pretty optOutput <+> "already existed" <+> "overwrite it"      printInfo "Start running..."     unless (optUpload || hasOutput) $@@ -89,6 +91,6 @@     putStrLn $       unlines         [ unArchLinuxName name <> (if optWithVersion then ": " <> version else "")-          | (name, version) <- Map.toList community,+          | (name, _version -> version) <- Map.toList community,             isHaskellPackage name         ]

@@ -21,10 +21,10 @@ linkedHaskellPackages = do   communityHaskellPackages <- filter (isHaskellPackage . fst) . Map.toList <$> ask @CommunityDB   hackagePackages <- Map.keys <$> ask @HackageDB-  let go xs ys ((name, version) : pkgs) =+  let go xs ys ((name, desc) : pkgs) =         let hName = toHackageName name          in if hName `elem` hackagePackages-              then getLatestCabal hName >>= \cabal -> go ((name, version, cabal) : xs) ys pkgs+              then getLatestCabal hName >>= \cabal -> go ((name, _version desc, cabal) : xs) ys pkgs               else go xs (name : ys) pkgs       go xs ys [] = pure (xs, ys)   (linked, unlinked) <- go [] [] communityHaskellPackages