{-# 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 qualified Data.Semigroup as Sem
import "mtl" Control.Monad.RWS.Strict
import Control.Monad.Catch
import Control.Applicative
import Prelude
data Host = Host
{ Host -> HostName
hostName :: HostName
, Host -> [ChildProperty]
hostProperties :: [ChildProperty]
, Host -> Info
hostInfo :: Info
}
deriving (Int -> Host -> ShowS
[Host] -> ShowS
Host -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Host] -> ShowS
$cshowList :: [Host] -> ShowS
show :: Host -> HostName
$cshow :: Host -> HostName
showsPrec :: Int -> Host -> ShowS
$cshowsPrec :: Int -> Host -> ShowS
Show, Typeable)
newtype Propellor p = Propellor { forall p. Propellor p -> RWST Host [EndAction] () IO p
runWithHost :: RWST Host [EndAction] () IO p }
deriving
( Applicative Propellor
forall a. a -> Propellor a
forall a b. Propellor a -> Propellor b -> Propellor b
forall a b. Propellor a -> (a -> Propellor b) -> Propellor b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Propellor a
$creturn :: forall a. a -> Propellor a
>> :: forall a b. Propellor a -> Propellor b -> Propellor b
$c>> :: forall a b. Propellor a -> Propellor b -> Propellor b
>>= :: forall a b. Propellor a -> (a -> Propellor b) -> Propellor b
$c>>= :: forall a b. Propellor a -> (a -> Propellor b) -> Propellor b
Monad
, forall a b. a -> Propellor b -> Propellor a
forall a b. (a -> b) -> Propellor a -> Propellor b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Propellor b -> Propellor a
$c<$ :: forall a b. a -> Propellor b -> Propellor a
fmap :: forall a b. (a -> b) -> Propellor a -> Propellor b
$cfmap :: forall a b. (a -> b) -> Propellor a -> Propellor b
Functor
, Functor Propellor
forall a. a -> Propellor a
forall a b. Propellor a -> Propellor b -> Propellor a
forall a b. Propellor a -> Propellor b -> Propellor b
forall a b. Propellor (a -> b) -> Propellor a -> Propellor b
forall a b c.
(a -> b -> c) -> Propellor a -> Propellor b -> Propellor c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Propellor a -> Propellor b -> Propellor a
$c<* :: forall a b. Propellor a -> Propellor b -> Propellor a
*> :: forall a b. Propellor a -> Propellor b -> Propellor b
$c*> :: forall a b. Propellor a -> Propellor b -> Propellor b
liftA2 :: forall a b c.
(a -> b -> c) -> Propellor a -> Propellor b -> Propellor c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Propellor a -> Propellor b -> Propellor c
<*> :: forall a b. Propellor (a -> b) -> Propellor a -> Propellor b
$c<*> :: forall a b. Propellor (a -> b) -> Propellor a -> Propellor b
pure :: forall a. a -> Propellor a
$cpure :: forall a. a -> Propellor a
Applicative
, MonadReader Host
, MonadWriter [EndAction]
, Monad Propellor
forall a. IO a -> Propellor a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Propellor a
$cliftIO :: forall a. IO a -> Propellor a
MonadIO
, MonadThrow Propellor
forall e a.
Exception e =>
Propellor a -> (e -> Propellor a) -> Propellor a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
Propellor a -> (e -> Propellor a) -> Propellor a
$ccatch :: forall e a.
Exception e =>
Propellor a -> (e -> Propellor a) -> Propellor a
MonadCatch
, Monad Propellor
forall e a. Exception e => e -> Propellor a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> Propellor a
$cthrowM :: forall e a. Exception e => e -> Propellor a
MonadThrow
, MonadCatch Propellor
forall b.
((forall a. Propellor a -> Propellor a) -> Propellor b)
-> Propellor b
forall a b c.
Propellor a
-> (a -> ExitCase b -> Propellor c)
-> (a -> Propellor b)
-> Propellor (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
Propellor a
-> (a -> ExitCase b -> Propellor c)
-> (a -> Propellor b)
-> Propellor (b, c)
$cgeneralBracket :: forall a b c.
Propellor a
-> (a -> ExitCase b -> Propellor c)
-> (a -> Propellor b)
-> Propellor (b, c)
uninterruptibleMask :: forall b.
((forall a. Propellor a -> Propellor a) -> Propellor b)
-> Propellor b
$cuninterruptibleMask :: forall b.
((forall a. Propellor a -> Propellor a) -> Propellor b)
-> Propellor b
mask :: forall b.
((forall a. Propellor a -> Propellor a) -> Propellor b)
-> Propellor b
$cmask :: forall b.
((forall a. Propellor a -> Propellor a) -> Propellor b)
-> Propellor b
MonadMask
)
class LiftPropellor m where
liftPropellor :: m a -> Propellor a
instance LiftPropellor Propellor where
liftPropellor :: forall a. Propellor a -> Propellor a
liftPropellor = forall a. a -> a
id
instance LiftPropellor IO where
liftPropellor :: forall a. IO a -> Propellor a
liftPropellor = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance Sem.Semigroup (Propellor Result) where
Propellor Result
x <> :: Propellor Result -> Propellor Result -> Propellor Result
<> Propellor Result
y = do
Result
rx <- Propellor Result
x
case Result
rx of
Result
FailedChange -> forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
Result
_ -> do
Result
ry <- Propellor Result
y
forall (m :: * -> *) a. Monad m => a -> m a
return (Result
rx forall a. Semigroup a => a -> a -> a
<> Result
ry)
instance Monoid (Propellor Result) where
mempty :: Propellor Result
mempty = forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
mappend :: Propellor Result -> Propellor Result -> Propellor Result
mappend = forall a. Semigroup a => a -> a -> a
(Sem.<>)
data EndAction = EndAction Desc (Result -> Propellor Result)
type Desc = String
data Props metatypes = Props [ChildProperty]
data ChildProperty = ChildProperty Desc (Maybe (Propellor Result)) Info [ChildProperty]
instance Show ChildProperty where
show :: ChildProperty -> HostName
show ChildProperty
p = HostName
"property " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> HostName
show (forall p. IsProp p => p -> HostName
getDesc ChildProperty
p)
class IsProp p where
setDesc :: p -> Desc -> p
getDesc :: p -> Desc
getChildren :: p -> [ChildProperty]
addChildren :: p -> [ChildProperty] -> p
getInfoRecursive :: p -> Info
getInfo :: p -> Info
toChildProperty :: p -> ChildProperty
getSatisfy :: p -> Maybe (Propellor Result)
instance IsProp ChildProperty where
setDesc :: ChildProperty -> HostName -> ChildProperty
setDesc (ChildProperty HostName
_ Maybe (Propellor Result)
a Info
i [ChildProperty]
c) HostName
d = HostName
-> Maybe (Propellor Result)
-> Info
-> [ChildProperty]
-> ChildProperty
ChildProperty HostName
d Maybe (Propellor Result)
a Info
i [ChildProperty]
c
getDesc :: ChildProperty -> HostName
getDesc (ChildProperty HostName
d Maybe (Propellor Result)
_ Info
_ [ChildProperty]
_) = HostName
d
getChildren :: ChildProperty -> [ChildProperty]
getChildren (ChildProperty HostName
_ Maybe (Propellor Result)
_ Info
_ [ChildProperty]
c) = [ChildProperty]
c
addChildren :: ChildProperty -> [ChildProperty] -> ChildProperty
addChildren (ChildProperty HostName
d Maybe (Propellor Result)
a Info
i [ChildProperty]
c) [ChildProperty]
c' = HostName
-> Maybe (Propellor Result)
-> Info
-> [ChildProperty]
-> ChildProperty
ChildProperty HostName
d Maybe (Propellor Result)
a Info
i ([ChildProperty]
c forall a. [a] -> [a] -> [a]
++ [ChildProperty]
c')
getInfoRecursive :: ChildProperty -> Info
getInfoRecursive (ChildProperty HostName
_ Maybe (Propellor Result)
_ Info
i [ChildProperty]
c) =
Info
i forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map forall p. IsProp p => p -> Info
getInfoRecursive [ChildProperty]
c)
getInfo :: ChildProperty -> Info
getInfo (ChildProperty HostName
_ Maybe (Propellor Result)
_ Info
i [ChildProperty]
_) = Info
i
toChildProperty :: ChildProperty -> ChildProperty
toChildProperty = forall a. a -> a
id
getSatisfy :: ChildProperty -> Maybe (Propellor Result)
getSatisfy (ChildProperty HostName
_ Maybe (Propellor Result)
a Info
_ [ChildProperty]
_) = Maybe (Propellor Result)
a
propsInfo :: Props metatypes -> Info
propsInfo :: forall metatypes. Props metatypes -> Info
propsInfo (Props [ChildProperty]
l) = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map forall p. IsProp p => p -> Info
getInfo [ChildProperty]
l)