esotericbot-0.0.1: Esotericbot/IRCCom.hs

{-# 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