summaryrefslogtreecommitdiff
path: root/src/Propellor/Types/MetaTypes.hs
diff options
context:
space:
mode:
authorJoey Hess2016-03-24 17:25:58 -0400
committerJoey Hess2016-03-24 17:28:20 -0400
commit83cd812ab5ac787769b34f59d1763f3c8648f06a (patch)
tree23b056fbe8616d34b623b58181e56225fcb939d6 /src/Propellor/Types/MetaTypes.hs
parent3d6a0d8663d32344a9f0761a144bfcacf9667378 (diff)
convert ensureProperty
Moved to its own module to keep everything related in one place.
Diffstat (limited to 'src/Propellor/Types/MetaTypes.hs')
-rw-r--r--src/Propellor/Types/MetaTypes.hs71
1 files changed, 10 insertions, 61 deletions
diff --git a/src/Propellor/Types/MetaTypes.hs b/src/Propellor/Types/MetaTypes.hs
index 7f7dae13..3d178641 100644
--- a/src/Propellor/Types/MetaTypes.hs
+++ b/src/Propellor/Types/MetaTypes.hs
@@ -9,46 +9,19 @@ module Propellor.Types.MetaTypes (
FreeBSD,
HasInfo,
type (+),
- OuterMetaTypes,
- ensureProperty,
- tightenTargets,
- pickOS,
Sing,
sing,
SingI,
Union,
IncludesInfo,
+ Targets,
+ NotSuperset,
+ CheckCombineTargets(..),
+ type (&&),
+ Not,
+ EqT,
) where
------ DEMO ----------
-
-foo :: Property (HasInfo + FreeBSD)
-foo = mkProperty' $ \t -> do
- ensureProperty t jail
-
-bar :: Property (Debian + FreeBSD)
-bar = aptinstall `pickOS` jail
-
-aptinstall :: Property Debian
-aptinstall = mkProperty $ do
- return ()
-
-jail :: Property FreeBSD
-jail = mkProperty $ do
- return ()
-
------ END DEMO ----------
-
-data Property metatypes = Property metatypes (IO ())
-
-mkProperty :: SingI l => IO () -> Property (Sing l)
-mkProperty = mkProperty' . const
-
-mkProperty' :: SingI l => (OuterMetaTypes l -> IO ()) -> Property (Sing l)
-mkProperty' a =
- let p = Property sing (a (outerMetaTypes p))
- in p
-
data MetaType
= Targeting OS -- ^ A target OS of a Property
| WithInfo -- ^ Indicates that a Property has associated Info
@@ -112,39 +85,13 @@ type instance Concat (a ': as) bs = a ': (Concat as bs)
type family IncludesInfo t :: Bool
type instance IncludesInfo (Sing l) = Elem 'WithInfo l
-newtype OuterMetaTypes l = OuterMetaTypes (Sing l)
-
-outerMetaTypes :: Property (Sing l) -> OuterMetaTypes l
-outerMetaTypes (Property metatypes _) = OuterMetaTypes metatypes
-
--- | Use `mkProperty''` to get the `OuterMetaTypes`. For example:
---
--- > foo = Property Debian
--- > foo = mkProperty' $ \t -> do
--- > ensureProperty t (aptInstall "foo")
---
--- The type checker will prevent using ensureProperty with a property
--- that does not support the target OSes needed by the OuterMetaTypes.
--- In the example above, aptInstall must support Debian.
---
--- The type checker will also prevent using ensureProperty with a property
--- with HasInfo in its MetaTypes. Doing so would cause the info associated
--- with the property to be lost.
-ensureProperty
- ::
- ( (Targets inner `NotSuperset` Targets outer) ~ 'CanCombineTargets
- , CannotUseEnsurePropertyWithInfo inner ~ 'True
- )
- => OuterMetaTypes outer
- -> Property (Sing inner)
- -> IO ()
-ensureProperty (OuterMetaTypes outermetatypes) (Property innermetatypes a) = a
-
-- The name of this was chosen to make type errors a more understandable.
type family CannotUseEnsurePropertyWithInfo (l :: [a]) :: Bool
type instance CannotUseEnsurePropertyWithInfo '[] = 'True
type instance CannotUseEnsurePropertyWithInfo (t ': ts) = Not (t `EqT` 'WithInfo) && CannotUseEnsurePropertyWithInfo ts
+{-
+
-- | Tightens the MetaType list of a Property, to contain fewer targets.
--
-- Anything else in the MetaType list is passed through unchanged.
@@ -178,6 +125,8 @@ pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io
-- system being run on.
io = undefined
+-}
+
data CheckCombineTargets = CannotCombineTargets | CanCombineTargets
-- | Detect intersection of two lists that don't have any common targets.