packages feed

rss2irc (empty) → 0.1

raw patch · 4 files changed

+258/−0 lines, 4 filesdep +basedep +feeddep +mtlsetup-changed

Dependencies added: base, feed, mtl, network, parallel, strict-concurrency, tagsoup

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2008 Don Stewart++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Main.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE PatternGuards #-}+--------------------------------------------------------------------+-- |+-- Module:     Subscribe to an RSS feed and write it to an IRC channel+-- Copyright : (c) Don Stewart, 2008+-- License   : BSD3+--+-- Maintainer: Don Stewart <dons@galois.com>+-- Stability : provisional+-- Portability:+--+--------------------------------------------------------------------++import System.Environment+import System.IO+import System.Exit+import Data.Char+import Data.List+import Data.Maybe++import Text.HTML.Download+import Text.HTML.TagSoup++import Text.Feed.Import+import Text.RSS.Syntax+import Text.Feed.Types++import Control.Monad.Reader+import Control.Monad+import qualified Control.Exception as C+import Control.Concurrent.Chan.Strict+import Control.Concurrent (forkIO,threadDelay)+import qualified Control.Parallel.Strategies as Par (NFData(..))++import Text.Printf+import Network++------------------------------------------------------------------------++type Net = ReaderT Bot IO++data Bot = Bot { socket  :: Handle+               , server  :: String+               , port    :: !Int+               , channel :: String+               , nick    :: String+               }++{-+server = "irc.freenode.org"+port   = 6667+chan   = "#arch-haskell"+nick   = "archrss"+-}++main :: IO ()+main = do+    args <- getArgs+    (st, feed, prefix) <- case args of+         [s,p,c,n,f,z] | Just intp <- maybeRead p ->+             return (Bot { socket  = stdout+                         , server  = s+                         , port    = intp+                         , channel = c+                         , nick    = n }+                         ,f, z)++         _ -> help++    C.bracket (connect st)+              (hClose . socket)+              (\st' -> C.catch+                (runReaderT (run feed prefix) st')+                (const $ return ()))++--+-- connect     to the server+--+connect :: Bot -> IO Bot+connect st = notify $ do+    h <- connectTo (server st) (PortNumber (fromIntegral (port st)))+    hSetBuffering h NoBuffering+    return st { socket = h }+  where+    notify a = C.bracket_+        (printf "Connecting to %s ... " (server st) >> hFlush stdout)+        (putStrLn "done.")+        a++--+-- We're in the Net monad now, so we've connected successfully+-- Join a channel, and start processing commands+--+run :: String -> String -> Net ()+run feed prefix = do+    n <- asks nick+    c <- asks channel+    h <- asks socket++    write "NICK" n+    write "USER" (n++" 0 * :tutorial bot")+    write "JOIN" c++    -- run RSS thread+    -- main thread just listens on commands+    liftIO $ forkIO $ reader c h feed prefix+    listen h++--+-- handle commands from the channel+--+listen :: Handle -> Net ()+listen h = forever $ do+    s <- init `fmap` io (hGetLine h)+    io (putStrLn s)+    if ping s then pong s else return () -- (io . print) (clean s)+  where+--    clean     = drop 1 . dropWhile (/= ':') . drop 1+    ping x    = "PING :" `isPrefixOf` x+    pong x    = write "PONG" (':' : drop 6 x)++------------------------------------------------------------------------++--+-- wait on an RSS thread, updating every 60 minutes.+--+reader :: String -> Handle -> String -> String -> IO ()+reader c h url prefix = go []+  where+    go old = do+        RSSFeed f <- (fromJust . parseFeedString) `fmap` openURL url+        let new = nubBy k . rssItems . rssChannel $ f+            diff = (foldl' (flip (deleteBy k)) new old)++        forM_ (take 5 diff) $ \item -> do+            case rssItemTitle item of+                Nothing -> return ()+                Just t  -> privmsgH h c $ prefix ++ t++        threadDelay (60 * minutes)+        go new++    seconds = 10^6+    minutes = 60 * seconds++    k x y = let a = fromJust $ rssItemTitle x+                b = fromJust $ rssItemTitle y+            in a == b -- title++instance Par.NFData RSSItem++------------------------------------------------------------------------++io :: IO a -> Net a+io = liftIO++--+-- Send a privmsg to the current chan + server+--+privmsg :: String -> Net ()+privmsg s = do+    h <- asks socket+    c <- asks channel+    io $ privmsgH h c s++write :: String -> String -> Net ()+write s t = do+    h <- asks socket+    io $ hWrite h s t++--+-- Send a message out to the server we're currently connected to+--+hWrite :: Handle -> String -> String -> IO ()+hWrite h s t = do+    hPrintf h "%s %s\r\n" s t+    printf    "> %s %s\n" s t+++privmsgH :: Handle -> String -> String -> IO ()+privmsgH h c s = hWrite h "PRIVMSG" (c ++ " :" ++ s)++------------------------------------------------------------------------++help = do+    putStrLn "rss2irc <server> <port> <channel> <nick> <feed-url> <msg-prefix>"+    exitWith ExitSuccess++maybeRead :: Read a => String -> Maybe a+maybeRead s = case reads s of+    [(x, _)] -> Just x+    _        -> Nothing
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ rss2irc.cabal view
@@ -0,0 +1,33 @@+name:                rss2irc+version:             0.1+homepage:            http://code.haskell.org/~dons/code/rss2irc+license:             BSD3+license-file:        LICENSE+author:              Don Stewart+maintainer:          dons@galois.com+category:            Network+synopsis:            Subscribe to an RSS feed and write it to an IRC channel+description:         Subscribe to an RSS feed and write it to an IRC channel+                     .+                     Example, announce Hackage updates in channel:+                     .+                     > rss2irc irc.freenode.org 6667 #zid39kd3 rss2irc http://hackage.haskell.org/packages/archive/recent.rss "New package: "+                     .+cabal-version:       >= 1.2+build-type:          Simple++flag small_base+  description: Choose the new smaller, split-up base package.++executable rss2irc+    main-is:         Main.hs++    build-depends:       feed,+                         tagsoup,+                         strict-concurrency,+                         mtl,+                         network+    if flag(small_base)+        build-depends:   base >= 3, parallel+    else+        build-depends:   base <  3