diff --git a/cnb.hs b/cnb.hs index d508797..e0f866d 100644 --- a/cnb.hs +++ b/cnb.hs @@ -3,46 +3,222 @@ import System.IO import Text.Printf import Data.List import System.Exit +import Control.Monad.State +import Text.Regex.Posix +import Data.Char (isSpace) server = "irc.epd-me.net" port = 6667 -chan = "#jeena" +chan = "#selfhtml" nick = "cnb" +rname = "clynx Nerv-Bot" +type Nick = String +data Type = Kick | Invite | Privmsg | Unknown + deriving (Show) + +type Text = String +data Message = Message Nick Type Text + deriving (Show) + +type Key = String +type Value = String +type Store = [(Key, Value)] + +type MyState = (Store, Handle) +type MyStateM = StateT MyState IO + +main :: IO () main = do h <- connectTo server (PortNumber (fromIntegral port)) hSetBuffering h NoBuffering - write h "NICK" nick - write h "USER" (nick ++ " 0 * :clynx Nerv-Bot") - write h "JOIN" chan - listen h + let state = (startStore, h) + runStateT (login >> listen) state >> return () -write :: Handle -> String -> String -> IO () -write h s t = do - hPrintf h "%s %s\r\n" s t - printf "> %s %s\n" s t +login :: MyStateM () +login = do + write "NICK" nick + write "USER" (nick ++ " 0 * :" ++ rname) + joinChan + return () -listen :: Handle -> IO () -listen h = forever $ do - t <- hGetLine h +joinChan :: MyStateM () +joinChan = do + write "JOIN" chan + +getHandle :: MyStateM (Handle) +getHandle = do + (_, h) <- get + return h + +putHandle :: Handle -> MyStateM () +putHandle h = do + (s, _) <- get + put (s, h) + return () + +getStore :: MyStateM (Store) +getStore = do + (s, _) <- get + return s + +putStore :: Store -> MyStateM () +putStore s = do + (_, h) <- get + put (s, h) + return () + +putKeyValue :: String -> String -> MyStateM () +putKeyValue k v = do + s <- getStore + putStore (s ++ [(k,v)]) + return () + +deleteKeyValue :: String -> MyStateM () +deleteKeyValue key = do + s <- getStore + let sn = [(k,v) | (k,v) <- s, k /= key] + putStore (sn) + +match :: String -> MyStateM (Maybe Value) +match s = do + st <- getStore + case (find (\(key, value) -> s =~ key) st) of + Nothing -> return Nothing + Just (k,v) -> return (Just v) + +write :: String -> String -> MyStateM () +write s t = do + h <- getHandle + liftIO $ hPrintf h "%s %s\r\n" s t + +listen :: MyStateM () +listen = forever $ do + h <- getHandle + t <- liftIO $ hGetLine h let s = init t - if ping s then pong s else eval h (clean s) - putStrLn s + if ping s + then pong s + else do eval (parse s) + liftIO $ putStrLn s + return () where forever a = a >> forever a clean = drop 1 . dropWhile (/= ':') . drop 1 ping x = "PING :" `isPrefixOf` x - pong x = write h "PONG" (':' : drop 6 x) + pong x = write "PONG" (':' : drop 6 x) -eval :: Handle -> String -> IO () -eval h "!quit" = write h "QUIT" ":Exiting" >> exitWith ExitSuccess -eval h "!jump" = privmsg h "The quick brown clynx jumps over the lazy oak." -eval h "!implode" = write h "QUIT" ":whhooooooshhhh ..." -eval h "!explode" = write h "QUIT" ":kaBOOooOOOOoommm ..." -eval h x | (nick ++ ":") `isPrefixOf` x = privmsg h "Halt die Fresse!" -eval h x | and [(not (isInfixOf "@clynx" x)), (isInfixOf "clynx" x)] = - privmsg h "Der clynx kann nix!" -eval _ _ = return () +eval :: Maybe Message -> MyStateM () +eval (Just m@(Message n Privmsg te)) = evalPrivmsg (Just m) +eval (Just (Message _ Invite _)) = invited +eval _ = return () -privmsg :: Handle -> String -> IO () -privmsg h s = write h "PRIVMSG" (chan ++ " :" ++s) +evalPrivmsg :: Maybe Message -> MyStateM () +evalPrivmsg Nothing = return () +evalPrivmsg (Just m@(Message n _ te)) = do + let pat = nick ++ ":(.*)" + let r = te =~ pat :: [[String]] + case r of + [] -> do m <- match te + case m of + Just v -> privmsg v + Nothing -> return () + a -> do let s = last $ head a + action (trim s) m + return () + +action :: String -> Message -> MyStateM () +action s (Message n _ _) | "add " `isPrefixOf` s = do + let (k,v) = parseKeyVal $ rest "add" s + putKeyValue k v + msg (k ++ "~" ++ v ++ " added") n + return () +action s (Message n _ _) | "delete " `isPrefixOf` s = do + let k = rest "delete" s + deleteKeyValue k + msg (k ++ " deleted") n + return () +action "list" (Message n _ _) = do + st <- getStore + mapM (\(k,v) -> msg (k ++ "~" ++ v) n) st + return () +action "leave" (Message n _ _) = do + leave ("Fuck you " ++ n ++ ", I'm quitting!") +action "help" (Message n _ _) = help n +action s (Message n _ _) = do + case (length s) of + 0 -> privmsg "What?!" + _ -> privmsg (n ++ " is boooring! What the fuck do you want me to do with " + ++ (show s) ++ "?") + + +rest :: String -> String -> String +rest k s = drop (length k + 1) s + +privmsg :: String -> MyStateM () +privmsg s = write "PRIVMSG" (chan ++ " :" ++ s) + +msg :: String -> Nick -> MyStateM () +msg s n = write "PRIVMSG" (n ++ " :" ++ s) + +leave :: String -> MyStateM () +leave s = do + privmsg s + write "PART" (chan ++ " :") + +invited :: MyStateM () +invited = joinChan + +parse :: String -> Maybe Message +parse s = do + -- :Jeena!~Jeena@host-3AB762DD.defunced.de PRIVMSG #jeena :test + let pat = ":([a-zA-Z0-9].+)!.+ ([A-Z].+) " ++ chan ++ " :(.*)" + let q = s =~ pat :: [[String]] + -- :Jeena!~Jeena@host-3AB762DD.defunced.de INVITE cnb :#jeena + let pat2 = ":([a-zA-Z0-9].+)!.+ ([A-Z].+) " ++ nick ++ " :" ++ chan + let q2 = s =~ pat2 :: [[String]] + case q of + [] -> do case q2 of + [] -> Nothing + r2 -> do let a2 = tail $ head r2 + case (head $ tail a2) of + "INVITE" -> Just (Message (head a2) Invite (last a2)) + _ -> Nothing + r -> do let a = tail $ head r + case (head $ tail a) of + "KICK" -> Just (Message (head a) Kick (last a)) + "PRIVMSG" -> Just (Message (head a) Privmsg (last a)) + _ -> Nothing + +parseKeyVal :: String -> (Key, Value) +parseKeyVal s = do + let a = wordsBy (=='~') s + (head a, unwords $ tail a) + +wordsBy :: (a -> Bool) -> [a] -> [[a]] +wordsBy sep str = s_skip str + where s_skip [] = [] + s_skip (c:cs) = if sep c then s_skip cs else s_word cs [c] + s_word [] w = [reverse w] + s_word (c:cs) w = if sep c then reverse w : s_skip cs + else s_word cs (c:w) + +trim :: String -> String +trim = f . f + where f = reverse . dropWhile isSpace + +help :: Nick -> MyStateM () +help n = do + privmsg "Hilf dir selbst, dann hilft dir Gott." + msg ("usage:") n + msg (" " ++ nick ++ ": help -> this help") n + msg (" " ++ nick ++ ": add regex~value -> adds a value for a regex") n + msg (" " ++ nick ++ ": delete regex -> deletes the regex-value pair") n + msg (" " ++ nick ++ ": list -> lists all available regex-value pairs") n + msg (" " ++ nick ++ ": leave -> bot leaves the chanel") n + msg (" /invite " ++ nick ++ " " ++ chan ++ " -> invites the bot back to the chanel") n + +startStore :: Store +startStore = [ + ("jump", "The quick brown clynx jumps over the lazy oak.") + ] \ No newline at end of file