arch-hs 0.3.0.0 → 0.4.0.0

raw patch · 23 files changed

+628/−392 lines, 23 filesdep ~polysemydep ~reqPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: polysemy, req

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• README.md +22/−36
• app/Args.hs +22/−1
• app/Main.hs +77/−68
• arch-hs.cabal +124/−116
• cbits/clib.c +34/−0
• cbits/clib.h +8/−0
• data/NAME_PRESET.json +1/−0
• diff/Diff.hs +45/−34
• diff/Main.hs +14/−7
• src/Distribution/ArchHs/Aur.hs +2/−4
• src/Distribution/ArchHs/Community.hs +64/−11
• src/Distribution/ArchHs/Core.hs +43/−49
• src/Distribution/ArchHs/Exception.hs +12/−4
• src/Distribution/ArchHs/Hackage.hs +4/−4
• src/Distribution/ArchHs/Name.hs +1/−1
• src/Distribution/ArchHs/OptionReader.hs +5/−8
• src/Distribution/ArchHs/PP.hs +18/−15
• src/Distribution/ArchHs/PkgBuild.hs +22/−3
• src/Distribution/ArchHs/Types.hs +5/−5
• src/Distribution/ArchHs/Utils.hs +47/−7
• submit/Main.hs +19/−9
• submit/Submit.hs +25/−10

