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 Support ( ljustify )
> import IOSupport ( getLine, putLine )
> import Sort ( mergeSort )
> import Trie ( Trie, fromList, prefixLookup )
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 -> putLine (show err) >>
> loop st)
> (\st' -> loop st')
> [(_, act)] ->
> try (act st args) >>=
> either
> (\err -> putLine (show err) >>
> loop st)
> (\st' -> loop st')
> _ ->
> putLine "\BELambiguous command" >>
> loop st
> handle st = putLine "<<interrupt>>" >>
> loop st
> bye EOF = putLine "\nlogout" >>
> exit
> bye err = putLine (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 [ putLine s
> | s<-mergeSort (beside2 helpList) ] >>
> return st)
Additional functions
> exit :: IO a
> exit = exitWith ExitSuccess
> unknown :: st -> [Char] -> IO st
> unknown st _ = putLine "\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]