1 -- 2 -- Interactive utility functions 3 -- Mark P. Jones November 1990 4 -- 5 -- uses Haskell B. version 0.99.3 6 -- 7 module Interact(Interactive, skip, end, readln, writeln, readch) where 8 9 -- The functions defined in this module provide basic facilities for 10 -- writing line-oriented interactive programs (i.e. a function mapping 11 -- an input string to an appropriate output string). These definitions 12 -- are an enhancement of thos in B+W 7.8 13 -- 14 -- skip p is an interactive program which consumes no input, produces 15 -- no output and then behaves like the interactive program p. 16 -- end is an interactive program which ignores the input and 17 -- produces no output. 18 -- writeln txt p is an interactive program which outputs the message txt 19 -- and then behaves like the interactive program p 20 -- readch act def is an interactive program which reads the first character c 21 -- from the input stream and behaves like the interactive 22 -- program act c. If the input character stream is empty, 23 -- readch act def prints the default string def and terminates. 24 -- 25 -- readln p g is an interactive program which prints the prompt p and 26 -- reads a line (upto the first carriage return, or end of 27 -- input) from the input stream. It then behaves like g line. 28 -- Backspace characters included in the input stream are 29 -- interpretted in the usual way. 30 31 type Interactive = String -> String 32 33 --- Interactive program combining forms: 34 35 skip :: Interactive -> Interactive 36 skip p inn = p inn -- a dressed up identity function 37 38 end :: Interactive 39 end inn = "" 40 41 writeln :: String -> Interactive -> Interactive 42 writeln txt p inn = txt ++ p inn 43 44 readch :: (Char -> Interactive) -> String -> Interactive 45 readch act def "" = def 46 readch act def (c:cs) = act c cs 47 48 readln :: String -> (String -> Interactive) -> Interactive 49 readln prompt g inn = prompt ++ lineOut 0 line ++ "\n" 50 ++ g (noBackSpaces line) input' 51 where line = before '\n' inn 52 input' = after '\n' inn 53 after x = tail . dropWhile (x/=) 54 before x = takeWhile (x/=) 55 56 --- Filter out backspaces etc: 57 58 rubout :: Char -> Bool 59 rubout c = (c=='\DEL' || c=='\BS') 60 61 lineOut :: Int -> String -> String 62 lineOut n "" = "" 63 lineOut n (c:cs) 64 | n>0 && rubout c = "\BS \BS" ++ lineOut (n-1) cs 65 | n==0 && rubout c = lineOut 0 cs 66 | otherwise = c:lineOut (n+1) cs 67 68 noBackSpaces :: String -> String 69 noBackSpaces = reverse . delete 0 . reverse 70 where delete n "" = "" 71 delete n (c:cs) 72 | rubout c = delete (n+1) cs 73 | n>0 = delete (n-1) cs 74 | otherwise = c:delete 0 cs 75 76 --- End of Interact.hs