git-svn-id: https://ssl.buetow.org/repos/hsbot/trunk@28 9f8f72e9-4bf4-416e-b76e-7d4203597157

1 files changed, 43 insertions, 2 deletions

diff --git a/Main.hs b/Main.hs
index 50e9f44..60d522c 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,9 +1,13 @@
 module Main where
 
+import System
+
+import Cmd
 import Conf
+import Env
 import IRC
 import State
-import Env
+import Tools
 
 main :: IO ()	
 main = do
@@ -11,9 +15,46 @@ main = do
    databaseFile <- get "databaseFile" conf
    let state = stateLoad databaseFile
    state' <- state -- Extract State from the IO Monad 
-   ircConnect (Env state' conf)
+   ircConnect (Env state' conf dispatch)
 
 -- Shortcut
 r :: IO ()
 r = main
 
+dispatch :: Dispatch
+dispatch cmd sendMessage env@(Env state conf _) = 
+   getLambda ("!" ++ cmd) state 
+      where
+         printHelp = sendMessage . concat . showL 
+         getLambda x = let (Cmd _ _ c) = getCmd x in c
+         getDescr x = let (Cmd _ b _) = getCmd x in b
+         getCmd x = 
+               let command = [ (Cmd a b c) | (Cmd a b c) <- commands, a == x ]
+                in if length command == 0
+                     then getCmd "!i" 
+                     else head command
+
+         commands = [      
+            Cmd "!h" "Prints help" 
+               (\_ -> printHelp commands ),
+
+            Cmd "!i" "Prints infos" 
+               (\_ -> sendMessage $ (envGet "name" env) 
+                     ++ " " ++ (envGet "version" env) 
+                     ++ " (try !h)" ),
+
+            Cmd "!p" "Prints current state" 
+               (\s -> sendMessage $ show s ),
+
+            Cmd "!s" "Stores current state to file" 
+               (\s -> do 
+                     sendMessage "Storing current state"
+                     stateSave (envGet "databaseFile" env) s ),
+
+            Cmd "!q" "quits"
+               (\s -> do
+                     sendMessage "Good bye"
+                     stateSave (envGet "databaseFile" env) s
+                     exitWith ExitSuccess ) 
+            ]
+