From 80ff91aa5d6cda6adc1c97dc39b950dd7daed9d5 Mon Sep 17 00:00:00 2001
From: pb <pb@9f8f72e9-4bf4-416e-b76e-7d4203597157>
Date: Sun, 28 Mar 2010 11:09:30 +0000
Subject: git-svn-id: https://ssl.buetow.org/repos/hsbot/trunk@50
 9f8f72e9-4bf4-416e-b76e-7d4203597157

---
 HsBot/Base.hs       | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++
 HsBot/Base/Cmd.hs   | 16 ++++++++++++++++
 HsBot/Base/Conf.hs  | 28 ++++++++++++++++++++++++++++
 HsBot/Base/Env.hs   | 19 +++++++++++++++++++
 HsBot/Base/State.hs | 32 ++++++++++++++++++++++++++++++++
 HsBot/Cmd.hs        | 16 ----------------
 HsBot/Conf.hs       | 28 ----------------------------
 HsBot/Env.hs        | 19 -------------------
 HsBot/IRC.hs        |  6 +++---
 HsBot/Logics.hs     |  2 +-
 HsBot/Start.hs      | 51 ---------------------------------------------------
 HsBot/State.hs      | 32 --------------------------------
 12 files changed, 150 insertions(+), 150 deletions(-)
 create mode 100644 HsBot/Base.hs
 create mode 100644 HsBot/Base/Cmd.hs
 create mode 100644 HsBot/Base/Conf.hs
 create mode 100644 HsBot/Base/Env.hs
 create mode 100644 HsBot/Base/State.hs
 delete mode 100644 HsBot/Cmd.hs
 delete mode 100644 HsBot/Conf.hs
 delete mode 100644 HsBot/Env.hs
 delete mode 100644 HsBot/Start.hs
 delete mode 100644 HsBot/State.hs

