arch-hs 0.11.0.0 → 0.11.1.0
raw patch · 28 files changed
+402/−403 lines, 28 filesdep ~aesondep ~arch-webdep ~megaparsecPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: aeson, arch-web, megaparsec, servant-client, tar-conduit
API changes (from Hackage documentation)
- Distribution.ArchHs.CommunityDB: defaultCommunityDBPath :: FilePath
- Distribution.ArchHs.CommunityDB: getPkgDesc :: (HasMyName n, Members [CommunityEnv, WithMyErr] r) => n -> Sem r PkgDesc
- Distribution.ArchHs.CommunityDB: isInCommunity :: (HasMyName n, Member CommunityEnv r) => n -> Sem r Bool
- Distribution.ArchHs.CommunityDB: loadCommunityDB :: FilePath -> IO CommunityDB
- Distribution.ArchHs.CommunityDB: versionInCommunity :: (HasMyName n, Members [CommunityEnv, WithMyErr] r) => n -> Sem r ArchLinuxVersion
- Distribution.ArchHs.FilesDB: Community :: DBKind
- Distribution.ArchHs.Options: CommunityDBOptions :: IO CommunityDB -> CommunityDBOptions
- Distribution.ArchHs.Options: [loadCommunityDBFromOptions] :: CommunityDBOptions -> IO CommunityDB
- Distribution.ArchHs.Options: communityDBOptionsParser :: Parser CommunityDBOptions
- Distribution.ArchHs.Options: newtype CommunityDBOptions
- Distribution.ArchHs.PP: ppCommunity :: Doc AnsiStyle
- Distribution.ArchHs.Types: ByCommunity :: DependencyProvider
- Distribution.ArchHs.Types: type CommunityDB = Map ArchLinuxName PkgDesc
- Distribution.ArchHs.Types: type CommunityEnv = Reader CommunityDB
+ Distribution.ArchHs.ExtraDB: defaultExtraDBPath :: FilePath
+ Distribution.ArchHs.ExtraDB: getPkgDesc :: (HasMyName n, Members [ExtraEnv, WithMyErr] r) => n -> Sem r PkgDesc
+ Distribution.ArchHs.ExtraDB: isInExtra :: (HasMyName n, Member ExtraEnv r) => n -> Sem r Bool
+ Distribution.ArchHs.ExtraDB: loadExtraDB :: FilePath -> IO ExtraDB
+ Distribution.ArchHs.ExtraDB: versionInExtra :: (HasMyName n, Members [ExtraEnv, WithMyErr] r) => n -> Sem r ArchLinuxVersion
+ Distribution.ArchHs.Options: ExtraDBOptions :: IO ExtraDB -> ExtraDBOptions
+ Distribution.ArchHs.Options: [loadExtraDBFromOptions] :: ExtraDBOptions -> IO ExtraDB
+ Distribution.ArchHs.Options: extraDBOptionsParser :: Parser ExtraDBOptions
+ Distribution.ArchHs.Options: newtype ExtraDBOptions
+ Distribution.ArchHs.PP: ppExtra :: Doc AnsiStyle
+ Distribution.ArchHs.Types: ByExtra :: DependencyProvider
+ Distribution.ArchHs.Types: type ExtraDB = Map ArchLinuxName PkgDesc
+ Distribution.ArchHs.Types: type ExtraEnv = Reader ExtraDB
- Distribution.ArchHs.Core: subsumeGHCVersion :: Members [CommunityEnv, WithMyErr] r => InterpreterFor KnownGHCVersion r
+ Distribution.ArchHs.Core: subsumeGHCVersion :: Members [ExtraEnv, WithMyErr] r => InterpreterFor KnownGHCVersion r
Files
- CHANGELOG.md +4/−0
- README.md +71/−71
- app/Args.hs +2/−2
- app/Main.hs +22/−26
- arch-hs.cabal +4/−4
- cbits/clib.c +4/−4
- cbits/clib.h +3/−3
- diff/Args.hs +3/−3
- diff/Diff.hs +10/−10
- diff/Main.hs +6/−6
- rdepcheck/Args.hs +3/−3
- rdepcheck/Check.hs +4/−4
- rdepcheck/Main.hs +6/−6
- src/Distribution/ArchHs/CommunityDB.hs +0/−160
- src/Distribution/ArchHs/Core.hs +5/−5
- src/Distribution/ArchHs/ExtraDB.hs +160/−0
- src/Distribution/ArchHs/FilesDB.hs +2/−3
- src/Distribution/ArchHs/Internal/NamePresetLoader.hs +3/−3
- src/Distribution/ArchHs/Local.hs +1/−1
- src/Distribution/ArchHs/Name.hs +16/−16
- src/Distribution/ArchHs/Options.hs +28/−28
- src/Distribution/ArchHs/PP.hs +3/−3
- src/Distribution/ArchHs/Types.hs +8/−8
- sync/Args.hs +6/−6
- sync/Check.hs +2/−2
- sync/Main.hs +13/−13
- sync/Submit.hs +9/−9
- sync/Utils.hs +4/−4
CHANGELOG.md view
@@ -3,6 +3,10 @@ `arch-hs` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.11.1.0++- Adapt to Arch Linux's git migration+ ## 0.11.0.0 - Add `arch-hs-rdepcheck`
README.md view
@@ -17,7 +17,7 @@ ## Introduction Given the name of a package in hackage, `arch-hs` can generate PKGBUILD files, not only for the package-whose name is given, but also for all dependencies missing in [[community]](https://www.archlinux.org/packages/).+whose name is given, but also for all dependencies missing in [[extra]](https://www.archlinux.org/packages/). `arch-hs` has a naive built-in dependency solver, which can fetch those dependencies and find out which are required to be packaged. During the dependency calculation, all version constraints will be discarded due to the arch haskell packaging strategy, thus there is no guarantee of dependencies' version consistency.@@ -26,7 +26,7 @@ `arch-hs` is a PKGBUILD text file generator, which is not integrated with `pacman`(See [Alpm Support](#Alpm-Support)), depending on nothing than: -* Pacman databases (`community.db`, `community.files`, `core.files`, and `extra.files`)+* Pacman databases (`extra.db`, `extra.files`, `core.db`, and `core.files`) * Hackage index tarball (`01-index.tar`, or `00-index.tar` previously) -- usually provided by `cabal-install` @@ -42,7 +42,7 @@ # pacman -S arch-hs ``` -`arch-hs` is available in [[community]](https://www.archlinux.org/packages/community/x86_64/arch-hs/), so you can install it using `pacman`.+`arch-hs` is available in [[extra]](https://www.archlinux.org/packages/extra/x86_64/arch-hs/), so you can install it using `pacman`. ### Install the development version @@ -84,90 +84,90 @@ ``` $ arch-hs -o ~/test --alpm gi-gdk ⓘ Loading hackage from /home/berberman/.cabal/packages/hackage.haskell.org/01-index.tar-ⓘ Loading community.db from libalpm+ⓘ Loading extra.db from libalpm ⓘ Start running... ⓘ Solved: ... gi-gdk ✘- ├─Cabal (Setup) ✔ [community]- ├─bytestring (Lib) ✔ [community]- ├─containers (Lib) ✔ [community]- ├─gi-cairo (Lib, Setup) ✔ [community]+ ├─Cabal (Setup) ✔ [extra]+ ├─bytestring (Lib) ✔ [extra]+ ├─containers (Lib) ✔ [extra]+ ├─gi-cairo (Lib, Setup) ✔ [extra] ├─gi-gdkpixbuf (Lib, Setup) ✘ ├─gi-gio (Lib, Setup) ✘ ├─gi-glib (Lib, Setup) ✘ ├─gi-gobject (Lib, Setup) ✘ ├─gi-pango (Lib, Setup) ✘- ├─haskell-gi (Lib, Setup) ✔ [community]- ├─haskell-gi-base (Lib) ✔ [community]- ├─haskell-gi-overloading (Lib) ✔ [community]- ├─text (Lib) ✔ [community]- └─transformers (Lib) ✔ [community]+ ├─haskell-gi (Lib, Setup) ✔ [extra]+ ├─haskell-gi-base (Lib) ✔ [extra]+ ├─haskell-gi-overloading (Lib) ✔ [extra]+ ├─text (Lib) ✔ [extra]+ └─transformers (Lib) ✔ [extra] gi-gdkpixbuf ✘- ├─Cabal (Setup) ✔ [community]- ├─bytestring (Lib) ✔ [community]- ├─containers (Lib) ✔ [community]+ ├─Cabal (Setup) ✔ [extra]+ ├─bytestring (Lib) ✔ [extra]+ ├─containers (Lib) ✔ [extra] ├─gi-gio (Lib, Setup) ✘ ├─gi-glib (Lib, Setup) ✘ ├─gi-gobject (Lib, Setup) ✘- ├─haskell-gi (Lib, Setup) ✔ [community]- ├─haskell-gi-base (Lib) ✔ [community]- ├─haskell-gi-overloading (Lib) ✔ [community]- ├─text (Lib) ✔ [community]- └─transformers (Lib) ✔ [community]+ ├─haskell-gi (Lib, Setup) ✔ [extra]+ ├─haskell-gi-base (Lib) ✔ [extra]+ ├─haskell-gi-overloading (Lib) ✔ [extra]+ ├─text (Lib) ✔ [extra]+ └─transformers (Lib) ✔ [extra] gi-gio ✘- ├─Cabal (Setup) ✔ [community]- ├─bytestring (Lib) ✔ [community]- ├─containers (Lib) ✔ [community]+ ├─Cabal (Setup) ✔ [extra]+ ├─bytestring (Lib) ✔ [extra]+ ├─containers (Lib) ✔ [extra] ├─gi-glib (Lib, Setup) ✘ ├─gi-gobject (Lib, Setup) ✘- ├─haskell-gi (Lib, Setup) ✔ [community]- ├─haskell-gi-base (Lib) ✔ [community]- ├─haskell-gi-overloading (Lib) ✔ [community]- ├─text (Lib) ✔ [community]- └─transformers (Lib) ✔ [community]+ ├─haskell-gi (Lib, Setup) ✔ [extra]+ ├─haskell-gi-base (Lib) ✔ [extra]+ ├─haskell-gi-overloading (Lib) ✔ [extra]+ ├─text (Lib) ✔ [extra]+ └─transformers (Lib) ✔ [extra] gi-glib ✘- ├─Cabal (Setup) ✔ [community]- ├─bytestring (Lib) ✔ [community]- ├─containers (Lib) ✔ [community]- ├─haskell-gi (Lib, Setup) ✔ [community]- ├─haskell-gi-base (Lib) ✔ [community]- ├─haskell-gi-overloading (Lib) ✔ [community]- ├─text (Lib) ✔ [community]- └─transformers (Lib) ✔ [community]+ ├─Cabal (Setup) ✔ [extra]+ ├─bytestring (Lib) ✔ [extra]+ ├─containers (Lib) ✔ [extra]+ ├─haskell-gi (Lib, Setup) ✔ [extra]+ ├─haskell-gi-base (Lib) ✔ [extra]+ ├─haskell-gi-overloading (Lib) ✔ [extra]+ ├─text (Lib) ✔ [extra]+ └─transformers (Lib) ✔ [extra] gi-gobject ✘- ├─Cabal (Setup) ✔ [community]- ├─bytestring (Lib) ✔ [community]- ├─containers (Lib) ✔ [community]+ ├─Cabal (Setup) ✔ [extra]+ ├─bytestring (Lib) ✔ [extra]+ ├─containers (Lib) ✔ [extra] ├─gi-glib (Lib, Setup) ✘- ├─haskell-gi (Lib, Setup) ✔ [community]- ├─haskell-gi-base (Lib) ✔ [community]- ├─haskell-gi-overloading (Lib) ✔ [community]- ├─text (Lib) ✔ [community]- └─transformers (Lib) ✔ [community]+ ├─haskell-gi (Lib, Setup) ✔ [extra]+ ├─haskell-gi-base (Lib) ✔ [extra]+ ├─haskell-gi-overloading (Lib) ✔ [extra]+ ├─text (Lib) ✔ [extra]+ └─transformers (Lib) ✔ [extra] gi-harfbuzz ✘- ├─Cabal (Setup) ✔ [community]- ├─bytestring (Lib) ✔ [community]- ├─containers (Lib) ✔ [community]+ ├─Cabal (Setup) ✔ [extra]+ ├─bytestring (Lib) ✔ [extra]+ ├─containers (Lib) ✔ [extra] ├─gi-glib (Lib, Setup) ✘ ├─gi-gobject (Lib, Setup) ✘- ├─haskell-gi (Lib, Setup) ✔ [community]- ├─haskell-gi-base (Lib) ✔ [community]- ├─haskell-gi-overloading (Lib) ✔ [community]- ├─text (Lib) ✔ [community]- └─transformers (Lib) ✔ [community]+ ├─haskell-gi (Lib, Setup) ✔ [extra]+ ├─haskell-gi-base (Lib) ✔ [extra]+ ├─haskell-gi-overloading (Lib) ✔ [extra]+ ├─text (Lib) ✔ [extra]+ └─transformers (Lib) ✔ [extra] gi-pango ✘- ├─Cabal (Setup) ✔ [community]- ├─bytestring (Lib) ✔ [community]- ├─containers (Lib) ✔ [community]+ ├─Cabal (Setup) ✔ [extra]+ ├─bytestring (Lib) ✔ [extra]+ ├─containers (Lib) ✔ [extra] ├─gi-glib (Lib, Setup) ✘ ├─gi-gobject (Lib, Setup) ✘ ├─gi-harfbuzz (Lib, Setup) ✘- ├─haskell-gi (Lib, Setup) ✔ [community]- ├─haskell-gi-base (Lib) ✔ [community]- ├─haskell-gi-overloading (Lib) ✔ [community]- ├─text (Lib) ✔ [community]- └─transformers (Lib) ✔ [community]+ ├─haskell-gi (Lib, Setup) ✔ [extra]+ ├─haskell-gi-base (Lib) ✔ [extra]+ ├─haskell-gi-overloading (Lib) ✔ [extra]+ ├─text (Lib) ✔ [extra]+ └─transformers (Lib) ✔ [extra] ... ⓘ Recommended package order:@@ -213,7 +213,7 @@ </details> This output tells us that in order to package `gi-gdk`, we must package its dependencies-listed in package order, which are not present in [community] repo. Particularly, `gi-gdk`+listed in package order, which are not present in [extra] repo. Particularly, `gi-gdk` requires external system dependencies, so `arch-hs` can map them to system packages using files db. ```@@ -414,12 +414,12 @@ ## Diff `arch-hs` also provides a component called `arch-hs-diff`. `arch-hs-diff` can show the differences of package description between two versions of a package,-and remind us if some required packages in community repo can't satisfy the version constraints, or they are non-existent.+and remind us if some required packages in extra repo can't satisfy the version constraints, or they are non-existent. This is useful in the subsequent maintenance of a package. For example: ``` $ arch-hs-diff --alpm comonad 5.0.6 5.0.7-ⓘ Loading community.db from libalpm+ⓘ Loading extra.db from libalpm ⓘ Start running... ⓘ Downloading cabal file from https://hackage.haskell.org/package/comonad-5.0.6/revision/0.cabal... ⓘ Downloading cabal file from https://hackage.haskell.org/package/comonad-5.0.7/revision/0.cabal...@@ -449,7 +449,7 @@ -------------------------------------- base -any doctest >=0.11.1 && <0.18-"doctest" is required to be in range (>=0.11.1 && <0.17), but [community] provides (0.17). +"doctest" is required to be in range (>=0.11.1 && <0.17), but [extra] provides (0.17). Flags: comonad ⚐ test-doctests:@@ -461,7 +461,7 @@ description: You can disable the use of the `containers` package using `-f-containers`. - Disabing this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users.+ Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. default: True isManual: True ⚐ distributive:@@ -485,7 +485,7 @@ description: You can disable the use of the `containers` package using `-f-containers`. - Disabing this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users.+ Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. default: True isManual: True ⚐ distributive:@@ -520,7 +520,7 @@ ## Limitations * `arch-hs` will run into error, if solved targets contain cycle. Indeed, circular dependency lies ubiquitously in hackage because of tests,-but basic cycles are resolved manually in [community] by maintainers. So after the provider simplification, `arch-hs` can eliminate these cycles.+but basic cycles are resolved manually in [extra] by maintainers. So after the provider simplification, `arch-hs` can eliminate these cycles. Nevertheless, if the target introduces new cycle or it dependens on a package in an unknown cycle, `arch-hs` will throw `CyclicExist` exception. * `arch-hs` is not able to handle with complicated situations: the libraries of a package partially exist in hackage, some libraries include external sources, etc. @@ -531,7 +531,7 @@ ## 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` and files dbs through this library is slightly faster than using the internal parser of `arch-hs`.+When running on Arch Linux, loading `extra.db` and files dbs 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: ```@@ -540,8 +540,8 @@ This flag is enabled by default in `arch-hs` Arch Linux package. Compiled with `alpm`, `arch-hs` uses alpm to load pacman databases by default.-In this case, the CLI flag `--no-alpm-community` and `--no-alpm-files` can be used to disable this feature.-> When `alpm` is enabled, `arch-hs` will lose the capability of specifying the path of `community.db` and directory of files db.+In this case, the CLI flag `--no-alpm-extra` and `--no-alpm-files` can be used to disable this feature.+> When `alpm` is enabled, `arch-hs` will lose the capability of specifying the path of `extra.db` and directory of files db. ## Contributing
app/Args.hs view
@@ -14,7 +14,7 @@ data Options = Options { optHackage :: HackageDBOptions,- optCommunityDB :: CommunityDBOptions,+ optExtraDB :: ExtraDBOptions, optFilesDB :: FilesDBOptions, optOutputDir :: FilePath, optFlags :: FlagAssignments,@@ -35,7 +35,7 @@ cmdOptions = Options <$> hackageDBOptionsParser- <*> communityDBOptionsParser+ <*> extraDBOptionsParser <*> filesDBOptionsParser <*> strOption ( long "output"
app/Main.hs view
@@ -22,7 +22,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import Distribution.ArchHs.Aur (Aur, aurToIO, isInAur)-import Distribution.ArchHs.CommunityDB+import Distribution.ArchHs.ExtraDB import Distribution.ArchHs.Core import Distribution.ArchHs.Exception import Distribution.ArchHs.FilesDB@@ -44,7 +44,7 @@ import System.FilePath (takeFileName) app ::- Members '[Embed IO, State (Set.Set PackageName), KnownGHCVersion, CommunityEnv, HackageEnv, FlagAssignmentsEnv, DependencyRecord, Trace, Aur, WithMyErr] r =>+ Members '[Embed IO, State (Set.Set PackageName), KnownGHCVersion, ExtraEnv, HackageEnv, FlagAssignmentsEnv, DependencyRecord, Trace, Aur, WithMyErr] r => PackageName -> FilePath -> Bool ->@@ -59,12 +59,12 @@ app target path aurSupport skip uusi force installDeps jsonPath noSkipMissing loadFilesDB' = do (deps, sublibs, sysDeps) <- getDependencies (fmap mkUnqualComponentName skip) Nothing target - inCommunity <- isInCommunity target+ inExtra <- isInExtra target - when inCommunity $+ when inExtra $ if force- then printWarn $ "Target has been provided by" <+> ppCommunity <> comma <+> "but you specified --force"- else throw $ TargetExist target ByCommunity+ then printWarn $ "Target has been provided by" <+> ppExtra <> comma <+> "but you specified --force"+ else throw $ TargetExist target ByExtra when aurSupport $ do inAur <- isInAur target@@ -78,12 +78,12 @@ grouped = removeSublibs $ groupDeps deps namesFromSolved x = x ^.. each . pkgName <> x ^.. each . pkgDeps . each . depName allNames = nubOrd $ namesFromSolved grouped- communityProvideList <- (<> ghcLibList) <$> filterM (\x -> if x == target && force then return False else isInCommunity x) allNames+ extraProvideList <- (<> ghcLibList) <$> filterM (\x -> if x == target && force then return False else isInExtra x) allNames - let providedPackages = filter (\x -> x ^. pkgName `elem` communityProvideList) grouped+ let providedPackages = filter (\x -> x ^. pkgName `elem` extraProvideList) grouped abnormalDependencies = mapMaybe- ( \x -> case filter (`notElem` communityProvideList) (x ^. pkgDeps ^.. each . depName) of+ ( \x -> case filter (`notElem` extraProvideList) (x ^. pkgDeps ^.. each . depName) of [] -> Nothing pkgs -> Just (x ^. pkgName, pkgs) )@@ -101,9 +101,9 @@ let fillProvidedPkgs provideList provider = map (\x -> if (x ^. pkgName) `elem` provideList then ProvidedPackage (x ^. pkgName) provider else x) fillProvidedDeps provideList provider = map (pkgDeps %~ each %~ (\y -> if y ^. depName `elem` provideList then y & depProvider ?~ provider else y))- filledByCommunity = fillProvidedPkgs communityProvideList ByCommunity . fillProvidedDeps communityProvideList ByCommunity $ grouped- -- after filling community- toBePacked1 = filledByCommunity ^.. each . filtered (not . isProvided)+ filledByExtra = fillProvidedPkgs extraProvideList ByExtra . fillProvidedDeps extraProvideList ByExtra $ grouped+ -- after filling extra+ toBePacked1 = filledByExtra ^.. each . filtered (not . isProvided) (filledByBoth, toBePacked2) <- do when aurSupport $ printInfo "Start searching AUR..."@@ -112,7 +112,7 @@ then -- after filling aur. toBePacked1 should not appear after the next line filterM (\n -> do printInfo ("Searching" <+> viaPretty n); isInAur n) $ filter (\x -> not $ x == target && force) $ toBePacked1 ^.. each . pkgName else return []- let a = fillProvidedPkgs aurProvideList ByAur . fillProvidedDeps aurProvideList ByAur $ filledByCommunity+ let a = fillProvidedPkgs aurProvideList ByAur . fillProvidedDeps aurProvideList ByAur $ filledByExtra b = a ^.. each . filtered (not . isProvided) return (a, b) @@ -158,10 +158,6 @@ unless b' $ do extraFiles <- loadFilesDB' Extra modifyIORef' sysDepsRef $ fmap (trySolve extraFiles)- b'' <- isAllSolvedM sysDepsRef- unless b'' $ do- communityFiles <- loadFilesDB' Community- modifyIORef' sysDepsRef $ fmap (trySolve communityFiles) sysDepsResult <- embed $ readIORef sysDepsRef @@ -212,14 +208,14 @@ let providedDepends pkg = pkg ^. pkgDeps ^.. each- . filtered (\x -> depNotMyself (pkg ^. pkgName) x && depNotInGHCLib x && x ^. depProvider == Just ByCommunity)+ . filtered (\x -> depNotMyself (pkg ^. pkgName) x && depNotInGHCLib x && x ^. depProvider == Just ByExtra) toStr = unArchLinuxName . toArchLinuxName . _depName depends = unwords . nubOrd . fmap toStr . mconcat $ providedDepends <$> toBePacked3 flattened' = filter (/= target) flattened case flattened' of [] -> pure ()- [x] -> printWarn $ "The following dependency is missing in" <+> ppCommunity <> colon <+> pretty (unPackageName x)- xs -> printWarn $ "Following dependencies are missing in" <+> ppCommunity <> colon <+> hsep (punctuate comma (pretty . unPackageName <$> xs))+ [x] -> printWarn $ "The following dependency is missing in" <+> ppExtra <> colon <+> pretty (unPackageName x)+ xs -> printWarn $ "Following dependencies are missing in" <+> ppExtra <> colon <+> hsep (punctuate comma (pretty . unPackageName <$> xs)) embed $ putDoc line case depends of [] -> printInfo "No extra dependency to install"@@ -263,15 +259,15 @@ runApp :: HackageDB ->- CommunityDB ->+ ExtraDB -> Map.Map PackageName FlagAssignment -> Bool -> FilePath -> IORef (Set.Set PackageName) -> Manager ->- Sem '[CommunityEnv, HackageEnv, FlagAssignmentsEnv, DependencyRecord, Trace, State (Set.Set PackageName), Aur, WithMyErr, Embed IO, Final IO] a ->+ Sem '[ExtraEnv, HackageEnv, FlagAssignmentsEnv, DependencyRecord, Trace, State (Set.Set PackageName), Aur, WithMyErr, Embed IO, Final IO] a -> IO (Either MyException a)-runApp hackage community flags traceStdout tracePath ref manager =+runApp hackage extra flags traceStdout tracePath ref manager = runFinal . embedToFinal . errorToIOFinal@@ -281,7 +277,7 @@ . evalState Map.empty . runReader flags . runReader hackage- . runReader community+ . runReader extra runTrace :: Member (Embed IO) r => Bool -> FilePath -> Sem (Trace ': r) a -> Sem r a runTrace stdout path = interpret $ \case@@ -332,7 +328,7 @@ let newHackage = foldr insertDB hackage parsedExtra - community <- loadCommunityDBFromOptions optCommunityDB+ extra <- loadExtraDBFromOptions optExtraDB printInfo "Start running..." @@ -342,7 +338,7 @@ runApp newHackage- community+ extra optFlags optStdoutTrace optFileTrace
arch-hs.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: arch-hs-version: 0.11.0.0+version: 0.11.1.0 synopsis: Distribute hackage packages to archlinux description: @arch-hs@ is a command-line program, which simplifies the process of producing@@ -38,7 +38,7 @@ build-depends: , aeson >=1.5.4 && <2.2 , algebraic-graphs >=0.5 && <0.8- , arch-web ^>=0.1.1+ , arch-web ^>=0.2 , base >=4.12 && <5 , bytestring , Cabal >=3.2 && <3.7@@ -57,7 +57,7 @@ , microlens-th ^>=0.4.3 , neat-interpolation ^>=0.5.1 , optparse-simple ^>=0.1.1.3- , polysemy >=1.5.0 && <1.9.1+ , polysemy >=1.5.0 && <1.10 , prettyprinter ^>=1.7.0 , prettyprinter-ansi-terminal ^>=1.1.2 , servant-client >=0.18.2 && <0.20@@ -98,7 +98,7 @@ autogen-modules: Paths_arch_hs exposed-modules: Distribution.ArchHs.Aur- Distribution.ArchHs.CommunityDB+ Distribution.ArchHs.ExtraDB Distribution.ArchHs.Compat Distribution.ArchHs.Core Distribution.ArchHs.Exception
cbits/clib.c view
@@ -4,7 +4,7 @@ #include <libgen.h> #include <string.h> -void dispatch_list(community_list_callback_t callback, const char *name,+void dispatch_list(extra_list_callback_t callback, const char *name, const char *key, alpm_list_t *src) { if (src == NULL) return;@@ -16,13 +16,13 @@ } } -void query_community(community_pkg_callback_t pkg_callback,- community_list_callback_t list_callback) {+void query_extra(extra_pkg_callback_t pkg_callback,+ extra_list_callback_t list_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_register_syncdb(handle, "extra", ALPM_SIG_USE_DEFAULT); alpm_list_t *i, *pkgs = NULL; pkgs = alpm_db_get_pkgcache(db);
cbits/clib.h view
@@ -2,13 +2,13 @@ #define CLIB_H 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,+typedef void extra_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,+typedef void extra_list_callback_t(const char *pkg_name, const char *key, const char *dependent_pkg_name, const char *dependent_pkg_version); -void query_community(community_pkg_callback_t pkg_callback, community_list_callback_t list_callback);+void query_extra(extra_pkg_callback_t pkg_callback, extra_list_callback_t list_callback); void query_files(const char *dbname, file_callback_t callback);
diff/Args.hs view
@@ -12,7 +12,7 @@ data Options = Options { optFlags :: FlagAssignments,- optCommunityDB :: CommunityDBOptions,+ optExtraDB :: ExtraDBOptions, optPackageName :: PackageName, optVersionA :: Version, optVersionB :: Version@@ -22,7 +22,7 @@ cmdOptions = Options <$> optFlagAssignmentParser- <*> communityDBOptionsParser+ <*> extraDBOptionsParser <*> argument optPackageNameReader (metavar "TARGET") <*> argument optVersionReader (metavar "VERSION_A") <*> argument optVersionReader (metavar "VERSION_B")@@ -33,7 +33,7 @@ simpleOptions archHsVersion "arch-hs-diff - create diff between different versions of package description"- "arch-hs-diff is a CLI tool that shows the differences of package description between two versions of a package, and remind us if some required packages in community repo can't satisfy the version constraints, or they are non-existent"+ "arch-hs-diff is a CLI tool that shows the differences of package description between two versions of a package, and remind us if some required packages in extra repo can't satisfy the version constraints, or they are non-existent" cmdOptions empty pure x
diff/Diff.hs view
@@ -9,7 +9,7 @@ import Data.Algorithm.Diff import qualified Data.ByteString.Lazy as LBS import Data.Maybe (catMaybes, fromJust)-import Distribution.ArchHs.CommunityDB (versionInCommunity)+import Distribution.ArchHs.ExtraDB (versionInExtra) import Distribution.ArchHs.Core import Distribution.ArchHs.Exception import Distribution.ArchHs.Internal.Prelude@@ -65,7 +65,7 @@ ----------------------------------------------------------------------------- -diffCabal :: Members [KnownGHCVersion, CommunityEnv, FlagAssignmentsEnv, WithMyErr, Trace, DependencyRecord, Reader Manager, Embed IO] r => PackageName -> Version -> Version -> Sem r ()+diffCabal :: Members [KnownGHCVersion, ExtraEnv, FlagAssignmentsEnv, WithMyErr, Trace, DependencyRecord, Reader Manager, Embed IO] r => PackageName -> Version -> Version -> Sem r () diffCabal name a b = do ga <- getCabalFromHackage name a gb <- getCabalFromHackage name b@@ -75,8 +75,8 @@ fb = genPackageFlags gb (ba, ma) <- directDependencies ga (bb, mb) <- directDependencies gb- queryb <- lookupDiffCommunity ba bb- querym <- lookupDiffCommunity ma mb+ queryb <- lookupDiffExtra ba bb+ querym <- lookupDiffExtra ma mb embed . putDoc $ vsep [ annMagneta "Package" <> colon <+> viaPretty name,@@ -109,15 +109,15 @@ url :: PackageDescription -> PackageDescription -> Doc AnsiStyle url = diffTerm "URL" getUrl -inRange :: Members [CommunityEnv, WithMyErr] r => (PackageName, VersionRange) -> Sem r (Either (PackageName, VersionRange) (PackageName, VersionRange, Version, Bool))+inRange :: Members [ExtraEnv, WithMyErr] r => (PackageName, VersionRange) -> Sem r (Either (PackageName, VersionRange) (PackageName, VersionRange, Version, Bool)) inRange (name, hRange) =- try @MyException (versionInCommunity name)+ try @MyException (versionInExtra name) >>= \case Right y -> let version = fromJust . simpleParsec $ y in return . Right $ (name, hRange, version, withinRange version hRange) Left _ -> return . Left $ (name, hRange) -lookupDiffCommunity :: Members [CommunityEnv, WithMyErr] r => VersionedList -> VersionedList -> Sem r (Doc AnsiStyle)-lookupDiffCommunity va vb = do+lookupDiffExtra :: Members [ExtraEnv, WithMyErr] r => VersionedList -> VersionedList -> Sem r (Doc AnsiStyle)+lookupDiffExtra va vb = do let diff = getGroupedDiff va vb diffOld = mconcat $ unDiff <$> filterFirstDiff diff diffNew = mconcat $ unDiff <$> filterSecondDiff diff@@ -129,7 +129,7 @@ <+> parens (annF b $ viaPretty range) <> comma <+> "but"- <+> ppCommunity+ <+> ppExtra <+> "provides" <+> parens (annF b $ viaPretty v) <> dot@@ -141,7 +141,7 @@ <+> parens (annF b $ viaPretty range) <> comma <+> "but"- <+> ppCommunity+ <+> ppExtra <+> "does not provide this package" <> dot
diff/Main.hs view
@@ -29,20 +29,20 @@ printInfo "You assigned flags:" putDoc $ prettyFlagAssignments optFlags <> line - community <- loadCommunityDBFromOptions optCommunityDB+ extra <- loadExtraDBFromOptions optExtraDB manager <- newTlsManager printInfo "Start running..."- runDiff community optFlags manager (subsumeGHCVersion $ diffCabal optPackageName optVersionA optVersionB) & printAppResult+ runDiff extra optFlags manager (subsumeGHCVersion $ diffCabal optPackageName optVersionA optVersionB) & printAppResult runDiff ::- CommunityDB ->+ ExtraDB -> FlagAssignments -> Manager ->- Sem '[CommunityEnv, FlagAssignmentsEnv, Reader Manager, Trace, DependencyRecord, WithMyErr, Embed IO, Final IO] a ->+ Sem '[ExtraEnv, FlagAssignmentsEnv, Reader Manager, Trace, DependencyRecord, WithMyErr, Embed IO, Final IO] a -> IO (Either MyException a)-runDiff community flags manager =+runDiff extra flags manager = runFinal . embedToFinal . errorToIOFinal@@ -50,4 +50,4 @@ . ignoreTrace . runReader manager . runReader flags- . runReader community+ . runReader extra
rdepcheck/Args.hs view
@@ -12,7 +12,7 @@ data Options = Options { optFlags :: FlagAssignments,- optCommunityDB :: CommunityDBOptions,+ optExtraDB :: ExtraDBOptions, optHackage :: HackageDBOptions, optPackageName :: PackageName }@@ -21,7 +21,7 @@ cmdOptions = Options <$> optFlagAssignmentParser- <*> communityDBOptionsParser+ <*> extraDBOptionsParser <*> hackageDBOptionsParser <*> argument optPackageNameReader (metavar "TARGET") @@ -31,7 +31,7 @@ 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"+ "arch-hs-rdepcheck is a CLI tool that shows all reverse dependencies of a Haskell package in [extra], giving the version range how it is depended on" cmdOptions empty pure x
rdepcheck/Check.hs view
@@ -10,7 +10,7 @@ import Data.List (find) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes)-import Distribution.ArchHs.CommunityDB+import Distribution.ArchHs.ExtraDB import Distribution.ArchHs.Core import Distribution.ArchHs.Exception import Distribution.ArchHs.Hackage@@ -31,7 +31,7 @@ check :: Members- [ CommunityEnv,+ [ ExtraEnv, HackageEnv, KnownGHCVersion, FlagAssignmentsEnv,@@ -45,7 +45,7 @@ Sem r () check target = do let aTarget = toArchLinuxName target- exists <- isInCommunity aTarget+ exists <- isInExtra aTarget unless exists $ throw $ PkgNotFound target reverseDeps <- ( \xs ->@@ -64,7 +64,7 @@ ] ) . Map.toList- <$> ask @CommunityDB+ <$> ask @ExtraDB forM_ reverseDeps $ \(PkgDesc {..}, src) -> do eCabal <- try @MyException $
rdepcheck/Main.hs view
@@ -29,18 +29,18 @@ putDoc $ prettyFlagAssignments optFlags <> line hackage <- loadHackageDBFromOptions optHackage- community <- loadCommunityDBFromOptions optCommunityDB+ extra <- loadExtraDBFromOptions optExtraDB printInfo "Start running..."- runCheck hackage community optFlags (subsumeGHCVersion $ check optPackageName) & printAppResult+ runCheck hackage extra optFlags (subsumeGHCVersion $ check optPackageName) & printAppResult runCheck :: HackageDB ->- CommunityDB ->+ ExtraDB -> FlagAssignments ->- Sem '[HackageEnv, CommunityEnv, FlagAssignmentsEnv, Trace, DependencyRecord, WithMyErr, Embed IO, Final IO] a ->+ Sem '[HackageEnv, ExtraEnv, FlagAssignmentsEnv, Trace, DependencyRecord, WithMyErr, Embed IO, Final IO] a -> IO (Either MyException a)-runCheck community flags manager =+runCheck extra flags manager = runFinal . embedToFinal . errorToIOFinal@@ -48,4 +48,4 @@ . ignoreTrace . runReader manager . runReader flags- . runReader community+ . runReader extra
− src/Distribution/ArchHs/CommunityDB.hs
@@ -1,160 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}---- | Copyright: (c) 2020-2021 berberman--- SPDX-License-Identifier: MIT--- Maintainer: berberman <berberman@yandex.com>--- Stability: experimental--- Portability: portable--- This module provides functions operating with @community.db@ of pacman.-module Distribution.ArchHs.CommunityDB- ( defaultCommunityDBPath,- loadCommunityDB,- isInCommunity,- versionInCommunity,- getPkgDesc,-#ifdef ALPM- loadCommunityDBFFI,-#endif- )-where--import Conduit-import qualified Data.Conduit.Tar as Tar-import qualified Data.Conduit.Zlib as Zlib-import qualified Data.Map.Strict as Map-import qualified Data.Text as T-import Distribution.ArchHs.Exception-import Distribution.ArchHs.Internal.Prelude-import Distribution.ArchHs.Name-import Distribution.ArchHs.PkgDesc-import Distribution.ArchHs.Types-import Data.Maybe (mapMaybe)---------------------------------------------------------------------------------#ifdef ALPM-{-# LANGUAGE ForeignFunctionInterface #-}--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 -> CString -> CString -> IO ()) -> IO (FunPtr (CString -> CString -> CString -> CString -> IO ()))--foreign import ccall "clib.h query_community"- query_community :: FunPtr (CString -> CString -> CString -> CString -> IO ()) -> FunPtr (CString -> CString -> CString -> CString -> IO ()) -> IO ()--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 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@.-defaultCommunityDBPath :: FilePath-defaultCommunityDBPath = "/" </> "var" </> "lib" </> "pacman" </> "sync" </> "community.db"--loadCommunityDBC ::- (MonadResource m, PrimMonad m, MonadThrow m) =>- FilePath ->- ConduitT i (ArchLinuxName, PkgDesc) m ()-loadCommunityDBC path = do- sourceFileBS path .| Zlib.ungzip .| Tar.untarChunks .| Tar.withEntries action- where- action header =- when (Tar.headerFileType header == Tar.FTNormal) $ do- x <- mconcat <$> sinkList- let txt = T.unpack . decodeUtf8 $ x- 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@.-loadCommunityDB :: FilePath -> IO CommunityDB-loadCommunityDB path = Map.fromList <$> runConduitRes (loadCommunityDBC 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 $ toArchLinuxName 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 ArchLinuxVersion-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 -> pure x- _ -> throw $ PkgNotFound name
src/Distribution/ArchHs/Core.hs view
@@ -30,7 +30,7 @@ import Data.Maybe (fromMaybe) import Data.Set (Set) import qualified Data.Set as Set-import Distribution.ArchHs.CommunityDB (versionInCommunity)+import Distribution.ArchHs.ExtraDB (versionInExtra) import Distribution.ArchHs.Exception import Distribution.ArchHs.Hackage ( getLatestCabal,@@ -348,9 +348,9 @@ ----------------------------------------------------------------------------- --- | Get the ghc version in 'CommunityDB'-subsumeGHCVersion :: Members [CommunityEnv, WithMyErr] r => InterpreterFor KnownGHCVersion r+-- | Get the ghc version in 'ExtraDB'+subsumeGHCVersion :: Members [ExtraEnv, WithMyErr] r => InterpreterFor KnownGHCVersion r subsumeGHCVersion m = do- rawVersion <- versionInCommunity $ ArchLinuxName "haskell-ghc"- let ghcVersion = fromMaybe (error $ "Impossible: unable to parse ghc version from [community]: " <> rawVersion) $ simpleParsec rawVersion+ rawVersion <- versionInExtra $ ArchLinuxName "haskell-ghc"+ let ghcVersion = fromMaybe (error $ "Impossible: unable to parse ghc version from [extra]: " <> rawVersion) $ simpleParsec rawVersion runReader ghcVersion m
+ src/Distribution/ArchHs/ExtraDB.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++-- | Copyright: (c) 2020-2021 berberman+-- SPDX-License-Identifier: MIT+-- Maintainer: berberman <berberman@yandex.com>+-- Stability: experimental+-- Portability: portable+-- This module provides functions operating with @extra.db@ of pacman.+module Distribution.ArchHs.ExtraDB+ ( defaultExtraDBPath,+ loadExtraDB,+ isInExtra,+ versionInExtra,+ getPkgDesc,+#ifdef ALPM+ loadExtraDBFFI,+#endif+ )+where++import Conduit+import qualified Data.Conduit.Tar as Tar+import qualified Data.Conduit.Zlib as Zlib+import qualified Data.Map.Strict as Map+import qualified Data.Text as T+import Distribution.ArchHs.Exception+import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Name+import Distribution.ArchHs.PkgDesc+import Distribution.ArchHs.Types+import Data.Maybe (mapMaybe)++-----------------------------------------------------------------------------++#ifdef ALPM+{-# LANGUAGE ForeignFunctionInterface #-}++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 -> CString -> CString -> IO ()) -> IO (FunPtr (CString -> CString -> CString -> CString -> IO ()))++foreign import ccall "clib.h query_extra"+ query_extra :: FunPtr (CString -> CString -> CString -> CString -> IO ()) -> FunPtr (CString -> CString -> CString -> CString -> IO ()) -> IO ()++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 'loadExtra' but use alpm to query extra db instead.+loadExtraDBFFI :: IO ExtraDB+loadExtraDBFFI = do+ ref <- newIORef Map.empty+ pkgCallbackW <- wrap $ pkgCallback ref+ listCallbackW <- wrap $ listCallback ref+ query_extra 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 @extra.db@.+defaultExtraDBPath :: FilePath+defaultExtraDBPath = "/" </> "var" </> "lib" </> "pacman" </> "sync" </> "extra.db"++loadExtraDBC ::+ (MonadResource m, PrimMonad m, MonadThrow m) =>+ FilePath ->+ ConduitT i (ArchLinuxName, PkgDesc) m ()+loadExtraDBC path = do+ sourceFileBS path .| Zlib.ungzip .| Tar.untarChunks .| Tar.withEntries action+ where+ action header =+ when (Tar.headerFileType header == Tar.FTNormal) $ do+ x <- mconcat <$> sinkList+ let txt = T.unpack . decodeUtf8 $ x+ 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 @extra.db@ from @path@.+-- @desc@ files in the db will be parsed by @descParser@.+loadExtraDB :: FilePath -> IO ExtraDB+loadExtraDB path = Map.fromList <$> runConduitRes (loadExtraDBC path .| sinkList)++-----------------------------------------------------------------------------++-- | Check if a package exists in archlinux extra repo.+-- See 'HasMyName'.+isInExtra :: (HasMyName n, Member ExtraEnv r) => n -> Sem r Bool+isInExtra name = ask @ExtraDB >>= \db -> return $ toArchLinuxName name `Map.member` db++-- | Get the version of a package in archlinux extra repo.+-- If the package does not exist, 'PkgNotFound' will be thrown.+versionInExtra :: (HasMyName n, Members [ExtraEnv, WithMyErr] r) => n -> Sem r ArchLinuxVersion+versionInExtra name = _version <$> getPkgDesc name++-- | Get the pkgdesc a package in archlinux extra repo.+-- If the package does not exist, 'PkgNotFound' will be thrown.+getPkgDesc :: (HasMyName n, Members [ExtraEnv, WithMyErr] r) => n -> Sem r PkgDesc+getPkgDesc name =+ ask @ExtraDB >>= \db -> case db Map.!? toArchLinuxName name of+ Just x -> pure x+ _ -> throw $ PkgNotFound name
src/Distribution/ArchHs/FilesDB.hs view
@@ -119,12 +119,11 @@ data Result = Files FilePath [File] | Desc FilePath ArchLinuxName deriving stock (Show) --- | Three files repos: @core@, @community@, and @extra@-data DBKind = Core | Community | Extra+-- | Two files repos: @core@ and @extra@+data DBKind = Core | Extra instance Show DBKind where show Core = "core"- show Community = "community" show Extra = "extra" -- | A file's name
src/Distribution/ArchHs/Internal/NamePresetLoader.hs view
@@ -18,9 +18,9 @@ let preset = case decodeStrict @(Map String String) txt of Just x -> x _ -> error "Failed to parse json"- a <- genFunc "communityToHackageP" preset- b <- genFunc "hackageToCommunityP" $ fromList . fmap swap . toList $ preset- d <- genArray "communityListP" $ keys preset+ a <- genFunc "extraToHackageP" preset+ b <- genFunc "hackageToExtraP" $ fromList . fmap swap . toList $ preset+ d <- genArray "extraListP" $ keys preset return [a, b, d] genFunc :: String -> Map String String -> DecQ
src/Distribution/ArchHs/Local.hs view
@@ -37,7 +37,7 @@ "unzip" ] --- | Packages already provided by <https://www.archlinux.org/packages/community/x86_64/ghc-libs/ ghc-libs>.+-- | Packages already provided by <https://www.archlinux.org/packages/extra/x86_64/ghc-libs/ ghc-libs>. ghcLibList :: PkgList ghcLibList = mkPackageName
src/Distribution/ArchHs/Name.hs view
@@ -12,7 +12,7 @@ -- Stability: experimental -- Portability: portable ----- Naming conversion between haskell package in hackage and archlinux community repo.+-- Naming conversion between haskell package in hackage and archlinux extra repo. -- -- To distribute a haskell package to archlinux, the name of package should be changed according to the naming convention: --@@ -28,12 +28,12 @@ -- -- @NAME_PRESET.json@ will be loaded during the compilation, generating haskell code to be called in runtime. ----- Converting a archlinux community name to hackage name following these steps:+-- Converting a archlinux extra name to hackage name following these steps: -- -- (1) Find if the name preset contains this rule -- (2) If it contains, then use it; or remove the @haskell-@ prefix ----- Converting a hackage name to archlinux community name following these steps:+-- Converting a hackage name to archlinux extra name following these steps: -- -- (1) Find if the name preset contains this rule -- (2) If it contains, then use it; or add the @haskell-@ prefix@@ -59,35 +59,35 @@ -- | The representation of a package name. data NameRep- = -- | archlinx community style+ = -- | archlinx extra style ArchLinuxRep | -- | hackage style HackageRep $(loadNamePreset) --- | Convert a name from community representation to hackage representation, according to the name preset.+-- | Convert a name from extra representation to hackage representation, according to the name preset. -- If the preset doesn't contain this mapping rule, the function will return 'Nothing'. -- This function is generated from @NAME_PRESET.json@-communityToHackageP :: MyName 'ArchLinuxRep -> Maybe (MyName 'HackageRep)+extraToHackageP :: MyName 'ArchLinuxRep -> Maybe (MyName 'HackageRep) --- | Convert a name from hackage representation to archlinux community representation, according to the name preset.+-- | Convert a name from hackage representation to archlinux extra representation, according to the name preset. -- If the preset doesn't contain this mapping rule, the function will return 'Nothing'. -- -- This function is generated from @NAME_PRESET.json@-hackageToCommunityP :: MyName 'HackageRep -> Maybe (MyName 'ArchLinuxRep)+hackageToExtraP :: MyName 'HackageRep -> Maybe (MyName 'ArchLinuxRep) --- | Community haskell packages of in the name preset.+-- | Extra haskell packages of in the name preset. -- -- This function is generated from @NAME_PRESET.json@-communityListP :: [MyName 'ArchLinuxRep]+extraListP :: [MyName 'ArchLinuxRep] -- | A general package name representation. -- It has a phantom @a@, which indexes this name. -- Normally, the index should be the data kinds of 'NameRep'. -- -- In Cabal API, packages' names are represented by the type 'PackageName';--- in arch-hs, names parsed from @community.db@ are represented by the type 'ArchLinuxName'.+-- in arch-hs, names parsed from @extra.db@ are represented by the type 'ArchLinuxName'. -- It would be tedious to use two converting functions everywhere, so here comes a intermediate data type -- to unify them, with type level constraints as bonus. newtype MyName a = MyName@@ -106,7 +106,7 @@ -- | To 'MyName' in hackage style. toHackageRep :: a -> MyName 'HackageRep - -- | To 'MyName' in community style.+ -- | To 'MyName' in extra style. toArchLinuxRep :: a -> MyName 'ArchLinuxRep instance HasMyName (MyName 'ArchLinuxRep) where@@ -121,7 +121,7 @@ toHackageRep = MyName . unPackageName toArchLinuxRep = go . unPackageName where- go s = case hackageToCommunityP (MyName s) of+ go s = case hackageToExtraP (MyName s) of Just x -> x _ -> MyName . fmap toLower $@@ -133,7 +133,7 @@ instance HasMyName ArchLinuxName where toHackageRep = go . unArchLinuxName where- go s = case communityToHackageP (MyName s) of+ go s = case extraToHackageP (MyName s) of Just x -> x _ -> MyName $ drop 8 s toArchLinuxRep = MyName . unArchLinuxName@@ -154,12 +154,12 @@ toHackageName :: HasMyName n => n -> PackageName toHackageName = mToHackageName . toHackageRep --- | Check if a package in archlinux community repo is haskell package.+-- | Check if a package in archlinux extra repo is haskell package. -- -- i.e. it is in @preset@ or has @haskell-@ prefix. -- Attention: There is no guarantee that the package exists in hackage. isHaskellPackage :: ArchLinuxName -> Bool-isHaskellPackage (toArchLinuxRep -> rep) = rep `elem` communityListP || "haskell-" `isPrefixOf` unsafeUnMyName rep+isHaskellPackage (toArchLinuxRep -> rep) = rep `elem` extraListP || "haskell-" `isPrefixOf` unsafeUnMyName rep -- | Check if a package is GHC or GHC Libs
src/Distribution/ArchHs/Options.hs view
@@ -9,9 +9,9 @@ -- This module contains CLI parsers used in executables. -- "Options.Applicative.Simple" is re-exported. module Distribution.ArchHs.Options- ( -- * Load Community DB- CommunityDBOptions (..),- communityDBOptionsParser,+ ( -- * Load Extra DB+ ExtraDBOptions (..),+ extraDBOptionsParser, -- * Load files DB FilesDBOptions (..),@@ -33,7 +33,7 @@ where import qualified Data.Map.Strict as Map-import Distribution.ArchHs.CommunityDB+import Distribution.ArchHs.ExtraDB import Distribution.ArchHs.FilesDB import Distribution.ArchHs.Hackage import Distribution.ArchHs.Internal.Prelude@@ -43,51 +43,51 @@ ----------------------------------------------------------------------------- --- | Parsed options for loading [community]-newtype CommunityDBOptions = CommunityDBOptions- { loadCommunityDBFromOptions :: IO CommunityDB+-- | Parsed options for loading [extra]+newtype ExtraDBOptions = ExtraDBOptions+ { loadExtraDBFromOptions :: IO ExtraDB } --- | CLI options parser of 'CommunityDBOptions'+-- | CLI options parser of 'ExtraDBOptions' ----- When alpm is enabled, it reads a flag @no-alpm-community@;--- otherwise it reads a string option @community@.-communityDBOptionsParser :: Parser CommunityDBOptions+-- When alpm is enabled, it reads a flag @no-alpm-extra@;+-- otherwise it reads a string option @extra@.+extraDBOptionsParser :: Parser ExtraDBOptions #ifndef ALPM-communityDBOptionsParser =- CommunityDBOptions+extraDBOptionsParser =+ ExtraDBOptions <$> fmap ( \s -> do- printInfo $ "Loading community.db from" <+> pretty s- loadCommunityDB s+ printInfo $ "Loading extra.db from" <+> pretty s+ loadExtraDB s ) ( strOption $- long "community"+ long "extra" <> metavar "PATH" <> short 'c'- <> help "Path to community.db"+ <> help "Path to extra.db" <> showDefault- <> value defaultCommunityDBPath+ <> value defaultExtraDBPath ) #else-communityDBOptionsParser =- CommunityDBOptions+extraDBOptionsParser =+ ExtraDBOptions <$> fmap ( \b -> do- let src = if b then "libalpm" else defaultCommunityDBPath- printInfo $ "Loading community.db from" <+> pretty src+ let src = if b then "libalpm" else defaultExtraDBPath+ printInfo $ "Loading extra.db from" <+> pretty src if b- then loadCommunityDBFFI- else loadCommunityDB defaultCommunityDBPath+ then loadExtraDBFFI+ else loadExtraDB defaultExtraDBPath ) ( flag True False- ( long "no-alpm-community"- <> help "Do not use libalpm to parse community db"+ ( long "no-alpm-extra"+ <> help "Do not use libalpm to parse extra db" ) ) #endif@@ -98,7 +98,7 @@ { loadFilesDBFromOptions :: DBKind -> IO FilesDB } --- | CLI options parser of 'CommunityDBOptions'+-- | CLI options parser of 'ExtraDBOptions' -- -- When alpm is enabled, it reads a flag @no-alpm-files@; -- otherwise it reads a string option @files@.@@ -119,7 +119,7 @@ <> metavar "PATH" <> short 'f' <> help- "Path of dir that includes core.files, extra.files and community.files"+ "Path of dir that includes core.files, extra.files and extra.files" <> showDefault <> value defaultFilesDBDir )
src/Distribution/ArchHs/PP.hs view
@@ -20,7 +20,7 @@ dui, cuo, yellowStarInParens,- ppCommunity,+ ppExtra, ppAur, ppDBKind, annYellow,@@ -177,8 +177,8 @@ printInfo :: (MonadIO m) => Doc AnsiStyle -> m () printInfo msg = liftIO . putDoc . annBlue $ "ⓘ" <+> msg <> line -ppCommunity :: Doc AnsiStyle-ppCommunity = annCyan $ viaShow ByCommunity+ppExtra :: Doc AnsiStyle+ppExtra = annCyan $ viaShow ByExtra ppDBKind :: DBKind -> Doc AnsiStyle ppDBKind x = annCyan . brackets $ viaShow x
src/Distribution/ArchHs/Types.hs view
@@ -21,9 +21,9 @@ PkgDependentList, PkgDesc (..), ArchLinuxVersion,- CommunityDB,+ ExtraDB, HackageEnv,- CommunityEnv,+ ExtraEnv, FlagAssignmentsEnv, KnownGHCVersion, DependencyType (..),@@ -95,17 +95,17 @@ deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData) --- | Version of packages in archlinux community repo+-- | Version of packages in archlinux extra repo type ArchLinuxVersion = String -- | Representation of @cummunity.db@-type CommunityDB = Map ArchLinuxName PkgDesc+type ExtraDB = Map ArchLinuxName PkgDesc -- | Reader effect of 'HackageDB' type HackageEnv = Reader HackageDB --- | Reader effect of 'CommunityDB'-type CommunityEnv = Reader CommunityDB+-- | Reader effect of 'ExtraDB'+type ExtraEnv = Reader ExtraDB -- | A map of packages with their 'FlagAssignment' type FlagAssignments = Map PackageName FlagAssignment@@ -175,12 +175,12 @@ show CSetup = "Setup" -- | Provider of a dependency.-data DependencyProvider = ByCommunity | ByAur+data DependencyProvider = ByExtra | ByAur deriving stock (Eq, Ord, Generic) deriving anyclass (NFData) instance Show DependencyProvider where- show ByCommunity = "[community]"+ show ByExtra = "[extra]" show ByAur = "[aur]" -- | A solved dependency, holden by 'SolvedPackage'
sync/Args.hs view
@@ -15,12 +15,12 @@ data CommonOptions = CommonOptions { optHackage :: HackageDBOptions,- optCommunityDB :: CommunityDBOptions+ optExtraDB :: ExtraDBOptions } commonOptionsParser :: Parser CommonOptions commonOptionsParser =- CommonOptions <$> hackageDBOptionsParser <*> communityDBOptionsParser+ CommonOptions <$> hackageDBOptionsParser <*> extraDBOptionsParser ----------------------------------------------------------------------------- @@ -73,14 +73,14 @@ data Mode = Submit CommonOptions SubmitOptions | Check CommonOptions CheckOptions- | List CommunityDBOptions ListOptions+ | List ExtraDBOptions ListOptions runArgsParser :: IO Mode runArgsParser = snd <$> do simpleOptions archHsVersion- "arch-hs-sync - sync metadata of Haskell packages between [community] and Hackage"+ "arch-hs-sync - sync metadata of Haskell packages between [extra] and Hackage" "arch-hs-sync is designed to be used by Hackage distribution maintainers" (pure ()) $ do@@ -96,6 +96,6 @@ (Check <$> commonOptionsParser <*> checkOptionsParser) addCommand "list"- "list all Haskell packages in [community]"+ "list all Haskell packages in [extra]" id- (List <$> communityDBOptionsParser <*> listOptionsParser)+ (List <$> extraDBOptionsParser <*> listOptionsParser)
sync/Check.hs view
@@ -11,13 +11,13 @@ import Distribution.Package (packageName, packageVersion) import Utils -check :: Members [HackageEnv, CommunityEnv, WithMyErr, Embed IO] r => Bool -> Sem r ()+check :: Members [HackageEnv, ExtraEnv, WithMyErr, Embed IO] r => Bool -> Sem r () check includeGHC = do linked <- linkedHaskellPackages let result = [ annMagneta (pretty (unArchLinuxName archName)) <+> "in"- <+> ppCommunity+ <+> ppExtra <+> "has version" <+> (if isHackageNewer then annRed else annGreen) (viaPretty archVersion)
sync/Main.hs view
@@ -26,41 +26,41 @@ main = runArgsParser >>= runMode runCheck ::- CommunityDB ->+ ExtraDB -> HackageDB -> Bool -> IO (Either MyException ())-runCheck community hackage includeGHC =+runCheck extra hackage includeGHC = ( runFinal . embedToFinal @IO . errorToIOFinal . runReader hackage- . runReader community+ . runReader extra ) (check includeGHC) runSubmit ::- CommunityDB ->+ ExtraDB -> HackageDB -> Manager -> Maybe String -> FilePath -> Bool -> IO (Either MyException ())-runSubmit community hackage manager token output upload =+runSubmit extra hackage manager token output upload = ( runFinal . embedToFinal @IO . errorToIOFinal . runReader manager . runReader hackage- . runReader community+ . runReader extra ) (submit token output upload) runMode :: Mode -> IO () runMode = \case Submit CommonOptions {..} SubmitOptions {..} -> do- community <- loadCommunityDBFromOptions optCommunityDB+ extra <- loadExtraDBFromOptions optExtraDB hackage <- loadHackageDBFromOptions optHackage token <- lookupEnv "HACKAGE_API_TOKEN"@@ -81,16 +81,16 @@ printWarn "Run diff and check only" manager <- newTlsManager- runSubmit community hackage manager token optOutput optUpload & printAppResult+ runSubmit extra hackage manager token optOutput optUpload & printAppResult Check CommonOptions {..} CheckOptions {..} -> do- community <- loadCommunityDBFromOptions optCommunityDB+ extra <- loadExtraDBFromOptions optExtraDB hackage <- loadHackageDBFromOptions optHackage- runCheck community hackage optShowGHCLibs & printAppResult- List CommunityDBOptions {..} ListOptions {..} -> do- community <- loadCommunityDBFromOptions+ runCheck extra hackage optShowGHCLibs & printAppResult+ List ExtraDBOptions {..} ListOptions {..} -> do+ extra <- loadExtraDBFromOptions putStrLn $ unlines [ unArchLinuxName name <> (if optWithVersion then ": " <> version else "")- | (name, _version -> version) <- Map.toList community,+ | (name, _version -> version) <- Map.toList extra, isHaskellPackage name ]
sync/Submit.hs view
@@ -21,8 +21,8 @@ import Submit.CSV import Utils --- | Generate Distro CSV from Community DB-genCSV :: Members [CommunityEnv, HackageEnv, WithMyErr, Embed IO] r => Sem r DistroCSV+-- | Generate Distro CSV from Extra DB+genCSV :: Members [ExtraEnv, HackageEnv, WithMyErr, Embed IO] r => Sem r DistroCSV genCSV = do linked <- linkedHaskellPackages pure $@@ -34,11 +34,11 @@ if isGHCLibs hackageName then "ghc" else unArchLinuxName archLinuxName- prefix = "https://www.archlinux.org/packages/community/x86_64/"+ prefix = "https://www.archlinux.org/packages/extra/x86_64/" ] -- | Check and submit distro CSV to Hackage-submit :: Members [HackageEnv, CommunityEnv, WithMyErr, Reader Manager, Embed IO] r => Maybe String -> FilePath -> Bool -> Sem r ()+submit :: Members [HackageEnv, ExtraEnv, WithMyErr, Reader Manager, Embed IO] r => Maybe String -> FilePath -> Bool -> Sem r () submit token output upload = do csv <- genCSV let v = renderDistroCSV csv@@ -66,9 +66,9 @@ printInfo "ResponseBody:" printInfo . pretty . decodeUtf8 . LBS.toStrict $ responseBody result --- | Download Distro CSV from Hackage and print differences from @community@+-- | Download Distro CSV from Hackage and print differences from @extra@ check :: Members [HackageEnv, WithMyErr, Reader Manager, Embed IO] r => DistroCSV -> Sem r ()-check community = do+check extra = do printInfo "Checking generated csv file..." req <- interceptHttpException $ parseRequest "https://hackage.haskell.org/distro/Arch/packages.csv"@@ -78,7 +78,7 @@ let bs = responseBody result hackage = parseDistroCSV . T.unpack . decodeUtf8 . LBS.toStrict $ bs - let diff = getGroupedDiff hackage community+ let diff = getGroupedDiff hackage extra diffOld = filterFirstDiff diff >>= (ppDiffColored . mapDiff (fmap ppRecord)) diffNew = filterSecondDiff diff >>= (ppDiffColored . mapDiff (fmap ppRecord)) ppRecord (name, version, url) = "(" <> name <> ", " <> version <> ", " <> url <> ")"@@ -97,8 +97,8 @@ "Found" <+> pretty (length hackage) <+> "packages with submitted distribution information in hackage, and"- <+> pretty (length community)+ <+> pretty (length extra) <+> "haskell packages in"- <+> ppCommunity+ <+> ppExtra <> dot <> line
sync/Utils.hs view
@@ -16,10 +16,10 @@ import Distribution.ArchHs.Types linkedHaskellPackages ::- Members [CommunityEnv, HackageEnv, WithMyErr, Embed IO] r =>+ Members [ExtraEnv, HackageEnv, WithMyErr, Embed IO] r => Sem r [(ArchLinuxName, ArchLinuxVersion, GenericPackageDescription)] linkedHaskellPackages = do- communityHaskellPackages <- filter (isHaskellPackage . fst) . Map.toList <$> ask @CommunityDB+ extraHaskellPackages <- filter (isHaskellPackage . fst) . Map.toList <$> ask @ExtraDB hackagePackages <- Map.keys <$> ask @HackageDB let go xs ys ((name, desc) : pkgs) = let hName = toHackageName name@@ -27,9 +27,9 @@ 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+ (linked, unlinked) <- go [] [] extraHaskellPackages embed $ unless (null unlinked) $ do- printWarn $ "Following packages in" <+> ppCommunity <+> "are not linked to hackage:"+ printWarn $ "Following packages in" <+> ppExtra <+> "are not linked to hackage:" putStrLn . unlines $ unArchLinuxName <$> unlinked pure linked