summaryrefslogtreecommitdiff
path: root/TestFunflow.hs
blob: 09a83730f3b1a2e55975acb0f8e5a6ca209be2b3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
{-# LANGUAGE Arrows              #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Arrow
import           Control.Arrow.Free
import           Control.Exception.Safe
import           Control.Funflow
import qualified Control.Funflow.ContentStore                as CS
import           Control.Funflow.External.Coordinator.Memory
import           Control.Funflow.Pretty
import           Data.Default
import           Data.Monoid                                 ((<>))
import           Path
import           Path.IO

mkError :: String -> SomeException
mkError = toException . userError

myFlow :: SimpleFlow () Bool
myFlow = proc () -> do
  age <- promptFor -< "How old are you"
  returnA -< age > (65::Int)

flow2 :: SimpleFlow () (Double,Double)
flow2 = proc () -> do
  r1 <- worstBernoulli mkError -< 0.1
  r2 <- worstBernoulli mkError -< 0.2
  returnA -< (r1,r2)

flow2caught :: SimpleFlow () (Double,Double)
flow2caught = retry 100 0 flow2

flow3 :: SimpleFlow [Int] [Int]
flow3 = mapA (arr (+1))

runFailingFlow :: Path Abs Dir -> IO ()
runFailingFlow storeDir = withSimpleLocalRunner storeDir $ \runner -> do
   r <- runner cachedFailStep ()
   print r

testFailingFlow :: IO ()
testFailingFlow =
  withSystemTempDir "test_output" $ \storeDir ->
    runFailingFlow storeDir >> runFailingFlow storeDir

main :: IO ()
main = do
  testFailingFlow
  withSystemTempDir "test_output" $ \storeDir ->
    CS.withStore storeDir $ \store -> do
      memHook <- createMemoryCoordinator
      res <- runSimpleFlow MemoryCoordinator memHook store flow2 ()
      print res
      res' <- runSimpleFlow MemoryCoordinator memHook store flow2caught ()
      print res'
      putStrLn $ showFlow myFlow
      putStrLn $ showFlow flow2
      res1 <- runSimpleFlow MemoryCoordinator memHook store flow3 [1..10]
      print res1
  --  main = redisTest
      externalTest
      storeTest

externalTest :: IO ()
externalTest = let
    someString = "External test"
    exFlow = external $ \t -> ExternalTask
      { _etCommand = "/run/current-system/sw/bin/echo"
      , _etParams = [textParam t]
      , _etWriteToStdOut = StdOutCapture
      , _etEnv = EnvExplicit []
      }
    flow = exFlow >>> readString_
  in withSystemTempDir "test_output_external_" $ \storeDir -> do
    withSimpleLocalRunner storeDir $ \run -> do
      out <- run flow someString
      case out of
        Left err     -> print err
        Right outStr -> putStrLn outStr

storeTest :: IO ()
storeTest = let
    string1 = "First line\n"
    string2 = "Second line\n"
    exFlow = external $ \(a, b) -> ExternalTask
      { _etCommand = "/run/current-system/sw/bin/cat"
      , _etParams = [contentParam a, contentParam b]
      , _etWriteToStdOut = StdOutCapture
      , _etEnv = EnvExplicit []
      }
    flow = proc (s1, s2) -> do
      f1 <- writeString_ -< s1
      s1' <- readString -< f1
      f2 <- writeString_ -< s2
      s2' <- readString -< f2
      f12 <- exFlow -< (f1, f2)
      s12 <- readString_ -< f12
      returnA -< s12 == s1' <> s2'
  in withSystemTempDir "test_output_store_" $ \storeDir -> do
    withSimpleLocalRunner storeDir $ \run -> do
      out <- run flow (string1, string2)
      case out of
        Left err -> print err
        Right b  -> print b