@@ -3,6 +3,20 @@ `arch-hs` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.4.0.0++* [Alpm](https://www.archlinux.org/pacman/libalpm.3.html) support++* Fix sub-libraries handling ([#22](https://github.com/berberman/arch-hs/issues/22))++* Fix missing build tools ([#24](https://github.com/berberman/arch-hs/issues/24))++* Fix flag comparison in diff ([#25](https://github.com/berberman/arch-hs/issues/25))++* Fix pretty printing of flags++* Update name preset ([#26](https://github.com/berberman/arch-hs/pull/26))+ ## 0.3.0.0  * Update name preset

@@ -20,7 +20,7 @@  ## Prerequisite -`arch-hs` is just a PKGBUILD text file generator, which is not integrated with `pacman`, depending on nothing than:+`arch-hs` is a PKGBUILD text file generator, which is not integrated with `pacman`(See [Alpm Support](#Alpm-Support)), depending on nothing than:  * Pacman database (`community.db`) @@ -28,8 +28,9 @@  ## Installation -Both `arch-hs` and `arch-hs-diff` are portable, which means that they are not restricted to Arch Linux.-However, if you want to run them in other systems, you have to build them from source.+`arch-hs` is portable, which means it's not restricted to Arch Linux.+However, `arch-hs` can use libalpm to load pacman database on Arch Linux,+and if you want to run them on other systems, you have to build it from source.  ### Install the latest release @@ -238,43 +239,13 @@  See [uusi](https://hackage.haskell.org/package/uusi) for details. -### Help+### Alpm  ```-$ arch-hs --help-arch-hs - a program generating PKGBUILD for hackage packages.--Usage: arch-hs [-h|--hackage PATH] [-c|--community PATH] [-o|--output PATH] -               [-f|--flags package_name:flag_name:true|false,...] -               [-s|--skip component_name,...] [-e|--extra PATH_1,...] [-a|--aur]-               [--trace] [--trace-file PATH] [--uusi] TARGET-  Try to reach the TARGET QAQ.--Available options:-  -h,--hackage PATH        Path to hackage index-                           tarball (default: "~/.cabal/packages/YOUR_HACKAGE_MIRROR/01-index.tar | 00-index.tar")-  -c,--community PATH      Path to-                           community.db (default: "/var/lib/pacman/sync/community.db")-  -o,--output PATH         Output path to generated PKGBUILD files (empty means-                           dry run)-  -f,--flags package_name:flag_name:true|false,...-                           Flag assignments for packages - e.g.-                           inline-c:gsl-example:true (separated by ',')-  -s,--skip component_name,...-                           Skip a runnable component (executable, test suit, or-                           benchmark) in dependency calculation-  -e,--extra PATH_1,...    Extra cabal files' path - e.g.-                           /home/berberman/arch-hs/arch-hs.cabal-  -a,--aur                 Enable AUR searching-  --trace                  Print trace to stdout-  --trace-file PATH        Path to trace file (empty means do not write trace to-                           file)-  --uusi                   Splicing uusi into prepare()-  -h,--help                Show this help text-+$ arch-hs --alpm TARGET ``` -For all available options, have a look at the help message.+See [Alpm Support](#Alpm-Support).   ## [Name preset](https://github.com/berberman/arch-hs/blob/master/data/NAME_PRESET.json)@@ -379,6 +350,21 @@  * Currently, `arch-hs`'s functionality is limited to dependency processing, whereas necessary procedures like file patches, loose of version constraints, etc. are need to be done manually, so **DO NOT** give too much trust in generated PKGBUILD files.++## Alpm Support++[alpm](https://www.archlinux.org/pacman/libalpm.3.html) is Arch Linux Package Management library.+When running on Arch Linux, loading `community.db` through this library is slightly faster than using the internal parser of `arch-hs`.+Thus, `arch-hs` provides a flag `alpm` to enable this feature:++```+cabal build -f alpm+```++This flag is enabled by default in `arch-hs` Arch Linux package.+Compiled with `alpm`, `arch-hs` can accpet 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.**+> When `alpm` is enabled, `arch-hs` will lose the capability of specifying the path of `community.db`.  ## ToDoList 

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} @@ -14,7 +15,9 @@  data Options = Options   { optHackagePath :: FilePath,+#ifndef ALPM     optCommunityPath :: FilePath,+#endif     optOutputDir :: FilePath,     optFlags :: FlagAssignments,     optSkip :: [String],@@ -23,6 +26,10 @@     optStdoutTrace :: Bool,     optFileTrace :: FilePath,     optUusi :: Bool,+    optMetaDir :: FilePath,+#ifdef ALPM+    optAlpm :: Bool,+#endif     optTarget :: PackageName   }   deriving stock (Show)@@ -38,6 +45,7 @@           <> showDefault           <> value "~/.cabal/packages/YOUR_HACKAGE_MIRROR/01-index.tar | 00-index.tar"       )+#ifndef ALPM       <*> strOption         ( long "community"             <> metavar "PATH"@@ -46,6 +54,7 @@             <> showDefault             <> value "/var/lib/pacman/sync/community.db"         )+#endif       <*> strOption         ( long "output"             <> metavar "PATH"@@ -94,8 +103,20 @@         )       <*> switch         ( long "uusi"-            <> help "Splicing uusi into prepare()"+            <> help "Splice uusi into prepare()"         )+      <*> strOption+        ( long "meta"+            <> metavar "PATH"+            <> help "Path to target meta package"+            <> value ""+        )+#ifdef ALPM+      <*> switch+        ( long "alpm"+            <> help "Use libalpm to parse community db"+        )+#endif       <*> argument optPackageNameReader (metavar "TARGET")  runArgsParser :: IO Options

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -10,7 +11,8 @@ import Args import qualified Colourista as C import Conduit-import Control.Monad (filterM)+import Control.Monad (filterM, unless)+import Data.Containers.ListUtils (nubOrd) import Data.IORef (IORef, newIORef) import Data.List.NonEmpty (toList) import qualified Data.Map.Strict as Map@@ -18,38 +20,18 @@ import qualified Data.Text as T import Distribution.ArchHs.Aur (Aur, aurToIO, isInAur) import Distribution.ArchHs.Community-  ( defaultCommunityPath,-    isInCommunity,-    loadProcessedCommunity,-  ) import Distribution.ArchHs.Core-  ( cabalToPkgBuild,-    getDependencies,-  ) import Distribution.ArchHs.Exception import Distribution.ArchHs.Hackage-  ( getPackageFlag,-    insertDB,-    loadHackageDB,-    lookupHackagePath,-    parseCabalFile,-  ) import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.Local+import Distribution.ArchHs.Name import Distribution.ArchHs.PP-  ( prettyDeps,-    prettyFlagAssignments,-    prettyFlags,-    prettySkip,-    prettySolvedPkgs,-  ) import qualified Distribution.ArchHs.PkgBuild as N import Distribution.ArchHs.Types-import Distribution.ArchHs.Utils (getTwo)-import Distribution.Hackage.DB (HackageDB)+import Distribution.ArchHs.Utils import System.Directory   ( createDirectoryIfMissing,-    doesFileExist,   ) import System.FilePath (takeFileName) @@ -60,24 +42,24 @@   Bool ->   [String] ->   Bool ->+  FilePath ->   Sem r ()-app target path aurSupport skip uusi = do-  (deps, ignored) <- getDependencies (fmap mkUnqualComponentName skip) Nothing target+app target path aurSupport skip uusi metaPath = do+  (deps, sublibs) <- getDependencies (fmap mkUnqualComponentName skip) Nothing target   inCommunity <- isInCommunity target   when inCommunity $ throw $ TargetExist target ByCommunity -  if aurSupport-    then do-      inAur <- isInAur target-      when inAur $ throw $ TargetExist target ByAur-    else return ()--  let grouped = groupDeps deps+  when aurSupport $ do+    inAur <- isInAur target+    when inAur $ throw $ TargetExist target ByAur+  let removeSublibs list =+        list ^.. each . filtered (\x -> x ^. pkgName `notElem` sublibs) & each %~ (\x -> x & pkgDeps %~ (filter (\d -> d ^. depName `notElem` sublibs)))+      grouped = removeSublibs $ groupDeps deps       namesFromSolved x = x ^.. each . pkgName <> x ^.. each . pkgDeps . each . depName-      allNames = nub $ namesFromSolved grouped+      allNames = nubOrd $ namesFromSolved grouped   communityProvideList <- (<> ghcLibList) <$> filterM isInCommunity allNames   let fillProvidedPkgs provideList provider = mapC (\x -> if (x ^. pkgName) `elem` provideList then ProvidedPackage (x ^. pkgName) provider else x)-      fillProvidedDeps provideList provider = mapC (pkgDeps %~ each %~ (\y -> if y ^. depName `elem` provideList then y & depProvider .~ (Just provider) else y))+      fillProvidedDeps provideList provider = mapC (pkgDeps %~ each %~ (\y -> if y ^. depName `elem` provideList then y & depProvider ?~ provider else y))       filledByCommunity =         runConduitPure $           yieldMany grouped@@ -87,7 +69,7 @@       toBePacked1 = filledByCommunity ^.. each . filtered (\case ProvidedPackage _ _ -> False; _ -> True)   (filledByBoth, toBePacked2) <- do     embed . when aurSupport $ C.infoMessage "Start searching AUR..."-    aurProvideList <- if aurSupport then filterM (\n -> do embed $ C.infoMessage ("Searching " <> (T.pack $ unPackageName n)); isInAur n) $ toBePacked1 ^.. each . pkgName else return []+    aurProvideList <- if aurSupport then filterM (\n -> do embed $ C.infoMessage ("Searching " <> T.pack (unPackageName n)); isInAur n) $ toBePacked1 ^.. each . pkgName else return []     let filledByBoth =           if aurSupport             then@@ -103,31 +85,29 @@             else toBePacked1     return (filledByBoth, toBePacked2) -  embed $ C.infoMessage "Solved target:"+  embed $ C.infoMessage "Solved:"   embed $ putStrLn . prettySolvedPkgs $ filledByBoth -  embed $ C.infoMessage "Recommended package order (from topological sort):"+  embed $ C.infoMessage "Recommended package order:"   let vertexesToBeRemoved = filledByBoth ^.. each . filtered (\case ProvidedPackage _ _ -> True; _ -> False) ^.. each . pkgName       removeSelfCycle g = foldr (\n acc -> GL.removeEdge n n acc) g $ toBePacked2 ^.. each . pkgName       newGraph = GL.induce (`notElem` vertexesToBeRemoved) deps-  flattened <- case G.topSort . GL.skeleton $ removeSelfCycle $ newGraph of+  flattened <- case G.topSort . GL.skeleton $ removeSelfCycle newGraph of     Left c -> throw . CyclicExist $ toList c-    Right x -> return x+    Right x -> return $ filter (`notElem` sublibs) x   embed $ putStrLn . prettyDeps . reverse $ flattened-  flags <- filter (\(_, l) -> length l /= 0) <$> mapM (\n -> (n,) <$> getPackageFlag n) flattened+  flags <- filter (\(_, l) -> not $ null l) <$> mapM (\n -> (n,) <$> getPackageFlag n) flattened    embed $-    when (length flags /= 0) $ do-      C.infoMessage "Detected flags from targets (their values will keep default unless you specify):"+    unless (null flags) $ do+      C.infoMessage "Detected flag(s) from targets:"       putStrLn . prettyFlags $ flags -  let dry = path == ""-  embed $ when dry $ C.warningMessage "You didn't pass -o, PKGBUILD files will not be generated."-  when (not dry) $+  unless (null path) $     mapM_       ( \solved -> do-          pkgBuild <- cabalToPkgBuild solved (Set.toList ignored) uusi-          let pName = "haskell-" <> N._pkgName pkgBuild+          pkgBuild <- cabalToPkgBuild solved uusi+          let pName = N._pkgName pkgBuild               dir = path </> pName               fileName = dir </> "PKGBUILD"               txt = N.applyTemplate pkgBuild@@ -137,6 +117,31 @@       )       toBePacked2 +  unless (null metaPath) $ do+    cabal <- getLatestCabal target+    let url = getUrl $ packageDescription cabal+        name = unPackageName target+        template = N.metaTemplate (T.pack url) (T.pack name)+        providedDepends pkg =+          pkg ^. pkgDeps+            ^.. each+              . filtered (\x -> depNotMyself (pkg ^. pkgName) x && depNotInGHCLib x && x ^. depProvider == Just ByCommunity)+        toStr x = "'" <> (unCommunityName . toCommunityName . _depName) x <> "'"+        depends = case intercalate " " . nubOrd . fmap toStr . mconcat $ providedDepends <$> toBePacked2 of+          [] -> ""+          xs -> " " <> xs+        flattened' = filter (/= target) flattened+        comment = case flattened' of+          [] -> "\n"+          [x] -> "# The following dependency is missing in community: " <> unPackageName x+          _ -> "# Following dependencies are missing in community:" <> (intercalate ", " $ unPackageName <$> flattened')+        txt = template (T.pack comment) (T.pack depends)+        dir = metaPath </> "haskell-" <> name <> "-meta"+        fileName = dir </> "PKGBUILD"+    embed $ createDirectoryIfMissing True dir+    embed $ writeFile fileName (T.unpack txt)+    embed $ C.infoMessage $ "Write file: " <> T.pack fileName+ -----------------------------------------------------------------------------  runApp ::@@ -148,13 +153,13 @@   IORef (Set.Set PackageName) ->   Sem '[CommunityEnv, HackageEnv, FlagAssignmentsEnv, DependencyRecord, Trace, State (Set.Set PackageName), Aur, WithMyErr, Embed IO, Final IO] a ->   IO (Either MyException a)-runApp hackage community flags stdout path ref =+runApp hackage community flags traceStdout tracePath ref =   runFinal     . embedToFinal     . errorToIOFinal     . aurToIO     . runStateIORef ref-    . runTrace stdout path+    . runTrace traceStdout tracePath     . evalState Map.empty     . runReader flags     . runReader hackage@@ -164,7 +169,7 @@ runTrace stdout path = interpret $ \case   Trace m -> do     when stdout (embed $ putStrLn m)-    when (not $ null path) (embed $ appendFile path (m ++ "\n"))+    unless (null path) (embed $ appendFile path (m ++ "\n"))  ----------------------------------------------------------------------------- @@ -173,28 +178,26 @@   do     Options {..} <- runArgsParser -    let traceToFile = not $ null optFileTrace-    when (traceToFile) $ do-      C.infoMessage $ "Trace will be dumped to " <> (T.pack optFileTrace) <> "."-      exist <- doesFileExist optFileTrace-      when exist $-        C.warningMessage $ "File " <> (T.pack optFileTrace) <> " already existed, overwrite it."--    let useDefaultHackage = isInfixOf "YOUR_HACKAGE_MIRROR" $ optHackagePath-        useDefaultCommunity = "/var/lib/pacman/sync/community.db" == optCommunityPath+    unless (null optFileTrace) $+      C.infoMessage $ "Trace will be dumped to " <> T.pack optFileTrace <> "." +    let useDefaultHackage = "YOUR_HACKAGE_MIRROR" `isInfixOf` optHackagePath     when useDefaultHackage $ C.skipMessage "You didn't pass -h, use hackage index file from default path."++#ifndef ALPM+    let useDefaultCommunity = "/var/lib/pacman/sync/community.db" == optCommunityPath     when useDefaultCommunity $ C.skipMessage "You didn't pass -c, use community db file from default path."+#endif -    let isFlagEmpty = optFlags == Map.empty-        isSkipEmpty = optSkip == []+    let isFlagEmpty = Map.null optFlags+        isSkipEmpty = null optSkip      when isFlagEmpty $ C.skipMessage "You didn't pass -f, different flag assignments may make difference in dependency resolving."-    when (not isFlagEmpty) $ do+    unless isFlagEmpty $ do       C.infoMessage "You assigned flags:"       putStrLn . prettyFlagAssignments $ optFlags -    when (not isSkipEmpty) $ do+    unless isSkipEmpty $ do       C.infoMessage "You chose to skip:"       putStrLn $ prettySkip optSkip @@ -205,23 +208,29 @@     hackage <- loadHackageDB =<< if useDefaultHackage then lookupHackagePath else return optHackagePath     C.infoMessage "Loading hackage..." -    let isExtraEmpty = optExtraCabalPath == []+    let isExtraEmpty = null optExtraCabalPath -    when (not isExtraEmpty) $+    unless isExtraEmpty $       C.infoMessage $ "You added " <> (T.pack . intercalate ", " $ map takeFileName optExtraCabalPath) <> " as extra cabal file(s), starting parsing right now."      parsedExtra <- mapM parseCabalFile optExtraCabalPath -    let newHackage = foldr (\x acc -> x `insertDB` acc) hackage parsedExtra+    let newHackage = foldr insertDB hackage parsedExtra +#ifdef ALPM+    when optAlpm $ C.infoMessage "Using alpm."+    community <- if optAlpm then loadCommunityFFI else loadProcessedCommunity defaultCommunityPath+#else     community <- loadProcessedCommunity $ if useDefaultCommunity then defaultCommunityPath else optCommunityPath+#endif+     C.infoMessage "Loading community.db..."      C.infoMessage "Start running..."      empty <- newIORef Set.empty -    runApp newHackage community optFlags optStdoutTrace optFileTrace empty (app optTarget optOutputDir optAur optSkip optUusi) & printAppResult+    runApp newHackage community optFlags optStdoutTrace optFileTrace empty (app optTarget optOutputDir optAur optSkip optUusi optMetaDir) & printAppResult  ----------------------------------------------------------------------------- @@ -242,4 +251,4 @@     parents = fmap fst result     children = mconcat $ fmap (\(_, ds) -> fmap snd ds) result     -- Maybe 'G.vertexSet' is a better choice-    aloneChildren = nub $ zip (filter (`notElem` parents) children) (repeat [])+    aloneChildren = nubOrd $ zip (filter (`notElem` parents) children) (repeat [])

@@ -1,127 +1,135 @@-cabal-version:       2.4-name:                arch-hs-version:             0.3.0.0-synopsis:            Distribute hackage packages to archlinux-description:         -    @arch-hs@ is a command-line program, which simplifies the process of producing-    and maintaining haskell packages for archlinux distribution by automating the-    PKGBUILD generation with the dependency resolving and template filling. Currently,-    @arch-hs@ is unstable, so packagers should not trust it 100%, but always follow the-    <https://wiki.archlinux.org/index.php/Haskell_package_guidelines Haskell package guidelines>.-homepage:            https://github.com/berberman/arch-hs-bug-reports:         https://github.com/berberman/arch-hs/issues-license:             MIT-license-file:        LICENSE-author:              berberman-maintainer:          berberman <1793913507@qq.com>-copyright:           2020 berberman-category:            Distribution-build-type:          Simple-extra-source-files:  data/NAME_PRESET.json-extra-doc-files:     README.md-                     CHANGELOG.md-tested-with:         GHC == 8.10.2+cabal-version:      2.4+name:               arch-hs+version:            0.4.0.0+synopsis:           Distribute hackage packages to archlinux+description:+  @arch-hs@ is a command-line program, which simplifies the process of producing+  and maintaining haskell packages for archlinux distribution by automating the+  PKGBUILD generation with the dependency resolving and template filling. Currently,+  @arch-hs@ is unstable, so packagers should not trust it 100%, but always follow the+  <https://wiki.archlinux.org/index.php/Haskell_package_guidelines Haskell package guidelines>. +homepage:           https://github.com/berberman/arch-hs+bug-reports:        https://github.com/berberman/arch-hs/issues+license:            MIT+license-file:       LICENSE+author:             berberman+maintainer:         berberman <1793913507@qq.com>+copyright:          2020 berberman+category:           Distribution+build-type:         Simple+extra-source-files: data/NAME_PRESET.json+extra-doc-files:+  CHANGELOG.md+  README.md++tested-with:        GHC ==8.10.2+ source-repository head-  type:                git-  location:            https://github.com/berberman/arch-hs.git+  type:     git+  location: https://github.com/berberman/arch-hs.git++flag alpm+  description: Whether to use libalpm+  default:     False+  manual:      True+ common common-options-  build-depends:       base ^>= 4.14.0,-                       Cabal ^>= 3.2.0, -                       aeson ^>= 1.5.4,-                       req ^>= 3.6.0,-                       hackage-db ^>= 2.1.0,-                       conduit ^>= 1.3.2,-                       containers ^>= 0.6.2,-                       deepseq ^>= 1.4.4,-                       algebraic-graphs ^>= 0.5,-                       megaparsec ^>= 8.0.0,-                       directory ^>= 1.3.6,-                       bytestring ^>= 0.10.10,-                       tar-conduit ^>= 0.3.2,-                       conduit-extra ^>= 1.3.5,-                       split ^>= 0.2.3,-                       neat-interpolation ^>= 0.5.1,-                       text ^>= 1.2.3,-                       microlens ^>= 0.4.11,-                       microlens-th ^>= 0.4.3,-                       polysemy ^>= 1.3.0,-                       filepath ^>= 1.4.2,-                       colourista ^>= 0.1,-                       template-haskell ^>= 2.16.0,-                       optparse-applicative ^>= 0.15.1+  build-depends:+    , aeson                 ^>=1.5.4+    , algebraic-graphs      ^>=0.5+    , base                  ^>=4.14.0+    , bytestring            ^>=0.10.10+    , Cabal                 ^>=3.2.0+    , colourista            ^>=0.1+    , conduit               ^>=1.3.2+    , conduit-extra         ^>=1.3.5+    , containers            ^>=0.6.2+    , deepseq               ^>=1.4.4+    , directory             ^>=1.3.6+    , filepath              ^>=1.4.2+    , hackage-db            ^>=2.1.0+    , megaparsec            ^>=8.0.0+    , microlens             ^>=0.4.11+    , microlens-th          ^>=0.4.3+    , neat-interpolation    ^>=0.5.1+    , optparse-applicative  ^>=0.15.1+    , polysemy              ^>=1.3.0 || ^>=1.4.0+    , req                   ^>=3.6.0 || ^>=3.7.0+    , split                 ^>=0.2.3+    , tar-conduit           ^>=0.3.2+    , template-haskell      ^>=2.16.0+    , text                  ^>=1.2.3 -  ghc-options:         -Wall-                       -Wcompat-                       -Widentities-                       -Wincomplete-uni-patterns-                       -Wincomplete-record-updates-                       -O2 -                       -flate-specialise -                       -fspecialise-aggressively-                       -Wredundant-constraints-                       -fhide-source-paths-                       -Wmissing-export-lists-                       -Wpartial-fields-                       -Wmissing-deriving-strategies+  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-uni-patterns+    -Wincomplete-record-updates -O2 -flate-specialise+    -fspecialise-aggressively -Wredundant-constraints+    -fhide-source-paths -Wmissing-export-lists -Wpartial-fields+    -Wmissing-deriving-strategies -  default-language:    Haskell2010-  default-extensions:  DataKinds-                       FlexibleContexts-                       GADTs-                       LambdaCase-                       PolyKinds-                       RankNTypes-                       ScopedTypeVariables-                       TypeOperators-                       TypeFamilies+  default-language:   Haskell2010+  default-extensions:+    DataKinds+    FlexibleContexts+    GADTs+    LambdaCase+    PolyKinds+    RankNTypes+    ScopedTypeVariables+    TypeFamilies+    TypeOperators++  if flag(alpm)+    c-sources:        cbits/clib.c+    extra-libraries:  alpm+    include-dirs:     cbits+    install-includes: cbits/clib.h+    cpp-options:      -DALPM+ library-  import:              common-options-  hs-source-dirs:      src-  exposed-modules:     Distribution.ArchHs.Aur,-                       Distribution.ArchHs.PkgDesc,-                       Distribution.ArchHs.Community,-                       Distribution.ArchHs.Core,-                       Distribution.ArchHs.Hackage,-                       Distribution.ArchHs.Local,-                       Distribution.ArchHs.PkgBuild,-                       Distribution.ArchHs.Types,-                       Distribution.ArchHs.Utils,-                       Distribution.ArchHs.PP,-                       Distribution.ArchHs.Name,-                       Distribution.ArchHs.Exception,-                       Distribution.ArchHs.Internal.Prelude-                       Distribution.ArchHs.OptionReader-  other-modules:       Data.Aeson.Ext-                       Distribution.ArchHs.Internal.NamePresetLoader-                       +  import:          common-options+  hs-source-dirs:  src+  exposed-modules:+    Distribution.ArchHs.Aur+    Distribution.ArchHs.Community+    Distribution.ArchHs.Core+    Distribution.ArchHs.Exception+    Distribution.ArchHs.Hackage+    Distribution.ArchHs.Internal.Prelude+    Distribution.ArchHs.Local+    Distribution.ArchHs.Name+    Distribution.ArchHs.OptionReader+    Distribution.ArchHs.PkgBuild+    Distribution.ArchHs.PkgDesc+    Distribution.ArchHs.PP+    Distribution.ArchHs.Types+    Distribution.ArchHs.Utils +  other-modules:+    Data.Aeson.Ext+    Distribution.ArchHs.Internal.NamePresetLoader+ executable arch-hs-  import:              common-options-  hs-source-dirs:      app-  main-is:             Main.hs-  other-modules:       Args-  build-depends:       arch-hs-  ghc-options:         -threaded-                       -rtsopts-                       -with-rtsopts=-N+  import:         common-options+  hs-source-dirs: app+  main-is:        Main.hs+  other-modules:  Args+  build-depends:  arch-hs+  ghc-options:    -threaded -rtsopts -with-rtsopts=-N  executable arch-hs-diff-  import:              common-options-  hs-source-dirs:      diff-  main-is:             Main.hs-  other-modules:       Diff-  build-depends:       arch-hs-  ghc-options:         -threaded-                       -rtsopts-                       -with-rtsopts=-N-                       +  import:         common-options+  hs-source-dirs: diff+  main-is:        Main.hs+  other-modules:  Diff+  build-depends:  arch-hs+  ghc-options:    -threaded -rtsopts -with-rtsopts=-N+ executable arch-hs-submit-  import:              common-options-  hs-source-dirs:      submit-  main-is:             Main.hs-  other-modules:       Submit-  build-depends:       arch-hs-  ghc-options:         -threaded-                       -rtsopts-                       -with-rtsopts=-N+  import:         common-options+  hs-source-dirs: submit+  main-is:        Main.hs+  other-modules:  Submit+  build-depends:  arch-hs+  ghc-options:    -threaded -rtsopts -with-rtsopts=-N

@@ -0,0 +1,34 @@+#include "clib.h"+#include <alpm.h>+#include <alpm_list.h>+#include <stdio.h>+#include <string.h>++int query_community(callback_t callback) {+  alpm_errno_t err;+  alpm_handle_t *handle;+  handle = alpm_initialize("/", "/var/lib/pacman", &err);+  alpm_db_t *db =+      alpm_register_syncdb(handle, "community", ALPM_SIG_USE_DEFAULT);+  alpm_list_t *i, *pkgs = NULL;++  pkgs = alpm_db_get_pkgcache(db);++  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);+    if (strcmp(name, "ghc") == 0 || strcmp(name, "ghc-libs") == 0) {+      alpm_list_t *v, *provides;+      provides = alpm_pkg_get_provides(i->data);+      for (v = provides; v; v = alpm_list_next(v)) {+        alpm_depend_t *d = v->data;+        const char *d_name = d->name;+        const char *d_ver = d->version;+        callback(d_name, d_ver);+      }+    } else+      callback(name, ver);+  }+  alpm_release(handle);+  return err;+}

@@ -0,0 +1,8 @@+#ifndef CLIB_H+#define CLIB_H++typedef void callback_t(const char *, const char *);++int query_community(callback_t callback);++#endif

@@ -10,6 +10,7 @@     "agda": "Agda",     "alex": "alex",     "arch-hs": "arch-hs",+    "bnfc": "BNFC",     "c2hs": "c2hs",     "haskell-cabal": "Cabal",     "cabal-install": "cabal-install",

@@ -1,5 +1,5 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-}  module Diff@@ -29,8 +29,12 @@ import Network.HTTP.Req hiding (header)  data Options = Options-  { optCommunityPath :: FilePath,-    optFlags :: FlagAssignments,+  { optFlags :: FlagAssignments,+#ifdef ALPM+    optAlpm :: Bool,+#else+    optCommunityPath :: FilePath,+#endif     optPackageName :: PackageName,     optVersionA :: Version,     optVersionB :: Version@@ -39,15 +43,7 @@ cmdOptions :: Parser Options cmdOptions =   Options-    <$> strOption-      ( long "community"-          <> metavar "PATH"-          <> short 'c'-          <> help "Path to community.db"-          <> showDefault-          <> value "/var/lib/pacman/sync/community.db"-      )-    <*> option+    <$> option       optFlagReader       ( long "flags"           <> metavar "package_name:flag_name:true|false,..."@@ -55,6 +51,21 @@           <> 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 "/var/lib/pacman/sync/community.db"+      )+#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")@@ -82,8 +93,8 @@   case cabal & condLibrary of     Just lib -> do       bInfo <- evalConditionTree cabal lib-      let libDeps = fmap unDepV $ buildDependsIfBuild bInfo-          toolDeps = fmap unExeV $ buildToolDependsIfBuild bInfo+      let libDeps = unDepV <$> buildDependsIfBuild bInfo+          toolDeps = unBuildTools $ buildToolsAndbuildToolDependsIfBuild bInfo       mapM_ (uncurry updateDependencyRecord) libDeps       mapM_ (uncurry updateDependencyRecord) toolDeps       return (libDeps, toolDeps)@@ -98,8 +109,8 @@ collectRunnableDeps f cabal skip = do   let exes = cabal & f   bInfo <- filter (not . (`elem` skip) . fst) . zip (exes <&> fst) <$> mapM (evalConditionTree cabal . snd) exes-  let deps = bInfo <&> ((_2 %~) $ fmap unDepV . buildDependsIfBuild)-      toolDeps = bInfo <&> ((_2 %~) $ fmap unExeV . buildToolDependsIfBuild)+  let deps = bInfo <&> _2 %~ (fmap unDepV . buildDependsIfBuild)+      toolDeps = bInfo <&> _2 %~ (unBuildTools . buildToolsAndbuildToolDependsIfBuild)   mapM_ (uncurry updateDependencyRecord) $ deps ^.. each . _2 ^. each   mapM_ (uncurry updateDependencyRecord) $ toolDeps ^.. each . _2 ^. each   return (deps, toolDeps)@@ -141,10 +152,10 @@       et = flatten exeToolsDeps       t = flatten testDeps       tt = flatten testToolsDeps-      notMyself = (/= (getPkgName' cabal))+      notMyself = (/= getPkgName' cabal)       distinct = filter (notMyself . fst) . nub       depends = distinct $ l <> e-      makedepends = (distinct $ lt <> et <> t <> tt) \\ depends+      makedepends = distinct (lt <> et <> t <> tt) \\ depends   return (depends, makedepends)  -----------------------------------------------------------------------------@@ -156,7 +167,7 @@   let pa = packageDescription ga       pb = packageDescription gb       fa = genPackageFlags ga-      fb = genPackageFlags ga+      fb = genPackageFlags gb   (ba, ma) <- directDependencies ga   (bb, mb) <- directDependencies gb   queryb <- lookupDiffCommunity ba bb@@ -180,8 +191,8 @@ diffTerm s f a b =   let f' = T.unpack . T.strip . T.pack . f       (ra, rb) = (f' a, f' b)-   in (C.formatWith [C.magenta] s)-        <> (if ra == rb then ra else ((C.formatWith [C.red] ra) <> "  ⇒  " <> C.formatWith [C.green] rb))+   in C.formatWith [C.magenta] s+        <> (if ra == rb then ra else C.formatWith [C.red] ra <> "  ⇒  " <> C.formatWith [C.green] rb)  desc :: PackageDescription -> PackageDescription -> String desc = diffTerm "Synopsis: " $ fromShortText . synopsis@@ -197,7 +208,7 @@  inRange :: Members [CommunityEnv, WithMyErr] r => (PackageName, VersionRange) -> Sem r (Either (PackageName, VersionRange) (PackageName, VersionRange, Version, Bool)) inRange (name, hRange) =-  (try @MyException (versionInCommunity name))+  try @MyException (versionInCommunity name)     >>= \case       Right y -> let version = fromJust . simpleParsec $ y in return . Right $ (name, hRange, version, withinRange version hRange)       Left _ -> return . Left $ (name, hRange)@@ -208,22 +219,22 @@       diffOld = va \\ vb       color b = C.formatWith [if b then C.green else C.red]       pp b (Right (name, range, v, False)) =-        "["+        "\""           <> color b (unPackageName name)-          <> "] is required to be in range ("+          <> "\" is required to be in range ("           <> color b (prettyShow range)           <> "), "-          <> "but community provides ("+          <> "but [community] provides ("           <> color b (prettyShow v)           <> ")."       pp _ (Right _) = ""       pp b (Left (name, range)) =-        "["+        "\""           <> color b (unPackageName name)-          <> "] is required to be in range ("+          <> "\" is required to be in range ("           <> color b (prettyShow range)           <> "), "-          <> "but community does not provide this package."+          <> "but [community] does not provide this package."    new <- fmap (pp True) <$> mapM inRange diffNew   old <- fmap (pp False) <$> mapM inRange diffOld@@ -232,13 +243,13 @@  dep :: String -> VersionedList -> VersionedList -> String dep s va vb =-  (C.formatWith [C.magenta] s) <> "    " <> case (diffOld <> diffNew) of+  C.formatWith [C.magenta] s <> "    " <> case diffOld <> diffNew of     [] -> joinToString a     _ ->-      (joinToString $ fmap (\x -> red (x `elem` diffOld) x) a)+      joinToString (fmap (\x -> red (x `elem` diffOld) x) a)         <> splitLine         <> "    "-        <> (joinToString $ fmap (\x -> green (x `elem` diffNew) x) b)+        <> joinToString (fmap (\x -> green (x `elem` diffNew) x) b)   where     a = joinVersionWithName <$> va     b = joinVersionWithName <$> vb@@ -252,13 +263,13 @@  flags :: PackageName -> [Flag] -> [Flag] -> String flags name a b =-  (C.formatWith [C.magenta] "Flags:\n") <> "  " <> case (diffOld <> diffNew) of+  C.formatWith [C.magenta] "Flags:\n" <> "  " <> case diffOld <> diffNew of     [] -> joinToString a     _ ->-      (joinToString a)+      joinToString a         <> splitLine         <> "    "-        <> (joinToString b)+        <> joinToString b   where     diffNew = b \\ a     diffOld = a \\ b

@@ -1,16 +1,15 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}  module Main (main) where  import qualified Colourista as C+import Control.Monad (unless) import qualified Data.Map as Map import qualified Data.Text as T import Diff import Distribution.ArchHs.Community-  ( defaultCommunityPath,-    loadProcessedCommunity,-  ) import Distribution.ArchHs.Exception import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.PP (prettyFlagAssignments)@@ -20,17 +19,25 @@ main = printHandledIOException $   do     Options {..} <- runArgsParser-    let useDefaultCommunity = "/var/lib/pacman/sync/community.db" == optCommunityPath-        isFlagEmpty = Map.null optFlags+    let isFlagEmpty = Map.null optFlags +#ifndef ALPM+    let useDefaultCommunity = "/var/lib/pacman/sync/community.db" == optCommunityPath     when useDefaultCommunity $ C.skipMessage "You didn't pass -c, use community db file from default path."+#endif      when isFlagEmpty $ C.skipMessage "You didn't pass -f, different flag values may make difference in dependency resolving."-    when (not isFlagEmpty) $ do+    unless isFlagEmpty $ do       C.infoMessage "You assigned flags:"       putStrLn . prettyFlagAssignments $ optFlags +#ifdef ALPM+    when optAlpm $ C.infoMessage "Using alpm."+    community <- if optAlpm then loadCommunityFFI else loadProcessedCommunity defaultCommunityPath+#else     community <- loadProcessedCommunity $ if useDefaultCommunity then defaultCommunityPath else optCommunityPath+#endif+         C.infoMessage "Loading community.db..."      C.infoMessage "Start running..."@@ -39,4 +46,4 @@       Right r -> putStrLn r >> C.successMessage "Success!"  runDiff :: CommunityDB -> FlagAssignments -> Sem '[CommunityEnv, FlagAssignmentsEnv, Trace, DependencyRecord, WithMyErr, Embed IO, Final IO] a -> IO (Either MyException a)-runDiff community flags = runFinal . embedToFinal . errorToIOFinal . evalState (Map.empty) . ignoreTrace . (runReader flags) . (runReader community)+runDiff community flags = runFinal . embedToFinal . errorToIOFinal . evalState Map.empty . ignoreTrace . runReader flags . runReader community

@@ -107,8 +107,6 @@   InfoByName :: String -> Aur m (Maybe AurInfo)   IsInAur :: HasMyName n => n -> Aur m Bool --- searchByName- makeSem_ ''Aur  -- | Serach a package from AUR@@ -130,7 +128,7 @@           "v" =: ("5" :: Text)             <> "type" =: ("search" :: Text)             <> "by" =: ("name" :: Text)-            <> "arg" =: (pack name)+            <> "arg" =: pack name         r = req GET baseURL NoReqBody jsonResponse parms     response <- interceptHttpException $ runReq defaultHttpConfig r     let body :: AurReply AurSearch = responseBody response@@ -142,7 +140,7 @@           "v" =: ("5" :: Text)             <> "type" =: ("info" :: Text)             <> "by" =: ("name" :: Text)-            <> "arg[]" =: (pack name)+            <> "arg[]" =: pack name         r = req GET baseURL NoReqBody jsonResponse parms     response <- interceptHttpException $ runReq defaultHttpConfig r     let body :: AurReply AurInfo = responseBody response

@@ -1,5 +1,5 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-}  -- | Copyright: (c) 2020 berberman@@ -13,6 +13,10 @@     loadProcessedCommunity,     isInCommunity,     versionInCommunity,+    compiledWithAlpm,+#ifdef ALPM+    loadCommunityFFI,+#endif   ) where @@ -26,7 +30,59 @@ import Distribution.ArchHs.Name import Distribution.ArchHs.PkgDesc import Distribution.ArchHs.Types+import Distribution.ArchHs.Utils +-----------------------------------------------------------------------------++#ifdef ALPM+{-# LANGUAGE ForeignFunctionInterface #-}+import qualified Data.Sequence as Seq+import Data.Foldable (toList)+import Data.IORef (IORef, modifyIORef', newIORef, readIORef)+import Foreign.C.String (CString, peekCString)+import Foreign.C.Types (CInt(..))+import Foreign.Ptr (FunPtr, freeHaskellFunPtr)++foreign import ccall "wrapper"+  wrap :: (CString -> CString -> IO ()) -> IO (FunPtr (CString -> CString -> IO ()))++foreign import ccall "clib.h query_community"+  query_community :: FunPtr (CString -> CString -> IO ()) -> IO CInt++foreign import ccall "alpm.h alpm_strerror"+  alpm_strerror :: CInt -> IO CString++callback :: IORef (Seq.Seq (CommunityName, CommunityVersion)) -> CString -> CString -> IO ()+callback ref x y = do+  x' <- peekCString x+  y' <- peekCString y+  modifyIORef' ref (Seq.|> (CommunityName x', extractFromEVR y'))++-- | The same purpose as 'loadCommunity' but use alpm to query community db instead.+loadCommunityFFI :: IO CommunityDB+loadCommunityFFI = do+  ref <- newIORef Seq.empty+  callbackW <- wrap $ callback ref+  errno <- query_community callbackW+  freeHaskellFunPtr callbackW+  when (errno /= 0) $ do+    msg <- peekCString =<< alpm_strerror errno+    -- TODO: why? :(+    putStrLn $ "warn: unexpected return code from libalpm: " <> show errno <> " (" <> msg <> ")"+  Map.fromList . toList <$> readIORef ref+#endif++-- | Whether this program enables alpm support.+compiledWithAlpm :: Bool+compiledWithAlpm =+#ifdef ALPM+  True+#else+  False+#endif++-----------------------------------------------------------------------------+ -- | Default path to @community.db@. defaultCommunityPath :: FilePath defaultCommunityPath = "/" </> "var" </> "lib" </> "pacman" </> "sync" </> "community.db"@@ -49,31 +105,28 @@                     Right r -> case head $ r Map.! "NAME" of                       "ghc" -> parseProvidedTerm <$> provided r                       "ghc-libs" -> parseProvidedTerm <$> provided r-                      _ -> [(head $ r Map.! "NAME", extractVer . head $ r Map.! "VERSION")]-                    -- TODO: Drop it+                      _ -> [(head $ r Map.! "NAME", extractFromEVR . head $ r Map.! "VERSION")]+                    -- Drop it if failed to parse                     Left _ -> []-            extractVer ver = head $-              splitOn "-" $ case splitOn ":" ver of-                (_ : v : []) -> v-                v : [] -> v-                _ -> fail "err"          yieldMany $ result & each . _1 %~ CommunityName  -- | Load @community.db@ from @path@. -- @desc@ files in the db will be parsed by @descParser@. loadProcessedCommunity :: (MonadUnliftIO m, PrimMonad m, MonadThrow m) => FilePath -> m CommunityDB-loadProcessedCommunity path = Map.fromList <$> (runConduitRes $ loadCommunity path .| sinkList)+loadProcessedCommunity path = Map.fromList <$> runConduitRes (loadCommunity path .| sinkList) +-----------------------------------------------------------------------------+ -- | Check if a package exists in archlinux community repo. -- See 'HasMyName'. isInCommunity :: (HasMyName n, Member CommunityEnv r) => n -> Sem r Bool-isInCommunity name = ask @CommunityDB >>= \db -> return $ (toCommunityName name) `Map.member` db+isInCommunity name = ask @CommunityDB >>= \db -> return $ toCommunityName name `Map.member` db  -- | 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 CommunityVersion versionInCommunity name =-  ask @CommunityDB >>= \db -> case db Map.!? (toCommunityName name) of+  ask @CommunityDB >>= \db -> case db Map.!? toCommunityName name of     Just x -> return x     _ -> throw $ PkgNotFound name

@@ -15,7 +15,7 @@ where  import qualified Algebra.Graph.Labelled.AdjacencyMap as G-import Data.Char (toLower)+import Data.Bifunctor (second) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set@@ -25,7 +25,7 @@     getLatestSHA256,   ) import Distribution.ArchHs.Internal.Prelude-import Distribution.ArchHs.Local (ghcLibList, ignoreList)+import Distribution.ArchHs.Local (ignoreList) import Distribution.ArchHs.Name import Distribution.ArchHs.PkgBuild   ( PkgBuild (..),@@ -77,7 +77,7 @@         mkFlagAssignment           . (<> flagAssignment)           . filter (\(fName, _) -> fName `notElem` flagNames)-          $ (unFlagAssignment defaultFlagAssignments)+          $ unFlagAssignment defaultFlagAssignments   trace' $ "Evaluating condition tree of " <> show name   trace' $ "Flags: " <> show thisFlag   traceCallStack@@ -96,7 +96,7 @@   Maybe PackageName ->   -- | Target   PackageName ->-  Sem r ((G.AdjacencyMap (Set DependencyType) PackageName), Set PackageName)+  Sem r (G.AdjacencyMap (Set DependencyType) PackageName, Set PackageName) getDependencies skip parent name = do   resolved <- get @(Set PackageName)   modify' $ Set.insert name@@ -104,7 +104,6 @@   trace' $ "Already resolved: " <> show resolved   traceCallStack   cabal <- getLatestCabal name-  -- Ignore subLibraries   (libDeps, libToolsDeps) <- collectLibDeps cabal   (subLibDeps, subLibToolsDeps) <- collectSubLibDeps cabal skip   (exeDeps, exeToolsDeps) <- collectExeDeps cabal skip@@ -126,14 +125,14 @@        filteredLibDeps = ignore libDeps       filteredLibToolsDeps = ignore libToolsDeps-      filteredExeDeps = ignoreFlatten CExe $ exeDeps-      filteredExeToolsDeps = ignoreFlatten CExeBuildTools $ exeToolsDeps-      filteredTestDeps = ignoreFlatten CTest $ testDeps-      filteredTestToolsDeps = ignoreFlatten CTest $ testToolsDeps-      filteredSubLibDeps = ignoreFlatten CSubLibs $ subLibDeps-      filteredSubLibToolsDeps = ignoreFlatten CSubLibsBuildTools $ subLibToolsDeps+      filteredExeDeps = ignoreFlatten CExe exeDeps+      filteredExeToolsDeps = ignoreFlatten CExeBuildTools exeToolsDeps+      filteredTestDeps = ignoreFlatten CTest testDeps+      filteredTestToolsDeps = ignoreFlatten CTest testToolsDeps+      filteredSubLibDeps = ignoreFlatten CSubLibs subLibDeps+      filteredSubLibToolsDeps = ignoreFlatten CSubLibsBuildTools subLibToolsDeps -      filteredSubLibDepsNames = fmap unqualComponentNameToPackageName . fmap fst $ subLibDeps+      filteredSubLibDepsNames = fmap (unqualComponentNameToPackageName . fst) subLibDeps       ignoreSubLibs = filter (`notElem` filteredSubLibDepsNames)       ignoreResolved = filter (`notElem` resolved) @@ -163,7 +162,7 @@   let temp = [nextLib, nextExe, nextSubLibs]       nexts = G.overlays $ temp ^. each ^.. each . _1       subsubs = temp ^. each ^.. each . _2 ^. each-  return $+  return     ( currentLib         <+> currentLibDeps         <+> currentExe@@ -183,10 +182,10 @@   case cabal & condLibrary of     Just lib -> do       let name = getPkgName' cabal-      trace' $ "Getting componential dependencies of " <> show name+      trace' $ "Getting libs dependencies of " <> show name       info <- evalConditionTree cabal lib-      let libDeps = fmap unDepV $ buildDependsIfBuild info-          toolDeps = fmap unExeV $ buildToolDependsIfBuild info+      let libDeps = unDepV <$> buildDependsIfBuild info+          toolDeps = unBuildTools $ buildToolsAndbuildToolDependsIfBuild info       mapM_ (uncurry updateDependencyRecord) libDeps       mapM_ (uncurry updateDependencyRecord) toolDeps       let result = (fmap fst libDeps, fmap fst toolDeps)@@ -197,18 +196,19 @@  collectComponentialDeps ::   (HasCallStack, Semigroup k, L.HasBuildInfo k, Members [FlagAssignmentsEnv, DependencyRecord, Trace] r) =>+  String ->   (GenericPackageDescription -> [(UnqualComponentName, CondTree ConfVar [Dependency] k)]) ->   GenericPackageDescription ->   [UnqualComponentName] ->   Sem r (ComponentPkgList, ComponentPkgList)-collectComponentialDeps f cabal skip = do+collectComponentialDeps tag f cabal skip = do   let conds = cabal & f       name = getPkgName' cabal-  trace' $ "Getting componential dependencies of " <> show name+  trace' $ "Getting " <> tag <> " dependencies of " <> show name   info <- filter (not . (`elem` skip) . fst) . zip (conds <&> fst) <$> mapM (evalConditionTree cabal . snd) conds-  let deps = info <&> ((_2 %~) $ fmap unDepV . buildDependsIfBuild)-      toolDeps = info <&> ((_2 %~) $ fmap unExeV . buildToolDependsIfBuild)-      k = fmap (\(c, l) -> (c, fmap fst l))+  let deps = info <&> _2 %~ (fmap unDepV . buildDependsIfBuild)+      toolDeps = info <&> _2 %~ (unBuildTools . buildToolsAndbuildToolDependsIfBuild)+      k = fmap (second $ fmap fst)   mapM_ (uncurry updateDependencyRecord) $ deps ^.. each . _2 ^. each   mapM_ (uncurry updateDependencyRecord) $ toolDeps ^.. each . _2 ^. each   let result = (k deps, k toolDeps)@@ -217,13 +217,13 @@   return result  collectExeDeps :: (HasCallStack, Members [FlagAssignmentsEnv, DependencyRecord, Trace] r) => GenericPackageDescription -> [UnqualComponentName] -> Sem r (ComponentPkgList, ComponentPkgList)-collectExeDeps = collectComponentialDeps condExecutables+collectExeDeps = collectComponentialDeps "exe" condExecutables  collectTestDeps :: (HasCallStack, Members [FlagAssignmentsEnv, DependencyRecord, Trace] r) => GenericPackageDescription -> [UnqualComponentName] -> Sem r (ComponentPkgList, ComponentPkgList)-collectTestDeps = collectComponentialDeps condTestSuites+collectTestDeps = collectComponentialDeps "test" condTestSuites  collectSubLibDeps :: (HasCallStack, Members [FlagAssignmentsEnv, DependencyRecord, Trace] r) => GenericPackageDescription -> [UnqualComponentName] -> Sem r (ComponentPkgList, ComponentPkgList)-collectSubLibDeps = collectComponentialDeps condSubLibraries+collectSubLibDeps = collectComponentialDeps "sublib" condSubLibraries  updateDependencyRecord :: Member DependencyRecord r => PackageName -> VersionRange -> Sem r () updateDependencyRecord name range = modify' $ Map.insertWith (<>) name [range]@@ -234,17 +234,16 @@ -----------------------------------------------------------------------------  -- | Generate 'PkgBuild' for a 'SolvedPackage'.-cabalToPkgBuild :: Members [HackageEnv, FlagAssignmentsEnv, WithMyErr] r => SolvedPackage -> PkgList -> Bool -> Sem r PkgBuild-cabalToPkgBuild pkg ignored uusi = do+cabalToPkgBuild :: Members [HackageEnv, FlagAssignmentsEnv, WithMyErr] r => SolvedPackage -> Bool -> Sem r PkgBuild+cabalToPkgBuild pkg uusi = do   let name = pkg ^. pkgName-  cabal <- packageDescription <$> (getLatestCabal name)-  _sha256sums <- (\case Just s -> "'" <> s <> "'"; Nothing -> "'SKIP'") <$> getLatestSHA256 name+  cabal <- packageDescription <$> getLatestCabal name+  _sha256sums <- (\case Just s -> "'" <> s <> "'"; Nothing -> "'SKIP'") <$> tryMaybe (getLatestSHA256 name)   let _hkgName = pkg ^. pkgName & unPackageName-      rawName = toLower <$> _hkgName-      _pkgName = maybe rawName id $ stripPrefix "haskell-" rawName+      _pkgName = unCommunityName . toCommunityName $ pkg ^. pkgName       _pkgVer = prettyShow $ getPkgVersion cabal       _pkgDesc = fromShortText $ synopsis cabal-      getL (NONE) = ""+      getL NONE = ""       getL (License e) = getE e       getE (ELicense (ELicenseId x) _) = show . mapLicense $ x       getE (ELicense (ELicenseIdPlus x) _) = show . mapLicense $ x@@ -253,19 +252,18 @@       getE (EOr x y) = getE x <> " " <> getE y        _license = getL . license $ cabal-      _enableCheck = any id $ pkg ^. pkgDeps & mapped %~ (\dep -> selectDepKind Test dep && dep ^. depName == pkg ^. pkgName)+      _enableCheck = or $ (pkg ^. pkgDeps) <&> depIsKind Test       depends =         pkg ^. pkgDeps           ^.. each             . filtered               ( \x ->-                  notMyself x-                    && notInGHCLib x-                    && ( selectDepKind Lib x-                           || selectDepKind Exe x-                           || selectDepKind SubLibs x+                  depNotMyself name x+                    && depNotInGHCLib x+                    && ( depIsKind Lib x+                           || depIsKind Exe x+                           || depIsKind SubLibs x                        )-                    && notIgnore x               )       makeDepends =         pkg ^. pkgDeps@@ -273,24 +271,20 @@             . filtered               ( \x ->                   x `notElem` depends-                    && notMyself x-                    && notInGHCLib x-                    && ( selectDepKind LibBuildTools x-                           || selectDepKind Test x-                           || selectDepKind TestBuildTools x-                           || selectDepKind SubLibsBuildTools x+                    && depNotMyself name x+                    && depNotInGHCLib x+                    && ( depIsKind LibBuildTools x+                           || depIsKind ExeBuildTools x+                           || depIsKind Test x+                           || depIsKind TestBuildTools x+                           || depIsKind SubLibsBuildTools x                        )-                    && notIgnore x               )       depsToString deps = deps <&> (wrap . unCommunityName . toCommunityName . _depName) & mconcat       _depends = depsToString depends       _makeDepends = (if uusi then " 'uusi'" else "") <> depsToString makeDepends       _url = getUrl cabal       wrap s = " '" <> s <> "'"-      notInGHCLib x = (x ^. depName) `notElem` ghcLibList-      notMyself x = x ^. depName /= name-      notIgnore x = x ^. depName `notElem` ignored-      selectDepKind k x = k `elem` (x ^. depType & mapped %~ dependencyTypeToKind)       _licenseFile = licenseFiles cabal ^? ix 0       _enableUusi = uusi   return PkgBuild {..}

@@ -15,6 +15,7 @@     printHandledIOException,     printAppResult,     interceptHttpException,+    tryMaybe,   ) where @@ -38,10 +39,10 @@   | NetworkException HttpException  instance Show MyException where-  show (PkgNotFound name) = "Unable to find [" <> (unPackageName $ toHackageName name) <> "] (hackage name) / [" <> (unCommunityName $ toCommunityName name) <> "] (community name)"-  show (VersionNotFound name version) = "Unable to find [" <> (unPackageName $ toHackageName name) <> "] (hackage name) / [" <> (unCommunityName $ toCommunityName name) <> "] (community name)" <> " " <> prettyShow version-  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 (PkgNotFound name) = "Unable to find \"" <> unPackageName (toHackageName name) <> "\""+  show (VersionNotFound name version) = "Unable to find \"" <> unPackageName (toHackageName name) <> "\" " <> prettyShow version+  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 (JsonHttpException s)) = "Failed to parse response " <> s   show (NetworkException (VanillaHttpException e)) = show e @@ -63,3 +64,10 @@   case x of     Left err -> throw $ NetworkException err     Right x' -> return x'++-- | Like 'try' but discard the concrete exception.+tryMaybe :: Member WithMyErr r => Sem r a -> Sem r (Maybe a)+tryMaybe m =+  try @MyException m >>= \case+    Left _ -> return Nothing+    Right x -> return $ Just x

