summaryrefslogtreecommitdiff
path: root/src/Propellor/Types.hs
diff options
context:
space:
mode:
authorJoey Hess2019-07-02 14:39:51 -0400
committerJoey Hess2019-07-02 14:52:22 -0400
commit1c12b89a671152d7da4630b41b48815eefc8c2fe (patch)
tree32834084533111b921e92a5106d781454f9d36ef /src/Propellor/Types.hs
parent60a655ebe4e0dfdfbca9681cd204f60eb432b40b (diff)
use ConstraintKinds
This is just a bit prettier code than manually needing to use constraint ~ True
Diffstat (limited to 'src/Propellor/Types.hs')
-rw-r--r--src/Propellor/Types.hs16
1 files changed, 9 insertions, 7 deletions
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 0a3dd122..0d9b3d6b 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -4,6 +4,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
@@ -46,6 +47,7 @@ module Propellor.Types (
) where
import GHC.TypeLits hiding (type (+))
+import GHC.Exts (Constraint)
import Data.Type.Bool
import qualified Data.Semigroup as Sem
import Data.Monoid
@@ -188,17 +190,17 @@ class Combines x y where
-> y
-> CombinedType x y
-instance (CheckCombinable x y ~ 'True, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (Property (MetaTypes y)) where
+instance (CheckCombinable x y, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (Property (MetaTypes y)) where
combineWith f _ (Property _ d1 a1 i1 c1) (Property _ d2 a2 i2 c2) =
Property sing d1 (f a1 a2) i1 (ChildProperty d2 a2 i2 c2 : c1)
-instance (CheckCombinable x y ~ 'True, CheckCombinable x' y' ~ 'True, SingI (Combine x y), SingI (Combine x' y')) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) where
+instance (CheckCombinable x y, CheckCombinable x' y', SingI (Combine x y), SingI (Combine x' y')) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (RevertableProperty (MetaTypes y) (MetaTypes y')) where
combineWith sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) =
RevertableProperty
(combineWith sf tf s1 s2)
(combineWith tf sf t1 t2)
-instance (CheckCombinable x y ~ 'True, SingI (Combine x y)) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) where
+instance (CheckCombinable x y, SingI (Combine x y)) => Combines (RevertableProperty (MetaTypes x) (MetaTypes x')) (Property (MetaTypes y)) where
combineWith sf tf (RevertableProperty x _) y = combineWith sf tf x y
-instance (CheckCombinable x y ~ 'True, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) where
+instance (CheckCombinable x y, SingI (Combine x y)) => Combines (Property (MetaTypes x)) (RevertableProperty (MetaTypes y) (MetaTypes y')) where
combineWith sf tf x (RevertableProperty y _) = combineWith sf tf x y
class TightenTargets p where
@@ -212,18 +214,18 @@ class TightenTargets p where
-- > upgraded = tightenTargets $ cmdProperty "apt-get" ["upgrade"]
tightenTargets
::
- ( TightenTargetsAllowed untightened tightened ~ 'True
+ ( TightenTargetsAllowed untightened tightened
, SingI tightened
)
=> p (MetaTypes untightened)
-> p (MetaTypes tightened)
-- Note that this uses PolyKinds
-type family TightenTargetsAllowed untightened tightened where
+type family TightenTargetsAllowed untightened tightened :: Constraint where
TightenTargetsAllowed untightened tightened =
If (Targets tightened `IsSubset` Targets untightened
&& NonTargets untightened `IsSubset` NonTargets tightened)
- 'True
+ ('True ~ 'True)
(IfStuck (Targets tightened)
(DelayError
('Text "Unable to infer desired Property type in this use of tightenTargets."