summaryrefslogtreecommitdiff
path: root/src/Propellor/Types
diff options
context:
space:
mode:
authorJoey Hess2016-03-27 19:59:20 -0400
committerJoey Hess2016-03-27 19:59:20 -0400
commit9d6dc29555b8499d8ae6c73c891b0b5dc19f83e5 (patch)
tree875311342f65bcdc380b31a14be8def60533b670 /src/Propellor/Types
parent3383d008c7df57e6b5dd066fa1dfa80ac39cdd8e (diff)
improve haddocks and move code around to make them more clear
Diffstat (limited to 'src/Propellor/Types')
-rw-r--r--src/Propellor/Types/Core.hs106
-rw-r--r--src/Propellor/Types/Info.hs5
2 files changed, 111 insertions, 0 deletions
diff --git a/src/Propellor/Types/Core.hs b/src/Propellor/Types/Core.hs
new file mode 100644
index 00000000..fa939d2b
--- /dev/null
+++ b/src/Propellor/Types/Core.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Propellor.Types.Core where
+
+import Propellor.Types.Info
+import Propellor.Types.OS
+import Propellor.Types.Result
+
+import Data.Monoid
+import "mtl" Control.Monad.RWS.Strict
+import Control.Monad.Catch
+import Control.Applicative
+import Prelude
+
+-- | Everything Propellor knows about a system: Its hostname,
+-- properties and their collected info.
+data Host = Host
+ { hostName :: HostName
+ , hostProperties :: [ChildProperty]
+ , hostInfo :: Info
+ }
+ deriving (Show, Typeable)
+
+-- | Propellor's monad provides read-only access to info about the host
+-- it's running on, and a writer to accumulate EndActions.
+newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
+ deriving
+ ( Monad
+ , Functor
+ , Applicative
+ , MonadReader Host
+ , MonadWriter [EndAction]
+ , MonadIO
+ , MonadCatch
+ , MonadThrow
+ , MonadMask
+ )
+
+class LiftPropellor m where
+ liftPropellor :: m a -> Propellor a
+
+instance LiftPropellor Propellor where
+ liftPropellor = id
+
+instance LiftPropellor IO where
+ liftPropellor = liftIO
+
+instance Monoid (Propellor Result) where
+ mempty = return NoChange
+ -- | The second action is only run if the first action does not fail.
+ mappend x y = do
+ rx <- x
+ case rx of
+ FailedChange -> return FailedChange
+ _ -> do
+ ry <- y
+ return (rx <> ry)
+
+-- | An action that Propellor runs at the end, after trying to satisfy all
+-- properties. It's passed the combined Result of the entire Propellor run.
+data EndAction = EndAction Desc (Result -> Propellor Result)
+
+type Desc = String
+
+-- | Props is a combination of a list of properties, with their combined
+-- metatypes.
+data Props metatypes = Props [ChildProperty]
+
+-- | Since there are many different types of Properties, they cannot be put
+-- into a list. The simplified ChildProperty can be put into a list.
+data ChildProperty = ChildProperty Desc (Propellor Result) Info [ChildProperty]
+
+instance Show ChildProperty where
+ show = getDesc
+
+class IsProp p where
+ setDesc :: p -> Desc -> p
+ getDesc :: p -> Desc
+ getChildren :: p -> [ChildProperty]
+ addChildren :: p -> [ChildProperty] -> p
+ -- | Gets the info of the property, combined with all info
+ -- of all children properties.
+ getInfoRecursive :: p -> Info
+ -- | Info, not including info from children.
+ getInfo :: p -> Info
+ -- | Gets a ChildProperty representing the Property.
+ -- You should not normally need to use this.
+ toChildProperty :: p -> ChildProperty
+ -- | Gets the action that can be run to satisfy a Property.
+ -- You should never run this action directly. Use
+ -- 'Propellor.EnsureProperty.ensureProperty` instead.
+ getSatisfy :: p -> Propellor Result
+
+instance IsProp ChildProperty where
+ setDesc (ChildProperty _ a i c) d = ChildProperty d a i c
+ getDesc (ChildProperty d _ _ _) = d
+ getChildren (ChildProperty _ _ _ c) = c
+ addChildren (ChildProperty d a i c) c' = ChildProperty d a i (c ++ c')
+ getInfoRecursive (ChildProperty _ _ i c) =
+ i <> mconcat (map getInfoRecursive c)
+ getInfo (ChildProperty _ _ i _) = i
+ toChildProperty = id
+ getSatisfy (ChildProperty _ a _ _) = a
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
index c7f6b82f..2e188ae5 100644
--- a/src/Propellor/Types/Info.hs
+++ b/src/Propellor/Types/Info.hs
@@ -19,6 +19,9 @@ import Data.Monoid
import Prelude
-- | Information about a Host, which can be provided by its properties.
+--
+-- Many different types of data can be contained in the same Info value
+-- at the same time. See `toInfo` and `fromInfo`.
newtype Info = Info [InfoEntry]
deriving (Monoid, Show)
@@ -47,6 +50,8 @@ class (Typeable v, Monoid v, Show v) => IsInfo v where
addInfo :: IsInfo v => Info -> v -> Info
addInfo (Info l) v = Info (InfoEntry v:l)
+-- | Converts any value in the `IsInfo` type class into an Info,
+-- which is otherwise empty.
toInfo :: IsInfo v => v -> Info
toInfo = addInfo mempty