@@ -62,11 +62,11 @@  -- | Insert a 'GenericPackageDescription' into 'HackageDB'. insertDB :: GenericPackageDescription -> HackageDB -> HackageDB-insertDB cabal db = Map.insert name packageData db+insertDB cabal = Map.insert name packageData   where     name = getPkgName $ packageDescription cabal     version = getPkgVersion $ packageDescription cabal-    versionData = VersionData cabal $ Map.empty+    versionData = VersionData cabal Map.empty     packageData = Map.singleton version versionData  -- | Read and parse @.cabal@ file.@@ -91,8 +91,8 @@ getLatestCabal = withLatestVersion cabalFile  -- | Get the latest SHA256 sum of the tarball .-getLatestSHA256 :: Members [HackageEnv, WithMyErr] r => PackageName -> Sem r (Maybe String)-getLatestSHA256 = withLatestVersion (\vdata -> tarballHashes vdata Map.!? "sha256")+getLatestSHA256 :: Members [HackageEnv, WithMyErr] r => PackageName -> Sem r String+getLatestSHA256 = withLatestVersion (\vdata -> tarballHashes vdata Map.! "sha256")  -- | Get 'GenericPackageDescription' with a specific version. getCabal :: Members [HackageEnv, WithMyErr] r => PackageName -> Version -> Sem r GenericPackageDescription

