summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Concurrent.hs
diff options
context:
space:
mode:
authorJoey Hess2016-04-02 15:33:48 -0400
committerJoey Hess2016-04-02 15:33:48 -0400
commitdce7e7bd72fa82ef7461535288b53d89db807566 (patch)
treecf97100b90cddfd988d069059222df4bb8459bc5 /src/Propellor/Property/Concurrent.hs
parentbeba93baede04835687e1caeefead24f173d9048 (diff)
parent48608a48bd91743776cf3d4abb2172b806d4b917 (diff)
Merge branch 'joeyconfig'
Diffstat (limited to 'src/Propellor/Property/Concurrent.hs')
-rw-r--r--src/Propellor/Property/Concurrent.hs14
1 files changed, 6 insertions, 8 deletions
diff --git a/src/Propellor/Property/Concurrent.hs b/src/Propellor/Property/Concurrent.hs
index 74afecc4..e69dc17d 100644
--- a/src/Propellor/Property/Concurrent.hs
+++ b/src/Propellor/Property/Concurrent.hs
@@ -37,6 +37,8 @@ module Propellor.Property.Concurrent (
) where
import Propellor.Base
+import Propellor.Types.Core
+import Propellor.Types.MetaTypes
import Control.Concurrent
import qualified Control.Concurrent.Async as A
@@ -77,8 +79,8 @@ concurrently p1 p2 = (combineWith go go p1 p2)
--
-- The above example will run foo and bar concurrently, and once either of
-- those 2 properties finishes, will start running baz.
-concurrentList :: IO Int -> Desc -> PropList -> Property HasInfo
-concurrentList getn d (PropList ps) = infoProperty d go mempty ps
+concurrentList :: SingI metatypes => IO Int -> Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
+concurrentList getn d (Props ps) = property d go `addChildren` ps
where
go = do
n <- liftIO getn
@@ -97,15 +99,11 @@ concurrentList getn d (PropList ps) = infoProperty d go mempty ps
(p:rest) -> return (rest, Just p)
case v of
Nothing -> return r
- -- This use of propertySatisfy does not lose any
- -- Info asociated with the property, because
- -- concurrentList sets all the properties as
- -- children, and so propigates their info.
Just p -> do
hn <- asks hostName
r' <- actionMessageOn hn
- (propertyDesc p)
- (propertySatisfy p)
+ (getDesc p)
+ (getSatisfy p)
worker q (r <> r')
-- | Run an action with the number of capabiities increased as necessary to