[CLI compiles now
jupdike@gmail.com**20080205172015] {
addfile ./CLI.lhs
hunk ./CLI.lhs 1
+COMMENT:-----------------------
+
+o Zus"atzliche Funktionen f"ur die Verarbeitung von Argumenten?
+-------------------------------
+
+Generic command line interpreter
+
+
+> module CLI            (  commandLineInterpreter,
+>                          commandLineInterpreterWithHelp,
+>                          exit, unknown
+>                       )
+> where
+
+
+
+
+ > import LibPosix
+ > import LibSystem
+
+> import System
+> import System.IO
+> import System.IO.Error
+
+ > import Support        (  ljustify  )
+
+ > import IOSupport      (  getLine, putLine  )
+
+
+
+> import Sort           (  mergeSort  )
+> import Trie           (  Trie, fromList, prefixLookup  )
+
+> spaces n = take n (repeat ' ')
+
+> ljustify                      :: Int -> String -> String
+> ljustify n s                  =  s ++ spaces (n - length s)
+
+
+Command line interpreter
+
+
+> commandLineInterpreter
+>               :: [Char]                               -- prompt
+>               -> [([[Char]], st -> [[Char]] -> IO st)]-- list of commands
+>               -> (st -> [Char] -> IO st)              -- default command
+>               -> st                                   -- initial state
+>               -> IO ()
+
+
+
+
+> commandLineInterpreter prompt cmdList defCmd st0
+>               =  loop st0
+>     where
+>     cmdTable  =  fromList [ (x, cmd) | (xs, cmd)<-cmdList, x<-xs ]
+>     loop st   =  --installHandler sigINT (Catch (handle st)) Nothing  >>
+>                  putStr prompt                                >>
+>                  catch getLine bye                            >>= \line ->
+>                  case words line of
+>                  [] ->
+>                      loop st
+>                  x@(cmd:args) ->
+>                      case prefixLookup cmdTable cmd of
+>                      [] ->
+>                          try (defCmd st (unwords x))          >>=
+>                          either
+>                          (\err -> putStrLn (show err)          >>
+>                                   loop st)
+>                          (\st' -> loop st')
+>                      [(_, act)] ->
+>                          try (act st args)                    >>=
+>                          either
+>                          (\err -> putStrLn (show err)          >>
+>                                   loop st)
+>                          (\st' -> loop st')
+>                      _ ->
+>                          putStrLn "\BELambiguous command"      >>
+>                          loop st
+>     handle st =  putStrLn "<<interrupt>>"                      >>
+>                  loop st
+
+
+
+> bye error     = do
+>                   eof <- isEOF
+>                   if eof
+>                      then do putStrLn "\nlogout"
+>                              exit
+>                      else do putStrLn (show error)
+>                              exitWith (ExitFailure 1)
+
+ > bye EOF       =  putStrLn "\nlogout"                           >>
+ >                  exit
+ > bye err       =  putStrLn (show err)                           >>
+ >                  exitWith (ExitFailure 1)
+
+
+
+Command line interpreter with help facility
+
+
+> commandLineInterpreterWithHelp
+>               :: [Char]                               -- prompt
+>               -> [([[Char]], [Char], [Char],          -- list of commands
+>                    st -> [[Char]] -> IO st)]
+>               -> (st -> [Char] -> IO st)              -- default command
+>               -> st                                   -- initial state
+>               -> IO ()
+
+
+
+
+> commandLineInterpreterWithHelp prompt cmdList
+>               =  commandLineInterpreter prompt
+>                      [ (xs, cmd) | (xs, _, _, cmd)<-cmdList' ]
+>     where
+>     cmdList'  =  help:cmdList
+>     helpList  =  [ (replace '%' s1 x, s2) | (xs, s1, s2, _)<-cmdList', x<-xs ]
+>     help      =  (["help", "?"], "%", "display this page",
+>                   \st _ ->
+>                   sequence [ putStrLn s
+>                   | s<-mergeSort (beside2 helpList) ]         >>
+>                   return st)
+
+
+
+Additional functions
+
+
+> exit          :: IO a
+> exit          =  exitWith ExitSuccess
+
+
+
+
+> unknown       :: st -> [Char] -> IO st 
+> unknown st _  =  putStrLn "\BELunknown command"                >>
+>                  return st
+
+
+
+Auxiliary definitions
+
+
+ > catch         :: IO a -> (IOError13 -> IO a) -> IO a
+ > catch a f     =  try a >>= either f return
+
+
+Der Aufruf replace c s t ersetzt das Zeichen c im String s durch den String t. AUSNAHME: dem Zeichen c geht das Escape-Zeichen c (ohne
+
+
+> replace                       :: Char -> [Char] -> [Char] -> [Char]
+> replace c s t                 = run s
+>     where
+>     run []                    = []
+>     run s@[a]
+>         | a == c              = t
+>         | otherwise           = s
+>     run (a:x@(b:x'))
+>         | a == '\\' && b == c =  c:run x'
+>         | a == c              =  t ++ run x
+>         | otherwise           =  a:run x
+
+
+
+
+> beside2 xys   =  [ ljustify m x ++ y | (x, y)<-xys ]
+>     where m   =  4 + maximum [ length x | (x, _)<-xys]
+
+
hunk ./Convert.lhs 43
-> abstract x (Neg e)            =  minus (abstract x e)
+> abstract x (Negg e)           =  minus (abstract x e)
hunk ./Expr.lhs 30
->                       |  Neg     Expr
+>                       |  Negg    Expr
hunk ./Limes.lhs 5
-> module Limes          (  Extended(..), mapE, limes
->                       )
+> module Limes     --     (  Extended, mapE, limes
+>                  --     )
hunk ./Limes.lhs 16
-> import Function       (  Function(..), Prim(..),
->                          minus, (***), zero, one, mone, two, mtwo  )
+> import Prim
+> import Function       --(  Function(..), Prim(..),
+>                       --   minus, (***), zero, one, mone, two, mtwo  )
hunk ./Parse.lhs 68
->               <|>  (do { lit '-'; e <- sfactor; return (Neg e) })
+>               <|>  (do { lit '-'; e <- sfactor; return (Negg e) })
hunk ./Print.lhs 18
-> import Expr           (  Prim(..), Expr(..)  )
-> import Limes          (  Extended(..)  )
+> import Expr           --(  Prim(..), Expr(..)  )
+> import Limes          --(  Extended(..)  )
hunk ./Print.lhs 57
->     ppPrec d (Neg e)          =  paren (d > 4)
+>     ppPrec d (Negg e)          =  paren (d > 4)
hunk ./Replace.lhs 14
-> import Function       (  Prim(..), Function(..)  )
+> import Prim
+> import Function       -- (  Prim(..), Function(..)  )
}