{-# OPTIONS -fglasgow-exts #-} module Esotericbot.IRCCom where import Prelude as P import Data.ByteString.Lazy.Char8 as BS import qualified Data.ByteString.Lazy as Lz import Data.ByteString.Unsafe import Data.Attoparsec import Data.Either import Data.List.Stream as L import System.IO as IO import Control.Applicative as Ap import Control.Monad.Reader import Control.Monad.State import Esotericbot.BSUtils import Esotericbot.EBTypes import Esotericbot.BSH -- only valid for the first message! get_real_server bs = do sb <- get zerozeroone <- liftIO $ ls2bs 3 "001"# return $ parse ( real_server zerozeroone $ nick sb ) bs real_server zerozeroone n = do word8 58 sv <- manyTill anyWord8 space string zerozeroone space string n return $ Lz.pack sv get_ops bs = do sb <- get return $ maybe Nothing ( \ cserv -> either ( const $ Nothing ) Just $ snd $ parse ( ops_p sb cserv ) bs ) $ cserver sb end_of_names bs = do sb <- get maybe ( return Nothing ) ( \ cserv -> do eons <- liftIO $ ls2bs 19 "End of /NAMES list."# either ( const $ return Nothing ) ( return . Just ) $ snd $ parse ( end_of_names_p sb cserv eons ) bs ) $ cserver sb end_of_names_p sb cserv eons = do word8 58 string cserv space digit digit digit space string $ nick sb space chan <- takeTill $ (==) 32 space word8 58 string eons return chan ops_p sb cserv = do word8 58 string $ cserv space digit digit digit space string $ nick sb space eitherP ( word8 64 ) $ word8 61 space chan <- takeTill $ (==) 32 space word8 58 ops_users <- many $ eitherP op luser -- honestly, theres a namespace clash return $ ( chan , lefts ops_users ) op = do word8 64 name <- notEmpty $ takeTill $ (==) 32 optional space return name -- LUZERS lololol. Ok shoot me now. Really, there is a namespace clash. luser = do name <- notEmpty $ takeTill $ (==) 32 optional space return name write2 h cmd val = do msg <- return $ cmd `hAppend` singleton ' ' `hAppend` val liftIO $ flip runReaderT h $ do msg `hAppend` crlf out msg writeMsg h msg = do liftIO $ flip runReaderT h $ msg `hAppend` crlf out msg -- like privmsg, but decides whether to send it to a channel, or just a user priv_msg h cmd r = maybe ( privmsg h ( irc_user cmd ) r ) ( \ chan -> privmsg h chan r ) $ irc_chan cmd -- here c is the person or channel to whom/which the message is being sent privmsg h c m = do sb <- get priv_msg <- liftIO $ ls2bs 8 "PRIVMSG "# colon <- liftIO $ ls2bs 2 " :"# msg <- return $ priv_msg `hAppend` c `hAppend` colon `hAppend` m liftIO $ flip runReaderT h $ msg `hAppend` crlf out msg out ms = do sb <- get liftIO $ do flip runReaderT IO.stdout $ '>' `hAppend` ms `hAppend` '\n' hFlush stdout crlf = do nl <- liftIO $ unsafePackAddressLen 2 "\r\n"# send nl h <- ask liftIO $ hFlush h cmd_line_p :: SmallBotConf -> Lz.ByteString -> Parser ( Either Command PluginCommand ) cmd_line_p sb prvm = do word8 58 name <- try ( takeTill $ (==) 33 ) <|> ( takeTill $ (==) 32 ) manyTill anyWord8 space string prvm word8 32 chan <- takeTill $ (==) 32 let mchan = if chan == nick sb then Nothing else Just chan word8 32 word8 58 try ( let plugin_shortcut pl = do maybe Ap.empty string $ shortcut pl space spaces cmd <- takeTill $ (==) 13 return $ Right $ PluginCommand { pirc_user = name , pirc_cmd = cmd , pirc_chan = mchan , plugin = pl } in choices $ L.map plugin_shortcut $ plugins sb ) <|> ( do string $ command_prefix sb cmd <- takeTill $ (==) 13 return $ Left $ Command { circ_user = name , circ_cmd = cmd , circ_chan = mchan } ) cmd_line line = do sb <- get prvm <- liftIO $ do ls2bs 7 "PRIVMSG"# return $ snd $ parse ( cmd_line_p sb prvm ) line