summaryrefslogtreecommitdiff
path: root/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Main.hs')
-rw-r--r--Main.hs45
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 )
+ ]
+