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

1 files changed, 51 insertions, 0 deletions

diff --git a/HsBot/Base.hs b/HsBot/Base.hs
new file mode 100644
index 0000000..a349fad
--- /dev/null
+++ b/HsBot/Base.hs
@@ -0,0 +1,51 @@
+module HsBot.Base (startBase) where
+
+import System
+
+import HsBot.Base.Cmd
+import HsBot.Base.Conf
+import HsBot.Base.Env
+import HsBot.Base.State
+import HsBot.General.Tools
+import HsBot.IRC
+import HsBot.Logics
+
+startBase :: IO ()	
+startBase = do
+   let conf = makeConf
+   databaseFile <- get "databaseFile" conf
+   let state = stateLoad databaseFile
+   state' <- state -- Extract State from the IO Monad 
+   ircStart (DispatchEnv state' conf dispatch)
+
+dispatch :: Dispatch
+dispatch msg sendMessage env@(Env state conf) = dispatch' msg
+   where
+      dispatch' ('!':_) = 
+         case cmdGet msg commands of
+           Just (Cmd _ _ cmdAction) -> do
+              cmdAction state
+              return (env)
+           Nothing -> return (env)
+      dispatch' _ = logicsRun msg env
+      commands = [      
+         Cmd "!h" "Prints help" printHelp,
+         Cmd "!i" "Prints infos" printInfos,
+         Cmd "!p" "Prints current state" printState, 
+         Cmd "!s" "Stores current state to file" storeState,
+         Cmd "!q" "quits" quit
+         ]
+      printHelp _ = printHelp' commands
+         where printHelp' = sendMessage . concat . showL 
+      printInfos _ = do
+         sendMessage $ (envGet "name" env) 
+            ++ " " ++ (envGet "version" env) 
+            ++ " (try !h)"
+      printState = sendMessage . show
+      storeState state = do
+         sendMessage "Storing current state"
+         stateSave (envGet "databaseFile" env) state
+      quit state = do
+         sendMessage "Good bye"
+         stateSave (envGet "databaseFile" env) state
+         exitWith ExitSuccess