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

1 files changed, 0 insertions, 141 deletions

diff --git a/HsBot.hs b/HsBot.hs
deleted file mode 100644
index 25d2b34..0000000
--- a/HsBot.hs
+++ /dev/null
@@ -1,141 +0,0 @@
-module IRC where
-
-import IO
-import List
-import Network
-import System
-import System.IO
-import Text.Printf
-
-import Conf
-import State
-import Tools
-import User
-
-load :: String -> IO State
-load databaseFile = do
-   file <- readFile databaseFile
-   return ( read file :: State )
-
-save :: State -> IO ()
-save = writeFile database . show
-
-saveIO :: IO State -> IO ()
-saveIO state = do
-   state' <- state
-   writeFile database (show state')
-
-makeIOState :: IO State
-makeIOState = return (makeState)
-
--- Will be removed some day:
-makeState :: State
-makeState = State { channel = "", line = "", users = [ ], karmas = [ ] } 
----
-
-data IrcMessage = IrcMessage {
-      raw :: String,
-      from :: String,
-      clean :: String,
-      isQuery :: Bool
-   } deriving Show
-
-ircWrite :: Handle -> String -> String -> IO ()
-ircWrite h s t = do
-   hPrintf h   "%s %s\r\n" s t
-   printf      "> %s %s\n" s t
-
-ircPrivmsg :: Handle -> IrcMessage -> State -> Conf -> String -> IO ()
-ircPrivmsg h msg state conf s = 
-      if isMultiline s then ircPrivmsg' (lines s) else ircPrivmsg' [s]
-   where
-      ircPrivmsg' [] = return ()
-      ircPrivmsg' (x:xs) =
-         let receiver = if (isQuery msg) then from msg else channel 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
-
-ircConnect :: State -> Conf -> IO ()
-ircConnect state conf = 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 state { channel = ircChannel } conf
-
-ircEvalLoop :: Handle -> State -> Conf -> IO ()
-ircEvalLoop h state conf = forever $ do
-      t <- hGetLine h
-      let s = init t
-      if ping s 
-         then pong s 
-         else let msg = IrcMessage { 
-                  raw = s,
-                  from = from s, 
-                  clean = clean s, 
-                  isQuery = isQuery s }
-               in ircEval h msg state conf
-   where 
-      forever a = do a; forever a
-      from = drop 1 . takeWhile (/= '!') 
-      clean = drop 1 . dropWhile (/= ':') . drop 1
-      isQuery x = split x ' ' !! 2 == ircNick
-         where ircNick = do { ircNick <- get "ircNick" conf; ircNick } 
-      ping x = "PING :" `isPrefixOf` x
-      pong x = ircWrite h "PONG" (':' : drop 6 x)
-
-ircEval :: Handle -> IrcMessage -> State -> Conf -> IO ()
-ircEval h msg state conf = 
-   case isCommand (clean msg) of
-      Just xs -> dispatch h xs msg state conf
-      Nothing -> ircEvalServerMessage (clean msg)
-   where
-      isCommand ('!':xs) = Just xs
-      isCommand _ = Nothing
-      ircEvalServerMessage "+x" = do
-            ircChannel <- get "ircChannel" conf
-            ircWrite h "JOIN" ircChannel
-      ircEvalServerMessage _ = putStrLn $ show msg
-
-data Command = Command String String (State -> IO ()) 
-instance Show Command where 
-   show (Command a b _) = a ++ " - " ++ b
-
-dispatch :: Handle -> String -> IrcMessage -> State -> Conf -> IO ()
-dispatch h cmd msg state conf = do
-   getLambda ("!" ++ cmd) state -- Eval the specific lambda function of 'command'
-      where
-         commands = [      
-            Command "!h" "Prints help" 
-               (\_ -> do { printHelp commands } ),
-            Command "!i" "Prints infos" 
-               (\_ -> do { sendMessage $ name ++ " " ++ version ++ " (try !h)"} ),
-            Command "!p" "Prints stateiguration" 
-               (\x -> do { sendMessage $ show x } ),
-            Command "!s" "Saves stateiguration" 
-               (\x -> do { sendMessage "Saving current stateiguration"; save x; } ),
-            Command "!q" "quits"
-               (\x -> do { sendMessage "Good bye"; save x; exitWith ExitSuccess } ) 
-            ]
-         sendMessage = ircPrivmsg h msg state conf
-         printHelp = sendMessage . concat . showL 
-         getLambda x = let (Command _ _ c) = getCommand x in c
-         getDescr x = let (Command _ b _) = getCommand x in b
-         getCommand x = 
-               let command = [ (Command a b c) | (Command a b c) <- commands, a == x ]
-                in if length command == 0
-                     then getCommand "!i" 
-                     else head command
-