propellor 5.14.1 → 5.15
raw patch · 7 files changed
+59/−49 lines, 7 files
Files
- CHANGELOG +11/−4
- debian/changelog +11/−4
- propellor.cabal +2/−2
- src/Propellor/Property/Apt/PPA.hs +8/−11
- src/Propellor/Property/ZFS/Process.hs +4/−1
- src/Propellor/Types/MetaTypes.hs +20/−21
- src/Propellor/Types/Singletons.hs +3/−6
CHANGELOG view
@@ -1,9 +1,16 @@-propellor (5.14.1) unstable; urgency=medium+propellor (5.15) unstable; urgency=medium - * Fix config.hs example, which was accidentially joeyconfig.hs in the- previous release.+ * Improve propellor's MetaTypes implementation to avoid an expontential+ blowup when several MetaTypes fail to unify. This should result in less+ memory use by ghc when there's a type error.+ * Avoid OOM when built by ghc 9.2.+ * Thanks to the ghc developers for their assistance, particularly spj+ and Sam Derbyshire.+ * Remove workaround to ghc using a lot of memory displaying an error+ message about a property of a host having the wrong number of+ arguments. This brings back clear error messages in such situations. - -- Joey Hess <id@joeyh.name> Sat, 15 Oct 2022 14:44:01 -0400+ -- Joey Hess <id@joeyh.name> Tue, 15 Nov 2022 15:34:11 -0400 propellor (5.14) unstable; urgency=medium
debian/changelog view
@@ -1,9 +1,16 @@-propellor (5.14.1) unstable; urgency=medium+propellor (5.15) unstable; urgency=medium - * Fix config.hs example, which was accidentially joeyconfig.hs in the- previous release.+ * Improve propellor's MetaTypes implementation to avoid an expontential+ blowup when several MetaTypes fail to unify. This should result in less+ memory use by ghc when there's a type error.+ * Avoid OOM when built by ghc 9.2.+ * Thanks to the ghc developers for their assistance, particularly spj+ and Sam Derbyshire.+ * Remove workaround to ghc using a lot of memory displaying an error+ message about a property of a host having the wrong number of+ arguments. This brings back clear error messages in such situations. - -- Joey Hess <id@joeyh.name> Sat, 15 Oct 2022 14:44:01 -0400+ -- Joey Hess <id@joeyh.name> Tue, 15 Nov 2022 15:34:11 -0400 propellor (5.14) unstable; urgency=medium
propellor.cabal view
@@ -1,5 +1,5 @@ Name: propellor-Version: 5.14.1+Version: 5.15 Cabal-Version: 1.20 License: BSD2 Maintainer: Joey Hess <id@joeyh.name>@@ -36,7 +36,7 @@ It is configured using haskell. Flag WithTypeErrors- Description: Build with type-errors library for better error messages and less memory use+ Description: Build with type-errors library for better error messages Library Default-Language: Haskell2010
src/Propellor/Property/Apt/PPA.hs view
@@ -31,12 +31,11 @@ instance IsString PPA where -- | Parse strings like "ppa:zfs-native/stable" into a PPA.- fromString s =- let- [_, ppa] = split "ppa:" s- [acct, arch] = split "/" ppa- in- PPA acct arch+ fromString s = case split "ppa:" s of+ [_, ppa] -> case split "/" ppa of+ [acct, arch] -> PPA acct arch+ _ -> PPA s s+ _ -> PPA s s -- | Adds a PPA to the local system repositories. addPpa :: PPA -> Property DebianLike@@ -89,11 +88,9 @@ val asrc = unwords ["deb", asURL asrc, asSuite asrc, unwords . asComponents $ asrc] instance IsString AptSource where- fromString s =- let- url:suite:comps = drop 1 . words $ s- in- AptSource url suite comps+ fromString s = case drop 1 (words s) of+ url:suite:comps -> AptSource url suite comps+ _ -> AptSource s s [] -- | A repository for apt-add-source, either a PPA or a regular repository line. data AptRepository = AptRepositoryPPA PPA | AptRepositorySource AptSource
src/Propellor/Property/ZFS/Process.hs view
@@ -12,8 +12,11 @@ -- | Gets the properties of a ZFS volume. zfsGetProperties :: ZFS -> IO ZFSProperties zfsGetProperties z =- let plist = fromPropertyList . map (\(_:k:v:_) -> (k, v)) . (map (split "\t"))+ let plist = fromPropertyList . mapMaybe parse . (map (split "\t")) in plist <$> runZfs "get" [Just "-H", Just "-p", Just "all"] z+ where+ parse (_:k:v:_) = Just (k, v)+ parse _ = Nothing zfsExists :: ZFS -> IO Bool zfsExists z = any id . map (isInfixOf (zfsName z))
src/Propellor/Types/MetaTypes.hs view
@@ -41,6 +41,7 @@ import GHC.TypeLits hiding (type (+)) import GHC.Exts (Constraint) import Data.Type.Bool+import Data.Kind (Type) #ifdef WITH_TYPE_ERRORS import Type.Errors@@ -118,7 +119,7 @@ -- Which is shorthand for this type: -- -- > MetaTypes '[WithInfo, Targeting OSDebian]-type family a + b :: * where+type family a + b :: Type where (MetaTypes a) + (MetaTypes b) = MetaTypes (Concat a b) type family Concat (list1 :: [a]) (list2 :: [a]) :: [a] where@@ -128,11 +129,22 @@ -- | Combine two MetaTypes lists, yielding a list -- that has targets present in both, and nontargets present in either. type family Combine (list1 :: [a]) (list2 :: [a]) :: [a] where- Combine (list1 :: [a]) (list2 :: [a]) =- (Concat- (NonTargets list1 `Union` NonTargets list2)- (Targets list1 `Intersect` Targets list2)- )+ Combine ('WithInfo : list1) ('WithInfo : list2) = 'WithInfo ':+ list1 `Intersect` list2+ Combine ('WithInfo : list1) list2 = 'WithInfo ':+ list1 `Intersect` list2+ Combine list1 ('WithInfo : list2) = 'WithInfo ':+ list1 `Intersect` list2+ Combine list1 list2 =+ list1 `Intersect` list2+ -- This is a cleaner implementation, but it causes an exponential+ -- blowup of the type checker due to referencing list1 twice on+ -- the right hand side.+ -- Combine (list1 :: [a]) (list2 :: [a]) =+ -- (Concat+ -- (NonTargets list1 `Union` NonTargets list2)+ -- (Targets list1 `Intersect` Targets list2)+ -- ) -- | Checks if two MetaTypes lists can be safly combined; -- eg they have at least one Target in common.@@ -172,7 +184,7 @@ type family CannotCombine (list1 :: [a]) (list2 :: [a]) (note :: Maybe ErrorMessage) :: Constraint where -- Checking IfStuck is to avoid ugly error -- message leaking type families from this module.- CannotCombine list1 list2 'Nothing = + CannotCombine list1 list2 note = IfStuck list1 (IfStuck list2 (DelayError (CannotCombineMessage UnknownType UnknownType UnknownTypeNote))@@ -180,21 +192,8 @@ ) (IfStuck list2 (DelayError (CannotCombineMessage (PrettyPrintMetaTypes list1) UnknownType UnknownTypeNote))- (DelayErrorFcf (CannotCombineMessage (PrettyPrintMetaTypes list1) (PrettyPrintMetaTypes list2) 'Nothing))+ (DelayErrorFcf (CannotCombineMessage (PrettyPrintMetaTypes list1) (PrettyPrintMetaTypes list2) note)) )- -- When there's a note, don't display the MetaTypes at all.- -- This is because the note is used when eg, combining properties- -- in a host with (&), and in that case, it's likely that the- -- problem resulted in the type checker getting stuck, and that- -- displaying the MetaTypes would involve a massive error messsage.- -- Displaying, or even checking IfStuck in that case can result in- -- huge amounts of memory being used by ghc. So, avoid it, and let- -- the note point the user in the right direction to fixing their- -- mistake.- CannotCombine list1 list2 ('Just note) = - TypeError ('Text "Cannot combine two Properties."- ':$$: 'Text "(They may have conflicting MetaTypes, or the wrong number of arguments.)"- ':$$: note) type family UnknownType :: ErrorMessage where UnknownType = 'Text "<unknown>"
src/Propellor/Types/Singletons.hs view
@@ -1,17 +1,14 @@ {-# LANGUAGE CPP, DataKinds, PolyKinds, TypeOperators, TypeFamilies, GADTs, FlexibleContexts #-} --- | Simple implementation of singletons, portable back to ghc 7.6.3+-- | Simple implementation of singletons, portable back to ghc 8.0.1 module Propellor.Types.Singletons ( module Propellor.Types.Singletons, KProxy(..) ) where -#if __GLASGOW_HASKELL__ > 707+import Data.Kind (Type) import Data.Proxy (KProxy(..))-#else-data KProxy (a :: *) = KProxy-#endif -- | The data family of singleton types. data family Sing (x :: k)@@ -34,7 +31,7 @@ instance SingI 'False where sing = FalseS class (kparam ~ 'KProxy) => SingKind (kparam :: KProxy k) where- type DemoteRep kparam :: *+ type DemoteRep kparam :: Type -- | From singleton to value. fromSing :: Sing (a :: k) -> DemoteRep kparam