summaryrefslogtreecommitdiff
path: root/src/Propellor/Property.hs
diff options
context:
space:
mode:
authorJoey Hess2016-03-24 20:20:34 -0400
committerJoey Hess2016-03-24 20:27:47 -0400
commite3a44ab5825466f9db9c4749497445bd0af1068e (patch)
tree038e97af1b86be7d7121023448046b0e712faea7 /src/Propellor/Property.hs
parent16ea40620ef2dbd62a2e8d5d8eb153e03d0c5848 (diff)
add tightenTargets, ported Network properties (DebinLike only)
Diffstat (limited to 'src/Propellor/Property.hs')
-rw-r--r--src/Propellor/Property.hs47
1 files changed, 47 insertions, 0 deletions
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 27d17135..cab233d0 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -1,5 +1,8 @@
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
module Propellor.Property (
-- * Property combinators
@@ -20,6 +23,7 @@ module Propellor.Property (
, property
, property'
, ensureProperty
+ , tightenTargets
--, withOS
, unsupportedOS
, makeChange
@@ -240,6 +244,49 @@ isNewerThan x y = do
where
mtime f = catchMaybeIO $ modificationTimeHiRes <$> getFileStatus f
+-- | Tightens the MetaType list of a Property, to contain fewer targets.
+--
+-- Anything else in the MetaType list is passed through unchanged.
+--
+-- For example, to make a property that uses apt-get, which is only
+-- available on DebianLike systems:
+--
+-- > upgraded :: Property DebianLike
+-- > upgraded = tightenTargets $ cmdProperty "apt-get" ["upgrade"]
+tightenTargets
+ ::
+ -- Note that this uses PolyKinds
+ ( (Targets old `NotSuperset` Targets new) ~ CanCombineTargets
+ , (NonTargets new `NotSuperset` NonTargets old) ~ CanCombineTargets
+ , SingI new
+ )
+ => Property (Sing old)
+ -> Property (Sing new)
+tightenTargets (Property old d a i c) = Property sing d a i c
+
+{-
+
+-- | Picks one of the two input properties to use,
+-- depending on the targeted OS.
+--
+-- If both input properties support the targeted OS, then the
+-- first will be used.
+pickOS
+ ::
+ ( combined ~ Union a b
+ , SingI combined
+ )
+ => Property (Sing a)
+ -> Property (Sing b)
+ -> Property (Sing combined)
+pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io
+ where
+ -- TODO pick with of ioa or iob to use based on final OS of
+ -- system being run on.
+ io = undefined
+
+-}
+
-- | Makes a property that is satisfied differently depending on the host's
-- operating system.
--