@@ -168,4 +168,4 @@ isHaskellPackage :: CommunityName -> Bool isHaskellPackage name =   let rep = toCommunityRep name-   in (rep `elem` communityListP || "haskell-" `isPrefixOf` (unMyName rep)) && rep `notElem` falseListP+   in (rep `elem` communityListP || "haskell-" `isPrefixOf` unMyName rep) && rep `notElem` falseListP

@@ -20,24 +20,21 @@ import qualified Data.Map.Strict as Map import Data.Void (Void) import Distribution.ArchHs.Internal.Prelude-import Distribution.ArchHs.Utils 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 [] = Map.empty readFlag list =-  Map.fromList-    . fmap (\l -> (mkPackageName . (^. _1) . head $ l, foldr (\(_, f, v) acc -> insertFlagAssignment (mkFlagName f) v acc) (mkFlagAssignment []) l))-    . groupBy (\a b -> uncurry (==) (getTwo _1 a b))-    $ 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 ""--- Right (fromList []) -- >>> 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"@@ -97,7 +94,7 @@       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+   in if failed /= [] then Left ("Unexpected file name: " <> intercalate ", " failed) else Right successful  -- | Read a 'Version' -- This function calls 'simpleParsec'.

@@ -26,10 +26,14 @@ prettySkip = C.formatWith [C.magenta] . intercalate ", "  prettyFlagAssignments :: Map.Map PackageName FlagAssignment -> String-prettyFlagAssignments m = mconcat $ fmap (fmap (\(n, a) -> C.formatWith [C.magenta] (unPackageName n) <> "\n" <> C.formatWith [C.indent 4] (prettyFlagAssignment a))) Map.toList m+prettyFlagAssignments m =+  mconcat $+    fmap (fmap (\(n, a) -> C.formatWith [C.magenta] (unPackageName n) <> "\n" <> prettyFlagAssignment a)) Map.toList m  prettyFlagAssignment :: FlagAssignment -> String-prettyFlagAssignment m = mconcat $ fmap (\(n, v) -> "⚐ " <> C.formatWith [C.yellow] (unFlagName n) <> " : " <> C.formatWith [C.cyan] (show v) <> "\n") $ unFlagAssignment m+prettyFlagAssignment m =+  mconcat $+    (\(n, v) -> "    ⚐ " <> C.formatWith [C.yellow] (unFlagName n) <> " : " <> C.formatWith [C.cyan] (show v) <> "\n") <$> unFlagAssignment m  prettyDeps :: [PackageName] -> String prettyDeps =@@ -38,10 +42,10 @@     . zip [1 ..]  prettyFlags :: [(PackageName, [Flag])] -> String-prettyFlags = mconcat . fmap (\(name, flags) -> (C.formatWith [C.magenta] $ unPackageName name <> "\n") <> mconcat (fmap (C.formatWith [C.indent 4] . prettyFlag) flags))+prettyFlags = mconcat . fmap (\(name, flags) -> C.formatWith [C.magenta] (unPackageName name <> "\n") <> mconcat (C.formatWith [C.indent 4] . prettyFlag <$> flags))  prettyFlag :: Flag -> String-prettyFlag f = "⚐ " <> C.formatWith [C.yellow] name <> ":\n" <> mconcat (fmap (C.formatWith [C.indent 6]) $ ["description:\n" <> desc, "default: " <> def <> "\n", "isManual: " <> manual <> "\n"])+prettyFlag f = "⚐ " <> C.formatWith [C.yellow] name <> ":\n" <> mconcat (C.formatWith [C.indent 6] <$> ["description:\n" <> desc, "default: " <> def <> "\n", "isManual: " <> manual <> "\n"])   where     name = unFlagName . flagName $ f     desc = unlines . fmap (C.formatWith [C.indent 8]) . lines $ flagDescription f@@ -54,19 +58,18 @@ prettySolvedPkg :: SolvedPackage -> [(String, String)] prettySolvedPkg SolvedPackage {..} =   (C.formatWith [C.bold, C.yellow] (unPackageName _pkgName), C.formatWith [C.red] "    ✘") :-  ( fmap-      ( \(i :: Int, SolvedDependency {..}) ->-          let prefix = if i == length _pkgDeps then " └─" else " ├─"-           in case _depProvider of-                (Just x) -> ((C.formatWith [C.green] $ (T.unpack prefix) <> unPackageName _depName <> " " <> show _depType), ((C.formatWith [C.green] "✔ ") <> (C.formatWith [C.cyan] $ "[" <> show x <> "]")))-                _ -> (C.formatWith [C.bold, C.yellow] $ (T.unpack prefix) <> unPackageName _depName <> " " <> show _depType, C.formatWith [C.red] "    ✘")-      )-      (zip [1 ..] _pkgDeps)-  )-prettySolvedPkg ProvidedPackage {..} = [((C.formatWith [C.green] $ unPackageName _pkgName), ((C.formatWith [C.green] "✔ ") <> (C.formatWith [C.cyan] $ "[" <> show _pkgProvider <> "]")))]+  fmap+    ( \(i :: Int, SolvedDependency {..}) ->+        let prefix = if i == length _pkgDeps then " └─" else " ├─"+         in case _depProvider of+              (Just x) -> (C.formatWith [C.green] $ T.unpack prefix <> unPackageName _depName <> " " <> show _depType, C.formatWith [C.green] "✔ " <> C.formatWith [C.cyan] (show x))+              _ -> (C.formatWith [C.bold, C.yellow] $ T.unpack prefix <> unPackageName _depName <> " " <> show _depType, C.formatWith [C.red] "    ✘")+    )+    (zip [1 ..] _pkgDeps)+prettySolvedPkg ProvidedPackage {..} = [(C.formatWith [C.green] (unPackageName _pkgName), C.formatWith [C.green] "✔ " <> C.formatWith [C.cyan] (show _pkgProvider))]  con :: [(String, String)] -> String con l = mconcat complemented   where     maxL = maximum $ fmap (length . fst) l-    complemented = fmap (\(x, y) -> (x <> (replicate (maxL - length x) ' ') <> y <> "\n")) l+    complemented = (\(x, y) -> x <> replicate (maxL - length x) ' ' <> y <> "\n") <$> l

