From 603e6d340611dc15bca876c6374bf5938b8a3d4e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 19 Jan 2015 15:09:03 -0400 Subject: [PATCH] split out types to improve haddock for Propellor.Types --- propellor.cabal | 3 ++ src/Propellor/CmdLine.hs | 1 + src/Propellor/Engine.hs | 2 +- src/Propellor/Info.hs | 1 + src/Propellor/Property/Chroot.hs | 1 + src/Propellor/Property/Docker.hs | 1 + src/Propellor/Spin.hs | 1 + src/Propellor/Types.hs | 87 ++------------------------------ src/Propellor/Types/CmdLine.hs | 27 ++++++++++ src/Propellor/Types/Result.hs | 37 ++++++++++++++ src/Propellor/Types/Val.hs | 22 ++++++++ 11 files changed, 99 insertions(+), 84 deletions(-) create mode 100644 src/Propellor/Types/CmdLine.hs create mode 100644 src/Propellor/Types/Result.hs create mode 100644 src/Propellor/Types/Val.hs diff --git a/propellor.cabal b/propellor.cabal index 00a5ac5..b410674 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -122,6 +122,9 @@ Library Propellor.Types.Empty Propellor.Types.OS Propellor.Types.PrivData + Propellor.Types.Val + Propellor.Types.Result + Propellor.Types.CmdLine Other-Modules: Propellor.Git Propellor.Gpg diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 378367e..15dc09c 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -13,6 +13,7 @@ import Propellor import Propellor.Gpg import Propellor.Git import Propellor.Spin +import Propellor.Types.CmdLine import qualified Propellor.Property.Docker as Docker import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Shim as Shim diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index 22fbdfb..90b8e3d 100644 --- a/src/Propellor/Engine.hs +++ b/src/Propellor/Engine.hs @@ -77,7 +77,7 @@ ensureProperties ps = ensure ps NoChange -- | Lifts an action into a different host. -- --- For example, `fromHost hosts "otherhost" getPubKey` +-- > fromHost hosts "otherhost" getPubKey fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a) fromHost l hn getter = case findHost l hn of Nothing -> return Nothing diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs index 15ea946..6cb3342 100644 --- a/src/Propellor/Info.hs +++ b/src/Propellor/Info.hs @@ -3,6 +3,7 @@ module Propellor.Info where import Propellor.Types +import Propellor.Types.Val import "mtl" Control.Monad.Reader import qualified Data.Set as S diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 395ec74..00c81b4 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -10,6 +10,7 @@ module Propellor.Property.Chroot ( ) where import Propellor +import Propellor.Types.CmdLine import Propellor.Types.Chroot import Propellor.Property.Chroot.Util import qualified Propellor.Property.Debootstrap as Debootstrap diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index e65d6bb..b641c89 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -40,6 +40,7 @@ module Propellor.Property.Docker ( import Propellor hiding (init) import Propellor.Types.Docker +import Propellor.Types.CmdLine import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Shim as Shim diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 339428b..5063145 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -24,6 +24,7 @@ import Propellor.PrivData.Paths import Propellor.Git import Propellor.Ssh import Propellor.Gpg +import Propellor.Types.CmdLine import qualified Propellor.Shim as Shim import Utility.FileMode import Utility.SafeCommand diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 728cebc..e330d5b 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -3,33 +3,21 @@ module Propellor.Types ( Host(..) - , Info(..) , Propellor(..) , Property(..) , RevertableProperty(..) , IsProp(..) , Desc - , Result(..) - , ToResult(..) - , ActionResult(..) - , CmdLine(..) - , PrivDataField(..) - , PrivData - , Context(..) - , anyContext - , SshKeyType(..) - , Val(..) - , fromVal + , Info(..) , RunLog , EndAction(..) , module Propellor.Types.OS , module Propellor.Types.Dns + , module Propellor.Types.Result ) where import Data.Monoid import Control.Applicative -import System.Console.ANSI -import System.Posix.Types import "mtl" Control.Monad.RWS.Strict import "MonadCatchIO-transformers" Control.Monad.CatchIO import qualified Data.Set as S @@ -41,6 +29,8 @@ import Propellor.Types.Dns import Propellor.Types.Docker import Propellor.Types.PrivData import Propellor.Types.Empty +import Propellor.Types.Val +import Propellor.Types.Result import qualified Propellor.Types.Dns as Dns -- | Everything Propellor knows about a system: Its hostname, @@ -126,58 +116,6 @@ instance IsProp RevertableProperty where type Desc = String -data Result = NoChange | MadeChange | FailedChange - deriving (Read, Show, Eq) - -instance Monoid Result where - mempty = NoChange - - mappend FailedChange _ = FailedChange - mappend _ FailedChange = FailedChange - mappend MadeChange _ = MadeChange - mappend _ MadeChange = MadeChange - mappend NoChange NoChange = NoChange - -class ToResult t where - toResult :: t -> Result - -instance ToResult Bool where - toResult False = FailedChange - toResult True = MadeChange - --- | Results of actions, with color. -class ActionResult a where - getActionResult :: a -> (String, ColorIntensity, Color) - -instance ActionResult Bool where - getActionResult False = ("failed", Vivid, Red) - getActionResult True = ("done", Dull, Green) - -instance ActionResult Result where - getActionResult NoChange = ("ok", Dull, Green) - getActionResult MadeChange = ("done", Vivid, Green) - getActionResult FailedChange = ("failed", Vivid, Red) - -data CmdLine - = Run HostName - | Spin [HostName] (Maybe HostName) - | SimpleRun HostName - | Set PrivDataField Context - | Dump PrivDataField Context - | Edit PrivDataField Context - | ListFields - | AddKey String - | Merge - | Serialized CmdLine - | Continue CmdLine - | Update (Maybe HostName) - | Relay HostName - | DockerInit HostName - | DockerChain HostName String - | ChrootChain HostName FilePath Bool Bool - | GitPush Fd Fd - deriving (Read, Show, Eq) - -- | Information about a host. data Info = Info { _os :: Val System @@ -216,23 +154,6 @@ instance Empty Info where , isEmpty (_chrootinfo i) ] -data Val a = Val a | NoVal - deriving (Eq, Show) - -instance Monoid (Val a) where - mempty = NoVal - mappend old new = case new of - NoVal -> old - _ -> new - -instance Empty (Val a) where - isEmpty NoVal = True - isEmpty _ = False - -fromVal :: Val a -> Maybe a -fromVal (Val a) = Just a -fromVal NoVal = Nothing - type RunLog = [EndAction] -- | An action that Propellor runs at the end, after trying to satisfy all diff --git a/src/Propellor/Types/CmdLine.hs b/src/Propellor/Types/CmdLine.hs new file mode 100644 index 0000000..b8f488a --- /dev/null +++ b/src/Propellor/Types/CmdLine.hs @@ -0,0 +1,27 @@ +module Propellor.Types.CmdLine where + +import Propellor.Types.OS +import Propellor.Types.PrivData + +import System.Posix.Types + +data CmdLine + = Run HostName + | Spin [HostName] (Maybe HostName) + | SimpleRun HostName + | Set PrivDataField Context + | Dump PrivDataField Context + | Edit PrivDataField Context + | ListFields + | AddKey String + | Merge + | Serialized CmdLine + | Continue CmdLine + | Update (Maybe HostName) + | Relay HostName + | DockerInit HostName + | DockerChain HostName String + | ChrootChain HostName FilePath Bool Bool + | GitPush Fd Fd + deriving (Read, Show, Eq) + diff --git a/src/Propellor/Types/Result.hs b/src/Propellor/Types/Result.hs new file mode 100644 index 0000000..9def9a3 --- /dev/null +++ b/src/Propellor/Types/Result.hs @@ -0,0 +1,37 @@ +module Propellor.Types.Result where + +import Data.Monoid +import System.Console.ANSI + +-- | There can be three results of satisfying a Property. +data Result = NoChange | MadeChange | FailedChange + deriving (Read, Show, Eq) + +instance Monoid Result where + mempty = NoChange + + mappend FailedChange _ = FailedChange + mappend _ FailedChange = FailedChange + mappend MadeChange _ = MadeChange + mappend _ MadeChange = MadeChange + mappend NoChange NoChange = NoChange + +class ToResult t where + toResult :: t -> Result + +instance ToResult Bool where + toResult False = FailedChange + toResult True = MadeChange + +-- | Results of actions, with color. +class ActionResult a where + getActionResult :: a -> (String, ColorIntensity, Color) + +instance ActionResult Bool where + getActionResult False = ("failed", Vivid, Red) + getActionResult True = ("done", Dull, Green) + +instance ActionResult Result where + getActionResult NoChange = ("ok", Dull, Green) + getActionResult MadeChange = ("done", Vivid, Green) + getActionResult FailedChange = ("failed", Vivid, Red) diff --git a/src/Propellor/Types/Val.hs b/src/Propellor/Types/Val.hs new file mode 100644 index 0000000..8890bee --- /dev/null +++ b/src/Propellor/Types/Val.hs @@ -0,0 +1,22 @@ +module Propellor.Types.Val where + +import Data.Monoid + +import Propellor.Types.Empty + +data Val a = Val a | NoVal + deriving (Eq, Show) + +instance Monoid (Val a) where + mempty = NoVal + mappend old new = case new of + NoVal -> old + _ -> new + +instance Empty (Val a) where + isEmpty NoVal = True + isEmpty _ = False + +fromVal :: Val a -> Maybe a +fromVal (Val a) = Just a +fromVal NoVal = Nothing