Control/Monad/X/tests/ContTests.hs

   1 import Control.Monad.X.Transformers
   2
   3 test00' _ = do a <- local (+1) ask
   4                b <- ask
   5                return (a,b)
   6
   7
   8 test0' _  = do a <- callCC $ \jmp -> local (+1) ask
   9                b <- ask
  10                return (a,b)
  11
  12 -- this illustrates an interesting phenomenon.
  13 -- if the reader is there before continuations,
  14 -- jumping will not undo "local" changes to the environment,
  15 -- and they will be seen in the continuation.
  16 -- this happens because the jump is within the scope
  17 -- of the local.
  18 test1' _  = do a <- callCC $ \jmp -> local (+1) (ask >>= jmp)
  19                b <- ask
  20                return (a,b)
  21
  22
  23 test2' _  = callCC $ \jmp -> tell [1] >> jmp 2
  24
  25 -- what should this do?
  26 test22' _ = do (a,w) <- callCC $ \jmp -> tell [1] >> listen (jmp (3,[]))
  27                tell [2]
  28                return (a,w)
  29
  30
  31 output w  = do x <- get
  32                put (mappend x w)
  33
  34 list m    = do w <- get
  35                put mempty
  36                a <- m        -- this is wrong if m jumps as it will delete all output
  37                w' <- get
  38                put w
  39                return (a,w')
  40
  41
  42 test32' _ = do (a,w) <- callCC $ \jmp -> output "1" >> {-list-} (jmp (3,""))
  43                output "2"
  44                return (a,w)
  45
  46 test33' _ = do (a,w) <- callCC $ \jmp -> output "1" >> list (output "7")
  47                output "2"
  48                return (a,w)
  49
  50
  51
  52 test3' _  = callCC $ \jmp -> put 1 >> jmp 2
  53
  54
  55 test00    = do print =<< (runCont $ runReader 7 $ test00' ())
  56                print =<< (runReader 7 $ runCont $ test00' ())
  57
  58 test0     = do print =<< (runCont $ runReader 7 $ test0' ())
  59                print =<< (runReader 7 $ runCont $ test0' ())
  60
  61 test1     = do print =<< (runCont $ runReader 7 $ test1' ())
  62                print =<< (runReader 7 $ runCont $ test1' ())
  63
  64 test2     = do print =<< (runCont $ runWriter $ test2' ())
  65                print =<< (runWriter $ runCont $ test2' ())
  66
  67 test3     = do print =<< (runCont $ runStateS 7 $ test3' ())
  68                print =<< (runStateS 7 $ runCont $ test3' ())
  69
  70 test32    = do print =<< (runCont $ runStateS [] $ test32' ())
  71                print =<< (runStateS [] $ runCont $ test32' ())
  72
  73 test33    = do print =<< (runCont $ runStateS [] $ test33' ())
  74                print =<< (runStateS [] $ runCont $ test33' ())