Merge pull request #1031 from haskell/cabal-3.4

GHC 9.0 and Cabal 3.4 (fix #1016)

Author: gbaz

.github/workflows/ci.yml

@@ -17,6 +17,8 @@ jobs:
       fail-fast: false
       matrix:
         versions:
+          - ghc: '9.0.2'
+            cabal: '3.6'
           - ghc: '8.10.7'
             cabal: '3.6'
           - ghc: '8.8.4'

hackage-server.cabal

@@ -113,7 +113,7 @@ common defaults
   -- other dependencies shared by most components
   build-depends:
     , aeson                 ^>= 1.5
-    , Cabal                 ^>= 3.2.1.0
+    , Cabal                 ^>= 3.4.1.0
     , fail                  ^>= 4.9.0
       -- we use Control.Monad.Except, introduced in mtl-2.2.1
     , network               >=  3 && < 3.2

src/Data/TarIndex.hs

@@ -69,8 +69,8 @@ newtype PathComponentId = PathComponentId Int
 
 type TarEntryOffset = Int
 
-$(deriveSafeCopy 0 'base ''TarIndex)
 $(deriveSafeCopy 0 'base ''PathComponentId)
+$(deriveSafeCopy 0 'base ''TarIndex)
 $(deriveSafeCopy 0 'base ''TarIndexEntry)
 
 instance MemSize TarIndex where

src/Distribution/Server/Features/BuildReports/BuildReport.hs

@@ -1,6 +1,12 @@
-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, RecordWildCards,
-             TemplateHaskell, TypeFamilies, FlexibleInstances, MultiParamTypeClasses,
-             OverloadedStrings #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Client.Reporting
@@ -52,14 +58,16 @@ import Distribution.CabalSpecVersion
 import Distribution.Pretty
          ( Pretty(..), pretty, prettyShow )
 import qualified Text.PrettyPrint as Disp
-import Distribution.Parsec.Newtypes
+
 import Distribution.Parsec
          ( Parsec(..), PError(..), parsec )
 import qualified Distribution.Parsec as P
 import qualified Distribution.Compat.CharParsing as P
 import Distribution.FieldGrammar
          ( FieldGrammar, parseFieldGrammar, prettyFieldGrammar, partitionFields
-         , uniqueField, uniqueFieldAla, booleanFieldDef, monoidalFieldAla )
+         , uniqueField, uniqueFieldAla, booleanFieldDef, monoidalFieldAla
+         , List, alaList
+         , VCat(..), FSep(..) )
 import Distribution.Fields.Parser
          ( readFields )
 import Distribution.Fields.Pretty
@@ -83,6 +91,7 @@ import Text.StringTemplate.Classes
 
 import Data.String (fromString)
 import Data.Aeson
+import Data.Functor.Identity (Identity)
 import Data.List
          ( unfoldr, isInfixOf )
 import Data.List.NonEmpty (toList)
@@ -308,7 +317,21 @@ show = showFields (const []) . prettyFieldGrammar CabalSpecV2_4 fieldDescrs
 -- -----------------------------------------------------------------------------
 -- Description of the fields, for parsing/printing
 
-fieldDescrs :: (Applicative (g BuildReport), FieldGrammar g) => g BuildReport BuildReport
+
+fieldDescrs
+    :: ( Applicative (g BuildReport), FieldGrammar c g
+       , c (Identity Arch)
+       , c (Identity CompilerId)
+       , c (List FSep (Identity FlagAss1) FlagAss1)
+ --      , c (Identity FlagAssignment)
+       , c (Identity InstallOutcome)
+       , c (Identity OS)
+       , c (Identity Outcome)
+       , c (Identity PackageIdentifier)
+       , c (List VCat (Identity PackageIdentifier) PackageIdentifier)
+       , c Time
+       )
+    => g BuildReport BuildReport
 fieldDescrs =
   BuildReport
     <$> uniqueField       "package"            packageL
@@ -473,17 +496,6 @@ instance Pretty BuildStatus where
   pretty (BuildFailCnt a)  = Disp.text "BuildFailCnt " Disp.<+> pretty a
   pretty BuildOK    = Disp.text "BuildOK"
 
--------------------
--- SafeCopy instances
---
-
-deriveSafeCopy 0 'base      ''Outcome
-deriveSafeCopy 1 'extension ''InstallOutcome
-deriveSafeCopy 3 'extension ''BuildReport
-deriveSafeCopy 1 'base      ''BuildStatus
-deriveSafeCopy 1 'base      ''BooleanCovg
-deriveSafeCopy 1 'base      ''BuildCovg
-
 
 -------------------
 -- Old SafeCopy versions
@@ -551,6 +563,8 @@ data InstallOutcome_v0
    | V0_InstallFailed
    | V0_InstallOk
 
+deriveSafeCopy 0 'base      ''Outcome
+
 deriveSafeCopy 0 'base      ''InstallOutcome_v0
 deriveSafeCopy 2 'extension ''BuildReport_v1
 
@@ -636,3 +650,13 @@ instance Data.Aeson.FromJSON PkgDetails where
       parseVersion :: Maybe String -> Maybe Version
       parseVersion Nothing = Nothing
       parseVersion (Just k) = P.simpleParsec k
+
+-------------------
+-- SafeCopy instances
+--
+
+deriveSafeCopy 1 'extension ''InstallOutcome
+deriveSafeCopy 3 'extension ''BuildReport
+deriveSafeCopy 1 'base      ''BuildStatus
+deriveSafeCopy 1 'base      ''BooleanCovg
+deriveSafeCopy 1 'base      ''BuildCovg

src/Distribution/Server/Features/BuildReports/BuildReports.hs

@@ -114,7 +114,7 @@ lookupReport pkgid reportId buildReports = remCvg.Map.lookup reportId . reports
 lookupPackageReports :: PackageId -> BuildReports -> [(BuildReportId, (BuildReport, Maybe BuildLog))]
 lookupPackageReports pkgid buildReports = case Map.lookup pkgid (reportsIndex buildReports) of
     Nothing -> []
-    Just rs -> map removeCovg $Map.toList (reports rs)
+    Just rs -> map removeCovg $ Map.toList (reports rs)
     where
         removeCovg (brid,(brpt,blog,_)) = (brid,(brpt,blog))
 
@@ -214,9 +214,32 @@ instance ToSElem BuildReportId where
 -- SafeCopy instances
 --
 
+
+newtype BuildReportId_v0 = BuildReportId_v0 Int
+    deriving (Serialize, Enum, Eq, Ord)
+
+instance SafeCopy BuildReportId_v0 where
+    getCopy = contain get
+    putCopy = contain . put
+
+instance Migrate BuildReportId where
+    type MigrateFrom BuildReportId = BuildReportId_v0
+    migrate (BuildReportId_v0 bid) = BuildReportId bid
+
 deriveSafeCopy 2 'extension ''BuildReportId
+
+newtype BuildLog_v0 = BuildLog_v0 BlobStorage.BlobId_v0
+    deriving Serialize
+
+instance SafeCopy BuildLog_v0 where
+    getCopy = contain get
+    putCopy = contain . put
+
+instance Migrate BuildLog where
+    type MigrateFrom BuildLog = BuildLog_v0
+    migrate (BuildLog_v0 bl) = BuildLog (migrate bl)
+
 deriveSafeCopy 2 'extension ''BuildLog
-deriveSafeCopy 3 'extension ''BuildReports
 
 -- note: if the set of report ids is [1, 2, 3], then nextReportId = 4
 -- after calling deleteReport for 3, the set is [1, 2] and nextReportId is still 4.
@@ -233,21 +256,16 @@ instance SafeCopy PkgBuildReports where
                             then BuildReportId 1
                             else incrementReportId (fst $ Map.findMax rs))
                           f
-instance MemSize BuildReports where
-    memSize (BuildReports a) = memSize1 a
 
 instance MemSize PkgBuildReports where
     memSize (PkgBuildReports a b c) = memSize3 a b c
 
--------------------
--- Old V2 SafeCopy versions
---
+
 data PkgBuildReports_v2 = PkgBuildReports_v2 {
     reports_v2      :: !(Map BuildReportId (BuildReport, Maybe BuildLog)),
     nextReportId_v2 :: !BuildReportId
 } deriving (Eq, Typeable, Show)
 
-
 instance SafeCopy PkgBuildReports_v2 where
     version = 2
     kind    = extension
@@ -262,6 +280,33 @@ instance SafeCopy PkgBuildReports_v2 where
 instance MemSize PkgBuildReports_v2 where
     memSize (PkgBuildReports_v2 a b) = memSize2 a b
 
+data PkgBuildReports_v0 = PkgBuildReports_v0
+                           !(Map BuildReportId_v0 (BuildReport_v0, Maybe BuildLog_v0))
+                           !BuildReportId_v0
+
+instance SafeCopy  PkgBuildReports_v0 where
+    getCopy = contain get
+    putCopy = contain . put
+
+instance Serialize PkgBuildReports_v0 where
+    put (PkgBuildReports_v0 listing _) = Serialize.put listing
+    get = mkReports <$> Serialize.get
+      where
+        mkReports rs = PkgBuildReports_v0 rs
+                         (if Map.null rs
+                            then BuildReportId_v0 1
+                            else succ (fst $ Map.findMax rs))
+
+instance Migrate PkgBuildReports_v2 where
+     type MigrateFrom PkgBuildReports_v2 = PkgBuildReports_v0
+     migrate (PkgBuildReports_v0 m n) =
+         PkgBuildReports_v2 (migrateMap m) (migrate n)
+       where
+         migrateMap :: Map BuildReportId_v0 (BuildReport_v0, Maybe BuildLog_v0)
+                    -> Map BuildReportId    (BuildReport,    Maybe BuildLog)
+         migrateMap = Map.mapKeys migrate
+                    . Map.map (\(br, l) -> (migrate (migrate br),
+                                            fmap migrate  l))
 
 instance Migrate PkgBuildReports where
      type MigrateFrom PkgBuildReports = PkgBuildReports_v2
@@ -273,47 +318,6 @@ instance Migrate PkgBuildReports where
          migrateMap = Map.mapKeys (\x->x)
                     . Map.map (\(br, l) -> (br, l, Nothing))
 
----
-
-data BuildReports_v2 = BuildReports_v2 {
-    reportsIndex_v2 :: !(Map.Map PackageId PkgBuildReports_v2)
-} deriving (Eq, Typeable, Show)
-
-deriveSafeCopy 2 'extension ''BuildReports_v2
-
-instance MemSize BuildReports_v2 where
-    memSize (BuildReports_v2 a) = memSize1 a
-
-instance Migrate BuildReports where
-     type MigrateFrom BuildReports = BuildReports_v2
-     migrate (BuildReports_v2 m) =
-       BuildReports (Map.mapKeys (\x->x) $ Map.map migrate m)
--------------------
--- Old SafeCopy versions
---
-
-newtype BuildReportId_v0 = BuildReportId_v0 Int deriving (Serialize, Enum, Eq, Ord)
-instance SafeCopy BuildReportId_v0 where
-    getCopy = contain get
-    putCopy = contain . put
-
-instance Migrate BuildReportId where
-    type MigrateFrom BuildReportId = BuildReportId_v0
-    migrate (BuildReportId_v0 bid) = BuildReportId bid
-
----
-
-newtype BuildLog_v0 = BuildLog_v0 BlobStorage.BlobId_v0 deriving Serialize
-instance SafeCopy BuildLog_v0 where
-    getCopy = contain get
-    putCopy = contain . put
-
-
-instance Migrate BuildLog where
-    type MigrateFrom BuildLog = BuildLog_v0
-    migrate (BuildLog_v0 bl) = BuildLog (migrate bl)
-
----
 
 data BuildReports_v0 = BuildReports_v0
                          !(Map.Map PackageIdentifier_v0 PkgBuildReports_v0)
@@ -326,37 +330,26 @@ instance Serialize BuildReports_v0 where
     put (BuildReports_v0 index) = Serialize.put index
     get = BuildReports_v0 <$> Serialize.get
 
+data BuildReports_v2 = BuildReports_v2
+  { reportsIndex_v2 :: !(Map.Map PackageId PkgBuildReports_v2)
+  } deriving (Eq, Typeable, Show)
+
 instance Migrate BuildReports_v2 where
      type MigrateFrom BuildReports_v2 = BuildReports_v0
      migrate (BuildReports_v0 m) =
        BuildReports_v2 (Map.mapKeys migrate $ Map.map migrate m)
 
----
+instance MemSize BuildReports_v2 where
+    memSize (BuildReports_v2 a) = memSize1 a
 
-data PkgBuildReports_v0 = PkgBuildReports_v0
-                           !(Map BuildReportId_v0 (BuildReport_v0, Maybe BuildLog_v0))
-                           !BuildReportId_v0
+deriveSafeCopy 2 'extension ''BuildReports_v2
 
-instance SafeCopy  PkgBuildReports_v0 where
-    getCopy = contain get
-    putCopy = contain . put
+instance Migrate BuildReports where
+    type MigrateFrom BuildReports = BuildReports_v2
+    migrate (BuildReports_v2 m) =
+      BuildReports (Map.mapKeys id $ Map.map migrate m)
 
-instance Serialize PkgBuildReports_v0 where
-    put (PkgBuildReports_v0 listing _) = Serialize.put listing
-    get = mkReports <$> Serialize.get
-      where
-        mkReports rs = PkgBuildReports_v0 rs
-                         (if Map.null rs
-                            then BuildReportId_v0 1
-                            else succ (fst $ Map.findMax rs))
+instance MemSize BuildReports where
+    memSize (BuildReports a) = memSize1 a
 
-instance Migrate PkgBuildReports_v2 where
-     type MigrateFrom PkgBuildReports_v2 = PkgBuildReports_v0
-     migrate (PkgBuildReports_v0 m n) =
-         PkgBuildReports_v2 (migrateMap m) (migrate n)
-       where
-         migrateMap :: Map BuildReportId_v0 (BuildReport_v0, Maybe BuildLog_v0)
-                    -> Map BuildReportId    (BuildReport,    Maybe BuildLog)
-         migrateMap = Map.mapKeys migrate
-                    . Map.map (\(br, l) -> (migrate (migrate br),
-                                            fmap migrate  l))
+deriveSafeCopy 3 'extension ''BuildReports