summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/List.hs
diff options
context:
space:
mode:
authorJoey Hess2016-03-25 14:04:40 -0400
committerJoey Hess2016-03-25 14:04:40 -0400
commit91d1833155a2e8be2c435d0a92a750cc9d2f30b5 (patch)
treebd9662a258b4b0544e19295a319b61086a201d6f /src/Propellor/Property/List.hs
parent48a05503493caeb80794a872b0e3b4482d5859ce (diff)
ported Property.List
I wanted to keep propertyList [foo, bar] working, but had some difficulty making the type class approach work. Anyway, that's unlikely to be useful, since foo and bar probably have different types, or could easiy have their types updated breaking it.
Diffstat (limited to 'src/Propellor/Property/List.hs')
-rw-r--r--src/Propellor/Property/List.hs104
1 files changed, 36 insertions, 68 deletions
diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs
index 74aa6ca6..b4a72fa8 100644
--- a/src/Propellor/Property/List.hs
+++ b/src/Propellor/Property/List.hs
@@ -1,86 +1,54 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Propellor.Property.List (
props,
- PropertyList(..),
- PropertyListType,
- PropList(..),
+ Props,
+ propertyList,
+ combineProperties,
) where
import Propellor.Types
+import Propellor.Types.MetaTypes
import Propellor.Engine
import Propellor.PropAccum
+import Propellor.Exception
import Data.Monoid
--- | Starts accumulating a list of properties.
+-- | Combines a list of properties, resulting in a single property
+-- that when run will run each property in the list in turn,
+-- and print out the description of each as it's run. Does not stop
+-- on failure; does propagate overall success/failure.
+--
+-- For example:
--
-- > propertyList "foo" $ props
--- > & someproperty
--- > ! oldproperty
--- > & otherproperty
-props :: PropList
-props = PropList []
-
-data PropList = PropList [Property HasInfo]
-
-instance PropAccum PropList where
- PropList l `addProp` p = PropList (toProp p : l)
- PropList l `addPropFront` p = PropList (l ++ [toProp p])
- getProperties (PropList l) = reverse l
-
-class PropertyList l where
- -- | Combines a list of properties, resulting in a single property
- -- that when run will run each property in the list in turn,
- -- and print out the description of each as it's run. Does not stop
- -- on failure; does propagate overall success/failure.
- --
- -- Note that Property HasInfo and Property NoInfo are not the same
- -- type, and so cannot be mixed in a list. To make a list of
- -- mixed types, which can also include RevertableProperty,
- -- use `props`
- propertyList :: Desc -> l -> Property (PropertyListType l)
-
- -- | Combines a list of properties, resulting in one property that
- -- ensures each in turn. Stops if a property fails.
- combineProperties :: Desc -> l -> Property (PropertyListType l)
-
--- | Type level function to calculate whether a PropertyList has Info.
-type family PropertyListType t
-type instance PropertyListType [Property HasInfo] = HasInfo
-type instance PropertyListType [Property NoInfo] = NoInfo
-type instance PropertyListType [RevertableProperty NoInfo] = NoInfo
-type instance PropertyListType [RevertableProperty HasInfo] = HasInfo
-type instance PropertyListType PropList = HasInfo
-
-instance PropertyList [Property NoInfo] where
- propertyList desc ps = simpleProperty desc (ensureProperties ps) ps
- combineProperties desc ps = simpleProperty desc (combineSatisfy ps NoChange) ps
-
-instance PropertyList [Property HasInfo] where
- -- It's ok to use ignoreInfo here, because the ps are made the
- -- child properties of the property, and so their info is visible
- -- that way.
- propertyList desc ps = infoProperty desc (ensureProperties $ map ignoreInfo ps) mempty ps
- combineProperties desc ps = infoProperty desc (combineSatisfy ps NoChange) mempty ps
-
-instance PropertyList [RevertableProperty HasInfo] where
- propertyList desc ps = propertyList desc (map setupRevertableProperty ps)
- combineProperties desc ps = combineProperties desc (map setupRevertableProperty ps)
-
-instance PropertyList [RevertableProperty NoInfo] where
- propertyList desc ps = propertyList desc (map setupRevertableProperty ps)
- combineProperties desc ps = combineProperties desc (map setupRevertableProperty ps)
-
-instance PropertyList PropList where
- propertyList desc = propertyList desc . getProperties
- combineProperties desc = combineProperties desc . getProperties
-
-combineSatisfy :: [Property i] -> Result -> Propellor Result
+-- > & bar
+-- > & baz
+propertyList :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
+propertyList desc (Props _i ps) =
+ property desc (ensureChildProperties cs)
+ `modifyChildren` (++ cs)
+ where
+ cs = map toProp ps
+
+-- | Combines a list of properties, resulting in one property that
+-- ensures each in turn. Stops if a property fails.
+combineProperties :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
+combineProperties desc (Props _i ps) =
+ property desc (combineSatisfy cs NoChange)
+ `modifyChildren` (++ cs)
+ where
+ cs = map toProp ps
+
+combineSatisfy :: [ChildProperty] -> Result -> Propellor Result
combineSatisfy [] rs = return rs
-combineSatisfy (l:ls) rs = do
- r <- ensureProperty $ ignoreInfo l
+combineSatisfy (p:ps) rs = do
+ r <- catchPropellor $ getSatisfy p
case r of
FailedChange -> return FailedChange
- _ -> combineSatisfy ls (r <> rs)
+ _ -> combineSatisfy ps (r <> rs)