summaryrefslogtreecommitdiff
path: root/src/Control/Funflow/Steps.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Control/Funflow/Steps.hs')
-rw-r--r--src/Control/Funflow/Steps.hs15
1 files changed, 12 insertions, 3 deletions
diff --git a/src/Control/Funflow/Steps.hs b/src/Control/Funflow/Steps.hs
index 1789574..0281efa 100644
--- a/src/Control/Funflow/Steps.hs
+++ b/src/Control/Funflow/Steps.hs
@@ -36,6 +36,7 @@ module Control.Funflow.Steps
, promptFor
, printS
, failStep
+ , cachedFailStep
, worstBernoulli
, pauseWith
, melancholicLazarus
@@ -45,7 +46,8 @@ where
import Control.Arrow
import Control.Arrow.Free (catch)
import Control.Exception.Safe (Exception, throwM)
-import Control.Funflow.Base (SimpleFlow)
+import Control.Funflow.Base (SimpleFlow, cache,
+ defaultCacherWithIdent)
import Control.Funflow.Class
import Control.Funflow.ContentHashable (ContentHashable,
DirectoryContent (..),
@@ -53,6 +55,7 @@ import Control.Funflow.ContentHashable (ContentHashable,
import Control.Funflow.ContentStore (Content ((:</>)))
import qualified Control.Funflow.ContentStore as CS
import qualified Control.Funflow.External.Docker as Docker
+import Data.Default (def)
import Data.Foldable (for_)
import Data.Store
import Data.Traversable (for)
@@ -78,6 +81,11 @@ printS = stepIO $ \s-> print s
failStep :: ArrowFlow eff ex arr => arr () ()
failStep = stepIO $ \_ -> fail "failStep"
+cachedFailStep :: ArrowFlow eff ex arr => arr () ()
+cachedFailStep = stepIO'
+ (def { cache = defaultCacherWithIdent 1235314531893843918})
+ (\_ -> fail "cachedFailStep")
+
worstBernoulli :: (Exception ex, ArrowFlow eff ex arr) => (String -> ex) -> arr Double Double
worstBernoulli errorC = stepIO $ \p -> do
r <- randomRIO (0,1)
@@ -107,7 +115,7 @@ melancholicLazarus = stepIO $ \s -> do
-- | `retry n s f` reruns `f` on failure at most n times with a delay of `s`
-- seconds between retries
-retry :: forall arr eff ex a b. (Exception ex, Store a, ArrowFlow eff ex arr)
+retry :: forall arr eff ex a b. (Exception ex, Store a, ArrowFlow eff ex arr, ArrowChoice arr)
=> Int -> Int -> arr a b -> arr a b
retry 0 _ f = f
retry n secs f = catch f $ proc (x, _ :: ex) -> do
@@ -140,7 +148,8 @@ copyFileToStore = putInStoreAt $ \p (FileContent inFP) -> copyFile inFP p
--
-- | @copyDirToStore (dIn, Just dOut)@ copies the contents of @dIn@ into the store
-- under relative path @dOut@ within the subtree
-copyDirToStore :: ArrowFlow eff ex arr => arr (DirectoryContent, Maybe (Path Rel Dir)) (CS.Content Dir)
+copyDirToStore :: (ArrowChoice arr, ArrowFlow eff ex arr)
+ => arr (DirectoryContent, Maybe (Path Rel Dir)) (CS.Content Dir)
copyDirToStore = proc (inDir, mbOutDir) ->
case mbOutDir of
Nothing -> do