summaryrefslogtreecommitdiff
path: root/src/Propellor/PropAccum.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/PropAccum.hs')
-rw-r--r--src/Propellor/PropAccum.hs122
1 files changed, 60 insertions, 62 deletions
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index 85a30af5..d9fa8ec7 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -1,88 +1,86 @@
-{-# LANGUAGE PackageImports, FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DataKinds #-}
module Propellor.PropAccum
( host
- , PropAccum(..)
+ , Props(..)
+ , props
, (&)
, (&^)
, (!)
- , propagateContainer
) where
-import Data.Monoid
-
import Propellor.Types
+import Propellor.Types.MetaTypes
+import Propellor.Types.Core
import Propellor.Property
-import Propellor.Types.Info
-import Propellor.PrivData
--- | Starts accumulating the properties of a Host.
+import Data.Monoid
+import Prelude
+
+-- | Defines a host and its properties.
--
--- > host "example.com"
+-- > host "example.com" $ props
-- > & someproperty
-- > ! oldproperty
-- > & otherproperty
-host :: HostName -> Host
-host hn = Host hn [] mempty
+host :: HostName -> Props metatypes -> Host
+host hn (Props ps) = Host hn ps (mconcat (map getInfoRecursive ps))
--- | Something that can accumulate properties.
-class PropAccum h where
- -- | Adds a property.
- addProp :: IsProp p => h -> p -> h
+-- | Start accumulating a list of properties.
+--
+-- Properties can be added to it using `(&)` etc.
+props :: Props UnixLike
+props = Props []
- -- | Like addProp, but adds the property at the front of the list.
- addPropFront :: IsProp p => h -> p -> h
+infixl 1 &
+infixl 1 &^
+infixl 1 !
- getProperties :: h -> [Property HasInfo]
+type family GetMetaTypes x
+type instance GetMetaTypes (Property (MetaTypes t)) = MetaTypes t
+type instance GetMetaTypes (RevertableProperty (MetaTypes t) undo) = MetaTypes t
--- | Adds a property to a `Host` or other `PropAccum`
+-- | Adds a property to a Props.
--
-- Can add Properties and RevertableProperties
-(&) :: (PropAccum h, IsProp p) => h -> p -> h
-(&) = addProp
+(&)
+ ::
+ ( IsProp p
+ , MetaTypes y ~ GetMetaTypes p
+ , CheckCombinable x y ~ 'CanCombine
+ )
+ => Props (MetaTypes x)
+ -> p
+ -> Props (MetaTypes (Combine x y))
+Props c & p = Props (c ++ [toChildProperty p])
-- | Adds a property before any other properties.
-(&^) :: (PropAccum h, IsProp p) => h -> p -> h
-(&^) = addPropFront
+(&^)
+ ::
+ ( IsProp p
+ , MetaTypes y ~ GetMetaTypes p
+ , CheckCombinable x y ~ 'CanCombine
+ )
+ => Props (MetaTypes x)
+ -> p
+ -> Props (MetaTypes (Combine x y))
+Props c &^ p = Props (toChildProperty p : c)
-- | Adds a property in reverted form.
-(!) :: IsProp (RevertableProperty i) => PropAccum h => h -> RevertableProperty i -> h
-h ! p = h & revert p
+(!)
+ :: (CheckCombinable x z ~ 'CanCombine)
+ => Props (MetaTypes x)
+ -> RevertableProperty (MetaTypes y) (MetaTypes z)
+ -> Props (MetaTypes (Combine x z))
+Props c ! p = Props (c ++ [toChildProperty (revert p)])
-infixl 1 &
-infixl 1 &^
-infixl 1 !
-
-instance PropAccum Host where
- (Host hn ps is) `addProp` p = Host hn (ps ++ [toProp p])
- (is <> getInfoRecursive p)
- (Host hn ps is) `addPropFront` p = Host hn (toProp p : ps)
- (getInfoRecursive p <> is)
- getProperties = hostProperties
-
--- | Adjust the provided Property, adding to its
--- propertyChidren the properties of the provided container.
---
--- The Info of the propertyChildren is adjusted to only include
--- info that should be propagated out to the Property.
---
--- Any PrivInfo that uses HostContext is adjusted to use the name
--- of the container as its context.
-propagateContainer
- :: (PropAccum container)
- => String
- -> container
- -> Property HasInfo
- -> Property HasInfo
-propagateContainer containername c prop = infoProperty
- (propertyDesc prop)
- (propertySatisfy prop)
- (propertyInfo prop)
- (propertyChildren prop ++ hostprops)
- where
- hostprops = map go $ getProperties c
- go p =
- let i = mapInfo (forceHostContext containername)
- (propagatableInfo (propertyInfo p))
- cs = map go (propertyChildren p)
- in infoProperty (propertyDesc p) (propertySatisfy p) i cs
+-- addPropsHost :: Host -> [Prop] -> Host
+-- addPropsHost (Host hn ps i) p = Host hn ps' i'
+-- where
+-- ps' = ps ++ [toChildProperty p]
+-- i' = i <> getInfoRecursive p