Control.Frame tests

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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE BangPatterns #-}

import Control.Frame
import Control.IMonad.Do
import Control.IMonad.Trans
import Prelude hiding (Monad(..), lines)
import qualified Control.Monad as M
import System.IO (hIsEOF, openFile, IOMode(..), hClose, Handle)
import Data.Text.IO (hGetLine)
import Data.Text (Text)
import qualified Data.Text as T

takeNoClose n = do
    replicateMR_ n $ do
        x <- await
        yield x

take' :: Int -> Frame a IO (M a) C ()
take' n = do
    replicateMR_ n $ do
        x <- await
        yield x
    close
    liftU $ putStrLn "You shall not pass!"

double = do
    foreverR $ do
      a <- await
      yield a
      yield a

-- This type-checks because foreverR is polymorphic in the final index
printer :: (Show b) => Frame C IO (M b) C r
printer = foreverR $ do
    a <- await
    liftU $ print a

 -- I'm keeping fromList's input end polymorphic for a later example
fromList :: (M.Monad m) => [b] -> Frame b m (M a) C ()
fromList xs = do
                close
                mapMR_ yield xs

stack :: Stack IO ()
stack = printer <-< take' 3 <-< fromList [1..]

test1 = runFrame stack

readFile' :: Handle -> Frame Text IO C C ()
readFile' h = do
    eof <- liftU $ hIsEOF h
    whenR (not eof) $ do
        s <- liftU $ hGetLine h
        yield s
        readFile' h

read' :: FilePath -> Frame Text IO C C ()
read' file = do
    liftU $ putStrLn "Opening file..."
    h <- liftU $ openFile file ReadMode
    -- The following requires "import qualified Control.Monad as M"
    finallyD (putStrLn "Closing file ..." M.>> hClose h) $ readFile' h

files = do
    close
    read' "file1.txt"
    read' "file2.txt"

test2 = runFrame $ printer <-< files

toList :: (M.Monad m) => Frame b m (M a) (M a) [a]
toList = do
    a' <- awaitF
    case a' of
        Nothing -> return []
        Just a  -> do
            as <- toList
            return (a:as)

p1 = do
    xs <- toList
    close
    return (Just xs)

p2 xs = do
    fromList xs
    return Nothing -- Remember: they need the same return type

test3 = runFrame $ p1 <-< p2 [1..10]

strict :: (M.Monad m) => Frame a m (M a) C ()
strict = do
    xs <- toList
    fromList xs

test4 = runFrame $ printer <-< strict <-< files

test5 = runFrame $ printer <-< strict <-< take' 2 <-< files

lines path = do { close; read' path }

consume f = foreverR $ do { a <- await; liftU $ f a }

foo1 x = putStrLn $ "the file name is: " ++ T.unpack x

bar1 = runFrame $ consume foo1 <-< lines "files"

count' !n = do
    a' <- awaitF
    case a' of
        Nothing -> return n
        Just a  -> count' (n+1)

count = count' 0

q1 = do n <- count 
        close
        return n

q2 xs = do fromList xs
           return 100

bar2 = runFrame $ q1 <-< q2 [3..8]

bar3 = runFrame $ q1 <-< p2 [3..8] -- doesn't work

bar4 = runFrame $ q1 <-< (lines "files" >> return (-1))

countFrame f = runFrame $ q1 <-< (f >> return (-1))

bar5 = countFrame $ p2 [101..115]

bar6 = runFrame $ printer <-< fromList [3..20]

bar7 = runFrame $ printer <-< take' 4 <-< fromList [3..20]

bar8 = runFrame $ printer <-< (takeNoClose 4 >> take' 2) <-< fromList [3..20]

bar9 = runFrame $ printer <-< files

files2 = do read' "file2.txt"
            read' "file1.txt"

bar10 = runFrame $ printer <-< do { close; files2 } 
15:17: Error: Redundant do
Found:
do replicateMR_ n $
do x <- await
yield x
Why not:
replicateMR_ n $
do x <- await
yield x
28:10: Error: Redundant do
Found:
do foreverR $
do a <- await
yield a
yield a
Why not:
foreverR $
do a <- await
yield a
yield a