summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2016-03-25 13:11:55 -0400
committerJoey Hess2016-03-25 13:11:55 -0400
commit48a05503493caeb80794a872b0e3b4482d5859ce (patch)
treef975c9efa43262c7f1834313a18c6de825f376b3
parenta7560c9677485dbecd7283aedf977c4653cfacb4 (diff)
ported PropAccum
Was not able to keep it a type class -- the type checker got too confused. (Or I did.) So, Host, Docker, and Chroot now need to be passed a Props, which is constructed using props. This is a small user-visible API change, but acceptable.
-rw-r--r--src/Propellor/PropAccum.hs85
1 files changed, 54 insertions, 31 deletions
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index 7c838c92..fb38e260 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -1,8 +1,14 @@
-{-# LANGUAGE PackageImports, FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DataKinds #-}
module Propellor.PropAccum
( host
- , PropAccum(..)
+ , Props(..)
+ , props
, (&)
, (&^)
, (!)
@@ -12,53 +18,70 @@ module Propellor.PropAccum
import Data.Monoid
import Propellor.Types
+import Propellor.Types.MetaTypes
import Propellor.Property
import Propellor.Types.Info
import Propellor.PrivData
--- | Starts accumulating the properties of a Host.
+-- | 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 i c) = Host hn c i
--- | Something that can accumulate properties.
-class PropAccum h where
- -- | Adds a property.
- addProp :: IsProp p => h -> p -> h
+-- | Props is a combination of a list of properties, with their combined
+-- metatypes and info.
+data Props metatypes = Props Info [ChildProperty]
- -- | Like addProp, but adds the property at the front of the list.
- addPropFront :: IsProp p => h -> p -> h
+-- | Start constructing a Props. Properties can then be added to it using
+-- `(&)` etc.
+props :: Props UnixLike
+props = Props mempty []
- getProperties :: h -> [ChildProperty]
+infixl 1 &
+infixl 1 &^
+infixl 1 !
--- | Adds a property to a `Host` or other `PropAccum`
+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 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 i c & p = Props (i <> getInfoRecursive p) (c ++ [toProp 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 i c &^ p = Props (i <> getInfoRecursive p) (toProp p : c)
-- | Adds a property in reverted form.
-(!) :: IsProp (RevertableProperty undometatypes setupmetatypes) => PropAccum h => h -> RevertableProperty setupmetatypes undometatypes -> h
-h ! p = h & 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
+(!)
+ :: (CheckCombinable x z ~ 'CanCombine)
+ => Props (MetaTypes x)
+ -> RevertableProperty (MetaTypes y) (MetaTypes z)
+ -> Props (MetaTypes (Combine x z))
+Props i c ! p = Props (i <> getInfoRecursive p) (c ++ [toProp (revert p)])
{-