@@ -14,6 +14,7 @@     mapLicense,     applyTemplate,     felixTemplate,+    metaTemplate,   ) where @@ -142,7 +143,7 @@       (pack _makeDepends)       (pack _sha256sums)       ( case _licenseFile of-          Just n -> "\n" <> (installLicense $ pack n)+          Just n -> "\n" <> installLicense (pack n)           _ -> "\n"       )       (if _enableUusi then "\n" <> uusi <> "\n\n" else "\n")@@ -178,11 +179,11 @@ felixTemplate :: Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text felixTemplate hkgname pkgname pkgver pkgdesc url license depends makedepends sha256sums licenseF uusiF checkF =   [text|-  # This file was generated by arch-hs, please check it manually.+  # This file was generated by https://github.com/berberman/arch-hs, please check it manually.   # Maintainer: Your Name <youremail@domain.com>    _hkgname=$hkgname-  pkgname=haskell-$pkgname+  pkgname=$pkgname   pkgver=$pkgver   pkgrel=1   pkgdesc="$pkgdesc"@@ -218,3 +219,21 @@     runhaskell Setup copy --destdir="$$pkgdir"$licenseF   } |]++-- | A fixed template of a haskell meta package.+metaTemplate :: Text -> Text -> Text -> Text -> Text+metaTemplate url pkgname comment depends =+  [text|+  # This file was generated by https://github.com/berberman/arch-hs, please check it manually.+  # This is a meta package, containing only dependencies of the target.+  # Maintainer: Your Name <youremail@domain.com>++  pkgname=haskell-$pkgname-meta+  pkgver=1+  pkgrel=1+  pkgdesc="Dependencies of $pkgname"+  url="$url"+  arch=('x86_64')+  $comment+  depends=('ghc-libs'$depends)+  |]

@@ -130,12 +130,12 @@  -- | Provider of a dependency. data DependencyProvider = ByCommunity | ByAur-  deriving stock (Eq, Generic)+  deriving stock (Eq, Ord, Generic)   deriving anyclass (NFData)  instance Show DependencyProvider where-  show ByCommunity = "community"-  show ByAur = "aur"+  show ByCommunity = "[community]"+  show ByAur = "[aur]"  -- | A solved dependency, holden by 'SolvedPackage' data SolvedDependency = SolvedDependency@@ -146,7 +146,7 @@     -- | Types of the dependency     _depType :: [DependencyType]   }-  deriving stock (Show, Eq, Generic)+  deriving stock (Show, Eq, Ord, Generic)   deriving anyclass (NFData)  -- | A solved package collected from dgraph. This data type is not designed to be recursively,@@ -166,7 +166,7 @@         -- | Package dependencies         _pkgDeps :: [SolvedDependency]       }-  deriving stock (Show, Eq, Generic)+  deriving stock (Show, Eq, Ord, Generic)   deriving anyclass (NFData)  makeLenses ''SolvedDependency

