arch-hs 0.14 → 0.14.1

raw patch · 14 files changed

+177/−32 lines, 14 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• arch-hs.cabal +1/−1
• data/NAME_PRESET.json +0/−1
• rdepcheck/Check.hs +1/−1
• rdepcheck/Main.hs +3/−3
• src/Distribution/ArchHs/Exception.hs +2/−0
• src/Distribution/ArchHs/Hackage.hs +35/−0
• src/Distribution/ArchHs/Local.hs +1/−0
• src/Distribution/ArchHs/Options.hs +26/−17
• src/Distribution/ArchHs/RDepCheck.hs +3/−3
• src/Distribution/ArchHs/Types.hs +10/−2
• sync/Check.hs +2/−0
• sync/Main.hs +10/−3
• test/Main.hs +77/−1

@@ -3,6 +3,12 @@ `arch-hs` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.14.1++- Keep `arch-hs-sync check --depcheck` suggestions on Hackage's non-deprecated preferred versions while still reading exact deprecated cabal files for current reverse dependency checks++- Treat `Cabal-syntax` as part of GHC libraries+ ## 0.14  - Teach `arch-hs-sync check` to report all newer non-deprecated Hackage versions

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               arch-hs-version:            0.14+version:            0.14.1 synopsis:           Distribute hackage packages to archlinux description:   @arch-hs@ is a command-line program, which simplifies the process of producing

@@ -10,7 +10,6 @@   "cabal-install": "cabal-install",   "cabal-fmt": "cabal-fmt",   "cabal-plan": "cabal-plan",-  "haskell-cabal-syntax": "Cabal-syntax",   "cbor-tool": "cbor-tool",   "cgrep": "cgrep",   "clash-ghc": "clash-ghc",

