split out types to improve haddock for Propellor.Types

This commit is contained in:
Joey Hess 2015-01-19 15:09:03 -04:00
parent 04d4d0d6c4
commit 603e6d3406
11 changed files with 99 additions and 84 deletions

View File

@ -122,6 +122,9 @@ Library
Propellor.Types.Empty Propellor.Types.Empty
Propellor.Types.OS Propellor.Types.OS
Propellor.Types.PrivData Propellor.Types.PrivData
Propellor.Types.Val
Propellor.Types.Result
Propellor.Types.CmdLine
Other-Modules: Other-Modules:
Propellor.Git Propellor.Git
Propellor.Gpg Propellor.Gpg

View File

@ -13,6 +13,7 @@ import Propellor
import Propellor.Gpg import Propellor.Gpg
import Propellor.Git import Propellor.Git
import Propellor.Spin import Propellor.Spin
import Propellor.Types.CmdLine
import qualified Propellor.Property.Docker as Docker import qualified Propellor.Property.Docker as Docker
import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Property.Chroot as Chroot
import qualified Propellor.Shim as Shim import qualified Propellor.Shim as Shim

View File

@ -77,7 +77,7 @@ ensureProperties ps = ensure ps NoChange
-- | Lifts an action into a different host. -- | 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 :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
fromHost l hn getter = case findHost l hn of fromHost l hn getter = case findHost l hn of
Nothing -> return Nothing Nothing -> return Nothing

View File

@ -3,6 +3,7 @@
module Propellor.Info where module Propellor.Info where
import Propellor.Types import Propellor.Types
import Propellor.Types.Val
import "mtl" Control.Monad.Reader import "mtl" Control.Monad.Reader
import qualified Data.Set as S import qualified Data.Set as S

View File

@ -10,6 +10,7 @@ module Propellor.Property.Chroot (
) where ) where
import Propellor import Propellor
import Propellor.Types.CmdLine
import Propellor.Types.Chroot import Propellor.Types.Chroot
import Propellor.Property.Chroot.Util import Propellor.Property.Chroot.Util
import qualified Propellor.Property.Debootstrap as Debootstrap import qualified Propellor.Property.Debootstrap as Debootstrap

View File

@ -40,6 +40,7 @@ module Propellor.Property.Docker (
import Propellor hiding (init) import Propellor hiding (init)
import Propellor.Types.Docker import Propellor.Types.Docker
import Propellor.Types.CmdLine
import qualified Propellor.Property.File as File import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Shim as Shim import qualified Propellor.Shim as Shim

View File

@ -24,6 +24,7 @@ import Propellor.PrivData.Paths
import Propellor.Git import Propellor.Git
import Propellor.Ssh import Propellor.Ssh
import Propellor.Gpg import Propellor.Gpg
import Propellor.Types.CmdLine
import qualified Propellor.Shim as Shim import qualified Propellor.Shim as Shim
import Utility.FileMode import Utility.FileMode
import Utility.SafeCommand import Utility.SafeCommand

View File

@ -3,33 +3,21 @@
module Propellor.Types module Propellor.Types
( Host(..) ( Host(..)
, Info(..)
, Propellor(..) , Propellor(..)
, Property(..) , Property(..)
, RevertableProperty(..) , RevertableProperty(..)
, IsProp(..) , IsProp(..)
, Desc , Desc
, Result(..) , Info(..)
, ToResult(..)
, ActionResult(..)
, CmdLine(..)
, PrivDataField(..)
, PrivData
, Context(..)
, anyContext
, SshKeyType(..)
, Val(..)
, fromVal
, RunLog , RunLog
, EndAction(..) , EndAction(..)
, module Propellor.Types.OS , module Propellor.Types.OS
, module Propellor.Types.Dns , module Propellor.Types.Dns
, module Propellor.Types.Result
) where ) where
import Data.Monoid import Data.Monoid
import Control.Applicative import Control.Applicative
import System.Console.ANSI
import System.Posix.Types
import "mtl" Control.Monad.RWS.Strict import "mtl" Control.Monad.RWS.Strict
import "MonadCatchIO-transformers" Control.Monad.CatchIO import "MonadCatchIO-transformers" Control.Monad.CatchIO
import qualified Data.Set as S import qualified Data.Set as S
@ -41,6 +29,8 @@ import Propellor.Types.Dns
import Propellor.Types.Docker import Propellor.Types.Docker
import Propellor.Types.PrivData import Propellor.Types.PrivData
import Propellor.Types.Empty import Propellor.Types.Empty
import Propellor.Types.Val
import Propellor.Types.Result
import qualified Propellor.Types.Dns as Dns import qualified Propellor.Types.Dns as Dns
-- | Everything Propellor knows about a system: Its hostname, -- | Everything Propellor knows about a system: Its hostname,
@ -126,58 +116,6 @@ instance IsProp RevertableProperty where
type Desc = String 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. -- | Information about a host.
data Info = Info data Info = Info
{ _os :: Val System { _os :: Val System
@ -216,23 +154,6 @@ instance Empty Info where
, isEmpty (_chrootinfo i) , 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] type RunLog = [EndAction]
-- | An action that Propellor runs at the end, after trying to satisfy all -- | An action that Propellor runs at the end, after trying to satisfy all

View File

@ -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)

View File

@ -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)

View File

@ -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