@@ -11,18 +11,25 @@     dependencyTypeToKind,     unExe,     unExeV,+    unLegacyExeV,+    unBuildTools,     unDepV,     getUrl,     getTwo,     buildDependsIfBuild,-    buildToolDependsIfBuild,+    buildToolsAndbuildToolDependsIfBuild,     traceCallStack,     trace',+    depNotInGHCLib,+    depNotMyself,+    depIsKind,+    extractFromEVR,   ) where  import Control.Monad ((<=<)) import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Local (ghcLibList) import Distribution.ArchHs.Types import Distribution.PackageDescription (repoLocation) import Distribution.Types.BuildInfo (BuildInfo (..))@@ -32,6 +39,7 @@     depVerRange,   ) import Distribution.Types.ExeDependency (ExeDependency (..))+import Distribution.Types.LegacyExeDependency import qualified Distribution.Types.PackageId as I import Distribution.Utils.ShortText (fromShortText) import GHC.Stack@@ -47,6 +55,14 @@ unExeV :: ExeDependency -> (PackageName, VersionRange) unExeV (ExeDependency name _ v) = (name, v) +-- | Extract the package name and the version range from a 'LegacyExeDependency'.+unLegacyExeV :: LegacyExeDependency -> (PackageName, VersionRange)+unLegacyExeV (LegacyExeDependency name v) = (mkPackageName name, v)++-- | Extract and join package names and version ranges of '[LegacyExeDependency]' and '[ExeDependency]'.+unBuildTools :: ([LegacyExeDependency], [ExeDependency]) -> [(PackageName, VersionRange)]+unBuildTools (l, e) = (unLegacyExeV <$> l) <> (unExeV <$> e)+ -- | Extract the 'PackageName' and 'VersionRange' of a 'Dependency'. unDepV :: Dependency -> (PackageName, VersionRange) unDepV dep = (depPkgName dep, depVerRange dep)@@ -74,16 +90,16 @@     fromJust _ = fail "Impossible."     home = f . fromShortText . homepage $ cabal     vcs = repoLocation <=< (^? ix 0) . sourceRepos $ cabal-    fallback = Just $ "https://hackage.haskell.org/package/" <> (unPackageName $ getPkgName cabal)+    fallback = Just $ "https://hackage.haskell.org/package/" <> unPackageName (getPkgName cabal)  -- | Map 'DependencyType' with its data constructor tag 'DependencyKind'. dependencyTypeToKind :: DependencyType -> DependencyKind dependencyTypeToKind (CExe _) = Exe dependencyTypeToKind (CExeBuildTools _) = ExeBuildTools-dependencyTypeToKind (CLib) = Lib+dependencyTypeToKind CLib = Lib dependencyTypeToKind (CTest _) = Test dependencyTypeToKind (CBenchmark _) = Benchmark-dependencyTypeToKind (CLibBuildTools) = LibBuildTools+dependencyTypeToKind CLibBuildTools = LibBuildTools dependencyTypeToKind (CTestBuildTools _) = TestBuildTools dependencyTypeToKind (CBenchmarkBuildTools _) = BenchmarkBuildTools dependencyTypeToKind (CSubLibs _) = SubLibs@@ -97,9 +113,10 @@ buildDependsIfBuild :: BuildInfo -> [Dependency] buildDependsIfBuild info = if buildable info then targetBuildDepends info else [] --- | Same as 'buildToolDepends', but check if this is 'buildable'.-buildToolDependsIfBuild :: BuildInfo -> [ExeDependency]-buildToolDependsIfBuild info = if buildable info then buildToolDepends info else []+-- | 'buildToolDepends' combined with 'buildTools', and check if this is 'buildable'.+-- Actually, we should avoid accessing these two fields directly, in in favor of 'Distribution.Simple.BuildToolDepends.getAllToolDependencies'+buildToolsAndbuildToolDependsIfBuild :: BuildInfo -> ([LegacyExeDependency], [ExeDependency])+buildToolsAndbuildToolDependsIfBuild info = if buildable info then (buildTools info, buildToolDepends info) else ([], [])  -- | Trace with prefix @[TRACE]@. trace' :: MemberWithError Trace r => String -> Sem r ()@@ -111,3 +128,26 @@   trace . prefix $ prettyCallStack callStack   where     prefix = unlines . fmap ("[TRACE]  " ++) . lines++-- | 'SolvedDependency' @x@' is not provided by ghc.+depNotInGHCLib :: SolvedDependency -> Bool+depNotInGHCLib x = (x ^. depName) `notElem` ghcLibList++-- | 'SolvedDependency' @x@'s name is not equal to @name@.+depNotMyself :: PackageName -> SolvedDependency -> Bool+depNotMyself name x = x ^. depName /= name++-- | 'SolvedDependency' @x@' has 'DependencyKind' @k@.+depIsKind :: DependencyKind -> SolvedDependency -> Bool+depIsKind k x = k `elem` (x ^. depType <&> dependencyTypeToKind)++-- | Extract package version from epoch-version-release.+--+-- >>> extractFromEVR "8.10.2-1"+-- "8.10.2"+-- >>> extractFromEVR "3:2.4.11-19"+-- "2.4.11"+extractFromEVR :: String -> CommunityVersion+extractFromEVR evr =+  let ev = head $ splitOn "-" evr+   in if ':' `elem` ev then tail $ dropWhile (/= ':') ev else ev

