lambdabot-xmpp 0.1.0.2 → 0.1.0.3

raw patch · 2 files changed

+34/−16 lines, 2 filesnew-component:exe:lambdabot-xmpp

Files

• XMPP.hs +31/−13
• lambdabot-xmpp.cabal +3/−3

@@ -12,6 +12,8 @@ import Data.List  -- Hackage+import Control.Concurrent+import Control.Concurrent.Chan import Control.Concurrent.Lifted (fork) import Control.Exception.Lifted as E (SomeException(..), throwIO, catch) import Control.Monad.Trans (lift)@@ -77,13 +79,33 @@             }         ]     }-    -sendMessage' :: Session -> XMPPConfig -> IrcMessage -> XMPP ()-sendMessage' sess xmppconf ircmsg = do++enqueue :: Chan T.Text -> IrcMessage -> XMPP ()+enqueue chan ircmsg = do     let msg = Data.List.last (ircMsgParams ircmsg)     let msg' = filtermsg $ T.filter (not . isControl) (T.drop 1 (T.pack msg))+    io $ writeChan chan msg'+    where+      filtermsg :: T.Text -> T.Text+      filtermsg m = case (T.isPrefixOf "ACTION " m) of+        True -> T.replace "ACTION" "/me" m+        False -> T.stripStart m++readTimeout :: Chan T.Text -> Int -> IO T.Text+readTimeout chan time = do+    result <- timeout time $ readChan chan+    case result of+        Nothing -> return T.empty+        Just text -> do+            next <- readTimeout chan time+            return $ T.concat [text, next]++consolidate :: Session -> XMPPConfig -> Chan T.Text -> XMPP ()+consolidate sess xmppconf chan = io $ forever $ do+    first <- readChan chan+    others <- readTimeout chan 50000     let name = Name "body" (Just "jabber:client") Nothing-        node = NodeContent (ContentText msg')+        node = NodeContent (ContentText $ T.concat [first, others])     let payload = Element name [] [node]      let m = Message{ messageFrom    = Nothing@@ -96,18 +118,13 @@             }     io $ sendMessage m sess >> return () -    where-      filtermsg :: T.Text -> T.Text-      filtermsg m = case (T.isPrefixOf "ACTION " m) of-        True -> T.replace "ACTION" "/me" m-        False -> T.stripStart m-      - online :: String -> XMPPConfig -> XMPP () online tag xmppconf = do+    chan <- io $ newChan     sess <- io $ xmppListen xmppconf+    void . fork $ consolidate sess xmppconf chan     E.catch-        (registerServer tag (sendMessage' sess xmppconf))+        (registerServer tag (enqueue chan))         (\err@SomeException{} -> E.throwIO err)              void . fork $ E.catch@@ -127,7 +144,8 @@      when ((/=) from (xmppNick xmppconf) &&           null delayElems &&-          (not . null) bodyElems) $ do+          (not . null) bodyElems &&+          messageType mes == GroupChat) $ do                  let body = head $ elementText (head bodyElems)             

@@ -1,5 +1,5 @@ name:                lambdabot-xmpp-version:             0.1.0.2+version:             0.1.0.3 synopsis:            Lambdabot plugin for XMPP (Jabber) protocol description:         Usage: cabal build && .\/dist\/build\/lambdabot\/lambdabot -e 'xmpp-connect asdfasdf example.com 5222 username nick password haskell@conference.example.com' license:             OtherLicense@@ -18,9 +18,9 @@ Source-repository this   type:              git   location:          https://github.com/l29ah/lambdabot-xmpp-  tag:               0.1.0.2+  tag:               0.1.0.3 -executable lambdabot+executable lambdabot-xmpp   main-is:             Main.hs   other-modules:        Modules,                         Paths_lambdabot_xmpp,