diff options
| -rw-r--r-- | gnu/local.mk | 6 | ||||
| -rw-r--r-- | gnu/packages/patches/ganeti-lens-compat.patch | 40 | ||||
| -rw-r--r-- | gnu/packages/patches/ganeti-procps-compat.patch | 45 | ||||
| -rw-r--r-- | gnu/packages/patches/ganeti-relax-dependencies.patch | 28 | ||||
| -rw-r--r-- | gnu/packages/patches/ganeti-reorder-arbitrary-definitions.patch | 90 | ||||
| -rw-r--r-- | gnu/packages/patches/ganeti-template-haskell-2.17.patch | 69 | ||||
| -rw-r--r-- | gnu/packages/patches/ganeti-template-haskell-2.18.patch | 179 | ||||
| -rw-r--r-- | gnu/packages/virtualization.scm | 8 |
8 files changed, 464 insertions, 1 deletions
diff --git a/gnu/local.mk b/gnu/local.mk index 2b20606ca1..8a3c93c1c1 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -1178,9 +1178,15 @@ dist_patch_DATA = \ %D%/packages/patches/gajim-honour-GAJIM_PLUGIN_PATH.patch \ %D%/packages/patches/ganeti-disable-version-symlinks.patch \ %D%/packages/patches/ganeti-haskell-pythondir.patch \ + %D%/packages/patches/ganeti-lens-compat.patch \ %D%/packages/patches/ganeti-pyyaml-compat.patch \ + %D%/packages/patches/ganeti-procps-compat.patch \ + %D%/packages/patches/ganeti-reorder-arbitrary-definitions.patch \ + %D%/packages/patches/ganeti-relax-dependencies.patch \ %D%/packages/patches/ganeti-shepherd-master-failover.patch \ %D%/packages/patches/ganeti-shepherd-support.patch \ + %D%/packages/patches/ganeti-template-haskell-2.17.patch \ + %D%/packages/patches/ganeti-template-haskell-2.18.patch \ %D%/packages/patches/gawk-shell.patch \ %D%/packages/patches/gcc-arm-bug-71399.patch \ %D%/packages/patches/gcc-arm-link-spec-fix.patch \ diff --git a/gnu/packages/patches/ganeti-lens-compat.patch b/gnu/packages/patches/ganeti-lens-compat.patch new file mode 100644 index 0000000000..1b9108d78f --- /dev/null +++ b/gnu/packages/patches/ganeti-lens-compat.patch @@ -0,0 +1,40 @@ +Fix building against Lens 5 by commenting out type signatures(!). + +Taken from upstream: + + https://github.com/ganeti/ganeti/commit/5e30bad1bba63c9f6c782003ef2560f107a0ba24 + +diff --git a/src/Ganeti/Network.hs b/src/Ganeti/Network.hs +index 1cb6aa1ec..696c1cd1b 100644 +--- a/src/Ganeti/Network.hs ++++ b/src/Ganeti/Network.hs +@@ -87,11 +87,11 @@ data PoolPart = PoolInstances | PoolExt + addressPoolIso :: Iso' AddressPool BA.BitArray + addressPoolIso = iso apReservations AddressPool + +-poolLens :: PoolPart -> Lens' Network (Maybe AddressPool) ++--poolLens :: PoolPart -> Lens' Network (Maybe AddressPool) + poolLens PoolInstances = networkReservationsL + poolLens PoolExt = networkExtReservationsL + +-poolArrayLens :: PoolPart -> Lens' Network (Maybe BA.BitArray) ++--poolArrayLens :: PoolPart -> Lens' Network (Maybe BA.BitArray) + poolArrayLens part = poolLens part . mapping addressPoolIso + + netIpv4NumHosts :: Network -> Integer +diff --git a/src/Ganeti/Utils/MultiMap.hs b/src/Ganeti/Utils/MultiMap.hs +index d54da3ab0..279e9335a 100644 +--- a/src/Ganeti/Utils/MultiMap.hs ++++ b/src/Ganeti/Utils/MultiMap.hs +@@ -91,7 +91,7 @@ multiMap :: (Ord k, Ord v) => M.Map k (S.Set v) -> MultiMap k v + multiMap = MultiMap . M.filter (not . S.null) + + -- | A 'Lens' that allows to access a set under a given key in a multi-map. +-multiMapL :: (Ord k, Ord v) => k -> Lens' (MultiMap k v) (S.Set v) ++--multiMapL :: (Ord k, Ord v) => k -> Lens' (MultiMap k v) (S.Set v) + multiMapL k f = fmap MultiMap + . at k (fmap (mfilter (not . S.null) . Just) + . f . fromMaybe S.empty) +-- +2.41.0 + diff --git a/gnu/packages/patches/ganeti-procps-compat.patch b/gnu/packages/patches/ganeti-procps-compat.patch new file mode 100644 index 0000000000..a2145274cb --- /dev/null +++ b/gnu/packages/patches/ganeti-procps-compat.patch @@ -0,0 +1,45 @@ +Fix compatibility with procps 4. + +Negative UIDs are no longer allowed. Use a very high one instead. + +Taken from upstream: + + https://github.com/ganeti/ganeti/commit/9cd67e6a81c66ed326d68ea8c3241d14eea6550b + +diff --git a/test/py/ganeti.uidpool_unittest.py b/test/py/ganeti.uidpool_unittest.py +index b2f5bc5cf2..2d9227cbf5 100755 +--- a/test/py/ganeti.uidpool_unittest.py ++++ b/test/py/ganeti.uidpool_unittest.py +@@ -106,23 +106,24 @@ def testRequestUnusedUid(self): + + # Check with a single, known unused user-id + # +- # We use "-1" here, which is not a valid user-id, so it's +- # guaranteed that it's unused. +- uid = uidpool.RequestUnusedUid(set([-1])) +- self.assertEqualValues(uid.GetUid(), -1) ++ # We use 2^30+42 here, which is a valid UID, but unlikely to be used on ++ # most systems (even as a subuid). ++ free_uid = 2**30 + 42 ++ uid = uidpool.RequestUnusedUid(set([free_uid])) ++ self.assertEqualValues(uid.GetUid(), free_uid) + + # Check uid-pool exhaustion + # +- # uid "-1" is locked now, so RequestUnusedUid is expected to fail ++ # free_uid is locked now, so RequestUnusedUid is expected to fail + self.assertRaises(errors.LockError, + uidpool.RequestUnusedUid, +- set([-1])) ++ set([free_uid])) + + # Check unlocking + uid.Unlock() + # After unlocking, "-1" should be available again +- uid = uidpool.RequestUnusedUid(set([-1])) +- self.assertEqualValues(uid.GetUid(), -1) ++ uid = uidpool.RequestUnusedUid(set([free_uid])) ++ self.assertEqualValues(uid.GetUid(), free_uid) + + + if __name__ == "__main__": diff --git a/gnu/packages/patches/ganeti-relax-dependencies.patch b/gnu/packages/patches/ganeti-relax-dependencies.patch new file mode 100644 index 0000000000..521b410b9e --- /dev/null +++ b/gnu/packages/patches/ganeti-relax-dependencies.patch @@ -0,0 +1,28 @@ +Relax version constraints to work with Stackage LTS 19. + +Taken from upstream: + + https://github.com/ganeti/ganeti/commit/4f8d61ea0101721eae1c6f43be8430d819e5e611 + +diff --git a/cabal/ganeti.template.cabal b/cabal/ganeti.template.cabal +index bb4ff8053..98491dd9f 100644 +--- a/cabal/ganeti.template.cabal ++++ b/cabal/ganeti.template.cabal +@@ -63,14 +63,14 @@ library + , unix >= 2.5.1.0 + , utf8-string >= 0.3.7 + +- , attoparsec >= 0.10.1.1 && < 0.14 +- , base64-bytestring >= 1.0.0.1 && < 1.2 ++ , attoparsec >= 0.10.1.1 && < 0.15 ++ , base64-bytestring >= 1.0.0.1 && < 1.3 + , case-insensitive >= 0.4.0.1 && < 1.3 + , curl >= 1.3.7 && < 1.4 + , hinotify >= 0.3.2 && < 0.5 + , hslogger >= 1.1.4 && < 1.4 + , json >= 0.5 && < 1.0 +- , lens >= 3.10 && < 5.0 ++ , lens >= 3.10 && < 6.0 + , lifted-base >= 0.2.0.3 && < 0.3 + , monad-control >= 0.3.1.3 && < 1.1 + , parallel >= 3.2.0.2 && < 3.3 diff --git a/gnu/packages/patches/ganeti-reorder-arbitrary-definitions.patch b/gnu/packages/patches/ganeti-reorder-arbitrary-definitions.patch new file mode 100644 index 0000000000..ba34c0bdd6 --- /dev/null +++ b/gnu/packages/patches/ganeti-reorder-arbitrary-definitions.patch @@ -0,0 +1,90 @@ +Fix ordering of Arbitrary definitions for GHC 9 compatibility. + +Taken from upstream: + + https://github.com/ganeti/ganeti/commit/feab8faa8fe055c89205497e4f277ae4c7b8caad + +diff --git a/test/hs/Test/Ganeti/Objects.hs b/test/hs/Test/Ganeti/Objects.hs +index 97ceb36dca..8d80be9e80 100644 +--- a/test/hs/Test/Ganeti/Objects.hs ++++ b/test/hs/Test/Ganeti/Objects.hs +@@ -93,8 +93,14 @@ instance Arbitrary (Container DataCollectorConfig) where + instance Arbitrary BS.ByteString where + arbitrary = genPrintableByteString + ++instance Arbitrary a => Arbitrary (Private a) where ++ arbitrary = Private <$> arbitrary ++ + $(genArbitrary ''PartialNDParams) + ++instance Arbitrary (Container J.JSValue) where ++ arbitrary = return $ GenericContainer Map.empty ++ + instance Arbitrary Node where + arbitrary = Node <$> genFQDN <*> genFQDN <*> genFQDN + <*> arbitrary <*> arbitrary <*> arbitrary <*> genFQDN +@@ -297,10 +303,6 @@ genDisk = genDiskWithChildren 3 + -- validation rules. + $(genArbitrary ''PartialISpecParams) + +--- | FIXME: This generates completely random data, without normal +--- validation rules. +-$(genArbitrary ''PartialIPolicy) +- + $(genArbitrary ''FilledISpecParams) + $(genArbitrary ''MinMaxISpecs) + $(genArbitrary ''FilledIPolicy) +@@ -309,6 +311,10 @@ $(genArbitrary ''FilledNDParams) + $(genArbitrary ''FilledNicParams) + $(genArbitrary ''FilledBeParams) + ++-- | FIXME: This generates completely random data, without normal ++-- validation rules. ++$(genArbitrary ''PartialIPolicy) ++ + -- | No real arbitrary instance for 'ClusterHvParams' yet. + instance Arbitrary ClusterHvParams where + arbitrary = return $ GenericContainer Map.empty +@@ -331,18 +337,12 @@ instance Arbitrary OsParams where + instance Arbitrary Objects.ClusterOsParamsPrivate where + arbitrary = (GenericContainer . Map.fromList) <$> arbitrary + +-instance Arbitrary a => Arbitrary (Private a) where +- arbitrary = Private <$> arbitrary +- + instance Arbitrary ClusterOsParams where + arbitrary = (GenericContainer . Map.fromList) <$> arbitrary + + instance Arbitrary ClusterBeParams where + arbitrary = (GenericContainer . Map.fromList) <$> arbitrary + +-instance Arbitrary IAllocatorParams where +- arbitrary = return $ GenericContainer Map.empty +- + $(genArbitrary ''Cluster) + + instance Arbitrary ConfigData where +diff --git a/test/hs/Test/Ganeti/Query/Language.hs b/test/hs/Test/Ganeti/Query/Language.hs +index 04fb8c3898..fa50196f00 100644 +--- a/test/hs/Test/Ganeti/Query/Language.hs ++++ b/test/hs/Test/Ganeti/Query/Language.hs +@@ -59,6 +59,9 @@ import Ganeti.Query.Language + instance Arbitrary (Filter FilterField) where + arbitrary = genFilter + ++instance Arbitrary FilterRegex where ++ arbitrary = genName >>= mkRegex -- a name should be a good regex ++ + -- | Custom 'Filter' generator (top-level), which enforces a + -- (sane) limit on the depth of the generated filters. + genFilter :: Gen (Filter FilterField) +@@ -97,9 +100,6 @@ $(genArbitrary ''QueryTypeLuxi) + + $(genArbitrary ''ItemType) + +-instance Arbitrary FilterRegex where +- arbitrary = genName >>= mkRegex -- a name should be a good regex +- + $(genArbitrary ''ResultStatus) + + $(genArbitrary ''FieldType) diff --git a/gnu/packages/patches/ganeti-template-haskell-2.17.patch b/gnu/packages/patches/ganeti-template-haskell-2.17.patch new file mode 100644 index 0000000000..be5948bb96 --- /dev/null +++ b/gnu/packages/patches/ganeti-template-haskell-2.17.patch @@ -0,0 +1,69 @@ +Handle GHC 9 changes in a backwards compatible manner. + +Taken from upstream: + + https://github.com/ganeti/ganeti/commit/b279fa738fd5b30320584f79f4d2f0e894315aab + +diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs +index 818c11f84..9ab93d5e3 100644 +--- a/src/Ganeti/THH.hs ++++ b/src/Ganeti/THH.hs +@@ -884,7 +884,7 @@ genLoadOpCode opdefs fn = do + ) $ zip mexps opdefs + defmatch = Match WildP (NormalB fails) [] + cst = NoBindS $ CaseE (VarE opid) $ mpats++[defmatch] +- body = DoE [st, cst] ++ body = mkDoE [st, cst] + -- include "OP_ID" to the list of used keys + bodyAndOpId <- [| $(return body) + <* tell (mkUsedKeys . S.singleton . T.pack $ opidKey) |] +@@ -1541,7 +1541,7 @@ loadExcConstructor inname sname fields = do + [x] -> BindS (ListP [VarP x]) + _ -> BindS (TupP (map VarP f_names)) + cval = appCons name $ map VarE f_names +- return $ DoE [binds read_args, NoBindS (AppE (VarE 'return) cval)] ++ return $ mkDoE [binds read_args, NoBindS (AppE (VarE 'return) cval)] + + {-| Generates the loadException function. + +diff --git a/src/Ganeti/THH/Compat.hs b/src/Ganeti/THH/Compat.hs +index d29e30d18..1f51e49d7 100644 +--- a/src/Ganeti/THH/Compat.hs ++++ b/src/Ganeti/THH/Compat.hs +@@ -40,9 +40,11 @@ module Ganeti.THH.Compat + , extractDataDConstructors + , myNotStrict + , nonUnaryTupE ++ , mkDoE + ) where + + import Language.Haskell.TH ++import Language.Haskell.TH.Syntax + + -- | Convert Names to DerivClauses + -- +@@ -61,7 +63,11 @@ derivesFromNames names = map ConT names + -- + -- Handle TH 2.11 and 2.12 changes in a transparent manner using the pre-2.11 + -- API. ++#if MIN_VERSION_template_haskell(2,17,0) ++gntDataD :: Cxt -> Name -> [TyVarBndr ()] -> [Con] -> [Name] -> Dec ++#else + gntDataD :: Cxt -> Name -> [TyVarBndr] -> [Con] -> [Name] -> Dec ++#endif + gntDataD x y z a b = + #if MIN_VERSION_template_haskell(2,12,0) + DataD x y z Nothing a $ derivesFromNames b +@@ -114,3 +120,12 @@ nonUnaryTupE es = TupE $ map Just es + #else + nonUnaryTupE es = TupE $ es + #endif ++ ++-- | DoE is now qualified with an optional ModName ++mkDoE :: [Stmt] -> Exp ++mkDoE s = ++#if MIN_VERSION_template_haskell(2,17,0) ++ DoE Nothing s ++#else ++ DoE s ++#endif diff --git a/gnu/packages/patches/ganeti-template-haskell-2.18.patch b/gnu/packages/patches/ganeti-template-haskell-2.18.patch new file mode 100644 index 0000000000..e7be869636 --- /dev/null +++ b/gnu/packages/patches/ganeti-template-haskell-2.18.patch @@ -0,0 +1,179 @@ +Fix compatibility with Template Haskell 2.18 and GHC 9.2. + + +diff --git a/src/Ganeti/BasicTypes.hs b/src/Ganeti/BasicTypes.hs +index 10d0426cd..d68bc7d5b 100644 +--- a/src/Ganeti/BasicTypes.hs ++++ b/src/Ganeti/BasicTypes.hs +@@ -206,12 +206,12 @@ instance MonadTrans (ResultT a) where + instance (MonadIO m, Error a) => MonadIO (ResultT a m) where + liftIO = ResultT . liftIO + . liftM (either (failError . show) return) +- . (try :: IO a -> IO (Either IOError a)) ++ . (try :: IO α -> IO (Either IOError α)) + + instance (MonadBase IO m, Error a) => MonadBase IO (ResultT a m) where + liftBase = ResultT . liftBase + . liftM (either (failError . show) return) +- . (try :: IO a -> IO (Either IOError a)) ++ . (try :: IO α -> IO (Either IOError α)) + + instance (Error a) => MonadTransControl (ResultT a) where + #if MIN_VERSION_monad_control(1,0,0) +diff --git a/src/Ganeti/Lens.hs b/src/Ganeti/Lens.hs +index faa5900ed..747366e6a 100644 +--- a/src/Ganeti/Lens.hs ++++ b/src/Ganeti/Lens.hs +@@ -93,14 +93,14 @@ makeCustomLenses' name lst = makeCustomLensesFiltered f name + -- Most often the @g@ functor is @(,) r@ and 'traverseOf2' is used to + -- traverse an effectful computation that also returns an additional output + -- value. +-traverseOf2 :: Over (->) (Compose f g) s t a b +- -> (a -> f (g b)) -> s -> f (g t) ++-- traverseOf2 :: Over (->) (Compose f g) s t a b ++-- -> (a -> f (g b)) -> s -> f (g t) + traverseOf2 k f = getCompose . traverseOf k (Compose . f) + + -- | Traverses over a composition of a monad and a functor. + -- See 'traverseOf2'. +-mapMOf2 :: Over (->) (Compose (WrappedMonad m) g) s t a b +- -> (a -> m (g b)) -> s -> m (g t) ++-- mapMOf2 :: Over (->) (Compose (WrappedMonad m) g) s t a b ++-- -> (a -> m (g b)) -> s -> m (g t) + mapMOf2 k f = unwrapMonad . traverseOf2 k (WrapMonad . f) + + -- | A helper lens over sets. +diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs +index 9ab93d5e3..9a10a9a07 100644 +--- a/src/Ganeti/THH.hs ++++ b/src/Ganeti/THH.hs +@@ -996,8 +996,8 @@ buildAccessor fnm fpfx rnm rpfx nm pfx field = do + f_body = AppE (VarE fpfx_name) $ VarE x + return $ [ SigD pfx_name $ ArrowT `AppT` ConT nm `AppT` ftype + , FunD pfx_name +- [ Clause [ConP rnm [VarP x]] (NormalB r_body) [] +- , Clause [ConP fnm [VarP x]] (NormalB f_body) [] ++ [ Clause [myConP rnm [VarP x]] (NormalB r_body) [] ++ , Clause [myConP fnm [VarP x]] (NormalB f_body) [] + ]] + + -- | Build lense declartions for a field. +@@ -1037,10 +1037,10 @@ buildLens (fnm, fdnm) (rnm, rdnm) nm pfx ar (field, i) = do + (ConE cdn) + $ zip [0..] vars + let setterE = LamE [VarP context, VarP var] $ CaseE (VarE context) +- [ Match (ConP fnm [ConP fdnm . set (element i) WildP ++ [ Match (myConP fnm [myConP fdnm . set (element i) WildP + $ map VarP vars]) + (body (not isSimple) fnm fdnm) [] +- , Match (ConP rnm [ConP rdnm . set (element i) WildP ++ , Match (myConP rnm [myConP rdnm . set (element i) WildP + $ map VarP vars]) + (body False rnm rdnm) [] + ] +@@ -1098,9 +1098,9 @@ buildObjectWithForthcoming sname field_pfx fields = do + $ JSON.showJSON $(varE x) |] + let rdjson = FunD 'JSON.readJSON [Clause [] (NormalB read_body) []] + shjson = FunD 'JSON.showJSON +- [ Clause [ConP (mkName real_nm) [VarP x]] ++ [ Clause [myConP (mkName real_nm) [VarP x]] + (NormalB show_real_body) [] +- , Clause [ConP (mkName forth_nm) [VarP x]] ++ , Clause [myConP (mkName forth_nm) [VarP x]] + (NormalB show_forth_body) [] + ] + instJSONdecl = gntInstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) +@@ -1121,9 +1121,9 @@ buildObjectWithForthcoming sname field_pfx fields = do + (fromDictWKeys $(varE xs)) |] + todictx_r <- [| toDict $(varE x) |] + todictx_f <- [| ("forthcoming", JSON.JSBool True) : toDict $(varE x) |] +- let todict = FunD 'toDict [ Clause [ConP (mkName real_nm) [VarP x]] ++ let todict = FunD 'toDict [ Clause [myConP (mkName real_nm) [VarP x]] + (NormalB todictx_r) [] +- , Clause [ConP (mkName forth_nm) [VarP x]] ++ , Clause [myConP (mkName forth_nm) [VarP x]] + (NormalB todictx_f) [] + ] + fromdict = FunD 'fromDictWKeys [ Clause [VarP xs] +@@ -1136,9 +1136,9 @@ buildObjectWithForthcoming sname field_pfx fields = do + let forthPredDecls = [ SigD forthPredName + $ ArrowT `AppT` ConT name `AppT` ConT ''Bool + , FunD forthPredName +- [ Clause [ConP (mkName real_nm) [WildP]] ++ [ Clause [myConP (mkName real_nm) [WildP]] + (NormalB $ ConE 'False) [] +- , Clause [ConP (mkName forth_nm) [WildP]] ++ , Clause [myConP (mkName forth_nm) [WildP]] + (NormalB $ ConE 'True) [] + ] + ] +@@ -1412,9 +1412,9 @@ savePParamField fvar field = do + normalexpr <- saveObjectField actualVal field + -- we have to construct the block here manually, because we can't + -- splice-in-splice +- return $ CaseE (VarE fvar) [ Match (ConP 'Nothing []) ++ return $ CaseE (VarE fvar) [ Match (myConP 'Nothing []) + (NormalB (ConE '[])) [] +- , Match (ConP 'Just [VarP actualVal]) ++ , Match (myConP 'Just [VarP actualVal]) + (NormalB normalexpr) [] + ] + +@@ -1440,9 +1440,9 @@ fillParam sname field_pfx fields = do + -- due to apparent bugs in some older GHC versions, we need to add these + -- prefixes to avoid "binding shadows ..." errors + fbinds <- mapM (newName . ("f_" ++) . nameBase) fnames +- let fConP = ConP name_f (map VarP fbinds) ++ let fConP = myConP name_f (map VarP fbinds) + pbinds <- mapM (newName . ("p_" ++) . nameBase) pnames +- let pConP = ConP name_p (map VarP pbinds) ++ let pConP = myConP name_p (map VarP pbinds) + -- PartialParams instance -------- + -- fillParams + let fromMaybeExp fn pn = AppE (AppE (VarE 'fromMaybe) (VarE fn)) (VarE pn) +@@ -1462,7 +1462,7 @@ fillParam sname field_pfx fields = do + memptyClause = Clause [] (NormalB memptyExp) [] + -- mappend + pbinds2 <- mapM (newName . ("p2_" ++) . nameBase) pnames +- let pConP2 = ConP name_p (map VarP pbinds2) ++ let pConP2 = myConP name_p (map VarP pbinds2) + -- note the reversal of 'l' and 'r' in the call to <|> + -- as we want the result to be the rightmost value + let altExp = zipWith (\l r -> AppE (AppE (VarE '(<|>)) (VarE r)) (VarE l)) +@@ -1575,9 +1575,9 @@ genLoadExc tname sname opdefs = do + opdefs + -- the first function clause; we can't use [| |] due to TH + -- limitations, so we have to build the AST by hand +- let clause1 = Clause [ConP 'JSON.JSArray +- [ListP [ConP 'JSON.JSString [VarP exc_name], +- VarP exc_args]]] ++ let clause1 = Clause [myConP 'JSON.JSArray ++ [ListP [myConP 'JSON.JSString [VarP exc_name], ++ VarP exc_args]]] + (NormalB (CaseE (AppE (VarE 'JSON.fromJSString) + (VarE exc_name)) + (str_matches ++ [defmatch]))) [] +diff --git a/src/Ganeti/THH/Compat.hs b/src/Ganeti/THH/Compat.hs +index 1f51e49d7..9b07c47ef 100644 +--- a/src/Ganeti/THH/Compat.hs ++++ b/src/Ganeti/THH/Compat.hs +@@ -41,6 +41,7 @@ module Ganeti.THH.Compat + , myNotStrict + , nonUnaryTupE + , mkDoE ++ , myConP + ) where + + import Language.Haskell.TH +@@ -129,3 +130,11 @@ mkDoE s = + #else + DoE s + #endif ++ ++-- | ConP is now qualified with an optional [Type]. ++myConP :: Name -> [Pat] -> Pat ++myConP n patterns = ConP n ++#if MIN_VERSION_template_haskell(2,18,0) ++ [] ++#endif ++ patterns diff --git a/gnu/packages/virtualization.scm b/gnu/packages/virtualization.scm index 4ae0049269..5c5225b694 100644 --- a/gnu/packages/virtualization.scm +++ b/gnu/packages/virtualization.scm @@ -668,7 +668,13 @@ firmware blobs. You can "ganeti-shepherd-master-failover.patch" "ganeti-haskell-pythondir.patch" "ganeti-pyyaml-compat.patch" - "ganeti-disable-version-symlinks.patch")))) + "ganeti-procps-compat.patch" + "ganeti-disable-version-symlinks.patch" + "ganeti-lens-compat.patch" + "ganeti-template-haskell-2.17.patch" + "ganeti-template-haskell-2.18.patch" + "ganeti-reorder-arbitrary-definitions.patch" + "ganeti-relax-dependencies.patch")))) (build-system gnu-build-system) (arguments `(#:imported-modules (,@%gnu-build-system-modules |