{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Propellor.Property.List (
props,
Props,
toProps,
propertyList,
combineProperties,
) where
import Propellor.Types
import Propellor.Types.Core
import Propellor.Types.MetaTypes
import Propellor.PropAccum
import Propellor.Engine
import Propellor.Exception
import Data.Monoid
import Prelude
toProps :: [Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps :: [Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps [Property (MetaTypes metatypes)]
ps = [ChildProperty] -> Props (MetaTypes metatypes)
forall metatypes. [ChildProperty] -> Props metatypes
Props ((Property (MetaTypes metatypes) -> ChildProperty)
-> [Property (MetaTypes metatypes)] -> [ChildProperty]
forall a b. (a -> b) -> [a] -> [b]
map Property (MetaTypes metatypes) -> ChildProperty
forall p. IsProp p => p -> ChildProperty
toChildProperty [Property (MetaTypes metatypes)]
ps)
propertyList :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList :: Desc
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList Desc
desc (Props [ChildProperty]
ps) =
Desc -> Propellor Result -> Property (MetaTypes metatypes)
forall k (metatypes :: k).
SingI metatypes =>
Desc -> Propellor Result -> Property (MetaTypes metatypes)
property Desc
desc ([ChildProperty] -> Propellor Result
ensureChildProperties [ChildProperty]
cs)
Property (MetaTypes metatypes)
-> [ChildProperty] -> Property (MetaTypes metatypes)
forall p. IsProp p => p -> [ChildProperty] -> p
`addChildren` [ChildProperty]
cs
where
cs :: [ChildProperty]
cs = (ChildProperty -> ChildProperty)
-> [ChildProperty] -> [ChildProperty]
forall a b. (a -> b) -> [a] -> [b]
map ChildProperty -> ChildProperty
forall p. IsProp p => p -> ChildProperty
toChildProperty [ChildProperty]
ps
combineProperties :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties :: Desc
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties Desc
desc (Props [ChildProperty]
ps) =
Desc -> Propellor Result -> Property (MetaTypes metatypes)
forall k (metatypes :: k).
SingI metatypes =>
Desc -> Propellor Result -> Property (MetaTypes metatypes)
property Desc
desc ([ChildProperty] -> Result -> Propellor Result
combineSatisfy [ChildProperty]
cs Result
NoChange)
Property (MetaTypes metatypes)
-> [ChildProperty] -> Property (MetaTypes metatypes)
forall p. IsProp p => p -> [ChildProperty] -> p
`addChildren` [ChildProperty]
cs
where
cs :: [ChildProperty]
cs = (ChildProperty -> ChildProperty)
-> [ChildProperty] -> [ChildProperty]
forall a b. (a -> b) -> [a] -> [b]
map ChildProperty -> ChildProperty
forall p. IsProp p => p -> ChildProperty
toChildProperty [ChildProperty]
ps
combineSatisfy :: [ChildProperty] -> Result -> Propellor Result
combineSatisfy :: [ChildProperty] -> Result -> Propellor Result
combineSatisfy [] Result
rs = Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
rs
combineSatisfy (ChildProperty
p:[ChildProperty]
ps) Result
rs = do
Result
r <- Propellor Result
-> (Propellor Result -> Propellor Result)
-> Maybe (Propellor Result)
-> Propellor Result
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange) Propellor Result -> Propellor Result
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
m Result -> m Result
catchPropellor (ChildProperty -> Maybe (Propellor Result)
forall p. IsProp p => p -> Maybe (Propellor Result)
getSatisfy ChildProperty
p)
case Result
r of
Result
FailedChange -> Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
Result
_ -> [ChildProperty] -> Result -> Propellor Result
combineSatisfy [ChildProperty]
ps (Result
r Result -> Result -> Result
forall a. Semigroup a => a -> a -> a
<> Result
rs)