@@ -1,9 +1,11 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}  module Main (main) where  import qualified Colourista as C+import Control.Monad (unless) import qualified Data.Text as T import Distribution.ArchHs.Community import Distribution.ArchHs.Exception@@ -19,27 +21,35 @@   do     Options {..} <- runArgsParser -    let useDefaultHackage = isInfixOf "YOUR_HACKAGE_MIRROR" $ optHackagePath-        useDefaultCommunity = "/var/lib/pacman/sync/community.db" == optCommunityPath-+    let useDefaultHackage = "YOUR_HACKAGE_MIRROR" `isInfixOf` optHackagePath     when useDefaultHackage $ C.skipMessage "You didn't pass -h, use hackage index file from default path."++#ifndef ALPM+    let useDefaultCommunity = "/var/lib/pacman/sync/community.db" == optCommunityPath     when useDefaultCommunity $ C.skipMessage "You didn't pass -c, use community db file from default path."+#endif      token <- lookupEnv "HACKAGE_API_TOKEN" -    when (token == Nothing) $ C.warningMessage "You didn't set HACKAGE_API_TOKEN, dry run only."+    when (null token) $ C.warningMessage "You didn't set HACKAGE_API_TOKEN, dry run only."      let hasOutput = not $ null optOutput-    when (hasOutput) $ do-      C.infoMessage $ "Output will be dumped to " <> (T.pack optOutput) <> "."+    when hasOutput $ do+      C.infoMessage $ "Output will be dumped to " <> T.pack optOutput <> "."       exist <- doesFileExist optOutput       when exist $-        C.warningMessage $ "File " <> (T.pack optOutput) <> " already existed, overwrite it."+        C.warningMessage $ "File " <> T.pack optOutput <> " already existed, overwrite it."     C.infoMessage "Start running..."-    when (not $ optUpload || hasOutput) $+    unless (optUpload || hasOutput) $       C.warningMessage "Run diff and check only." +#ifdef ALPM+    when optAlpm $ C.infoMessage "Using alpm."+    community <- if optAlpm then loadCommunityFFI else loadProcessedCommunity defaultCommunityPath+#else     community <- loadProcessedCommunity $ if useDefaultCommunity then defaultCommunityPath else optCommunityPath+#endif+     C.infoMessage "Loading community.db..."      hackage <- loadHackageDB =<< if useDefaultHackage then lookupHackagePath else return optHackagePath@@ -48,4 +58,4 @@     runSubmit community hackage (submit token optOutput optUpload) & printAppResult  runSubmit :: CommunityDB -> HackageDB -> Sem '[CommunityEnv, HackageEnv, WithMyErr, Embed IO, Final IO] a -> IO (Either MyException a)-runSubmit community hackage = runFinal . embedToFinal . errorToIOFinal . (runReader hackage) . (runReader community)+runSubmit community hackage = runFinal . embedToFinal . errorToIOFinal . runReader hackage . runReader community

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} @@ -9,6 +10,7 @@ where  import qualified Colourista as C+import Control.Monad (unless) import qualified Data.ByteString.Char8 as BS import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromJust)@@ -28,7 +30,11 @@  data Options = Options   { optHackagePath :: FilePath,+#ifndef ALPM     optCommunityPath :: FilePath,+#else+    optAlpm :: Bool,+#endif     optOutput :: FilePath,     optUpload :: Bool   }@@ -44,6 +50,7 @@           <> showDefault           <> value "~/.cabal/packages/YOUR_HACKAGE_MIRROR/01-index.tar | 00-index.tar"       )+#ifndef ALPM     <*> strOption       ( long "community"           <> metavar "PATH"@@ -52,6 +59,12 @@           <> showDefault           <> value "/var/lib/pacman/sync/community.db"       )+#else+      <*> switch+        ( long "alpm"+            <> help "Use libalpm to parse community db"+        )+#endif     <*> Options.Applicative.option       str       ( long "output"@@ -90,8 +103,8 @@  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)+  (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@@ -102,6 +115,8 @@ genCSV :: Member CommunityEnv r => Sem r DistroCSV genCSV = do   db <- ask @CommunityDB++  {-# HLINT ignore "Use <&>" #-}   let communityPackages = Map.toList db       fields =         communityPackages@@ -115,7 +130,7 @@       prefix = "https://www.archlinux.org/packages/community/x86_64/"       processField (communityName, (hackageName, version)) =         let communityName' =-              if (hackageName `elem` ghcLibList || hackageName == "ghc")+              if hackageName `elem` ghcLibList || hackageName == "ghc"                 then "ghc"                 else unCommunityName communityName          in (unPackageName hackageName, version, prefix <> communityName')@@ -126,12 +141,12 @@   csv <- genCSV   let v = renderDistroCSV csv   embed $-    when (not . null $ output) $ do+    unless (null output) $ do       C.infoMessage $ "Write file: " <> T.pack output       writeFile output v   check csv   interceptHttpException $-    when (token /= Nothing && upload) $ do+    when ((not . null) token && upload) $ do       C.infoMessage "Uploading..."       let api = https "hackage.haskell.org" /: "distro" /: "Arch" /: "packages"           r =@@ -139,13 +154,13 @@               header "Authorization" (BS.pack $ "X-ApiKey " <> fromJust token) <> header "Content-Type" "text/csv"       result <- runReq defaultHttpConfig r       C.infoMessage $ "StatusCode: " <> (T.pack . show $ responseStatusCode result)-      C.infoMessage $ "ResponseMessage: " <> (decodeUtf8 $ responseStatusMessage result)+      C.infoMessage $ "ResponseMessage: " <> decodeUtf8 (responseStatusMessage result)       C.infoMessage "ResponseBody:"       putStrLn . BS.unpack $ responseBody result  check :: Members [HackageEnv, WithMyErr, Embed IO] r => DistroCSV -> Sem r () check community = do-  embed $ C.infoMessage "Checking generated CSV file..."+  embed $ C.infoMessage "Checking generated csv file..."    let hackageNames = fmap (\(a, _, _) -> a) community       pipe = fmap (\case Left (PkgNotFound x) -> Just (unCommunityName $ toCommunityName x); _ -> Nothing)@@ -153,7 +168,7 @@   failed <- catMaybes . pipe <$> mapM (\x -> try @MyException (getLatestCabal $ mkPackageName x)) hackageNames    embed $-    when (not $ null failed) $+    unless (null failed) $       C.warningMessage "Following packages in community are not linked to hackage:"    embed . putStrLn . unlines $ failed@@ -170,11 +185,11 @@       ppRecord b (name, version, url) = (if b then C.formatWith [C.green] else C.formatWith [C.red]) $ "(" <> name <> ", " <> version <> ", " <> url <> ")"    embed . putStrLn $ C.formatWith [C.magenta] "Diff:"-  embed $ case (diffNew <> diffOld) of+  embed $ case diffNew <> diffOld of     [] -> putStrLn "[]"     _ -> do       putStr . unlines $ fmap (ppRecord False) diffOld       putStrLn $ replicate 68 '-'       putStr . unlines $ fmap (ppRecord True) diffNew -  embed . putStrLn $ "Found " <> show (length hackage) <> " packages with submitted distribution information in hackage, and " <> show (length community) <> " haskell packages in community."+  embed . putStrLn $ "Found " <> show (length hackage) <> " packages with submitted distribution information in hackage, and " <> show (length community) <> " haskell packages in [community]."