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

11 files changed, 0 insertions, 338 deletions

diff --git a/AI.hs b/AI.hs
deleted file mode 100644
index bcae182..0000000
--- a/AI.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module AI (aiRun) where
-
-import Env
-
-aiRun :: String -> Env -> IO Env
-aiRun str env = return (env)
diff --git a/Cmd.hs b/Cmd.hs
deleted file mode 100644
index 3e85e86..0000000
--- a/Cmd.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Cmd where
-
-import 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/Conf.hs b/Conf.hs
deleted file mode 100644
index 9db9c19..0000000
--- a/Conf.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-module 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/Env.hs b/Env.hs
deleted file mode 100644
index bb6a0b8..0000000
--- a/Env.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module Env where
-
-import Conf
-import 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/IRC.hs b/IRC.hs
deleted file mode 100644
index d516e3f..0000000
--- a/IRC.hs
+++ /dev/null
@@ -1,96 +0,0 @@
-module IRC (ircStart) where
-
-import IO
-import List
-import Network
-import System
-import System.IO
-import Text.Printf
-
-import Conf
-import Env
-import State
-import Tools
-import User
-
-data IrcMessage = IrcMessage {
-      raw :: String,
-      from :: String,
-      clean :: String,
-      isQuery :: Bool
-   } deriving Show
-
-ircWrite :: Handle -> String -> String -> IO ()
-ircWrite h s t = do
-   printf    "> %s %s\n" s t
-   hPrintf h "%s %s\r\n" s t
-
-ircPrivMsg :: Handle -> IrcMessage -> Env -> String -> IO ()
-ircPrivMsg h msg env@(Env state _) s = do
-      ircPrivMsg' $ if isMultiline s then (lines s) else [s]
-   where
-      ircPrivMsg' [] = return ()
-      ircPrivMsg' (x:xs) = 
-         let maxMessageSize = 
-               envGetInt "maxMessageSize" env 
-             receiver = 
-               if (isQuery msg) 
-                  then from msg 
-                  else currentChannel state
-          in if length x > maxMessageSize
-               then do 
-                  ircWrite h "PRIVMSG" (receiver ++ " :" 
-                        ++ (take maxMessageSize x) ++ "...")
-                  ircWrite h "PRIVMSG" (receiver ++ " :" 
-                        ++ "...this message has been cut to " 
-                        ++ (show maxMessageSize) ++ " chars")
-                  ircPrivMsg' xs
-               else do
-                  ircWrite h "PRIVMSG" (receiver ++ " :" ++ x)
-                  ircPrivMsg' xs
-
-ircStart :: Env -> IO ()
-ircStart (DispatchEnv state conf dispatch) = do
-   ircChannel <- get "ircChannel" conf
-   ircNick <- get "ircNick" conf
-   ircPort <- get "ircPort" conf
-   ircServer <- get "ircServer" conf
-   ircUser <- get "ircUser" conf
-   h <- connectTo ircServer (PortNumber $ fromIntegral (read ircPort :: Int))
-   hSetBuffering h NoBuffering
-   ircWrite h "NICK" ircNick
-   ircWrite h "USER" $ ircNick ++ " 0 * :" ++ ircUser
-   ircEvalLoop h (DispatchEnv state { currentChannel = ircChannel } conf dispatch)
-   return ()
-
-ircEvalLoop :: Handle -> Env -> IO () 
-ircEvalLoop h env = do
-      t <- hGetLine h
-      let s = init t
-      env' <- branch s
-      ircEvalLoop h env'
-   where 
-      branch s 
-         | ping s = do { pong s; return (env) }
-         | otherwise = ircEval h (msg s) env
-      ping x = "PING :" `isPrefixOf` x
-      pong x = ircWrite h "PONG" (':' : drop 6 x)
-      from = drop 1 . takeWhile (/= '!') 
-      clean = drop 1 . dropWhile (/= ':') . drop 1
-      isQuery x = split x ' ' !! 2 == (envGet "ircNick" env)
-      msg s = IrcMessage { 
-         raw = s, from = from s, 
-         clean = clean s, isQuery = isQuery s
-      }
-
-ircEval :: Handle -> IrcMessage -> Env -> IO Env
-ircEval h msg env@(DispatchEnv state _ dispatch) = ircEval' (clean msg)
-   where
-      ircEval' "+x" = do
-         ircWrite h "JOIN" (currentChannel state)
-         return (env)
-      ircEval' cleanMsg = do
-         (Env s c) <- dispatch cleanMsg sendReplyMsg (castEnv env)
-         return (DispatchEnv s c dispatch)
-      sendReplyMsg = ircPrivMsg h msg (castEnv env)
-
diff --git a/Karma.hs b/Karma.hs
deleted file mode 100644
index 9093936..0000000
--- a/Karma.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module Karma where
-
-data Karma = Karma { 
-      karmaName :: String, 
-      minPts :: Int, 
-      minPerc :: Float
-   } deriving (Show, Read)
-
-instance Eq Karma where 
-   x == y = (minPerc x) == (minPerc y) && (minPts x == minPts y)
-
-instance Ord Karma where
-   x > y
-      | (minPerc x) > (minPerc y) = True
-      | otherwise = (minPts x) > (minPts y)
-   x < y
-      | (minPerc x) < (minPerc y) = True
-      | otherwise = (minPts x) < (minPts y)
-   x >= y = not (x < y)
-   x <= y = not (x > y)
-
diff --git a/Main.hs b/Main.hs
deleted file mode 100644
index 4bd88dc..0000000
--- a/Main.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-module Main where
-
-import System
-
-import AI
-import Cmd
-import Conf
-import Env
-import IRC
-import State
-import Tools
-
-main :: IO ()	
-main = 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)
-
--- Shortcut
-r :: IO ()
-r = main
-
-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' _ = aiRun 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/Render.hs b/Render.hs
deleted file mode 100644
index 924040b..0000000
--- a/Render.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-module Render where
-
-class Render a where 
-   render :: a -> String
-
diff --git a/State.hs b/State.hs
deleted file mode 100644
index 8ab8e33..0000000
--- a/State.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-module State where
-
-import qualified Data.Map as M
-
-import List
-import 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/Tools.hs b/Tools.hs
deleted file mode 100644
index e28d4f9..0000000
--- a/Tools.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-module Tools where
-
-uniq :: (Eq a) => [a] -> [a]
-uniq list = 
-	let r = u' list 0                    
-            u' [] _ = []              
-  	    u' (x:list) n 
-		   | member x r n = u' list n 
-		   | otherwise = x:(u' list (n + 1))
-  	    member e list 0 = False
-  	    member y (x:list) n = x == y || member y list (n - 1)
-    in r
-
-split :: String -> Char -> [String]
-split [] delim = [""]
-split (c:cs) delim 
-      | c == delim = "" : rest
-   	| otherwise = (c : head rest) : tail rest
-   where rest = split cs delim
-
-empty :: String -> Bool
-empty str = length str == 0
-
-contains :: String -> Char -> Bool
-contains str char = takeWhile (/= char) str /= str
-
-isMultiline :: String -> Bool
-isMultiline str = contains str '\n'
-
-showL :: Show a => [a] -> [String]
-showL = map (\x -> show x ++ "\n")
-
diff --git a/User.hs b/User.hs
deleted file mode 100644
index ba1a58c..0000000
--- a/User.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-module User where
-
-import List
-
-import Karma
-import Render
-
-data User = User { 
-      userName :: String,
-      userPts :: Int 
-   } deriving (Show, Read) 
-
-instance Eq User where 
-   x == y = (userPts x) == (userPts y)
-
-instance Ord User where
-	x < y = (userPts x) < (userPts y)
-	x > y = (userPts x) > (userPts y)
-	x >= y = not (x < y)
-	x <= y = not (x > y)
-
-instance Render User where
-	render user = userName user ++ ": " ++ 
-		(show $ userPts user) ++ "pts"
-
-userEquals :: User -> User -> Bool
-userEquals x y = (userName x) == (userName y)
-