content: -----------------------------------------------------------------------------
  -- Library for simple interactive programs:
  --
  -- Suitable for use with Hugs 98
  -----------------------------------------------------------------------------
  
  module Interact(
  	Interact(..),
  	end,
  	readChar, peekChar, unreadChar, pressAnyKey,
  	writeChar, writeStr,
  	readLine,
  	ringBell
  	) where
  
  --- Interactive program combining forms:
  
  type Interact = String -> String
  
  end                      :: Interact
  readChar, peekChar       :: Interact -> (Char -> Interact) -> Interact
  pressAnyKey              :: Interact -> Interact
  unreadChar               :: Char -> Interact -> Interact
  writeChar                :: Char -> Interact -> Interact
  writeStr                 :: String -> Interact -> Interact
  ringBell                 :: Interact -> Interact
  readLine                 :: String -> (String -> Interact) -> Interact
  
  end cs                    = ""
  
  readChar eof use []       = eof []
  readChar eof use (c:cs)   = use c cs
  
  peekChar eof use []       = eof []     -- like readChar, but character is
  peekChar eof use cs@(c:_) = use c cs   -- not removed from input stream
  
  pressAnyKey prog          = readChar prog (\c -> prog)
  
  unreadChar c prog cs      = prog (c:cs)
  
  writeChar c prog cs       = c : prog cs
  
  writeStr s prog cs        = s ++ prog cs
  
  ringBell                  = writeChar '\BEL'
  
  readLine prompt g is  = prompt ++ lineOut 0 line ++ "\n"
                                 ++ g (noBackSpaces line) input'
   where line     = before '\n' is
         input'   = after  '\n' is
         after x  = tail . dropWhile (x/=)
         before x = takeWhile (x/=)
  
         rubout  :: Char -> Bool
         rubout c = (c=='\DEL' || c=='\BS')
  
         lineOut                      :: Int -> String -> String
         lineOut n ""                  = ""
         lineOut n (c:cs)
                   | n>0  && rubout c  = "\BS \BS" ++ lineOut (n-1) cs
                   | n==0 && rubout c  = lineOut 0 cs
                   | otherwise         = c:lineOut (n+1) cs
  
         noBackSpaces :: String -> String
         noBackSpaces  = reverse . delete 0 . reverse
                         where delete n ""          = ""
                               delete n (c:cs)
                                        | rubout c  = delete (n+1) cs
                                        | n>0       = delete (n-1) cs
                                        | otherwise = c:delete 0 cs
  
  -----------------------------------------------------------------------------
  