diff options
Diffstat (limited to 'Propellor/Types.hs')
| -rw-r--r-- | Propellor/Types.hs | 73 |
1 files changed, 69 insertions, 4 deletions
diff --git a/Propellor/Types.hs b/Propellor/Types.hs index 52c0c999..e6e02126 100644 --- a/Propellor/Types.hs +++ b/Propellor/Types.hs @@ -1,19 +1,74 @@ -module Propellor.Types where +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ExistentialQuantification #-} + +module Propellor.Types + ( Host(..) + , Attr + , HostName + , UserName + , GroupName + , Propellor(..) + , Property(..) + , RevertableProperty(..) + , AttrProperty(..) + , IsProp + , describe + , toProp + , getAttr + , requires + , Desc + , Result(..) + , System(..) + , Distribution(..) + , DebianSuite(..) + , Release + , Architecture + , ActionResult(..) + , CmdLine(..) + , PrivDataField(..) + ) where import Data.Monoid +import Control.Applicative import System.Console.ANSI +import "mtl" Control.Monad.Reader +import "MonadCatchIO-transformers" Control.Monad.CatchIO + +import Propellor.Types.Attr + +data Host = Host [Property] (Attr -> Attr) -type HostName = String type UserName = String +type GroupName = String + +-- | Propellor's monad provides read-only access to attributes of the +-- system. +newtype Propellor p = Propellor { runWithAttr :: ReaderT Attr IO p } + deriving + ( Monad + , Functor + , Applicative + , MonadReader Attr + , MonadIO + , MonadCatchIO + ) +-- | 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 = Property { propertyDesc :: Desc -- | must be idempotent; may run repeatedly - , propertySatisfy :: IO Result + , propertySatisfy :: Propellor Result } +-- | A property that can be reverted. data RevertableProperty = RevertableProperty Property Property +-- | A property that affects the Attr. +data AttrProperty = forall p. IsProp p => AttrProperty p (Attr -> Attr) + class IsProp p where -- | Sets description. describe :: p -> Desc -> p @@ -21,6 +76,7 @@ class IsProp p where -- | Indicates that the first property can only be satisfied -- once the second one is. requires :: p -> Property -> p + getAttr :: p -> (Attr -> Attr) instance IsProp Property where describe p d = p { propertyDesc = d } @@ -30,6 +86,7 @@ instance IsProp Property where case r of FailedChange -> return FailedChange _ -> propertySatisfy x + getAttr _ = id instance IsProp RevertableProperty where -- | Sets the description of both sides. @@ -38,6 +95,13 @@ instance IsProp RevertableProperty where toProp (RevertableProperty p1 _) = p1 (RevertableProperty p1 p2) `requires` y = RevertableProperty (p1 `requires` y) p2 + getAttr _ = id + +instance IsProp AttrProperty where + describe (AttrProperty p a) d = AttrProperty (describe p d) a + toProp (AttrProperty p _) = toProp p + (AttrProperty p a) `requires` y = AttrProperty (p `requires` y) a + getAttr (AttrProperty _ a) = a type Desc = String @@ -63,7 +127,7 @@ data Distribution deriving (Show) data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release - deriving (Show) + deriving (Show, Eq) type Release = String @@ -100,6 +164,7 @@ data PrivDataField = DockerAuthentication | SshPrivKey UserName | Password UserName + | PrivFile FilePath deriving (Read, Show, Ord, Eq) |
