effects-0.2.2: examples.hs

module Main where

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
import Control.Applicative


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) $ \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


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, 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