summaryrefslogtreecommitdiff
path: root/Propellor/Types.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Propellor/Types.hs')
-rw-r--r--Propellor/Types.hs75
1 files changed, 70 insertions, 5 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
-type HostName = String
-type UserName = String
+import Propellor.Types.Attr
+
+data Host = Host [Property] (Attr -> Attr)
+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)