moving to using the GADT
The problem this exposes has to do with requires. As implemented,
requires yields either a Property HasInfo or a Property NoInfo depending
on its inputs. That works. But look what happens when it's used:
*Propellor.Types> let foo = IProperty "foo" (return NoChange) mempty mempty
*Propellor.Types> let bar = IProperty "bar" (return NoChange) mempty mempty
*Propellor.Types> foo `requires` bar
<interactive>:17:5:
No instance for (Requires (Property HasInfo) (Property HasInfo) r0)
arising from a use of `requires'
The type variable `r0' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
Note: there is a potential instance available:
instance Requires
(Property HasInfo) (Property HasInfo) (Property HasInfo)
-- Defined at Propellor/Types.hs:167:10
Possible fix:
add an instance declaration for
(Requires (Property HasInfo) (Property HasInfo) r0)
In the expression: foo `requires` bar
In an equation for `it': it = foo `requires` bar
This can be avoided by specifying the result type:
*Propellor.Types> (foo `requires` bar) :: Property HasInfo
property "foo"
But then when multiple `requires` are given, the result type has to be
given each time:
*Propellor.Types> (foo `requires` bar `requires` bar) :: Property HasInfo
<interactive>:22:6:
No instance for (Requires (Property HasInfo) (Property HasInfo) x0)
arising from a use of `requires'
The type variable `x0' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
Note: there is a potential instance available:
instance Requires
(Property HasInfo) (Property HasInfo) (Property HasInfo)
-- Defined at Propellor/Types.hs:167:10
Possible fix:
add an instance declaration for
(Requires (Property HasInfo) (Property HasInfo) x0)
In the first argument of `requires', namely `foo `requires` bar'
In the expression:
(foo `requires` bar `requires` bar) :: Property HasInfo
In an equation for `it':
it = (foo `requires` bar `requires` bar) :: Property HasInfo
<interactive>:22:21:
No instance for (Requires x0 (Property HasInfo) (Property HasInfo))
arising from a use of `requires'
The type variable `x0' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
Note: there are several potential instances:
instance Requires
(Property NoInfo) (Property HasInfo) (Property HasInfo)
-- Defined at Propellor/Types.hs:175:10
instance Requires
(Property HasInfo) (Property HasInfo) (Property HasInfo)
-- Defined at Propellor/Types.hs:167:10
Possible fix:
add an instance declaration for
(Requires x0 (Property HasInfo) (Property HasInfo))
In the expression:
(foo `requires` bar `requires` bar) :: Property HasInfo
In an equation for `it':
it = (foo `requires` bar `requires` bar) :: Property HasInfo
*Propellor.Types> (((foo `requires` bar) :: Property HasInfo) `requires` bar) :: Property HasInfo
property "foo"
Yuggh!
This commit is contained in:
Joey Hess
parent
414ee7eee6
commit
45c94ffdd7
|
|
@ -45,7 +45,7 @@ mainProperties host = do
|
|||
FailedChange -> exitWith (ExitFailure 1)
|
||||
_ -> exitWith ExitSuccess
|
||||
where
|
||||
ps = hostProperties host
|
||||
ps = map ignoreInfo $ hostProperties host
|
||||
|
||||
-- | Runs a Propellor action with the specified host.
|
||||
--
|
||||
|
|
@ -66,13 +66,12 @@ runEndAction host res (EndAction desc a) = actionMessageOn (hostName host) desc
|
|||
-- | For when code running in the Propellor monad needs to ensure a
|
||||
-- Property.
|
||||
--
|
||||
-- Note that the Info of the Property is not propigated out, so it will
|
||||
-- not be visible to propellor, unless you arrange for it to be propigated.
|
||||
ensureProperty :: Property -> Propellor Result
|
||||
-- This can only be used on a Property that has NoInfo.
|
||||
ensureProperty :: Property NoInfo -> Propellor Result
|
||||
ensureProperty = catchPropellor . propertySatisfy
|
||||
|
||||
-- | Ensures a list of Properties, with a display of each as it runs.
|
||||
ensureProperties :: [Property] -> Propellor Result
|
||||
ensureProperties :: [Property NoInfo] -> Propellor Result
|
||||
ensureProperties ps = ensure ps NoChange
|
||||
where
|
||||
ensure [] rs = return rs
|
||||
|
|
|
|||
|
|
@ -12,13 +12,13 @@ import Data.Maybe
|
|||
import Data.Monoid
|
||||
import Control.Applicative
|
||||
|
||||
pureInfoProperty :: Desc -> Info -> Property
|
||||
pureInfoProperty :: Desc -> Info -> Property HasInfo
|
||||
pureInfoProperty desc i = mkProperty ("has " ++ desc) (return NoChange) i mempty
|
||||
|
||||
askInfo :: (Info -> Val a) -> Propellor (Maybe a)
|
||||
askInfo f = asks (fromVal . f . hostInfo)
|
||||
|
||||
os :: System -> Property
|
||||
os :: System -> Property HasInfo
|
||||
os system = pureInfoProperty ("Operating " ++ show system) $
|
||||
mempty { _os = Val system }
|
||||
|
||||
|
|
@ -34,11 +34,11 @@ getOS = askInfo _os
|
|||
-- When propellor --spin is used to deploy a host, it checks
|
||||
-- if the host's IP Property matches the DNS. If the DNS is missing or
|
||||
-- out of date, the host will instead be contacted directly by IP address.
|
||||
ipv4 :: String -> Property
|
||||
ipv4 :: String -> Property HasInfo
|
||||
ipv4 = addDNS . Address . IPv4
|
||||
|
||||
-- | Indidate that a host has an AAAA record in the DNS.
|
||||
ipv6 :: String -> Property
|
||||
ipv6 :: String -> Property HasInfo
|
||||
ipv6 = addDNS . Address . IPv6
|
||||
|
||||
-- | Indicates another name for the host in the DNS.
|
||||
|
|
@ -47,7 +47,7 @@ ipv6 = addDNS . Address . IPv6
|
|||
-- to use their address, rather than using a CNAME. This avoids various
|
||||
-- problems with CNAMEs, and also means that when multiple hosts have the
|
||||
-- same alias, a DNS round-robin is automatically set up.
|
||||
alias :: Domain -> Property
|
||||
alias :: Domain -> Property HasInfo
|
||||
alias d = pureInfoProperty ("alias " ++ d) $ mempty
|
||||
{ _aliases = S.singleton d
|
||||
-- A CNAME is added here, but the DNS setup code converts it to an
|
||||
|
|
@ -55,7 +55,7 @@ alias d = pureInfoProperty ("alias " ++ d) $ mempty
|
|||
, _dns = S.singleton $ CNAME $ AbsDomain d
|
||||
}
|
||||
|
||||
addDNS :: Record -> Property
|
||||
addDNS :: Record -> Property HasInfo
|
||||
addDNS r = pureInfoProperty (rdesc r) $ mempty { _dns = S.singleton r }
|
||||
where
|
||||
rdesc (CNAME d) = unwords ["alias", ddesc d]
|
||||
|
|
|
|||
|
|
@ -2,24 +2,31 @@
|
|||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE EmptyDataDecls #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
module Propellor.Types
|
||||
( Host(..)
|
||||
, Property(..)
|
||||
, HasInfo
|
||||
, NoInfo
|
||||
, Desc
|
||||
, mkProperty
|
||||
, propertyDesc
|
||||
, propertySatisfy
|
||||
, propertyInfo
|
||||
, propertyChildren
|
||||
, RevertableProperty(..)
|
||||
, mkRevertableProperty
|
||||
, requires
|
||||
, IsProp(..)
|
||||
, Desc
|
||||
, Info(..)
|
||||
, Propellor(..)
|
||||
, EndAction(..)
|
||||
, module Propellor.Types.OS
|
||||
, module Propellor.Types.Dns
|
||||
, module Propellor.Types.Result
|
||||
, ignoreInfo
|
||||
) where
|
||||
|
||||
import Data.Monoid
|
||||
|
|
@ -43,7 +50,7 @@ import qualified Propellor.Types.Dns as Dns
|
|||
-- properties and their collected info.
|
||||
data Host = Host
|
||||
{ hostName :: HostName
|
||||
, hostProperties :: [Property]
|
||||
, hostProperties :: [Property HasInfo]
|
||||
, hostInfo :: Info
|
||||
}
|
||||
deriving (Show)
|
||||
|
|
@ -65,96 +72,134 @@ newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
|
|||
-- properties. It's passed the combined Result of the entire Propellor run.
|
||||
data EndAction = EndAction Desc (Result -> Propellor Result)
|
||||
|
||||
type Desc = String
|
||||
|
||||
-- | The core data type of Propellor, this represents a property
|
||||
-- that the system should have, and an action to ensure it has the
|
||||
-- property.
|
||||
data Property = IProperty (GProperty HasInfo) | SProperty (GProperty NoInfo)
|
||||
data Property i where
|
||||
IProperty :: Desc -> Propellor Result -> Info -> [Property HasInfo] -> Property HasInfo
|
||||
SProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo
|
||||
|
||||
data HasInfo
|
||||
data NoInfo
|
||||
|
||||
-- | Constructs a Property
|
||||
mkProperty
|
||||
:: Desc -- ^ description of the property
|
||||
-> Propellor Result -- ^ action to run to satisfy the property (must be idempotent; may run repeatedly)
|
||||
-> Info -- ^ info associated with the property
|
||||
-> [Property] -- ^ child properties
|
||||
-> Property
|
||||
mkProperty d a i cs
|
||||
| isEmpty i && all isEmpty (map propertyInfo cs) =
|
||||
SProperty (GSProperty d a cs)
|
||||
| otherwise = IProperty (GIProperty d a i cs)
|
||||
-> [Property i] -- ^ child properties
|
||||
-> Property HasInfo
|
||||
mkProperty d a i cs = IProperty d a i (map toIProperty cs)
|
||||
|
||||
instance Show Property where
|
||||
toIProperty :: Property i -> Property HasInfo
|
||||
toIProperty p@(IProperty {}) = p
|
||||
toIProperty (SProperty d s cs) = IProperty d s mempty (map toIProperty cs)
|
||||
|
||||
toSProperty :: Property i -> Property NoInfo
|
||||
toSProperty (IProperty d s _ cs) = SProperty d s (map toSProperty cs)
|
||||
toSProperty p@(SProperty {}) = p
|
||||
|
||||
-- | Makes a version of a Proprty without its Info.
|
||||
-- Use with caution!
|
||||
ignoreInfo :: Property HasInfo -> Property NoInfo
|
||||
ignoreInfo = toSProperty
|
||||
|
||||
instance Show (Property i) where
|
||||
show p = "property " ++ show (propertyDesc p)
|
||||
|
||||
-- | This GADT allows creating operations that only act on Properties
|
||||
-- that do not add Info to their Host.
|
||||
data GProperty i where
|
||||
GIProperty :: Desc -> Propellor Result -> Info -> [Property] -> GProperty HasInfo
|
||||
GSProperty :: Desc -> Propellor Result -> [Property] -> GProperty NoInfo
|
||||
propertyDesc :: Property i -> Desc
|
||||
propertyDesc (IProperty d _ _ _) = d
|
||||
propertyDesc (SProperty d _ _) = d
|
||||
|
||||
data HasInfo
|
||||
data NoInfo
|
||||
propertySatisfy :: Property i -> Propellor Result
|
||||
propertySatisfy (IProperty _ a _ _) = a
|
||||
propertySatisfy (SProperty _ a _) = a
|
||||
|
||||
propertyDesc :: Property -> Desc
|
||||
propertyDesc (IProperty (GIProperty d _ _ _)) = d
|
||||
propertyDesc (SProperty (GSProperty d _ _)) = d
|
||||
|
||||
propertySatisfy :: Property -> Propellor Result
|
||||
propertySatisfy (IProperty (GIProperty _ a _ _)) = a
|
||||
propertySatisfy (SProperty (GSProperty _ a _)) = a
|
||||
|
||||
propertyInfo :: Property -> Info
|
||||
propertyInfo (IProperty (GIProperty _ _ i _)) = i
|
||||
propertyInfo (SProperty _) = mempty
|
||||
propertyInfo :: Property i -> Info
|
||||
propertyInfo (IProperty _ _ i _) = i
|
||||
propertyInfo (SProperty {}) = mempty
|
||||
|
||||
-- | A Property can include a list of child properties that it also
|
||||
-- satisfies. This allows them to be introspected to collect their info, etc.
|
||||
propertyChildren :: Property -> [Property]
|
||||
propertyChildren (IProperty (GIProperty _ _ _ cs)) = cs
|
||||
propertyChildren (SProperty (GSProperty _ _ cs)) = cs
|
||||
propertyChildren :: Property i -> [Property i]
|
||||
propertyChildren (IProperty _ _ _ cs) = cs
|
||||
propertyChildren (SProperty _ _ cs) = cs
|
||||
|
||||
-- | A property that can be reverted.
|
||||
data RevertableProperty = RevertableProperty Property Property
|
||||
data RevertableProperty = RevertableProperty (Property HasInfo) (Property HasInfo)
|
||||
|
||||
mkRevertableProperty :: Property i1 -> Property i2 -> RevertableProperty
|
||||
mkRevertableProperty p1 p2 = RevertableProperty (toIProperty p1) (toIProperty p2)
|
||||
|
||||
class IsProp p where
|
||||
-- | Sets description.
|
||||
describe :: p -> Desc -> p
|
||||
toProp :: p -> Property
|
||||
-- | Indicates that the first property can only be satisfied
|
||||
-- once the second one is.
|
||||
requires :: p -> Property -> p
|
||||
toProp :: p -> Property HasInfo
|
||||
-- | Gets the info of the property, combined with all info
|
||||
-- of all children properties.
|
||||
getInfoRecursive :: p -> Info
|
||||
|
||||
instance IsProp Property where
|
||||
describe (IProperty (GIProperty _ a i cs)) d =
|
||||
IProperty (GIProperty d a i cs)
|
||||
describe (SProperty (GSProperty _ a cs)) d =
|
||||
SProperty (GSProperty d a cs)
|
||||
toProp p = p
|
||||
getInfoRecursive (IProperty (GIProperty _ _ i cs)) =
|
||||
instance IsProp (Property HasInfo) where
|
||||
describe (IProperty _ a i cs) d = IProperty d a i cs
|
||||
toProp = id
|
||||
getInfoRecursive (IProperty _ _ i cs) =
|
||||
i <> mconcat (map getInfoRecursive cs)
|
||||
getInfoRecursive (SProperty _) = mempty
|
||||
x `requires` y = mkProperty (propertyDesc x) satisfy (propertyInfo x) cs
|
||||
where
|
||||
satisfy = do
|
||||
r <- propertySatisfy y
|
||||
case r of
|
||||
FailedChange -> return FailedChange
|
||||
_ -> propertySatisfy x
|
||||
cs = y : propertyChildren x
|
||||
instance IsProp (Property NoInfo) where
|
||||
describe (SProperty _ a cs) d = SProperty d a cs
|
||||
toProp = toIProperty
|
||||
getInfoRecursive _ = mempty
|
||||
|
||||
instance IsProp RevertableProperty where
|
||||
-- | Sets the description of both sides.
|
||||
describe (RevertableProperty p1 p2) d =
|
||||
RevertableProperty (describe p1 d) (describe p2 ("not " ++ d))
|
||||
toProp (RevertableProperty p1 _) = p1
|
||||
(RevertableProperty p1 p2) `requires` y =
|
||||
RevertableProperty (p1 `requires` y) p2
|
||||
-- | Return the Info of the currently active side.
|
||||
getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
|
||||
|
||||
type Desc = String
|
||||
class Requires x y r where
|
||||
-- Indicates that the first property depends on the second,
|
||||
-- so before the first is ensured, the second will be ensured.
|
||||
requires :: x -> y -> r
|
||||
|
||||
instance Requires (Property HasInfo) (Property HasInfo) (Property HasInfo) where
|
||||
requires (IProperty d1 a1 i1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
|
||||
IProperty d1 (a2 `andThen` a1) i1 (y : cs1)
|
||||
|
||||
instance Requires (Property HasInfo) (Property NoInfo) (Property HasInfo) where
|
||||
requires (IProperty d1 a1 i1 cs1) y@(SProperty _d2 a2 _cs2) =
|
||||
IProperty d1 (a2 `andThen` a1) i1 (toIProperty y : cs1)
|
||||
|
||||
instance Requires (Property NoInfo) (Property HasInfo) (Property HasInfo) where
|
||||
requires x y = requires y x
|
||||
|
||||
instance Requires (Property NoInfo) (Property NoInfo) (Property NoInfo) where
|
||||
requires (SProperty d1 a1 cs1) y@(SProperty _d2 a2 _cs2) =
|
||||
SProperty d1 (a2 `andThen` a1) (y : cs1)
|
||||
|
||||
instance Requires RevertableProperty (Property HasInfo) RevertableProperty where
|
||||
requires (RevertableProperty p1 p2) y =
|
||||
RevertableProperty (p1 `requires` y) p2
|
||||
|
||||
instance Requires RevertableProperty (Property NoInfo) RevertableProperty where
|
||||
requires (RevertableProperty p1 p2) y =
|
||||
RevertableProperty (p1 `requires` toIProperty y) p2
|
||||
|
||||
instance Requires RevertableProperty RevertableProperty RevertableProperty where
|
||||
requires (RevertableProperty x1 x2) (RevertableProperty y1 y2) =
|
||||
RevertableProperty
|
||||
(x1 `requires` y1)
|
||||
-- when reverting, run actions in reverse order
|
||||
(y2 `requires` x2)
|
||||
|
||||
andThen :: Propellor Result -> Propellor Result -> Propellor Result
|
||||
x `andThen` y = do
|
||||
r <- x
|
||||
case r of
|
||||
FailedChange -> return FailedChange
|
||||
_ -> y
|
||||
|
||||
-- | Information about a host.
|
||||
data Info = Info
|
||||
|
|
|
|||
Loading…
Reference in New Issue