@@ -13,7 +13,7 @@ check ::   Members     [ ExtraEnv,-      HackageEnv,+      RawHackageEnv,       KnownGHCVersion,       FlagAssignmentsEnv,       Trace,

@@ -29,7 +29,7 @@       printInfo "You assigned flags:"       putDoc $ prettyFlagAssignments optFlags <> line -    hackage <- loadHackageDBFromOptions optHackage+    hackage <- loadRawHackageDBFromOptions optHackage     extra <- loadExtraDBFromOptions optExtraDB      printInfo "Start running..."@@ -48,10 +48,10 @@       exitFailure  runCheck ::-  HackageDB ->+  RawHackageDB ->   ExtraDB ->   FlagAssignments ->-  Sem '[HackageEnv, ExtraEnv, FlagAssignmentsEnv, Trace, DependencyRecord, WithMyErr, Embed IO, Final IO] a ->+  Sem '[RawHackageEnv, ExtraEnv, FlagAssignmentsEnv, Trace, DependencyRecord, WithMyErr, Embed IO, Final IO] a ->   IO (Either MyException a) runCheck extra flags manager =   runFinal

@@ -39,6 +39,7 @@   | NetworkException ClientError   | HackageUploadFailed Int String   | VersionNoParse String+  | CabalNoParse PackageName Version  instance Show MyException where   show (PkgNotFound name) = "Unable to find \"" <> unPackageName (toHackageName name) <> "\""@@ -51,6 +52,7 @@       <> show status       <> if null message then "" else " " <> message   show (VersionNoParse v) = "String \"" <> v <> "\" can not be parsed to Cabal version"+  show (CabalNoParse name version) = "Unable to parse \"" <> unPackageName name <> "\" " <> prettyShow version <> " cabal file"  -- | Catch 'CE.IOException' and print it. printHandledIOException :: IO () -> IO ()

@@ -9,15 +9,19 @@ module Distribution.ArchHs.Hackage   ( lookupHackagePath,     loadHackageDB,+    loadRawHackageDB,+    loadHackageDBs,     insertDB,     parseCabalFile,     getLatestCabal,     getNewerVersions,     getCabal,+    getCabalIncludingDeprecated,     getPackageFlag,     traverseHackage,     getLatestSHA256,     HackageDB,+    RawHackageDB,   ) where @@ -33,9 +37,13 @@ import Distribution.ArchHs.Utils (getPkgName, getPkgVersion) import Distribution.Hackage.DB (HackageDB, VersionData (VersionData, cabalFile), readTarball, tarballHashes) import Distribution.Hackage.DB.Path (cabalStateDir)+import qualified Distribution.Hackage.DB.Parsed as Parsed+import qualified Distribution.Hackage.DB.Unparsed as Unparsed import Distribution.PackageDescription.Parsec (parseGenericPackageDescriptionMaybe) import System.Directory (doesDirectoryExist, doesFileExist, getModificationTime, listDirectory) +type RawHackageDB = Unparsed.HackageDB+ -- | Look up hackage tarball path from Cabal's package index cache. -- Preferred to the newest @01-index.tar@, whereas fallback to the newest @00-index.tar@. lookupHackagePath :: IO FilePath@@ -80,6 +88,16 @@ loadHackageDB :: FilePath -> IO HackageDB loadHackageDB = readTarball Nothing +-- | Read the Hackage index tarball without applying preferred-version ranges.+loadRawHackageDB :: FilePath -> IO RawHackageDB+loadRawHackageDB = Unparsed.readTarball Nothing++-- | Read Hackage once and expose both preferred and raw views.+loadHackageDBs :: FilePath -> IO (HackageDB, RawHackageDB)+loadHackageDBs path = do+  raw <- loadRawHackageDB path+  pure (Parsed.parseDB raw, raw)+ -- | Insert a 'GenericPackageDescription' into 'HackageDB'. insertDB :: GenericPackageDescription -> HackageDB -> HackageDB insertDB cabal = Map.insert name packageData@@ -132,6 +150,23 @@   case Map.lookup name db of     (Just m) -> case Map.lookup version m of       Just vdata -> return $ vdata & cabalFile+      Nothing -> throw $ VersionNotFound name version+    Nothing -> throw $ PkgNotFound name++-- | Get a specific cabal file without applying preferred-version ranges.+--+-- Upgrade candidates should use 'getCabal' so deprecated Hackage versions stay+-- hidden. Reverse dependency checks need this exact lookup because [extra] can+-- temporarily contain a version that Hackage later deprecated.+getCabalIncludingDeprecated :: Members [RawHackageEnv, WithMyErr] r => PackageName -> Version -> Sem r GenericPackageDescription+getCabalIncludingDeprecated name version = do+  db <- ask @RawHackageDB+  case Map.lookup name db of+    Just packageData -> case Map.lookup version (Unparsed.versions packageData) of+      Just vdata ->+        case parseGenericPackageDescriptionMaybe (Unparsed.cabalFile vdata) of+          Just cabal -> pure cabal+          Nothing -> throw $ CabalNoParse name version       Nothing -> throw $ VersionNotFound name version     Nothing -> throw $ PkgNotFound name 

@@ -48,6 +48,7 @@           "binary",           "bytestring",           "Cabal",+          "Cabal-syntax",           "containers",           "deepseq",           "directory",

@@ -145,29 +145,38 @@ -----------------------------------------------------------------------------  -- | Parsed options for loading 'HackageDB'-newtype HackageDBOptions = HackageDBOptions-  { loadHackageDBFromOptions :: IO HackageDB+data HackageDBOptions = HackageDBOptions+  { loadHackageDBFromOptions :: IO HackageDB,+    loadRawHackageDBFromOptions :: IO RawHackageDB,+    loadHackageDBsFromOptions :: IO (HackageDB, RawHackageDB)   }  -- | CLI options parser that reads a string option @hackage@. hackageDBOptionsParser :: Parser HackageDBOptions hackageDBOptionsParser =-  HackageDBOptions-    <$> fmap-      ( \s ->-          do-            hackagePath <- if null s then lookupHackagePath else pure s-            printInfo $ "Loading hackage from" <+> pretty hackagePath-            loadHackageDB hackagePath-      )-      ( strOption $-          long "hackage"-            <> metavar "PATH"-            <> short 'h'-            <> help "Path to hackage index tarball"-            <> showDefault-            <> value ""+  mkHackageDBOptions+    <$> strOption+      ( long "hackage"+          <> metavar "PATH"+          <> short 'h'+          <> help "Path to hackage index tarball"+          <> showDefault+          <> value ""       )+  where+    resolvePath s = if null s then lookupHackagePath else pure s++    withHackagePath s load = do+      hackagePath <- resolvePath s+      printInfo $ "Loading hackage from" <+> pretty hackagePath+      load hackagePath++    mkHackageDBOptions s =+      HackageDBOptions+        { loadHackageDBFromOptions = withHackagePath s loadHackageDB,+          loadRawHackageDBFromOptions = withHackagePath s loadRawHackageDB,+          loadHackageDBsFromOptions = withHackagePath s loadHackageDBs+        }  ----------------------------------------------------------------------------- 

@@ -56,7 +56,7 @@ reverseDependencyRanges ::   Members     [ ExtraEnv,-      HackageEnv,+      RawHackageEnv,       KnownGHCVersion,       FlagAssignmentsEnv,       Trace,@@ -75,7 +75,7 @@ reverseDependencyRangesWithSkips ::   Members     [ ExtraEnv,-      HackageEnv,+      RawHackageEnv,       KnownGHCVersion,       FlagAssignmentsEnv,       Trace,@@ -112,7 +112,7 @@     forM reverseDeps $ \(PkgDesc {..}, src) -> do       eCabal <-         try @MyException $-          getCabal (toHackageName _name) =<< case simpleParsec _version of+          getCabalIncludingDeprecated (toHackageName _name) =<< case simpleParsec _version of             Just v -> pure v             _ -> throw $ VersionNoParse _version       case eCabal of

@@ -23,6 +23,7 @@     ArchLinuxVersion,     ExtraDB,     HackageEnv,+    RawHackageEnv,     ExtraEnv,     FlagAssignmentsEnv,     KnownGHCVersion,@@ -44,7 +45,8 @@  import Data.Map.Strict (Map) import Distribution.ArchHs.Internal.Prelude-import Distribution.Hackage.DB (HackageDB)+import qualified Distribution.Hackage.DB as Hackage+import qualified Distribution.Hackage.DB.Unparsed as RawHackage import Lens.Micro.TH (makeLenses)  -- | A list of 'PackageName'@@ -103,7 +105,13 @@ type ExtraDB = Map ArchLinuxName PkgDesc  -- | Reader effect of 'HackageDB'-type HackageEnv = Reader HackageDB+type HackageEnv = Reader Hackage.HackageDB++-- | Reader effect of the unfiltered Hackage database.+--+-- This keeps exact package versions available even when Hackage's+-- preferred-version range marks them as deprecated.+type RawHackageEnv = Reader RawHackage.HackageDB  -- | Reader effect of 'ExtraDB' type ExtraEnv = Reader ExtraDB

@@ -28,6 +28,7 @@ check ::   Members     [ HackageEnv,+      RawHackageEnv,       ExtraEnv,       KnownGHCVersion,       FlagAssignmentsEnv,@@ -73,6 +74,7 @@   Members     [ ExtraEnv,       HackageEnv,+      RawHackageEnv,       KnownGHCVersion,       FlagAssignmentsEnv,       Trace,

@@ -29,17 +29,19 @@ runCheck ::   ExtraDB ->   HackageDB ->+  RawHackageDB ->   Bool ->   Bool ->   Bool ->   IO (Either MyException ())-runCheck extra hackage includeGHC runDepCheck verbose =+runCheck extra hackage rawHackage includeGHC runDepCheck verbose =   ( runFinal       . embedToFinal @IO       . errorToIOFinal       . evalState (Map.empty :: Map.Map PackageName [VersionRange])       . ignoreTrace       . runReader (Map.empty :: FlagAssignments)+      . runReader rawHackage       . runReader hackage       . runReader extra   )@@ -93,8 +95,13 @@     runSubmit extra hackage manager token optOutput optUpload & printAppResult   Check CommonOptions {..} CheckOptions {..} -> do     extra <- loadExtraDBFromOptions optExtraDB-    hackage <- loadHackageDBFromOptions optHackage-    runCheck extra hackage optShowGHCLibs optDepCheck optVerbose & printAppResult+    (hackage, rawHackage) <-+      if optDepCheck+        then loadHackageDBsFromOptions optHackage+        else do+          hackage <- loadHackageDBFromOptions optHackage+          pure (hackage, Map.empty)+    runCheck extra hackage rawHackage optShowGHCLibs optDepCheck optVerbose & printAppResult   List ExtraDBOptions {..} ListOptions {..} -> do     extra <- loadExtraDBFromOptions     putStrLn $

@@ -4,16 +4,22 @@ module Main (main) where  import Control.Monad (forM_)+import qualified Data.ByteString.Char8 as B8 import Data.List (isPrefixOf, sortOn) import qualified Data.Map.Strict as Map import Data.Maybe (listToMaybe, mapMaybe) import Diff (inRange) import Distribution.ArchHs.Exception import Distribution.ArchHs.ExtraDB (defaultExtraDBPath, loadExtraDB)+import Distribution.ArchHs.Hackage (getCabalIncludingDeprecated, getNewerVersions) import Distribution.ArchHs.Name (isGHCLibs, isHaskellPackage, toHackageName) import Distribution.ArchHs.Types+import qualified Distribution.Hackage.DB.Parsed as Hackage+import qualified Distribution.Hackage.DB.Unparsed as RawHackage+import Distribution.Package (packageName, packageVersion)+import Distribution.PackageDescription (GenericPackageDescription, packageDescription) import Distribution.Parsec (simpleParsec)-import Distribution.Types.PackageName (PackageName, unPackageName)+import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName) import Distribution.Types.Version (Version) import Distribution.Types.VersionRange (VersionRange, anyVersion) import Polysemy (run)@@ -74,6 +80,22 @@         result ->           expectationFailure $ "expected VersionNoParse, got: " <> show result +  describe "Hackage preferred-version handling" $ do+    it "does not report masked versions as newer candidates" $ do+      let (preferred, _, name, version100, version101) = maskedHackageDBs+      assertGetNewerVersions preferred name version100 []+      assertGetNewerVersions preferred name version101 []++    it "can still load an exact masked cabal from the raw Hackage DB" $ do+      let (_, raw, name, _, version101) = maskedHackageDBs+      case runGetCabalIncludingDeprecated raw name version101 of+        Right cabal -> do+          let desc = packageDescription cabal+          packageName desc `shouldBe` name+          packageVersion desc `shouldBe` version101+        Left err ->+          expectationFailure $ "expected masked cabal lookup to succeed, got: " <> show err+ loadLiveExtraDB :: IO ExtraDB loadLiveExtraDB = do   exists <- doesFileExist defaultExtraDBPath@@ -143,6 +165,60 @@     . runError @MyException     . runReader extra     $ inRange (name, range)++maskedHackageDBs :: (Hackage.HackageDB, RawHackage.HackageDB, PackageName, Version, Version)+maskedHackageDBs =+  (Hackage.parseDB raw, raw, name, version100, version101)+  where+    name = mkPackageName "masked"+    version100 = parseVersion "1.0.0"+    version101 = parseVersion "1.0.1"+    raw =+      Map.singleton+        name+        ( RawHackage.PackageData+            (B8.pack "masked <1.0.1 || >1.0.1")+            ( Map.fromList+                [ (version100, RawHackage.VersionData (cabalFile "1.0.0") (B8.pack "{}")),+                  (version101, RawHackage.VersionData (cabalFile "1.0.1") (B8.pack "{}"))+                ]+            )+        )++    cabalFile version =+      B8.pack $+        unlines+          [ "cabal-version: 1.12",+            "name: masked",+            "version: " <> version,+            "build-type: Simple"+          ]++parseVersion :: String -> Version+parseVersion raw =+  case simpleParsec raw of+    Just version -> version+    Nothing -> error $ "test fixture version does not parse: " <> raw++runGetNewerVersions :: Hackage.HackageDB -> PackageName -> Version -> Either MyException [Version]+runGetNewerVersions hackage name version =+  run+    . runError @MyException+    . runReader hackage+    $ getNewerVersions name version++assertGetNewerVersions :: Hackage.HackageDB -> PackageName -> Version -> [Version] -> Expectation+assertGetNewerVersions hackage name version expected =+  case runGetNewerVersions hackage name version of+    Right actual -> actual `shouldBe` expected+    Left err -> expectationFailure $ "expected newer versions, got: " <> show err++runGetCabalIncludingDeprecated :: RawHackage.HackageDB -> PackageName -> Version -> Either MyException GenericPackageDescription+runGetCabalIncludingDeprecated hackage name version =+  run+    . runError @MyException+    . runReader hackage+    $ getCabalIncludingDeprecated name version  skip :: String -> IO a skip reason = pendingWith reason >> error "unreachable"