summaryrefslogtreecommitdiff
path: root/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Main.hs')
-rw-r--r--Main.hs57
1 files changed, 25 insertions, 32 deletions
diff --git a/Main.hs b/Main.hs
index f550665..b3c6f7c 100644
--- a/Main.hs
+++ b/Main.hs
@@ -23,36 +23,29 @@ r = main
dispatch :: Dispatch
dispatch cmd sendMessage env@(Env state conf _) =
- let (Cmd _ _ dispatchFunction) = getCmd ("!" ++ cmd)
- in dispatchFunction state
- where
- 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,
- 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
-
+ let 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
+
+ in case cmdGet ("!" ++ cmd) commands of
+ Just (Cmd _ _ dispatchFunction) -> dispatchFunction state
+ Nothing -> dispatch "i" sendMessage env