simpleirc 0.1.0 → 0.2.0

raw patch · 6 files changed

+378/−312 lines, 6 filesdep ~networkPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: network

API changes (from Hackage documentation)

Files

• Network/SimpleIRC.hs +2/−8
• Network/SimpleIRC/Core.hs +296/−106
• Network/SimpleIRC/Messages.hs +77/−57
• Network/SimpleIRC/Types.hs +0/−106
• Network/SimpleIRC/Utils.hs +0/−29
• simpleirc.cabal +3/−6

@@ -15,15 +15,9 @@      -- * Messages   , module Network.SimpleIRC.Messages-  -    -- * Utils-  , module Network.SimpleIRC.Utils-  -    -- * Types-  , module Network.SimpleIRC.Types++   ) where  import Network.SimpleIRC.Core import Network.SimpleIRC.Messages-import Network.SimpleIRC.Utils-import Network.SimpleIRC.Types

@@ -11,8 +11,14 @@ {-# LANGUAGE OverloadedStrings #-} module Network.SimpleIRC.Core   ( +    -- * Types+    MIrc +  , EventFunc+  , IrcConfig(..)+  , IrcEvent(..)+         -- * Functions-    connect+  , connect   , disconnect   , sendRaw   , sendMsg@@ -21,6 +27,16 @@   , changeEvents   , remEvent   , defaultConfig+  +   -- * Utils+  , getDest+  +   -- * Accessors+  , getChannels+  , getNickname+  , getAddress+  , getUsername+  , getRealname   ) where    import Network@@ -30,9 +46,8 @@ import Control.Monad import Control.Concurrent import Control.Concurrent.Chan+import Control.Concurrent.MVar import Network.SimpleIRC.Messages-import Network.SimpleIRC.Types-import Network.SimpleIRC.Utils import Data.Unique import System.IO.Error import Data.Time@@ -43,15 +58,90 @@ internalEvents     = [joinChans, pong, onJoin] internalNormEvents = [Privmsg ctcpHandler] +type MIrc = MVar IrcServer++data IrcConfig = IrcConfig+  { cAddr     :: String   -- ^ Server address to connect to+  , cPort     :: Int      -- ^ Server port to connect to+  , cNick     :: String   -- ^ Nickname+  , cUsername :: String   -- ^ Username+  , cRealname :: String   -- ^ Realname+  , cChannels :: [String]   -- ^ List of channels to join on connect+  , cEvents   :: [IrcEvent] -- ^ Events to bind+  , cCTCPVersion :: String  -- ^ What to send on CTCP VERSION+  , cCTCPTime    :: IO String  -- ^ What to send on CTCP TIME+  }++data SIrcCommand =+    SIrcAddEvent (Unique, IrcEvent)+  | SIrcChangeEvents (Map.Map Unique IrcEvent)+  | SIrcRemoveEvent Unique++data IrcServer = IrcServer+  { sAddr         :: B.ByteString+  , sPort         :: Int+  , sNickname     :: B.ByteString+  , sUsername     :: B.ByteString+  , sRealname     :: B.ByteString+  , sChannels     :: [B.ByteString]+  , sEvents       :: Map.Map Unique IrcEvent+  , sSock         :: Maybe Handle+  , sListenThread :: Maybe ThreadId+  , sCmdThread    :: Maybe ThreadId+  , sCmdChan      :: Chan SIrcCommand+  , sDebug        :: Bool+  -- Other info+  , sCTCPVersion  :: String+  , sCTCPTime     :: IO String+  }++-- When adding events here, remember add them in callEvents and in eventFunc+-- AND also in the Show instance and Eq instance++data IrcEvent = +    Privmsg EventFunc -- ^ PRIVMSG+  | Numeric EventFunc -- ^ Numeric, 001, 002, 372 etc.+  | Ping EventFunc    -- ^ PING+  | Join EventFunc    -- ^ JOIN+  | Part EventFunc    -- ^ PART+  | Mode EventFunc    -- ^ MODE+  | Topic EventFunc   -- ^ TOPIC+  | Invite EventFunc  -- ^ INVITE+  | Kick EventFunc    -- ^ KICK+  | Quit EventFunc    -- ^ QUIT+  | Nick EventFunc    -- ^ NICK+  | Notice EventFunc  -- ^ NOTICE+  | RawMsg EventFunc  -- ^ This event gets called on every message received+  | Disconnect (IrcServer -> IO ()) -- ^ This event gets called whenever the+                                    --   connection with the server is dropped+  +instance Show IrcEvent where+  show (Privmsg _) = "IrcEvent - Privmsg"+  show (Numeric _) = "IrcEvent - Numeric"+  show (Ping    _) = "IrcEvent - Ping"+  show (Join    _) = "IrcEvent - Join"+  show (Part    _) = "IrcEvent - Part"+  show (Mode    _) = "IrcEvent - Mode"+  show (Topic   _) = "IrcEvent - Topic"+  show (Invite  _) = "IrcEvent - Invite"+  show (Kick    _) = "IrcEvent - Kick"+  show (Quit    _) = "IrcEvent - Quit"+  show (Nick    _) = "IrcEvent - Nick"+  show (Notice  _) = "IrcEvent - Notice"+  show (RawMsg  _) = "IrcEvent - RawMsg"+  show (Disconnect  _) = "IrcEvent - Disconnect"++type EventFunc = (MIrc -> IrcMessage -> IO ())+ -- |Connects to a server connect :: IrcConfig       -- ^ Configuration            -> Bool         -- ^ Run in a new thread            -> Bool         -- ^ Print debug messages-           -> IO (Either IOError IrcServer) -- ^ IrcServer instance+           -> IO (Either IOError MIrc) -- ^ IrcServer instance connect config threaded debug = try $ do-  if debug-    then B.putStrLn $ "Connecting to " `B.append` (B.pack $ cAddr config)-    else return ()+  (when debug $+    B.putStrLn $ "Connecting to " `B.append` B.pack (cAddr config))+     h <- connectTo (cAddr config) (PortNumber $ fromIntegral $ cPort config)   hSetBuffering h NoBuffering   @@ -61,21 +151,28 @@   -- Initialize connection with the server   greetServer server   -  -- Start listening+  -- Create a new MVar+  res <- newMVar server+  +  -- Start the loops, listen and exec cmds   if threaded-    then do listenId <- forkIO (listenLoop server)-            return server {sListenThread = Just listenId}-    else do listenLoop server-            return server-    +    then do listenId <- forkIO (listenLoop res)+            cmdId <- forkIO (execCmdsLoop res)+            modifyMVar_ res (\srv -> return $ srv {sListenThread = Just listenId}) +            return res+    else do listenLoop res+            return res+ -- |Sends a QUIT command to the server.-disconnect :: IrcServer+disconnect :: MIrc               -> B.ByteString -- ^ Quit message               -> IO () disconnect server quitMsg = do-  write server $ "QUIT :" `B.append` quitMsg+  s <- readMVar server+  +  let h = fromJust $ sSock s+  write s $ "QUIT :" `B.append` quitMsg   return ()-  where h = fromJust $ sSock server  genUnique :: IrcEvent -> IO (Unique, IrcEvent) genUnique e = do@@ -89,12 +186,12 @@  toServer :: IrcConfig -> Handle -> Chan SIrcCommand -> Bool -> IO IrcServer toServer config h cmdChan debug = do-  uniqueEvents <- genUniqueMap $ internalNormEvents ++ (cEvents config)+  uniqueEvents <- genUniqueMap $ internalNormEvents ++ cEvents config    return $ IrcServer (B.pack $ cAddr config) (cPort config)               (B.pack $ cNick config) (B.pack $ cUsername config)                (B.pack $ cRealname config) (map B.pack $ cChannels config) -              uniqueEvents (Just h) Nothing cmdChan debug+              uniqueEvents (Just h) Nothing Nothing cmdChan debug               (cCTCPVersion config) (cCTCPTime config)  greetServer :: IrcServer -> IO IrcServer@@ -109,54 +206,70 @@         real = sRealname server         addr = sAddr server --- TODO: I think this should execute all commands that are available.-execCmds :: IrcServer -> IO IrcServer-execCmds server = do-  empty <- isEmptyChan $ sCmdChan server-  if not $ empty -    then do cmd <- readChan $ sCmdChan server-            case cmd of (SIrcAddEvent uEvent) -> return server {sEvents = Map.insert (fst uEvent) (snd uEvent) (sEvents server)}-                        (SIrcChangeEvents events) -> return server {sEvents = events}-                        (SIrcRemoveEvent key) -> return server {sEvents = Map.delete key (sEvents server)}-    else return server+execCmdsLoop :: MIrc -> IO ()+execCmdsLoop mIrc = do+  server <- readMVar mIrc+  cmd <- readChan $ sCmdChan server+  case cmd of (SIrcAddEvent uEvent)     -> do+                swapMVar mIrc (server {sEvents = +                  (uncurry Map.insert uEvent) (sEvents server)}) +                execCmdsLoop mIrc+              (SIrcChangeEvents events) -> do+                swapMVar mIrc (server {sEvents = events}) +                execCmdsLoop mIrc+              (SIrcRemoveEvent key)     -> do+                swapMVar mIrc (server {sEvents = +                  Map.delete key (sEvents server)})+                execCmdsLoop mIrc -listenLoop :: IrcServer -> IO ()++listenLoop :: MIrc -> IO () listenLoop s = do-  server <- execCmds s+  server <- readMVar s    let h = fromJust $ sSock server   eof <- hIsEOF h+     -- If EOF then we are disconnected   if eof      then do       let comp   = (\a -> a `eqEvent` (Disconnect undefined))           events = Map.filter comp (sEvents server)           eventCall = (\obj -> (eventFuncD $ snd obj) server)-      debugWrite s $ B.pack $ show $ length $ Map.toList events-      mapM eventCall (Map.toList events)-      return ()+      debugWrite server $ B.pack $ show $ length $ Map.toList events+      mapM_ eventCall (Map.toList events)     else do       line <- B.hGetLine h-      debugWrite s $ (B.pack ">> ") `B.append` line       -      newServ <- foldM (\s f -> f s (parse line)) server internalEvents+      server1 <- takeMVar s       -      callEvents newServ (parse line)+      -- Print the received line.+      debugWrite server1 $ (B.pack ">> ") `B.append` line+      +      -- Call the internal events+      newServ <- foldM (\sr f -> f sr (parse line)) server1 internalEvents+      +      putMVar s newServ -- Put the MVar back.+      +      -- Call the events+      callEvents s (parse line) -      listenLoop newServ+      ++      listenLoop s      -- Internal Events - They can edit the server joinChans :: IrcServer -> IrcMessage -> IO IrcServer-joinChans server msg = do+joinChans server msg =   if code == "001"-    then do mapM (\chan -> write server $ "JOIN " `B.append` chan) (sChannels server)+    then do mapM_ (\chan -> write server $ "JOIN " `B.append` chan) (sChannels server)             return server {sChannels = []}     else return server   where h    = fromJust $ sSock server         code = mCode msg  pong :: IrcServer -> IrcMessage -> IO IrcServer-pong server msg = do+pong server msg =   if code == "PING"     then do       write server $ "PONG :" `B.append` pingMsg@@ -167,6 +280,7 @@         pingMsg = mMsg msg         code    = mCode msg +-- TODO: Nick and Channels tracking. KICK, PART and NICK. onJoin :: IrcServer -> IrcMessage -> IO IrcServer onJoin server msg   | code == "JOIN" = do@@ -181,68 +295,83 @@  -- Internal normal events ctcpHandler :: EventFunc-ctcpHandler server iMsg-  | msg == "\x01VERSION\x01" =-    sendCmd server+ctcpHandler mServ iMsg+  | msg == "\x01VERSION\x01" = do+    server <- readMVar mServ+    +    chan <- getDest mServ iMsg+    sendCmd mServ       (MNotice chan ("\x01VERSION " `B.append`-        (B.pack $ sCTCPVersion server) `B.append` "\x01"))+        B.pack (sCTCPVersion server) `B.append` "\x01"))   | msg == "\x01TIME\x01" = do+    server <- readMVar mServ+         time <- sCTCPTime server-    sendCmd server+    chan <- getDest mServ iMsg+    sendCmd mServ       (MNotice chan ("\x01TIME " `B.append`         (B.pack time) `B.append` "\x01"))+  | "\x01PING " `B.isPrefixOf` msg = do+    server <- readMVar mServ+    +    chan <- getDest mServ iMsg+    sendCmd mServ+      (MNotice chan msg)+   | otherwise = return ()-  where msg  = mMsg iMsg-        chan = getChan server iMsg+  where msg = mMsg iMsg+ -- Event code-events :: IrcServer -> IrcEvent -> IrcMessage -> IO ()-events server event msg = do-  mapM eventCall (Map.toList events)-  return ()-  where comp   = (\a -> a `eqEvent` event)-        events = Map.filter comp (sEvents server)-        eventCall = (\obj -> (eventFunc $ snd obj) server msg)+events :: MIrc -> IrcEvent -> IrcMessage -> IO ()+events mServ event msg = do+  server <- readMVar mServ+  let comp   = (`eqEvent` event)+      events = Map.filter comp (sEvents server)+      eventCall = (\obj -> (eventFunc $ snd obj) mServ msg) -callEvents :: IrcServer -> IrcMessage -> IO ()-callEvents server msg-  | mCode msg == "PRIVMSG"     = do-    events server (Privmsg undefined) msg+  mapM_ eventCall (Map.toList events)+++callEvents :: MIrc -> IrcMessage -> IO ()+callEvents mServ msg+  | mCode msg == "PRIVMSG"     =+    events mServ (Privmsg undefined) msg     -  | mCode msg == "PING"        = do-    events server (Ping undefined) msg+  | mCode msg == "PING"        =+    events mServ (Ping undefined) msg -  | mCode msg == "JOIN"        = do-    events server (Join undefined) msg+  | mCode msg == "JOIN"        =+    events mServ (Join undefined) msg   -  | mCode msg == "PART"        = do-    events server (Part undefined) msg+  | mCode msg == "PART"        =+    events mServ (Part undefined) msg -  | mCode msg == "MODE"        = do-    events server (Mode undefined) msg+  | mCode msg == "MODE"        =+    events mServ (Mode undefined) msg -  | mCode msg == "TOPIC"       = do-    events server (Topic undefined) msg+  | mCode msg == "TOPIC"       =+    events mServ (Topic undefined) msg -  | mCode msg == "INVITE"      = do-    events server (Invite undefined) msg+  | mCode msg == "INVITE"      =+    events mServ (Invite undefined) msg -  | mCode msg == "KICK"        = do-    events server (Kick undefined) msg+  | mCode msg == "KICK"        =+    events mServ (Kick undefined) msg -  | mCode msg == "QUIT"        = do-    events server (Quit undefined) msg+  | mCode msg == "QUIT"        =+    events mServ (Quit undefined) msg -  | mCode msg == "NICK"        = do-    events server (Nick undefined) msg+  | mCode msg == "NICK"        =+    events mServ (Nick undefined) msg -  | mCode msg == "NOTICE"      = do-    events server (Notice undefined) msg+  | mCode msg == "NOTICE"      =+    events mServ (Notice undefined) msg -  | B.all isNumber (mCode msg) = do-    events server (Numeric undefined) msg+  | B.all isNumber (mCode msg) =+    events mServ (Numeric undefined) msg   -  | otherwise                = do-    events server (RawMsg undefined) msg+  | otherwise                =+    events mServ (RawMsg undefined) msg  (Privmsg _) `eqEvent` (Privmsg _) = True (Numeric _) `eqEvent` (Numeric _) = True@@ -278,48 +407,55 @@ eventFuncD (Disconnect  f) = f  -- |Sends a raw command to the server-sendRaw :: IrcServer -> B.ByteString -> IO ()-sendRaw server msg = write server msg+sendRaw :: MIrc -> B.ByteString -> IO ()+sendRaw mServ msg = do+  server <- readMVar mServ+  write server msg  -- |Sends a message to a channel  -- |Please note: As of now this function doesn't provide flood control.--- So be careful.-sendMsg :: IrcServer +-- So be careful with \\n.+sendMsg :: MIrc             -> B.ByteString -- ^ Channel            -> B.ByteString -- ^ Message            -> IO ()-sendMsg server chan msg = do-  mapM (s) lins-  return ()+sendMsg mServ chan msg =+  mapM_ s lins   where lins = B.lines msg-        s m = sendCmd server (MPrivmsg chan m)-sendCmd :: IrcServer+        s m = sendCmd mServ (MPrivmsg chan m)+        +        +sendCmd :: MIrc            -> Command -- Command to send            -> IO ()-sendCmd server cmd =-  sendRaw server (showCommand cmd)+sendCmd mServ cmd = sendRaw mServ (showCommand cmd) -addEvent :: IrcServer -> IrcEvent -> IO Unique-addEvent s event = do+addEvent :: MIrc -> IrcEvent -> IO Unique+addEvent mIrc event = do+  s <- readMVar mIrc+   u <- newUnique   writeChan (sCmdChan s) (SIrcAddEvent (u, event))   return u -changeEvents :: IrcServer -> [IrcEvent] -> IO ()-changeEvents s events = do++changeEvents :: MIrc -> [IrcEvent] -> IO ()+changeEvents mIrc events = do+  s <- readMVar mIrc+   uniqueEvents <- genUniqueMap events   writeChan (sCmdChan s) (SIrcChangeEvents uniqueEvents) -remEvent :: IrcServer -> Unique -> IO ()-remEvent s uniq = do+remEvent :: MIrc -> Unique -> IO ()+remEvent mIrc uniq = do+  s <- readMVar mIrc+   writeChan (sCmdChan s) (SIrcRemoveEvent uniq)  debugWrite :: IrcServer -> B.ByteString -> IO ()-debugWrite s msg = do-  if sDebug s-    then B.putStrLn msg-    else return ()+debugWrite s msg =+  (when (sDebug s) $ B.putStrLn msg)  write :: IrcServer -> B.ByteString -> IO () write s msg = do@@ -334,7 +470,61 @@   , cRealname = "SimpleIRC Bot"   , cChannels = []   , cEvents   = []-  , cCTCPVersion = "SimpleIRC v0.1"-  , cCTCPTime    =  getZonedTime >>= -    (\t -> return $ formatTime defaultTimeLocale "%c" t)+  , cCTCPVersion = "SimpleIRC v0.2"+  , cCTCPTime    = fmap (formatTime defaultTimeLocale "%c") getZonedTime   }+  +-- Utils++-- |Gets the destination, i.e if the IrcMessage was sent+--  directly to you returns the senders nick otherwise the channel.+getDest :: MIrc -> IrcMessage -> IO B.ByteString+getDest mIrc m = do+  s <- readMVar mIrc+  +  if sNickname s == chan+    then return (fromJust $ mNick m)+    else return chan+  +  where chan = fromJust $ mChan m+  +-- MIrc Accessors+-- |Returns a list of channels currently joined.+-- +-- Currently this is not updated on KICK or PART.+getChannels :: MIrc -> IO [B.ByteString]+getChannels mIrc = do+  s <- readMVar mIrc+  +  return $ sChannels s++-- |Returns the current nickname.+-- +-- Currently this is not updated on NICK.+getNickname :: MIrc -> IO B.ByteString+getNickname mIrc = do+  s <- readMVar mIrc+  +  return $ sNickname s+  +-- |Returns the address+getAddress :: MIrc -> IO B.ByteString+getAddress mIrc = do+  s <- readMVar mIrc+  +  return $ sAddr s  ++-- |Returns the User name+getUsername :: MIrc -> IO B.ByteString+getUsername mIrc = do+  s <- readMVar mIrc+  +  return $ sUsername s  ++-- |Returns the Real name+getRealname :: MIrc -> IO B.ByteString+getRealname mIrc = do+  s <- readMVar mIrc+  +  return $ sRealname s  +

@@ -7,18 +7,20 @@ -- Stability : provisional -- Portability : portable ----- Messages module+-- Messages (parsing) module ---{-# LANGUAGE OverloadedStrings #-}-module Network.SimpleIRC.Messages -  ( Command(..)+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}+module Network.SimpleIRC.Messages+  ( IrcMessage(..)+  , Command(..)   , parse-  , showCommand  -  ) +  , showCommand+  ) where import Data.Maybe-import Network.SimpleIRC.Types import qualified Data.ByteString.Char8 as B+import Control.Arrow+import Data.Typeable  -- PING :asimov.freenode.net -- :haskellTestBot!~test@host86-177-151-242.range86-177.btcentralplus.com JOIN :#()@@ -30,89 +32,106 @@ -- :asimov.freenode.net 332 haskellTestBot #() :Parenthesis  -- :asimov.freenode.net 333 haskellTestBot #() Raynes!~macr0@unaffiliated/raynes 1281221819-+   data Command = Command-  | MPrivmsg B.ByteString B.ByteString              -- ^ PRIVMSG #chan :msg-  | MJoin    B.ByteString (Maybe B.ByteString)      -- ^ JOIN #chan key-  | MPart    B.ByteString B.ByteString              -- ^ PART #chan :msg-  | MMode    B.ByteString B.ByteString -      (Maybe B.ByteString)                          -- ^ MODE #chan +o user-  | MTopic   B.ByteString (Maybe B.ByteString)      -- ^ TOPIC #chan :topic-  | MInvite  B.ByteString B.ByteString              -- ^ INVITE user #chan-  | MKick    B.ByteString B.ByteString B.ByteString -- ^ KICK #chan user :msg-  | MQuit    B.ByteString                           -- ^ QUIT :msg-  | MNick    B.ByteString                           -- ^ NICK newnick-  | MNotice  B.ByteString B.ByteString              -- ^ NOTICE usr/#chan :msg-  | MAction  B.ByteString B.ByteString              -- ^ PRIVMSG usr/#chan :\\x01ACTION msg\\x01+  | MPrivmsg B.ByteString B.ByteString                      -- ^ PRIVMSG #chan :msg+  | MJoin    B.ByteString (Maybe B.ByteString)              -- ^ JOIN #chan key+  | MPart    B.ByteString B.ByteString                      -- ^ PART #chan :msg+  | MMode    B.ByteString B.ByteString (Maybe B.ByteString) -- ^ MODE #chan +o user+  | MTopic   B.ByteString (Maybe B.ByteString)              -- ^ TOPIC #chan :topic+  | MInvite  B.ByteString B.ByteString                      -- ^ INVITE user #chan+  | MKick    B.ByteString B.ByteString B.ByteString         -- ^ KICK #chan user :msg+  | MQuit    B.ByteString                                   -- ^ QUIT :msg+  | MNick    B.ByteString                                   -- ^ NICK newnick+  | MNotice  B.ByteString B.ByteString                      -- ^ NOTICE usr/#chan :msg+  | MAction  B.ByteString B.ByteString                      -- ^ PRIVMSG usr/#chan :ACTION msg   deriving (Eq, Read, Show) +data IrcMessage = IrcMessage+  { mNick   :: Maybe B.ByteString+  , mUser   :: Maybe B.ByteString+  , mHost   :: Maybe B.ByteString+  , mServer :: Maybe B.ByteString+  , mCode   :: B.ByteString+  , mMsg    :: B.ByteString+  , mChan   :: Maybe B.ByteString+  , mOther  :: Maybe [B.ByteString]+  , mRaw    :: B.ByteString+  } deriving (Show, Typeable)+ -- |Parse a raw IRC message parse :: B.ByteString -> IrcMessage parse txt = -  case length split of 2 -> (parse2 split) txt-                       3 -> (parse3 split) txt-                       4 -> (parse4 split) txt -                       5 -> (parse5 split) txt-                       otherwise -> (parseOther split) txt-                       +  case length split of +    2 -> parse2 split txt+    3 -> parse3 split txt+    4 -> parse4 split txt +    5 -> parse5 split txt+    _ -> parseOther split txt+     where split = smartSplit (takeCarriageRet txt) -parse4 :: [B.ByteString] -> (B.ByteString -> IrcMessage)-parse4 (first:code:chan:msg:_) = -  let (nick, host, server) = parseFirst first-  in IrcMessage nick host server (code)-       (dropColon msg) (Just chan) Nothing- -- Nick, Host, Server-parseFirst :: B.ByteString -> (Maybe B.ByteString, Maybe B.ByteString, Maybe B.ByteString)+parseFirst :: B.ByteString -> (Maybe B.ByteString, Maybe B.ByteString, Maybe B.ByteString, Maybe B.ByteString) parseFirst first =    if '!' `B.elem` first-    then let (nick, host) = B.break (== '!') (dropColon first)-         in (Just nick, Just host, Nothing)-    else (Nothing, Nothing, Just $ dropColon first) --dropColon :: B.ByteString -> B.ByteString-dropColon xs =-  if B.take 1 xs == (B.pack ":")-    then B.drop 1 xs-    else xs+    then let (nick, user_host) = B.break (== '!') (dropColon first)+         in if '@' `B.elem` user_host+               then let (user, host) = second B.tail $ B.break (== '@') $ B.tail user_host+                    in (Just nick, Just user, Just host, Nothing)+               else (Just nick, Nothing, Just user_host, Nothing)+    else (Nothing, Nothing, Nothing, Just $ dropColon first)  -parse2 :: [B.ByteString] -> (B.ByteString -> IrcMessage)+parse2 :: [B.ByteString] -> B.ByteString -> IrcMessage parse2 (code:msg:_) =-  IrcMessage Nothing Nothing Nothing (code)+  IrcMessage Nothing Nothing Nothing Nothing code     (dropColon msg) Nothing Nothing     -parse3 :: [B.ByteString] -> (B.ByteString -> IrcMessage)+parse3 :: [B.ByteString] -> B.ByteString -> IrcMessage parse3 (first:code:msg:_) =-  let (nick, host, server) = parseFirst first-  in IrcMessage nick host server (code) (dropColon msg) Nothing Nothing+  let (nick, user, host, server) = parseFirst first+  in IrcMessage nick user host server code (dropColon msg) Nothing Nothing   -parse5 :: [B.ByteString] -> (B.ByteString -> IrcMessage)+parse4 :: [B.ByteString] -> B.ByteString -> IrcMessage+parse4 (first:code:chan:msg:_) = +  let (nick, user, host, server) = parseFirst first+  in IrcMessage nick user host server code+       (dropColon msg) (Just chan) Nothing++parse5 :: [B.ByteString] -> B.ByteString -> IrcMessage parse5 (server:code:nick:chan:msg:_) =-  IrcMessage (Just nick) Nothing (Just server) (code)+  IrcMessage (Just nick) Nothing Nothing (Just server) code     (dropColon msg) (Just chan) Nothing -parseOther :: [B.ByteString] -> (B.ByteString -> IrcMessage)+parseOther :: [B.ByteString] -> B.ByteString -> IrcMessage parseOther (server:code:nick:chan:other) =-  IrcMessage (Just nick) Nothing (Just server) (code)+  IrcMessage (Just nick) Nothing Nothing (Just server) code     (B.unwords other) (Just chan) (Just other)  smartSplit :: B.ByteString -> [B.ByteString]-smartSplit txt-  | ':' `B.elem` (dropColon txt) =-    let (first, msg) = B.break (== ':') (dropColon txt)-    in (B.words $ takeLast first) ++ [msg]-  | otherwise = B.words $ txt+smartSplit txt = +  case B.breakSubstring (B.pack " :") (dropColon txt) of+    (x,y) | B.null y -> +              B.words txt+          | otherwise -> +              let (_, msg) = B.break (== ':') y+              in B.words x ++ [msg]  takeLast :: B.ByteString -> B.ByteString takeLast xs = B.take (B.length xs - 1) xs  takeCarriageRet :: B.ByteString -> B.ByteString takeCarriageRet xs = -  if B.drop (B.length xs - 1) xs == (B.pack "\r")+  if B.drop (B.length xs - 1) xs == B.pack "\r"     then takeLast xs     else xs +dropColon :: B.ByteString -> B.ByteString+dropColon xs =+  if B.take 1 xs == B.pack ":"+    then B.drop 1 xs+    else xs+ showCommand :: Command -> B.ByteString showCommand (MPrivmsg chan msg)             = "PRIVMSG " `B.append` chan `B.append`                                               " :" `B.append` msg@@ -141,3 +160,4 @@ showCommand (MAction  chan msg)             = showCommand $ MPrivmsg chan                                               ("\x01 ACTION " `B.append` msg                                               `B.append` "\x01")+

@@ -1,106 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-module Network.SimpleIRC.Types-  ( -    -- * Datatypes-    IrcConfig(..)-  , IrcServer(..)-  , SIrcCommand(..)-  , IrcEvent(..)-  , EventFunc-  , IrcMessage(..)-  ) where-import qualified Data.ByteString.Char8 as B-import Control.Concurrent (ThreadId)-import Control.Concurrent.Chan (Chan)-import System.IO (Handle)-import Data.Unique (Unique)-import Data.Map (Map)-import Data.Typeable--data IrcConfig = IrcConfig-  { cAddr     :: String   -- ^ Server address to connect to-  , cPort     :: Int      -- ^ Server port to connect to-  , cNick     :: String   -- ^ Nickname-  , cUsername :: String   -- ^ Username-  , cRealname :: String   -- ^ Realname-  , cChannels :: [String]   -- ^ List of channels to join on connect-  , cEvents   :: [IrcEvent] -- ^ Events to bind-  , cCTCPVersion :: String  -- ^ What to send on CTCP VERSION-  , cCTCPTime    :: IO String  -- ^ What to send on CTCP TIME-  }---data SIrcCommand =-    SIrcAddEvent (Unique, IrcEvent)-  | SIrcChangeEvents (Map Unique IrcEvent)-  | SIrcRemoveEvent Unique-  -data IrcServer = IrcServer-  { sAddr         :: B.ByteString-  , sPort         :: Int-  , sNickname     :: B.ByteString-  , sUsername     :: B.ByteString-  , sRealname     :: B.ByteString-  , sChannels     :: [B.ByteString]-  , sEvents       :: Map Unique IrcEvent-  , sSock         :: Maybe Handle-  , sListenThread :: Maybe ThreadId-  , sCmdChan      :: Chan SIrcCommand-  , sDebug        :: Bool-  -- Other info-  , sCTCPVersion  :: String-  , sCTCPTime     :: IO String-  }--type EventFunc = (IrcServer -> IrcMessage -> IO ())---- When adding events here, remember add them in callEvents and in eventFunc--- AND also in the Show instance and Eq instance--data IrcEvent = -    Privmsg EventFunc -- ^ PRIVMSG-  | Numeric EventFunc -- ^ Numeric, 001, 002, 372 etc.-  | Ping EventFunc    -- ^ PING-  | Join EventFunc    -- ^ JOIN-  | Part EventFunc    -- ^ PART-  | Mode EventFunc    -- ^ MODE-  | Topic EventFunc   -- ^ TOPIC-  | Invite EventFunc  -- ^ INVITE-  | Kick EventFunc    -- ^ KICK-  | Quit EventFunc    -- ^ QUIT-  | Nick EventFunc    -- ^ NICK-  | Notice EventFunc  -- ^ NOTICE-  | RawMsg EventFunc  -- ^ This event gets called on every message received-  | Disconnect (IrcServer -> IO ()) -- ^ This event gets called whenever the-                                    --   connection with the server is dropped-  -  -instance Show IrcEvent where-  show (Privmsg _) = "IrcEvent - Privmsg"-  show (Numeric _) = "IrcEvent - Numeric"-  show (Ping    _) = "IrcEvent - Ping"-  show (Join    _) = "IrcEvent - Join"-  show (Part    _) = "IrcEvent - Part"-  show (Mode    _) = "IrcEvent - Mode"-  show (Topic   _) = "IrcEvent - Topic"-  show (Invite  _) = "IrcEvent - Invite"-  show (Kick    _) = "IrcEvent - Kick"-  show (Quit    _) = "IrcEvent - Quit"-  show (Nick    _) = "IrcEvent - Nick"-  show (Notice  _) = "IrcEvent - Notice"-  show (RawMsg  _) = "IrcEvent - RawMsg"-  show (Disconnect  _) = "IrcEvent - Disconnect"-  -data IrcMessage = IrcMessage-  { mNick   :: Maybe B.ByteString-  , mHost   :: Maybe B.ByteString-  , mServer :: Maybe B.ByteString-  , mCode   :: B.ByteString-  , mMsg    :: B.ByteString-  , mChan   :: Maybe B.ByteString-  , mOther  :: Maybe [B.ByteString]-  , mRaw    :: B.ByteString-  } deriving (Show, Typeable)-  -  -   

@@ -1,29 +0,0 @@--- |--- Module : Network.SimpleIRC.Core--- Copyright : (c) Dominik Picheta 2010--- License : BSD3------ Maintainer : morfeusz8@gmail.com--- Stability : provisional--- Portability : portable------ Utils module-----module Network.SimpleIRC.Utils-  ( -    -- * Functions-    getChan-  ) where-import Network.SimpleIRC.Types-import qualified Data.ByteString.Char8 as B-import Data.Maybe (fromJust)-  --- |If the IrcMessage was sent directly to you returns the nick otherwise the channel.-getChan :: IrcServer -> IrcMessage -> B.ByteString-getChan s m =-  if sNickname s == chan-    then (fromJust $ mNick m)-    else chan-  -  where chan = fromJust $ mChan m

@@ -1,8 +1,7 @@ Name:          simpleirc-Version:       0.1.0+Version:       0.2.0 Category:      Network, IRC Synopsis:      Simple IRC Library-Package-URL:   http://code.haskell.org/fastirc/ Maintainer:    Dominik Picheta <dominikpicheta@googlemail.com> Author:        Dominik Picheta <dominikpicheta@googlemail.com> Copyright:     (c) 2010 Dominik Picheta@@ -22,13 +21,13 @@ Source-repository this   Type:     git   Location: git://github.com/dom96/SimpleIRC.git-  tag:      V0.1.0+  tag:      v0.2.0  Library   Build-depends:     base >= 4 && < 5,     bytestring >= 0.9.1.7,-    network >= 2.2.1.7,+    network >= 2.2.1.5,     containers >= 0.3.0.0,     time >= 1.1.4,     old-locale >= 1.0.0.2@@ -36,5 +35,3 @@     Network.SimpleIRC     Network.SimpleIRC.Core     Network.SimpleIRC.Messages-    Network.SimpleIRC.Utils-    Network.SimpleIRC.Types