1 -- *** what's left after removing data/type decls
3 -- I/O functions and definitions
9 import List ( (++), foldr )
10 import PS ( _PackedString, _unpackPS )
14 -- File and channel names:
22 readFile :: String -> FailCont -> StrCont -> Dialogue
23 writeFile :: String -> String -> FailCont -> SuccCont -> Dialogue
24 appendFile :: String -> String -> FailCont -> SuccCont -> Dialogue
25 readBinFile :: String -> FailCont -> BinCont -> Dialogue
26 writeBinFile :: String -> Bin -> FailCont -> SuccCont -> Dialogue
27 appendBinFile :: String -> Bin -> FailCont -> SuccCont -> Dialogue
28 deleteFile :: String -> FailCont -> SuccCont -> Dialogue
29 statusFile :: String -> FailCont -> StrCont -> Dialogue
30 readChan :: String -> FailCont -> StrCont -> Dialogue
31 appendChan :: String -> String -> FailCont -> SuccCont -> Dialogue
32 readBinChan :: String -> FailCont -> BinCont -> Dialogue
33 appendBinChan :: String -> Bin -> FailCont -> SuccCont -> Dialogue
34 statusChan :: String -> FailCont -> StrCont -> Dialogue
35 echo :: Bool -> FailCont -> SuccCont -> Dialogue
36 getArgs :: FailCont -> StrListCont -> Dialogue
37 getProgName :: FailCont -> StrCont -> Dialogue
38 getEnv :: String -> FailCont -> StrCont -> Dialogue
39 setEnv :: String -> String -> FailCont -> SuccCont -> Dialogue
40 sigAction :: Int -> SigAct -> FailCont -> SuccCont -> Dialogue
44 readFile name fail succ resps =
45 (ReadFile name) : strDispatch fail succ resps
47 writeFile name contents fail succ resps =
48 (WriteFile name contents) : succDispatch fail succ resps
50 appendFile name contents fail succ resps =
51 (AppendFile name contents) : succDispatch fail succ resps
53 readBinFile name fail succ resps =
54 (ReadBinFile name) : binDispatch fail succ resps
56 writeBinFile name contents fail succ resps =
57 (WriteBinFile name contents) : succDispatch fail succ resps
59 appendBinFile name contents fail succ resps =
60 (AppendBinFile name contents) : succDispatch fail succ resps
62 deleteFile name fail succ resps =
63 (DeleteFile name) : succDispatch fail succ resps
65 statusFile name fail succ resps =
66 (StatusFile name) : strDispatch fail succ resps
68 readChan name fail succ resps =
69 (ReadChan name) : strDispatch fail succ resps
71 appendChan name contents fail succ resps =
72 (AppendChan name contents) : succDispatch fail succ resps
74 readBinChan name fail succ resps =
75 (ReadBinChan name) : binDispatch fail succ resps
77 appendBinChan name contents fail succ resps =
78 (AppendBinChan name contents) : succDispatch fail succ resps
80 statusChan name fail succ resps =
81 (StatusChan name) : strDispatch fail succ resps
83 echo bool fail succ resps =
84 (Echo bool) : succDispatch fail succ resps
86 getArgs fail succ resps =
87 GetArgs : strListDispatch fail succ resps
89 getProgName fail succ resps =
90 GetProgName : strDispatch fail succ resps
92 getEnv name fail succ resps =
93 (GetEnv name) : strDispatch fail succ resps
95 setEnv name val fail succ resps =
96 (SetEnv name val) : succDispatch fail succ resps
98 sigAction signal action fail succ resps =
99 (SigAction signal action) : succDispatch fail succ resps
101 strDispatch fail succ (resp:resps) =
102 case resp of Str val -> succ val resps
103 Failure msg -> fail msg resps
105 strListDispatch fail succ (resp:resps) =
106 case resp of StrList val -> succ val resps
107 Failure msg -> fail msg resps
109 binDispatch fail succ (resp:resps) =
110 case resp of Bn val -> succ val resps
111 Failure msg -> fail msg resps
113 succDispatch fail succ (resp:resps) =
114 case resp of Success -> succ resps
115 Failure msg -> fail msg resps
122 exit err = appendChan stderr (msg ++ "\n") abort done
123 where msg = case err of ReadError s -> s
130 print :: (Text a) => a -> Dialogue
131 print x = appendChan stdout (show x) exit done
132 prints :: (Text a) => a -> String -> Dialogue
133 prints x s = appendChan stdout (shows x s) exit done
135 interact :: (String -> String) -> Dialogue
136 interact f = readChan stdin exit
137 (\x -> appendChan stdout (f x) exit done)