rss2irc 1.0.2 → 1.0.3
raw patch · 4 files changed
+61/−33 lines, 4 filesdep +resourcetdep ~http-conduit
Dependencies added: resourcet
Dependency ranges changed: http-conduit
Files
- Base.hs +8/−1
- Feed.hs +27/−23
- rss2irc.cabal +15/−2
- rss2irc.hs +11/−7
Base.hs view
@@ -13,10 +13,12 @@ import Control.Concurrent.Chan (Chan) import Control.DeepSeq (NFData) import Control.Exception+import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Time () import Data.Time.Clock import Data.Typeable import Distribution.PackageDescription.TH (packageVariable, package, pkgName, pkgVersion)+import Network.HTTP.Conduit (Manager) import System.Console.CmdArgs import System.IO (Handle) import Text.Feed.Types (Item)@@ -108,9 +110,12 @@ ,irc_address :: String } deriving (Show, Data, Typeable) -data Reader = Reader { iterationsleft :: !(Maybe Int)+data Reader = Reader { httpManager :: !(Maybe Manager)+ , iterationsleft :: !(Maybe Int) } deriving (Show) +instance Show Manager where show = const "(Manager)"+ data Bot = Bot { socket :: !Handle -- ^ the bot's active IRC connection, or stdout indicating none , server :: !String -- ^ the IRC server's hostname or IP address, or "" indicating none , port :: !Int -- ^ the IRC server's port number@@ -149,3 +154,5 @@ instance NFData Item +io :: MonadIO m => IO a -> m a+io = liftIO
Feed.hs view
@@ -13,12 +13,13 @@ import Control.Concurrent import Control.Exception import Control.Monad+import Control.Monad.Trans.Resource (ResourceT, runResourceT) import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as LB8 import Data.Maybe import Data.List import System.IO.Storage-import Network.HTTP.Conduit (Request(requestHeaders),Response(responseBody),parseUrl,withManager,httpLbs)+import Network.HTTP.Conduit import Network.HTTP.Types (hCacheControl) import Network.URI import Prelude hiding (log)@@ -80,12 +81,12 @@ feedReader :: Shared App -> IO () feedReader !appvar = do -- first poll - prime the pump- app@App{aOpts=opts@Opts{feed=url}, aReader=Reader{iterationsleft=numleft}, aBot=Bot{announcequeue=q}} <- getSharedVar appvar+ app@App{aOpts=opts@Opts{feed=url}, aReader=Reader{httpManager=mmanager,iterationsleft=numleft}, aBot=Bot{announcequeue=q}} <- getSharedVar appvar case numleft of Just 0 -> return () _ -> do unless (quiet opts) $ log $ printf "Polling %s %s" url (everyMinutesString $ interval opts)- fetched <- fetchItems url opts+ fetched <- fetchItems (fromJust mmanager) url opts let polls = 1 -- with --recent N, send last N (non-duplicate) items to announcer thread let unique = (if allow_duplicates opts then id else (elideDuplicates [])) fetched@@ -102,13 +103,13 @@ feedReaderPoll :: Shared App -> Integer -> [(String,String)] -> Maybe String -> Integer -> IO () feedReaderPoll !appvar !polls !seen !lastpubdate !numannounced = do -- second & subsequent polls - wait interval then look for new items- app@App{aOpts=opts@Opts{feed=url}, aReader=Reader{iterationsleft=numleft}, aBot=Bot{announcequeue=q}} <- getSharedVar appvar+ app@App{aOpts=opts@Opts{feed=url}, aReader=Reader{httpManager=mmanager,iterationsleft=numleft}, aBot=Bot{announcequeue=q}} <- getSharedVar appvar case numleft of Just 0 -> return () _ -> do threadDelay $ (interval opts) * minutes when (debug_feed opts) $ log $ printf "polling %s" url- fetched <- fetchItems url opts+ fetched <- fetchItems (fromJust mmanager) url opts -- detect announceable items let seenids = map fst seen hasunseenid = (`notElem` seenids).itemId@@ -145,40 +146,43 @@ -- | Fetch a feed's items, or the empty list in case of transient IO -- errors (and log those).-fetchItems :: FeedAddress -> Opts -> IO [Item]-fetchItems url opts =- feedItems `fmap` readFeed url opts- `catches` [- Handler $ \(e :: IOException) -> handleIOError e,- Handler $ \(e :: FeedParseException) -> handleIOError e- ]+fetchItems :: Manager -> FeedAddress -> Opts -> IO [Item]+fetchItems manager url opts =+ runResourceT (feedItems `fmap` readFeed manager url opts)+ `catches`+ [Handler $ \(e :: IOException) -> handleFetchError e+ ,Handler $ \(e :: HttpException) -> handleFetchError e+ ,Handler $ \(e :: FeedParseException) -> handleFetchError e+ ] where- handleIOError e = do+ handleFetchError e = do log $ printf "Error (%s), retrying %s" (show e) (inMinutesString $ interval opts) return [] -- | Fetch and parse a feed's content, or raise an exception.-readFeed :: FeedAddress -> Opts -> IO Feed-readFeed url opts = do- s <- readUri url opts- when (debug_xml opts) $ log $ labelledText (printf "FEED CONTENT FROM %s " url) s+readFeed :: Manager -> FeedAddress -> Opts -> ResourceT IO Feed+readFeed manager url opts = do+ s <- readUri manager url opts+ when (debug_xml opts) $ io $ log $ labelledText (printf "FEED CONTENT FROM %s " url) s case parseFeedString s of- Nothing -> throwIO $ FeedParseException url- Just (XMLFeed _) -> throwIO $ FeedParseException url+ Nothing -> io $ throwIO $ FeedParseException url+ Just (XMLFeed _) -> io $ throwIO $ FeedParseException url Just f -> return f -- | Fetch the contents of a uri, which must be an ascii string. -- Redirects, authentication, https: and file: uris are supported.-readUri :: String -> Opts -> IO String-readUri s opts =+readUri :: Manager -> String -> Opts -> ResourceT IO String+readUri manager s opts = case parseURI' s of- Just URI{uriScheme="file:",uriPath=f} -> readFeedFile f+ Just URI{uriScheme="file:",uriPath=f} -> io $ readFeedFile f Just _ -> do+ -- LB8.unpack `fmap` simpleHttp s+ -- http-conduit is complex, cf https://github.com/snoyberg/http-conduit/issues/97 r <- parseUrl s let cachecontrol = cache_control opts r' | null cachecontrol = r | otherwise = r{requestHeaders=(hCacheControl, B8.pack cachecontrol):requestHeaders r}- rsp <- withManager (httpLbs r')+ rsp <- httpLbs r' manager return $ LB8.unpack $ responseBody rsp Nothing -> opterror $ "could not parse URI: " ++ s
rss2irc.cabal view
@@ -1,5 +1,5 @@ name: rss2irc-version: 1.0.2+version: 1.0.3 homepage: http://hackage.haskell.org/package/rss2irc license: BSD3 license-file: LICENSE@@ -17,12 +17,24 @@ . > $ rss2irc http://hackage.haskell.org/packages/archive/recent.rss mybot@irc.freenode.org/#haskell .+ 1.0.3 (2013\/2\/22)+ .+ Fixed:+ .+ * fix http-conduit usage so the feed poller doesn't die within hours+ . 1.0.2 (2013\/2\/18) . Fixed: . * `--use-actions` works again .+ 1.0.1 (2013\/2\/15)+ .+ Fixed:+ .+ * release notes formatting on hackage+ . 1.0 (2013\/2\/15) . New:@@ -86,7 +98,8 @@ ,deepseq ,irc >= 0.5 && < 0.6 ,feed >= 0.3.8 && < 0.4- ,http-conduit >= 1.8 && < 1.9+ ,http-conduit >= 1.9 && < 2.0+ ,resourcet >= 0.4.4 && < 0.5 ,http-types >= 0.6.4 && < 0.9 ,io-storage >= 0.3 && < 0.4 ,network >= 2.4 && < 2.5
rss2irc.hs view
@@ -18,6 +18,7 @@ import Data.Time.Clock (getCurrentTime) import Prelude hiding (log) import Network (withSocketsDo)+import Network.HTTP.Conduit (newManager, def) import System.Console.CmdArgs import System.Exit (ExitCode(ExitSuccess), exitFailure, exitSuccess) import System.IO@@ -40,7 +41,8 @@ return opts q <- newChan t <- getCurrentTime- let reader = Reader{iterationsleft=num_iterations opts+ let reader = Reader{httpManager=Nothing+ ,iterationsleft=num_iterations opts } bot = Bot{socket = stdout ,server = ""@@ -65,12 +67,14 @@ -- disconnect and report when there is a problem. main :: IO () main =- withSocketsDo $ -- for ms windows- withStore "globals" $ do -- for readFeedFile- (opts,reader,bot) <- getRss2IrcArgs- let app = App{aOpts=opts,aReader=reader,aBot=bot}- when (delay opts > 0) $ threadDelay $ (delay opts) * minutes- runThreads app+ withStore "globals" $ do -- for readFeedFile+ -- http-conduit stuff+ withSocketsDo $ do -- for ms windows+ manager <- io $ newManager Network.HTTP.Conduit.def+ (opts,reader,bot) <- getRss2IrcArgs+ let app = App{aOpts=opts,aReader=reader{httpManager=Just manager},aBot=bot}+ when (delay opts > 0) $ threadDelay $ (delay opts) * minutes+ runThreads app runThreads :: App -> IO () runThreads app@App{aOpts=opts} = do