-
Notifications
You must be signed in to change notification settings - Fork 0
/
examples.hs
107 lines (86 loc) · 2.5 KB
/
examples.hs
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
107
import Control.Effects
import Control.Effects.Cont
import Control.Effects.Either
import Control.Effects.Error
import Control.Effects.State
import Control.Effects.Writer
import Control.Effects.NonDet
import qualified Data.Set as Set
import Data.Monoid
testIO :: IO ()
testIO = runBase $ do
base $ putStrLn "What's your name?"
name <- base getLine
base $ putStrLn $ "Hello, " ++ name
testRefIO :: IO ()
testRefIO = runBase $ do
with (ref (5::Int)) $ \x -> do
val <- get x
base $ print val
testRef :: (Int, Int)
testRef = run $ do
with (ref 5) $ \x -> do
with (ref 10) $ \y -> do
x =: (+) <$> get x <*> get y
y =: (+) <$> get x <*> get y
(,) <$> get x <*> get y
testWriter :: (String, (String, Int))
testWriter = run $ do
with writer $ \w1 -> do
with writer $ \w2 -> do
tell w1 "123"
tell w2 "abc"
tell w1 "456"
tell w2 "def"
return 1
testSet :: Set.Set Int
testSet = run $
with set $ \s -> do
x <- choose s [1, 2]
y <- choose s [1, 2]
z <- choose s [1, 2]
return $ x * x - y * z * x + z * z * z - y * y * x
testAccumulate :: Bool
testAccumulate = run $
with (accumulate Any) $ \s -> do
x <- choose s [1, 2]
y <- choose s [1, 2]
z <- choose s [1, 2]
return $ x * x - y * z * x + z * z * z - y * y * x == (0::Int)
testDfs :: [Int] -> [(Int, Int, Int)]
testDfs = run . with (dfs return) . triples
testBfs :: [Int] -> [(Int, Int, Int)]
testBfs = run . with (bfs return) . triples
triples :: (Num a, Eq a, Monoid e, AutoLift e m n) => [a] -> Effect e m -> n (a, a, a)
triples range s = do
x <- choose s range
y <- choose s range
z <- choose s range
guard s $ x*x + y*y == z*z
return (x,y,z)
testError :: IO ()
testError = runBase $ do
with (catchError (\e -> base $ putStrLn ("Error: " ++ e))) $ \c -> do
base $ putStrLn "before"
_ <- throwError c "123"
base $ putStrLn "after"
testEither :: IO ()
testEither = runBase $ do
with (catchEither (\e -> base $ putStrLn ("Error: " ++ e))) $ \c -> do
base $ putStrLn "before"
_ <- throwEither c "123"
base $ putStrLn "after"
testReset1 :: Int
testReset1 = run $ do
with reset $ \r -> do
x <- shift r (\k -> k (k (k (return 7))))
return $ x * 2 + 1
testReset2 :: IO ()
testReset2 = runBase $ do
r <- with reset $ \promptA -> do
base $ putStrLn "Batman"
with reset $ \promptB -> do
shift promptB $ \k -> k (k (shift promptA $ \l -> l (l (return ()))))
base $ putStrLn "Robin"
base $ putStrLn "Cat woman"
base $ print r