diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,14 @@ `arch-hs` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.9.1.0 + +* Support Cabal 3.4 + +* Use the version of [`haskell-ghc`](https://archlinux.org/packages/community/x86_64/ghc/) to evaluate condition trees + +* Fix the bug that sub-lib components appear wrongly in results + ## 0.9.0.0 * Remove `arch-hs-submit` executable diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,8 +6,8 @@ | Env | CI | | ---------------- | ------------------------------------------------------------------------------------------------------------------------- | -| pacman (-f alpm) | [![GitHub CI](https://github.com/berberman/arch-hs/workflows/CI/badge.svg)](https://github.com/berberman/arch-hs/actions) | -| cabal-install | [![Build Status](https://travis-ci.com/berberman/arch-hs.svg?branch=master)](https://travis-ci.com/berberman/arch-hs) | +| pacman (-f alpm) | [![ArchLinux](https://github.com/berberman/arch-hs/actions/workflows/archlinux.yml/badge.svg)](https://github.com/berberman/arch-hs/actions/workflows/archlinux.yml) | +| cabal-install | [![CI](https://github.com/berberman/arch-hs/actions/workflows/ci.yml/badge.svg)](https://github.com/berberman/arch-hs/actions/workflows/ci.yml) | A program generating PKGBUILD for hackage packages. Special thanks to [felixonmars](https://github.com/felixonmars/). diff --git a/app/Json.hs b/app/Json.hs --- a/app/Json.hs +++ b/app/Json.hs @@ -31,7 +31,7 @@ archLinuxName :: ArchLinuxName -> Value archLinuxName (ArchLinuxName name) = String $ T.pack name -flag :: Flag -> Value +flag :: PkgFlag -> Value flag f = object [ "name" .= unFlagName (flagName f), @@ -99,7 +99,7 @@ data FlagsS = FlagsS { fPkg :: PackageName, - fFlag :: [Flag] + fFlag :: [PkgFlag] } instance ToJSON FlagsS where @@ -137,5 +137,5 @@ fromSolvedPackage ProvidedPackage {..} = SolvedPackageS _pkgName [] (Just _pkgProvider) fromSolvedPackage SolvedPackage {..} = SolvedPackageS _pkgName (fromSolvedDependency <$> _pkgDeps) Nothing -fromFlag :: (PackageName, [Flag]) -> FlagsS +fromFlag :: (PackageName, [PkgFlag]) -> FlagsS fromFlag (fPkg, fFlag) = FlagsS {..} diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -42,7 +42,7 @@ import System.FilePath (takeFileName) app :: - Members '[Embed IO, State (Set.Set PackageName), CommunityEnv, HackageEnv, FlagAssignmentsEnv, DependencyRecord, Trace, Aur, WithMyErr] r => + Members '[Embed IO, State (Set.Set PackageName), KnownGHCVersion, CommunityEnv, HackageEnv, FlagAssignmentsEnv, DependencyRecord, Trace, Aur, WithMyErr] r => PackageName -> FilePath -> Bool -> @@ -337,7 +337,7 @@ optFileTrace ref manager - (app optTarget optOutputDir optAur optSkip optUusi optForce optMetaDir optJson (loadFilesDBFromOptions optFilesDB)) + (subsumeGHCVersion $ app optTarget optOutputDir optAur optSkip optUusi optForce optMetaDir optJson (loadFilesDBFromOptions optFilesDB)) & printAppResult ----------------------------------------------------------------------------- diff --git a/arch-hs.cabal b/arch-hs.cabal --- a/arch-hs.cabal +++ b/arch-hs.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: arch-hs -version: 0.9.0.0 +version: 0.9.1.0 synopsis: Distribute hackage packages to archlinux description: @arch-hs@ is a command-line program, which simplifies the process of producing @@ -23,7 +23,7 @@ CHANGELOG.md README.md -tested-with: GHC ==8.10.4 +tested-with: GHC ==8.10.5 || ==9.0.1 source-repository head type: git @@ -52,18 +52,18 @@ , hackage-db ^>=2.1.0 , http-client , http-client-tls - , megaparsec ^>=9.0.0 + , megaparsec ^>=9.0.0 || ^>=9.1.0 , microlens ^>=0.4.11 , microlens-th ^>=0.4.3 , neat-interpolation ^>=0.5.1 , optparse-simple ^>=0.1.1.3 - , polysemy + , polysemy ^>=1.5.0 || ^>=1.6.0 , prettyprinter ^>=1.7.0 , prettyprinter-ansi-terminal ^>=1.1.2 , servant-client ^>=0.18.2 , split ^>=0.2.3 , tar-conduit ^>=0.3.2 - , template-haskell ^>=2.16.0 + , template-haskell ^>=2.16.0 || ^>=2.17.0 , text ghc-options: @@ -99,6 +99,7 @@ exposed-modules: Distribution.ArchHs.Aur Distribution.ArchHs.CommunityDB + Distribution.ArchHs.Compat Distribution.ArchHs.Core Distribution.ArchHs.Exception Distribution.ArchHs.FilesDB diff --git a/diff/Diff.hs b/diff/Diff.hs --- a/diff/Diff.hs +++ b/diff/Diff.hs @@ -8,81 +8,20 @@ import Data.Algorithm.Diff import qualified Data.ByteString.Lazy as LBS -import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromJust) import Distribution.ArchHs.CommunityDB (versionInCommunity) -import Distribution.ArchHs.Core (evalConditionTree) +import Distribution.ArchHs.Core import Distribution.ArchHs.Exception import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.PP import Distribution.ArchHs.Types import Distribution.ArchHs.Utils -import Distribution.PackageDescription (CondTree, ConfVar) import Distribution.PackageDescription.Parsec (parseGenericPackageDescriptionMaybe) -import qualified Distribution.Types.BuildInfo.Lens as L -import Distribution.Types.Dependency (Dependency) -import Distribution.Types.SetupBuildInfo import Distribution.Utils.ShortText (fromShortText) import Network.HTTP.Client ------------------------------------------------------------------------------ - --- Duplicated from Core.hs with modifications. - type VersionedList = [(PackageName, VersionRange)] -type VersionedComponentList = [(UnqualComponentName, VersionedList)] - -collectLibDeps :: Members [FlagAssignmentsEnv, Trace, DependencyRecord] r => GenericPackageDescription -> Sem r (VersionedList, VersionedList) -collectLibDeps cabal = do - case cabal & condLibrary of - Just lib -> do - bInfo <- evalConditionTree cabal lib - let libDeps = unDepV <$> buildDependsIfBuild bInfo - toolDeps = unBuildTools $ buildToolsAndbuildToolDependsIfBuild bInfo - mapM_ (uncurry updateDependencyRecord) libDeps - mapM_ (uncurry updateDependencyRecord) toolDeps - return (libDeps, toolDeps) - Nothing -> return ([], []) - -collectComponentialDeps :: - (Semigroup k, L.HasBuildInfo k, Members [FlagAssignmentsEnv, Trace, DependencyRecord] r) => - (GenericPackageDescription -> [(UnqualComponentName, CondTree ConfVar [Dependency] k)]) -> - GenericPackageDescription -> - [UnqualComponentName] -> - Sem r (VersionedComponentList, VersionedComponentList) -collectComponentialDeps 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 %~ (unBuildTools . buildToolsAndbuildToolDependsIfBuild) - mapM_ (uncurry updateDependencyRecord) $ deps ^.. each . _2 ^. each - mapM_ (uncurry updateDependencyRecord) $ toolDeps ^.. each . _2 ^. each - return (deps, toolDeps) - -collectExeDeps :: Members [FlagAssignmentsEnv, Trace, DependencyRecord] r => GenericPackageDescription -> [UnqualComponentName] -> Sem r (VersionedComponentList, VersionedComponentList) -collectExeDeps = collectComponentialDeps condExecutables - -collectTestDeps :: Members [FlagAssignmentsEnv, Trace, DependencyRecord] r => GenericPackageDescription -> [UnqualComponentName] -> Sem r (VersionedComponentList, VersionedComponentList) -collectTestDeps = collectComponentialDeps condTestSuites - -collectSubLibDeps :: Members [FlagAssignmentsEnv, Trace, DependencyRecord] r => GenericPackageDescription -> [UnqualComponentName] -> Sem r (VersionedComponentList, VersionedComponentList) -collectSubLibDeps = collectComponentialDeps condSubLibraries - -collectSetupDeps :: Member Trace r => GenericPackageDescription -> Sem r VersionedList -collectSetupDeps cabal = do - let name = getPkgName' cabal - trace' $ "Getting setup dependencies of " <> show name - case setupBuildInfo $ packageDescription cabal of - Just (SetupBuildInfo deps _) -> do - let result = unDepV <$> deps - trace' $ "Found: " <> show result - return result - _ -> return [] - -updateDependencyRecord :: Member DependencyRecord r => PackageName -> VersionRange -> Sem r () -updateDependencyRecord name range = modify' $ Map.insertWith (<>) name [range] - ----------------------------------------------------------------------------- getCabalFromHackage :: Members [Embed IO, WithMyErr, Reader Manager] r => PackageName -> Version -> Sem r GenericPackageDescription @@ -98,15 +37,15 @@ _ -> error "Failed to parse .cabal file" directDependencies :: - Members [FlagAssignmentsEnv, Trace, DependencyRecord] r => + Members [KnownGHCVersion, FlagAssignmentsEnv, Trace, DependencyRecord] r => GenericPackageDescription -> Sem r (VersionedList, VersionedList) directDependencies cabal = do - (libDeps, libToolsDeps) <- collectLibDeps cabal - (subLibDeps, subLibToolsDeps) <- collectSubLibDeps cabal [] - (exeDeps, exeToolsDeps) <- collectExeDeps cabal [] - (testDeps, testToolsDeps) <- collectTestDeps cabal [] - setupDeps <- collectSetupDeps cabal + (libDeps, libToolsDeps, _) <- collectLibDeps id cabal + (subLibDeps, subLibToolsDeps, _) <- collectSubLibDeps id cabal [] + (exeDeps, exeToolsDeps, _) <- collectExeDeps id cabal [] + (testDeps, testToolsDeps, _) <- collectTestDeps id cabal [] + setupDeps <- collectSetupDeps id cabal let flatten = mconcat . fmap snd l = libDeps lt = libToolsDeps @@ -116,8 +55,9 @@ et = flatten exeToolsDeps t = flatten testDeps tt = flatten testToolsDeps - notMyself = (/= getPkgName' cabal) - distinct = filter (notMyself . fst) . nub + mySubLibs = fmap (unqualComponentNameToPackageName . fst) subLibDeps + notMyselfOrSubLib = (&&) <$> (/= getPkgName' cabal) <*> (`notElem` mySubLibs) + distinct = filter (notMyselfOrSubLib . fst) . nub depends = distinct $ l <> sl <> e makedepends = distinct (lt <> slt <> et <> t <> tt <> setupDeps) \\ depends sort' = sortBy (\x y -> uncurry compare $ getTwo _1 x y) @@ -125,7 +65,7 @@ ----------------------------------------------------------------------------- -diffCabal :: Members [CommunityEnv, FlagAssignmentsEnv, WithMyErr, Trace, DependencyRecord, Reader Manager, Embed IO] r => PackageName -> Version -> Version -> Sem r () +diffCabal :: Members [KnownGHCVersion, CommunityEnv, 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 @@ -228,7 +168,7 @@ joinToString xs = indent 2 $ vsep xs joinVersionWithName (n, range) = unPackageName n <> " " <> prettyShow range -flags :: PackageName -> [Flag] -> [Flag] -> Doc AnsiStyle +flags :: PackageName -> [PkgFlag] -> [PkgFlag] -> Doc AnsiStyle flags name a b = annMagneta "Flags" <> colon <> line <> if noDiff diff diff --git a/diff/Main.hs b/diff/Main.hs --- a/diff/Main.hs +++ b/diff/Main.hs @@ -9,6 +9,7 @@ import qualified Data.Map as Map import Data.Text.Prettyprint.Doc.Render.Terminal import Diff +import Distribution.ArchHs.Core (subsumeGHCVersion) import Distribution.ArchHs.Exception import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.Options @@ -34,7 +35,7 @@ manager <- newTlsManager printInfo "Start running..." - runDiff community optFlags manager (diffCabal optPackageName optVersionA optVersionB) & printAppResult + runDiff community optFlags manager (subsumeGHCVersion $ diffCabal optPackageName optVersionA optVersionB) & printAppResult runDiff :: CommunityDB -> diff --git a/src/Distribution/ArchHs/Compat.hs b/src/Distribution/ArchHs/Compat.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/ArchHs/Compat.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE PatternSynonyms #-} + +module Distribution.ArchHs.Compat + ( pattern PkgFlag, + PkgFlag, + ) +where + +import Distribution.Types.ConfVar +import Distribution.Types.Flag + +pattern PkgFlag :: FlagName -> ConfVar +{-# COMPLETE PkgFlag #-} + +#if MIN_VERSION_Cabal(3,4,0) +type PkgFlag = PackageFlag +pattern PkgFlag x = PackageFlag x +#else +type PkgFlag = Flag +pattern PkgFlag x = Flag x +#endif diff --git a/src/Distribution/ArchHs/Core.hs b/src/Distribution/ArchHs/Core.hs --- a/src/Distribution/ArchHs/Core.hs +++ b/src/Distribution/ArchHs/Core.hs @@ -11,6 +11,14 @@ ( getDependencies, cabalToPkgBuild, evalConditionTree, + subsumeGHCVersion, + + -- * Helper functions + collectLibDeps, + collectExeDeps, + collectTestDeps, + collectSubLibDeps, + collectSetupDeps, ) where @@ -18,8 +26,10 @@ import Data.Bifunctor (second) import Data.Containers.ListUtils (nubOrd) import qualified Data.Map as Map +import Data.Maybe (fromMaybe) import Data.Set (Set) import qualified Data.Set as Set +import Distribution.ArchHs.CommunityDB (versionInCommunity) import Distribution.ArchHs.Exception import Distribution.ArchHs.Hackage ( getLatestCabal, @@ -36,7 +46,7 @@ import Distribution.ArchHs.Types import Distribution.ArchHs.Utils import Distribution.Compiler (CompilerFlavor (..)) -import Distribution.PackageDescription +import Distribution.PackageDescription hiding (pkgName) import Distribution.SPDX import Distribution.System (Arch (X86_64), OS (Linux)) import qualified Distribution.Types.BuildInfo.Lens as L @@ -44,21 +54,21 @@ import Distribution.Types.Dependency (Dependency) import Distribution.Utils.ShortText (fromShortText) -archEnv :: FlagAssignment -> ConfVar -> Either ConfVar Bool -archEnv _ (OS Linux) = Right True -archEnv _ (OS _) = Right False -archEnv _ (Arch X86_64) = Right True -archEnv _ (Arch _) = Right False -archEnv _ (Impl GHC range) = Right $ withinRange (mkVersion [8, 10, 4]) range -archEnv _ (Impl _ _) = Right False -archEnv assignment f@(Flag f') = go f $ lookupFlagAssignment f' assignment +archEnv :: Version -> FlagAssignment -> ConfVar -> Either ConfVar Bool +archEnv _ _ (OS Linux) = Right True +archEnv _ _ (OS _) = Right False +archEnv _ _ (Arch X86_64) = Right True +archEnv _ _ (Arch _) = Right False +archEnv ghcVersion _ (Impl GHC range) = Right $ withinRange ghcVersion range +archEnv _ _ (Impl _ _) = Right False +archEnv _ assignment f@(PkgFlag f') = go f $ lookupFlagAssignment f' assignment where go _ (Just r) = Right r go x Nothing = Left x -- | Simplify the condition tree from 'GenericPackageDescription' with given flag assignments and archlinux system assumption. evalConditionTree :: - (HasCallStack, Semigroup k, L.HasBuildInfo k, Members [FlagAssignmentsEnv, Trace] r) => + (HasCallStack, Semigroup k, L.HasBuildInfo k, Members [KnownGHCVersion, FlagAssignmentsEnv, Trace] r) => GenericPackageDescription -> CondTree ConfVar [Dependency] k -> Sem r BuildInfo @@ -80,7 +90,8 @@ trace' $ "Evaluating condition tree of " <> show name trace' $ "Flags: " <> show thisFlag traceCallStack - return $ (^. L.buildInfo) . snd $ simplifyCondTree (archEnv thisFlag) cond + ghcVersion <- ask + return $ (^. L.buildInfo) . snd $ simplifyCondTree (archEnv ghcVersion thisFlag) cond ----------------------------------------------------------------------------- @@ -88,7 +99,7 @@ -- All version constraints will be discarded, -- and only packages depended by executables, libraries, and test suits will be collected. getDependencies :: - (HasCallStack, Members [HackageEnv, FlagAssignmentsEnv, WithMyErr, DependencyRecord, State (Set PackageName), Trace] r) => + (HasCallStack, Members [KnownGHCVersion, HackageEnv, FlagAssignmentsEnv, WithMyErr, DependencyRecord, State (Set PackageName), Trace] r) => -- | Skipped [UnqualComponentName] -> -- | Parent @@ -103,11 +114,14 @@ trace' $ "Already resolved: " <> show resolved traceCallStack cabal <- getLatestCabal name - (libDeps, libToolsDeps, libSysDeps) <- collectLibDeps cabal - (subLibDeps, subLibToolsDeps, subLibSysDeps) <- collectSubLibDeps cabal skip - (exeDeps, exeToolsDeps, exeSysDeps) <- collectExeDeps cabal skip - (testDeps, testToolsDeps, testSysDeps) <- collectTestDeps cabal skip - setupDeps <- collectSetupDeps cabal + let kIgnoreVersionLib = fmap fst + kIgnoreVersionComp = fmap (second $ fmap fst) + kIgnoreVersionSetup = kIgnoreVersionLib + (libDeps, libToolsDeps, libSysDeps) <- collectLibDeps kIgnoreVersionLib cabal + (subLibDeps, subLibToolsDeps, subLibSysDeps) <- collectSubLibDeps kIgnoreVersionComp cabal skip + (exeDeps, exeToolsDeps, exeSysDeps) <- collectExeDeps kIgnoreVersionComp cabal skip + (testDeps, testToolsDeps, testSysDeps) <- collectTestDeps kIgnoreVersionComp cabal skip + setupDeps <- collectSetupDeps kIgnoreVersionSetup cabal -- Ignore benchmarks -- (benchDeps, benchToolsDeps) <- collectBenchMarkDeps cabal skip let uname :: (UnqualComponentName -> DependencyType) -> ComponentPkgList -> [(DependencyType, PkgList)] @@ -186,8 +200,12 @@ (if null currentSysDeps then Map.empty else Map.singleton name currentSysDeps) <> nextSys ) -collectLibDeps :: Members [FlagAssignmentsEnv, DependencyRecord, Trace] r => GenericPackageDescription -> Sem r (PkgList, PkgList, [SystemDependency]) -collectLibDeps cabal = do +collectLibDeps :: + (Members [KnownGHCVersion, FlagAssignmentsEnv, DependencyRecord, Trace] r, Show a, Monoid a) => + ([(PackageName, VersionRange)] -> a) -> + GenericPackageDescription -> + Sem r (a, a, [SystemDependency]) +collectLibDeps k cabal = do case cabal & condLibrary of Just lib -> do let name = getPkgName' cabal @@ -198,20 +216,21 @@ systemDeps = unSystemDependency $ pkgconfigDependsAndExtraLibsIfBuild info mapM_ (uncurry updateDependencyRecord) libDeps mapM_ (uncurry updateDependencyRecord) toolDeps - let result = (fmap fst libDeps, fmap fst toolDeps, systemDeps) + let result = (k libDeps, k toolDeps, systemDeps) trace' $ "Found: " <> show result traceCallStack return result - Nothing -> return ([], [], []) + Nothing -> return mempty -- 'Monoid a' comes from here collectComponentialDeps :: - (HasCallStack, Semigroup k, L.HasBuildInfo k, Members [FlagAssignmentsEnv, DependencyRecord, Trace] r) => + (HasCallStack, Semigroup k, L.HasBuildInfo k, Members [KnownGHCVersion, FlagAssignmentsEnv, DependencyRecord, Trace] r, Show a) => String -> (GenericPackageDescription -> [(UnqualComponentName, CondTree ConfVar [Dependency] k)]) -> + ([(UnqualComponentName, [(PackageName, VersionRange)])] -> a) -> GenericPackageDescription -> [UnqualComponentName] -> - Sem r (ComponentPkgList, ComponentPkgList, [SystemDependency]) -collectComponentialDeps tag f cabal skip = do + Sem r (a, a, [SystemDependency]) +collectComponentialDeps tag f k cabal skip = do let conds = cabal & f name = getPkgName' cabal trace' $ "Getting " <> tag <> " dependencies of " <> show name @@ -219,7 +238,6 @@ let deps = info <&> _2 %~ (fmap unDepV . buildDependsIfBuild) toolDeps = info <&> _2 %~ (unBuildTools . buildToolsAndbuildToolDependsIfBuild) sysDeps = info <&> _2 %~ (unSystemDependency . pkgconfigDependsAndExtraLibsIfBuild) - 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, mconcat $ fmap snd sysDeps) @@ -227,25 +245,44 @@ traceCallStack return result -collectExeDeps :: (HasCallStack, Members [FlagAssignmentsEnv, DependencyRecord, Trace] r) => GenericPackageDescription -> [UnqualComponentName] -> Sem r (ComponentPkgList, ComponentPkgList, [SystemDependency]) +collectExeDeps :: + (HasCallStack, Members [KnownGHCVersion, FlagAssignmentsEnv, DependencyRecord, Trace] r, Show a) => + ([(UnqualComponentName, [(PackageName, VersionRange)])] -> a) -> + GenericPackageDescription -> + [UnqualComponentName] -> + Sem r (a, a, [SystemDependency]) collectExeDeps = collectComponentialDeps "exe" condExecutables -collectTestDeps :: (HasCallStack, Members [FlagAssignmentsEnv, DependencyRecord, Trace] r) => GenericPackageDescription -> [UnqualComponentName] -> Sem r (ComponentPkgList, ComponentPkgList, [SystemDependency]) +collectTestDeps :: + (HasCallStack, Members [KnownGHCVersion, FlagAssignmentsEnv, DependencyRecord, Trace] r, Show a) => + ([(UnqualComponentName, [(PackageName, VersionRange)])] -> a) -> + GenericPackageDescription -> + [UnqualComponentName] -> + Sem r (a, a, [SystemDependency]) collectTestDeps = collectComponentialDeps "test" condTestSuites -collectSubLibDeps :: (HasCallStack, Members [FlagAssignmentsEnv, DependencyRecord, Trace] r) => GenericPackageDescription -> [UnqualComponentName] -> Sem r (ComponentPkgList, ComponentPkgList, [SystemDependency]) +collectSubLibDeps :: + (HasCallStack, Members [KnownGHCVersion, FlagAssignmentsEnv, DependencyRecord, Trace] r, Show a) => + ([(UnqualComponentName, [(PackageName, VersionRange)])] -> a) -> + GenericPackageDescription -> + [UnqualComponentName] -> + Sem r (a, a, [SystemDependency]) collectSubLibDeps = collectComponentialDeps "sublib" condSubLibraries -collectSetupDeps :: Member Trace r => GenericPackageDescription -> Sem r PkgList -collectSetupDeps cabal = do +collectSetupDeps :: + (Member Trace r, Show a, Monoid a) => + ([(PackageName, VersionRange)] -> a) -> + GenericPackageDescription -> + Sem r a +collectSetupDeps k cabal = do let name = getPkgName' cabal trace' $ "Getting setup dependencies of " <> show name case setupBuildInfo $ packageDescription cabal of Just (SetupBuildInfo deps _) -> do - let result = fst . unDepV <$> deps + let result = k $ unDepV <$> deps trace' $ "Found: " <> show result return result - _ -> return [] + _ -> return mempty updateDependencyRecord :: Member DependencyRecord r => PackageName -> VersionRange -> Sem r () updateDependencyRecord name range = modify' $ Map.insertWith (<>) name [range] @@ -311,3 +348,12 @@ _licenseFile = licenseFiles cabal ^? ix 0 _enableUusi = uusi return PkgBuild {..} + +----------------------------------------------------------------------------- + +-- | Get the ghc version in 'CommunityDB' +subsumeGHCVersion :: Members [CommunityEnv, 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 + runReader ghcVersion m diff --git a/src/Distribution/ArchHs/Hackage.hs b/src/Distribution/ArchHs/Hackage.hs --- a/src/Distribution/ArchHs/Hackage.hs +++ b/src/Distribution/ArchHs/Hackage.hs @@ -93,7 +93,7 @@ Nothing -> throw $ PkgNotFound name -- | Get flags of a package. -getPackageFlag :: Members [HackageEnv, WithMyErr] r => PackageName -> Sem r [Flag] +getPackageFlag :: Members [HackageEnv, WithMyErr] r => PackageName -> Sem r [PkgFlag] getPackageFlag name = do cabal <- getLatestCabal name return $ cabal & genPackageFlags diff --git a/src/Distribution/ArchHs/Internal/Prelude.hs b/src/Distribution/ArchHs/Internal/Prelude.hs --- a/src/Distribution/ArchHs/Internal/Prelude.hs +++ b/src/Distribution/ArchHs/Internal/Prelude.hs @@ -31,6 +31,7 @@ module Polysemy.Reader, module Polysemy.State, module Polysemy.Trace, + module Distribution.ArchHs.Compat, module Distribution.Types.PackageDescription, module Distribution.Types.GenericPackageDescription, module Distribution.Types.Version, @@ -60,6 +61,7 @@ ( decodeUtf8, encodeUtf8, ) +import Distribution.ArchHs.Compat import Distribution.Parsec (simpleParsec) import Distribution.Pretty (prettyShow) import Distribution.Types.Flag diff --git a/src/Distribution/ArchHs/PP.hs b/src/Distribution/ArchHs/PP.hs --- a/src/Distribution/ArchHs/PP.hs +++ b/src/Distribution/ArchHs/PP.hs @@ -97,10 +97,10 @@ . fmap (\(i :: Int, n) -> pretty i <> dot <+> viaPretty n) . zip [1 ..] -prettyFlags :: [(PackageName, [Flag])] -> Doc AnsiStyle +prettyFlags :: [(PackageName, [PkgFlag])] -> Doc AnsiStyle prettyFlags = vsep . fmap (\(name, flags) -> annMagneta (viaPretty name) <> line <> indent 2 (vsep (prettyFlag <$> flags))) -prettyFlag :: Flag -> Doc AnsiStyle +prettyFlag :: PkgFlag -> Doc AnsiStyle prettyFlag f = "⚐" <+> annYellow name <> colon <> line <> indent diff --git a/src/Distribution/ArchHs/Types.hs b/src/Distribution/ArchHs/Types.hs --- a/src/Distribution/ArchHs/Types.hs +++ b/src/Distribution/ArchHs/Types.hs @@ -22,6 +22,7 @@ HackageEnv, CommunityEnv, FlagAssignmentsEnv, + KnownGHCVersion, DependencyType (..), DependencyKind (..), DependencyProvider (..), @@ -83,6 +84,9 @@ -- | Unused state effect type DependencyRecord = State (Map PackageName [VersionRange]) + +-- | Reader effect of GHC version in dependency resolution +type KnownGHCVersion = Reader Version -- | The type of a dependency. Who requires this? data DependencyType