(limited to 'HsBot')

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 
diff --git a/HsBot/Base/Cmd.hs b/HsBot/Base/Cmd.hs
new file mode 100644
index 0000000..c4963ac
--- /dev/null
+++ b/HsBot/Base/Cmd.hs
@@ -0,0 +1,16 @@
+module HsBot.Base.Cmd where
+
+import HsBot.Base.State
+
+data Cmd = Cmd String String (State -> IO ()) 
+
+instance Show Cmd where 
+   show (Cmd a b _) = a ++ " - " ++ b
+
+cmdGet :: String -> [Cmd] -> Maybe Cmd
+cmdGet x commands = 
+   let command = [ (Cmd a b c) | (Cmd a b c) <- commands, a == x ]
+    in if length command == 0
+         then Nothing
+         else Just (head command)
+
diff --git a/HsBot/Base/Conf.hs b/HsBot/Base/Conf.hs
new file mode 100644
index 0000000..54749ba
--- /dev/null
+++ b/HsBot/Base/Conf.hs
@@ -0,0 +1,28 @@
+module HsBot.Base.Conf where
+
+import qualified Data.Map as M
+
+type Conf = M.Map String String
+
+makeConf = M.fromList 
+         [ ("name", "HsBot")
+         , ("version", "v0.0")
+         , ("databaseFile", "hsbot.db")
+         , ("maxMessageSize", "400")
+         , ("admin", "rantanplan")
+         , ("ircServer", "irc.german-elite.net")
+         , ("ircChannel", "#buetow.org")
+         , ("ircNick", "hotdog")
+         , ("ircPort", "6667")
+         , ("ircUser", "hsbot.haskell.eu")
+         ]
+
+get :: (Monad m) => String -> Conf -> m String
+get = M.lookup 
+
+getUnwrappedInt :: String -> Conf -> Int
+getUnwrappedInt key conf = read (getUnwrapped key conf) :: Int
+
+getUnwrapped :: String -> Conf -> String
+getUnwrapped key conf = do { val <- get key conf; val }
+
diff --git a/HsBot/Base/Env.hs b/HsBot/Base/Env.hs
new file mode 100644
index 0000000..58b2347
--- /dev/null
+++ b/HsBot/Base/Env.hs
@@ -0,0 +1,19 @@
+module HsBot.Base.Env where
+
+import HsBot.Base.Conf
+import HsBot.Base.State
+
+type Dispatch = String -> (String -> IO ()) -> Env -> IO Env
+data Env = DispatchEnv State Conf Dispatch | Env State Conf
+
+castEnv :: Env -> Env
+castEnv (DispatchEnv state conf _) = Env state conf
+
+envGetInt :: String -> Env -> Int
+envGetInt key (Env _ conf) = getUnwrappedInt key conf
+envGetInt key env = envGetInt key (castEnv env)
+
+envGet :: String -> Env -> String
+envGet key (Env _ conf) = getUnwrapped key conf
+envGet key env = envGet key (castEnv env)
+
diff --git a/HsBot/Base/State.hs b/HsBot/Base/State.hs
new file mode 100644
index 0000000..abcf479
--- /dev/null
+++ b/HsBot/Base/State.hs
@@ -0,0 +1,32 @@
+module HsBot.Base.State where
+
+import qualified Data.Map as M
+
+import List
+import HsBot.IRC.User
+
+data State = State { 
+      currentChannel :: String, 
+      line :: String, 
+      users :: [User]
+   } deriving (Show, Read)
+
+stateNumUsers :: State -> Int
+stateNumUsers state = length $ users state
+
+stateSortedUsers :: State -> [User]
+stateSortedUsers state = sort $ users state
+
+stateLoad :: String -> IO State
+stateLoad databaseFile = do
+   file <- readFile databaseFile
+   return ( read file :: State )
+
+stateSave :: String -> State -> IO ()
+stateSave databaseFile = writeFile databaseFile . show
+
+stateSaveIO :: String -> IO State -> IO ()
+stateSaveIO databaseFile state = do
+   state' <- state
+   writeFile databaseFile (show state')
+
diff --git a/HsBot/Cmd.hs b/HsBot/Cmd.hs
deleted file mode 100644
index 7de643e..0000000
--- a/HsBot/Cmd.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module HsBot.Cmd where
-
-import HsBot.State
-
-data Cmd = Cmd String String (State -> IO ()) 
-
-instance Show Cmd where 
-   show (Cmd a b _) = a ++ " - " ++ b
-
-cmdGet :: String -> [Cmd] -> Maybe Cmd
-cmdGet x commands = 
-   let command = [ (Cmd a b c) | (Cmd a b c) <- commands, a == x ]
-    in if length command == 0
-         then Nothing
-         else Just (head command)
-
diff --git a/HsBot/Conf.hs b/HsBot/Conf.hs
deleted file mode 100644
index 2faed0b..0000000
--- a/HsBot/Conf.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-module HsBot.Conf where
-
-import qualified Data.Map as M
-
-type Conf = M.Map String String
-
-makeConf = M.fromList 
-         [ ("name", "HsBot")
-         , ("version", "v0.0")
-         , ("databaseFile", "hsbot.db")
-         , ("maxMessageSize", "400")
-         , ("admin", "rantanplan")
-         , ("ircServer", "irc.german-elite.net")
-         , ("ircChannel", "#buetow.org")
-         , ("ircNick", "hotdog")
-         , ("ircPort", "6667")
-         , ("ircUser", "hsbot.haskell.eu")
-         ]
-
-get :: (Monad m) => String -> Conf -> m String
-get = M.lookup 
-
-getUnwrappedInt :: String -> Conf -> Int
-getUnwrappedInt key conf = read (getUnwrapped key conf) :: Int
-
-getUnwrapped :: String -> Conf -> String
-getUnwrapped key conf = do { val <- get key conf; val }
-
diff --git a/HsBot/Env.hs b/HsBot/Env.hs
deleted file mode 100644
index e8f6092..0000000
--- a/HsBot/Env.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module HsBot.Env where
-
-import HsBot.Conf
-import HsBot.State
-
-type Dispatch = String -> (String -> IO ()) -> Env -> IO Env
-data Env = DispatchEnv State Conf Dispatch | Env State Conf
-
-castEnv :: Env -> Env
-castEnv (DispatchEnv state conf _) = Env state conf
-
-envGetInt :: String -> Env -> Int
-envGetInt key (Env _ conf) = getUnwrappedInt key conf
-envGetInt key env = envGetInt key (castEnv env)
-
-envGet :: String -> Env -> String
-envGet key (Env _ conf) = getUnwrapped key conf
-envGet key env = envGet key (castEnv env)
-
diff --git a/HsBot/IRC.hs b/HsBot/IRC.hs
index 7efb732..cf1a1e8 100644
--- a/HsBot/IRC.hs
+++ b/HsBot/IRC.hs
@@ -7,9 +7,9 @@ import System
 import System.IO
 import Text.Printf
 
-import HsBot.Conf
-import HsBot.Env
-import HsBot.State
+import HsBot.Base.Conf
+import HsBot.Base.Env
+import HsBot.Base.State
 import HsBot.General.Tools
 import HsBot.IRC.User
 
diff --git a/HsBot/Logics.hs b/HsBot/Logics.hs
index 01eda7c..d27c96f 100644
--- a/HsBot/Logics.hs
+++ b/HsBot/Logics.hs
@@ -1,6 +1,6 @@
 module HsBot.Logics (logicsRun) where
 
-import HsBot.Env
+import HsBot.Base.Env
 
 logicsRun :: String -> Env -> IO Env
 logicsRun str env = return (env)
diff --git a/HsBot/Start.hs b/HsBot/Start.hs
deleted file mode 100644
index 97466d8..0000000
--- a/HsBot/Start.hs
+++ /dev/null
@@ -1,51 +0,0 @@
-module HsBot.Start (start) where
-
-import System
-
-import HsBot.Cmd
-import HsBot.Conf
-import HsBot.Env
-import HsBot.IRC
-import HsBot.Logics
-import HsBot.State
-import HsBot.General.Tools
-
-start :: IO ()	
-start = 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 
diff --git a/HsBot/State.hs b/HsBot/State.hs
deleted file mode 100644
index 9d1fa87..0000000
--- a/HsBot/State.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-module HsBot.State where
-
-import qualified Data.Map as M
-
-import List
-import HsBot.IRC.User
-
-data State = State { 
-      currentChannel :: String, 
-      line :: String, 
-      users :: [User]
-   } deriving (Show, Read)
-
-stateNumUsers :: State -> Int
-stateNumUsers state = length $ users state
-
-stateSortedUsers :: State -> [User]
-stateSortedUsers state = sort $ users state
-
-stateLoad :: String -> IO State
-stateLoad databaseFile = do
-   file <- readFile databaseFile
-   return ( read file :: State )
-
-stateSave :: String -> State -> IO ()
-stateSave databaseFile = writeFile databaseFile . show
-
-stateSaveIO :: String -> IO State -> IO ()
-stateSaveIO databaseFile state = do
-   state' <- state
-   writeFile databaseFile (show state')
-
-- 
cgit v1.2.3