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