diff options
Diffstat (limited to '')
| -rw-r--r-- | Hsbot/Core.hs | 52 |
1 files changed, 33 insertions, 19 deletions
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs index 7f97918..43276f9 100644 --- a/Hsbot/Core.hs +++ b/Hsbot/Core.hs @@ -17,6 +17,7 @@ import Network.TLS import Prelude hiding (catch) import System.IO import System.Log.Logger +import Text.ParserCombinators.Parsec import Hsbot.Plugin import Hsbot.Types @@ -104,25 +105,38 @@ runHsbot die_msgs = do return code botReader :: BotEnv -> Handle -> Maybe (TLSCtx Handle) -> Chan Message -> IO () -botReader env _ (Just ctx) chan = forever $ - fmap L.toString (recvData ctx) `catch` handleIOException env "botReader died" >>= handleIncomingStr chan -botReader env handle Nothing chan = forever $ - hGetLine handle `catch` handleIOException env "botReader died" >>= handleIncomingStr chan - -handleIOException :: BotEnv -> String -> IOException -> IO String -handleIOException env msg ioException = do - runReaderT (setGlobalQuitMVar $ BotRestart (show ioException, Just msg)) env - myId <- myThreadId - killThread myId - return "" - -handleIncomingStr :: Chan Message -> String -> IO () -handleIncomingStr chan str = - case IRC.decode str of - Just msg -> do - debugM "Hsbot.Reader" $ "<-- " ++ show msg - writeChan chan $ IncomingMsg msg - Nothing -> return () +botReader env handle mctx chan = do + ioException <- botTrueReader "" `catch` return + runReaderT (setGlobalQuitMVar $ BotRestart (show ioException, Just "botReader died")) env + where + botTrueReader :: String -> IO IOException + botTrueReader buff = do + str <- readThis handle mctx + case parse messages [] (buff ++ str) of + Right (msgs, trash) -> do + mapM_ handleMessage msgs + botTrueReader trash + Left err -> do + errorM "Hsbot.Reader" $ "Reader decode error (" ++ show err ++ ") on " ++ str + botTrueReader "" + messages = do + msgs <- many1 message + trash <- option "" $ many1 anyChar + return (msgs, trash) + message = do + mess <- many1 $ noneOf "\r\n" + end <- string "\r\n" <|> string "\r" <|> string "\n" + return $ mess ++ end + handleMessage :: String -> IO () + handleMessage str = + case IRC.decode str of + Just msg -> do + debugM "Hsbot.Reader" $ "<-- " ++ show msg + writeChan chan $ IncomingMsg msg + Nothing -> return () + readThis :: Handle -> Maybe (TLSCtx Handle) -> IO String + readThis _ (Just ctx) = fmap L.toString (recvData ctx) + readThis h Nothing = hGetLine h botLoop :: Env IO () botLoop = forever $ do |