feed-collect 0.1.0.1 → 0.2.0.0

raw patch · 6 files changed

+469/−294 lines, 6 filesdep +data-default-classdep +time-intervalPVP ok

version bump matches the API change (PVP)

Dependencies added: data-default-class, time-interval

API changes (from Hackage documentation)

Files

• NEWS +0/−49
• NEWS.md +80/−0
• README.md +2/−2
• feed-collect.cabal +13/−11
• src/Control/Applicative/Util.hs +0/−50
• src/Web/Feed/Collect.hs +374/−182

@@ -1,49 +0,0 @@-This file lists the user-visible interesting changes between releases. For a-full list of changes to the source, see the ChangeLog.----feed-collect 0.1.0.1 -- 2015-09-15-==================================--General, build and documentation changes:--* (None)--New APIs, features and enhancements:--* (None)--Bug fixes:--* The feed XML file was being parsed in a byte-based manner, which works right-  only for ASCII (or other single-byte encodings). Now the parsing involves-  UTF-8 encoding.--Dependency changes:--* Add utf8-string (but it already was an indirect dependency before)-* Remove bytestring (but it's still an indirect dependency)------feed-collect 0.1.0.0 -- 2015-09-11-==================================--General, build and documentation changes:--* (This is the first release, so everything is new)--New APIs, features and enhancements:--* (This is the first release, so everything is a new feature)--Bug fixes:--* (This is just the first release)--Dependency changes:--* (This is the first release)

@@ -0,0 +1,80 @@+This file lists the user-visible interesting changes between releases. For a+full list of changes to the source, see the ChangeLog.++++feed-collect 0.2.0.0 -- 2015-12-16+==================================++General, build and documentation changes:++* Tutorial and (hopefully) all other docs updated to reflect new API++New APIs, features and enhancements:++* Error logging callback now takes an additional parameter, the feed label+* Parameters for `run` are now passed through a `WatcherConfig` type+* Debug options have evolved from `Bool` into `DebugConfig`+* `feedActive` has become `setFeedActive`+* New commands for controlling debug mode while running+* Convenience functions for specifying the feed list++Bug fixes:++* When the 'feedActive' (now 'setFeedActive') was executed, the updated list of+  feed records would contain only the updated feed, and all other feeds would+  be discarded. As a result, from that point at most that one feed would be+  visited. Thanks to wolftune for noticing and reporting a problem!++Dependency changes:++* Add data-default-class, time-interval++++++feed-collect 0.1.0.1 -- 2015-09-15+==================================++General, build and documentation changes:++* (None)++New APIs, features and enhancements:++* (None)++Bug fixes:++* The feed XML file was being parsed in a byte-based manner, which works right+  only for ASCII (or other single-byte encodings). Now the parsing involves+  UTF-8 encoding.++Dependency changes:++* Add utf8-string (but it already was an indirect dependency before)+* Remove bytestring (but it's still an indirect dependency)++++++feed-collect 0.1.0.0 -- 2015-09-11+==================================++General, build and documentation changes:++* (This is the first release, so everything is new)++New APIs, features and enhancements:++* (This is the first release, so everything is a new feature)++Bug fixes:++* (This is just the first release)++Dependency changes:++* (This is the first release)

@@ -10,5 +10,5 @@ boring "legal" details see the file 'COPYING'.  See the file 'INSTALL' for hints on installation. The file 'ChangeLog' explains-how to see the history log of the changes done in the code. 'NEWS' provides a-friendly overview of the changes for each release.+how to see the history log of the changes done in the code. 'NEWS.md' provides+a friendly overview of the changes for each release.

@@ -1,5 +1,5 @@ name:                feed-collect-version:             0.1.0.1+version:             0.2.0.0 synopsis:            Watch RSS/Atom feeds (and do with them whatever you like). description:   RSS and Atom are common technologies for publishing news updates and watching@@ -26,7 +26,7 @@ copyright:           ♡ Copying is an act of love. Please copy, reuse and share. category:            Web build-type:          Simple-extra-source-files:  AUTHORS ChangeLog COPYING INSTALL NEWS README.md+extra-source-files:  AUTHORS ChangeLog COPYING INSTALL NEWS.md README.md cabal-version:       >=1.10  source-repository head@@ -35,17 +35,19 @@  library   exposed-modules:     Web.Feed.Collect-  other-modules:       Control.Applicative.Util+  -- other-modules:          -- other-extensions:    -  build-depends:       base            >=4.7 && <5-                     , feed            >=0.3.9-                     , http-client     >=0.4.19-                     , http-client-tls >=0.2.2-                     , time            >=1.5-                     , timerep         >=2-                     , time-units      >=1+  build-depends:       base               >=4.7 && <5+                     , data-default-class+                     , feed               >=0.3.9+                     , http-client        >=0.4.19+                     , http-client-tls    >=0.2.2+                     , time               >=1.5+                     , time-interval+                     , timerep            >=2+                     , time-units         >=1                      , transformers-                     , utf8-string     >=1+                     , utf8-string        >=1   hs-source-dirs:      src   default-language:    Haskell2010   ghc-options:         -Wall

@@ -1,50 +0,0 @@-{- This file is part of feed-collect.- -- - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.- - Date parser format strings written originally by koral <koral@mailoo.org>- - for the imm package and were copied here (imm is released as WTFPL).- -- - ♡ Copying is an act of love. Please copy, reuse and share.- -- - The author(s) have dedicated all copyright and related and neighboring- - rights to this software to the public domain worldwide. This software is- - distributed without any warranty.- -- - You should have received a copy of the CC0 Public Domain Dedication along- - with this software. If not, see- - <http://creativecommons.org/publicdomain/zero/1.0/>.- -}--{-# Language CPP #-}--module Control.Applicative.Util-    ( applyIf-    , applyIf'-    )-where--#if MIN_VERSION_base(4,8,0)--import Control.Applicative---- | Conditionally apply an applicative action to a value. If the condition is--- 'False', return the value as-is (inside the applicative).-applyIf :: Applicative f => a -> Bool -> (a -> f a) -> f a-applyIf val apply action = if apply then action val else pure val---- | Like 'applyIf', but takes a condition predicate to apply to the value.-applyIf' :: Applicative f => a -> (a -> Bool) -> (a -> f a) -> f a-applyIf' v p = applyIf v (p v)--#else---- | Conditionally apply an monadic action to a value. If the condition is--- 'False', return the value as-is (inside the monad).-applyIf :: Monad m => a -> Bool -> (a -> m a) -> m a-applyIf val apply action = if apply then action val else return val---- | Like 'applyIf', but takes a condition predicate to apply to the value.-applyIf' :: Monad m => a -> (a -> Bool) -> (a -> m a) -> m a-applyIf' v p = applyIf v (p v)--#endif

@@ -25,7 +25,7 @@ -- Both http and https URLs are supported. -- -- The original use case which motivated the creation of this library is--- <http://rel4tion.org/projects/funbot FunBot>.+-- <https://notabug.org/fr33domlover/funbot FunBot>. -- -- = Running --@@ -34,6 +34,8 @@ -- -- Here is a simple usage example. --+-- > import Data.Default.Class (def)+-- > import Data.Time.Interval -- > import Data.Time.Units -- > import Web.Feed.Collect -- >@@ -44,14 +46,20 @@ -- >     putStrLn $ showFeed feed -- >     putStrLn $ showItem item -- >--- > logError :: Error -> IO ()--- > logError = print+-- > logError :: Label -> Error -> IO ()+-- > logError l e = putStrLn $ l ++ " : " ++ show e -- > -- > feeds :: [(Label, Url)] -- > feeds = [("democ-now", "http://www.democracynow.org/democracynow.rss")] -- > -- > main :: IO ()--- > main = run collect Nothing logError Nothing (1 :: Minute) 3 feeds+-- > main = run def+-- >     { wcCollect       = collect+-- >     , wcLogError      = logError+-- >     , wcVisitInterval = time (1 :: Minute)+-- >     , wcMaxItems      = 3+-- >     , wcFeeds         = fromPairs feeds+-- >     } -- -- For quick testing, you can use one of the predefined collector functions. -- For example, there is 'collectorNull' which discards the feed items and does@@ -59,17 +67,17 @@ -- debugging the library itself), and 'collectorPretty' which writes a short -- nicely formatted entry to stdout for each new feed item. And there are more. ----- If new items aren't being detected correctly, you can try using 'runDebug'--- in place of 'run'. It takes and same arguments and runs the same loop, but--- also writes a detailed log of the detection process into a file--- \"debug.log\". You can use @tail -f debug.log@ from your terminal to watch--- new log entries get appended to the file.+-- If new items aren't being detected correctly, you can enable debugging+-- through the 'wcDebug' field. You can get detailed logs of the detection+-- process. You can @tail -f@ a log file from your terminal to watch new log+-- entries get appended to it. -- -- = Using Control Commands ----- Now let's see how to push control commands into the loop. The 4th parameter--- 'run' takes is an optional command queue. In the example above we just--- passed 'Nothing'. Now let's provide an actual queue and use it.+-- Now let's see how to push control commands into the loop. The+-- 'wcCommandQueue' field is an optional command queue for making changes+-- while the watcher runs. In the example above we didn't provide one. Now+-- let's provide a queue and use it. -- -- Suppose we are writing a program with a command-line interface. It watches -- news feeds in the background, and can take commands from the user at the@@ -83,6 +91,8 @@ -- @parseCommand@ we can write the program like this: -- -- > import Control.Concurrent (forkIO)+-- > import Data.Default.Class (def)+-- > import Data.Time.Interval -- > import Data.Time.Units -- > import System.IO -- > import Web.Feed.Collect@@ -90,11 +100,8 @@ -- > collect :: Label -> URL -> Feed -> Item -> IO () -- > collect = collectPretty -- >--- > logE :: Error -> IO ()--- > logE = print--- >--- > feeds :: [(Label, Url)]--- > feeds = [("fsf-news", "https://www.fsf.org/static/fsforg/rss/news.xml")]+-- > feed :: FeedConfig+-- > feed = mkFeed "fsf-news" "https://www.fsf.org/static/fsforg/rss/news.xml" -- > -- > parseCommand :: String -> Maybe Command -- > parseCommand line = {- ... - }@@ -102,7 +109,11 @@ -- > main :: IO () -- > main = do -- >     cqueue <- newCommandQueue--- >     forkIO $ run collect Nothing logE (Just cqueue) (1 :: Minute) 3 feeds+-- >     forkIO $ run def+-- >         { wcCollect      = collect+-- >         , wcCommandQueue = Just cqueue+-- >         , wcFeeds        = [feed]+-- >         } -- >     let loop = do -- >         line <- getLine -- >         if line == "quit"@@ -114,12 +125,27 @@ -- >                 loop -- >     loop module Web.Feed.Collect-    ( -- * Types+    ( -- * Misc Types       Label     , Url-    , Command ()-    , CommandQueue ()     , Error (..)+      -- * Specifying Feeds+    , FeedConfig ()+    , fcLabel+    , fcUrl+    , fcActive+    , fcDebug+    , mkFeed+    , fromPairs+      -- * Watcher Configuration+    , WatcherConfig ()+    , wcCollect+    , wcCollectMany+    , wcLogError+    , wcCommandQueue+    , wcVisitInterval+    , wcMaxItems+    , wcFeeds       -- * Collectors     , collectorNull     , collectorPrint@@ -127,43 +153,51 @@     , collectorLog       -- * Running     , run-    , runDebug-      -- * Control commands+      -- * Control Commands+    , CommandQueue ()     , newCommandQueue     , sendCommand     , sendCommands+    , Command ()     , addFeed     , removeFeed-    , feedActive+    , setFeedActive     , setInterval     , setMaxPerVisit-      -- * Utilities+      -- * Utilities and Debugging     , showFeed     , showItem+    , DebugConfig (..)+    , setFeedDebug+    , setGeneralDebug     ) where -import           Control.Applicative.Util (applyIf')-import           Control.Concurrent (threadDelay)-import           Control.Concurrent.MVar-import           Control.Exception (catch)-import           Control.Monad (liftM, when)-import           Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Concurrent (threadDelay)+import Control.Concurrent.MVar+import Control.Exception (catch)+import Control.Monad (liftM, when)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Default.Class+import Data.List (partition)+import Data.Maybe (catMaybes, fromMaybe, listToMaybe)+import Data.Time.Clock (UTCTime)+import Data.Time.Format+import Data.Time.Interval+import Data.Time.LocalTime (getZonedTime, zonedTimeToUTC)+import Data.Time.RFC2822 (parseTimeRFC2822)+import Data.Time.RFC3339 (parseTimeRFC3339)+import Data.Time.RFC822 (parseTimeRFC822)+import Data.Time.Units (TimeUnit (..), Minute)+import Network.HTTP.Client+import Network.HTTP.Client.TLS (tlsManagerSettings)+import System.IO+import Text.Feed.Import (parseFeedString)+import Text.Feed.Query+import Text.Feed.Types (Item, Feed (..))+import Text.Show.Functions ()+ import qualified Data.ByteString.Lazy.UTF8 as BU-import           Data.Maybe (catMaybes, fromMaybe, listToMaybe)-import           Data.Time.Clock (UTCTime)-import           Data.Time.Format-import           Data.Time.LocalTime (getZonedTime, zonedTimeToUTC)-import           Data.Time.RFC2822 (parseTimeRFC2822)-import           Data.Time.RFC3339 (parseTimeRFC3339)-import           Data.Time.RFC822 (parseTimeRFC822)-import           Data.Time.Units (TimeUnit (..))-import           Network.HTTP.Client-import           Network.HTTP.Client.TLS (tlsManagerSettings)-import           System.IO-import           Text.Feed.Import (parseFeedString)-import           Text.Feed.Query-import           Text.Feed.Types (Item, Feed (..))  -- | A short name tag for a feed, for quick reference and internal use. type Label = String@@ -175,16 +209,20 @@ -- behavior. data Command     -- | Add a new feed to watch.-    = AddFeed Label Url+    = AddFeed FeedConfig     -- | Remove a previously added feed.     | RemoveFeed Label     -- | Set whether a given feed should be watched (active) or not (inactive).-    | FeedActive Label Bool+    | SetFeedActive Label Bool     -- | Set the interval, in microseconds, between feed scans.     | SetInterval Int     -- | Set the maximal number of feed items to be collected per feed per     -- scan. If more new items are found, they wait for the next scan.     | SetMaxPerVisit Int+    -- | Enable or disable feed specific debug log.+    | SetFeedDebug Label Bool+    -- | Enable or disable general debug log.+    | SetGeneralDebug Bool  -- | A queue of control commands for the 'run' loop to execute while running. --@@ -194,6 +232,112 @@ -- calls). newtype CommandQueue = CommandQueue { cqMVar :: MVar [Command] } +-- | Details of a news feed to be watched. Some of these are just initial+-- settings which you can change while the watcher runs, using the command+-- queue.+--+-- You can use 'def' and override fields a needed. In that case you should+-- specify at least the label and URL! Alternatively, use 'mkFeed' or+-- 'fromPairs'.+data FeedConfig = FeedConfig+    { -- | A short name tag by which you can refer to the feed.+      fcLabel  :: Label+      -- | The HTTP or HTTPS URL of the feed.+    , fcUrl    :: Url+      -- | Whether the feed should initially be active. Disabled feeds aren't+      -- visited (except once to remember the old feed items). You can enable+      -- and disable feeds later, while the watcher runs, using the command+      -- queue.+    , fcActive :: Bool+      -- | Whether per-feed debug logs should be written for this feed. These+      -- are detailed messages listing the results of each step of the new item+      -- detection process. You can later toggle this setting per feed using+      -- the command queue.+    , fcDebug  :: Bool+    }++instance Default FeedConfig where+    def = FeedConfig+        { fcLabel  = ""+        , fcUrl    = ""+        , fcActive = True+        , fcDebug  = False+        }++-- | Debugging options. Useful when new items aren't being detected as+-- expected. The 'Default' instance has all debugging off. These are just the+-- initial settings: you can change some of them while the feed watcher runs,+-- using the command queue.+--+-- Since debugging is expected to be used only during development, changes to+-- the fields of this type will cause only a /micro/ version change in the+-- package version. If you think some options here are useful for more than+-- debugging, please contact the author.+data DebugConfig = DebugConfig+    { -- | Whether to log a summary of the watcher cycle. The log lists for+      -- each iteration which feeds are active and which aren't, whether items+      -- were detected for the active feeds, and whether any command came+      -- through the command queue.+      dcDebugCycle :: Bool+      -- | File into which to write debug messages which aren't specific to a+      -- single feed. The cycle debug log (see 'dcDebugCycle') is written into+      -- this file.+    , dcGeneralLog :: FilePath+      -- | A function used to determine the detection debug log file for a+      -- given feed.+    , dcFeedLog    :: Label -> FilePath+    }+    deriving Show++instance Default DebugConfig where+    def = DebugConfig+        { dcDebugCycle = False+        , dcGeneralLog = "feed-debug.log"+        , dcFeedLog    = \ l -> "feed-debug-" ++ l ++ ".log"+        }++-- | Feed watcher behavior description. To create one, use 'def' and override+-- fields as needed.+data WatcherConfig m = WatcherConfig+    { -- | Collector, i.e. action to perform when receiving a feed item.+      wcCollect       :: (Label -> Url -> Feed -> Item -> m ())+      -- | Action to perform when receiving feed items. This is just a chance+      -- to provide an efficient shortcut instead of repeated use of+      -- 'wcCollect'. If there is no such shortcut, simply pass 'Nothing'.+    , wcCollectMany   :: Maybe (Label -> Url -> Feed -> [Item] -> m ())+      -- | Error logging action. It will be called when an error occurs while+      -- trying to download and parse a feed. Such an error doesn't cause+      -- anything to stop. Execution simply goes on to read the next feed, and+      -- will try the erronous feed again in the next round.+    , wcLogError      :: (Label -> Error -> m ())+      -- | A command queue you can use to change settings while the program+      -- runs. For example, you can add a new feed or change the interval+      -- between polls without relaunching 'run'.+    , wcCommandQueue  :: Maybe CommandQueue+      -- | Time interval between visits of a watched feed.+    , wcVisitInterval :: TimeInterval+      -- | Maximal number of items to collect per visit (if more are available,+      -- they will be collected in the next visit).+    , wcMaxItems      :: Int+      -- | List of feeds and their configuration details.+    , wcFeeds         :: [FeedConfig]+      -- | Debugging options. Useful when new items aren't being detected as+      -- expected.+    , wcDebug         :: DebugConfig+    }++instance MonadIO m => Default (WatcherConfig m) where+    def = WatcherConfig+        { wcCollect       = \ l u f i -> liftIO $ collectorPretty l u f i+        , wcCollectMany   = Nothing+        , wcLogError      = \ l e -> liftIO $ putStrLn $ l ++ " : " ++ show e+        , wcCommandQueue  = Nothing+        , wcVisitInterval = time (1 :: Minute)+        , wcMaxItems      = 3+        , wcFeeds         = []+        , wcDebug         = def+        }+ -- Since no item field is guaranteed to be provided, we need some way to attach -- a practically-mostly-unique ID to each feed item, so that we can remember -- the items we already collected. Item fields we can expect to be mostly@@ -224,12 +368,15 @@     (BySummary i) == (BySummary j) = i == j     _             == _             = False +-- | Information the feed watcher holds per feed while running. data FeedRecord = FeedRecord-    { feedName    :: String        -- A short identifier for easy reference-    , feedUrl     :: String        -- The feed's URL-    , feedOn      :: Bool          -- Whether the feed is active-    , feedPrevIDs :: [ItemID]      -- Previously collected feed item IDs-    , feedUpdated :: Maybe UTCTime -- Last time a feed item was published+    { feedName     :: String        -- A short identifier for easy reference+    , feedUrl      :: String        -- The feed's URL+    , feedOn       :: Bool          -- Whether the feed is active+    , feedPrevIDs  :: [ItemID]      -- Previously collected feed item IDs+    , feedUpdated  :: Maybe UTCTime -- Last time a feed item was published+    , feedDebug    :: Bool          -- Whether to create detection debug logs+    , feedDebugLog :: FilePath      -- Debug log file name     }     deriving Show @@ -237,6 +384,7 @@     { usecInterval     :: Int          -- Microseconds between polls     , maxItemsPerVisit :: Int          -- Per-feed items to collect per poll     , records          :: [FeedRecord] -- Per-feed state+    , stDebug          :: Bool         -- Whether to write general debug logs     }     deriving Show @@ -245,9 +393,17 @@     -- | Error while creating an HTTP request or receiving a response.     = HttpError HttpException     -- | Error while parsing the HTTP response body into feed content-    | FeedParsingFailed Label Url+    | FeedParsingFailed Url     deriving Show +-- | Initialize feed details from a feed label and its URL.+mkFeed :: Label -> Url -> FeedConfig+mkFeed l u = def { fcLabel = l, fcUrl = u }++-- | Create a list of feed configs from a list of label-url pairs.+fromPairs :: [(Label, Url)] -> [FeedConfig]+fromPairs = map $ uncurry mkFeed+ showFeedKind :: Feed -> String showFeedKind (AtomFeed _) = "Atom" showFeedKind (RSSFeed _)  = "RSS"@@ -351,6 +507,9 @@ (Just u) `newerThan` (Just v) = u > v _        `newerThan` _        = True +showTime :: FormatTime t => t -> String+showTime = formatTime defaultTimeLocale rfc822DateFormat+ -- Find recent items we haven't collected yet detectNewItems :: Int -> FeedRecord -> Feed -> ([Item], FeedRecord, IO ()) detectNewItems maxItems rec feed =@@ -371,16 +530,14 @@                     []                -> feedUpdated rec             }         report = do-            let showTime :: FormatTime t => t -> String-                showTime = formatTime defaultTimeLocale rfc822DateFormat-                updated' = fmap showTime . feedUpdated+            let updated' = fmap showTime . feedUpdated                 prevIDs = feedPrevIDs rec                 prevIDsS = take 5 prevIDs                 itemsS = take maxItems items                 iidsS = take maxItems iids                 prevIDsFinal = feedPrevIDs rec'                 prevIDsFinalS = take 5 prevIDsFinal-            h <- openFile "debug.log" AppendMode+            h <- openFile (feedDebugLog rec) AppendMode             let line = hPutStrLn h                 nl = hPutChar h '\n'                 printIT (_, i, t) = line $ show t ++ " " ++ show i@@ -438,167 +595,194 @@     in  action `catch` handler  -- Try to download a feed from its URL-fetch :: Manager -> Label -> Url -> IO (Either Error Feed)-fetch manager label url = do+fetch :: Manager -> Url -> IO (Either Error Feed)+fetch manager url = do     ebody <- fetchRaw manager url     return $ case ebody of         Left err   -> Left $ HttpError err         Right body ->             case parseFeedString body of                 Just feed -> Right feed-                Nothing   -> Left $ FeedParsingFailed label url+                Nothing   -> Left $ FeedParsingFailed url  -- Fill initial feed record initRec :: MonadIO m-        => (Error -> m ())+        => (Label -> Error -> m ())         -> Manager-        -> Label-        -> Url+        -> FilePath+        -> FeedConfig         -> m FeedRecord-initRec logError manager label url = do-    efeed <- liftIO $ fetch manager label url+initRec logError manager logfile fc = do+    efeed <- liftIO $ fetch manager (fcUrl fc)+    let rec = FeedRecord+            { feedName     = fcLabel fc+            , feedUrl      = fcUrl fc+            , feedOn       = fcActive fc+            , feedPrevIDs  = []+            , feedUpdated  = Nothing+            , feedDebug    = fcDebug fc+            , feedDebugLog = logfile+            }     case efeed of         Right feed ->             let items = feedItems feed-            in  return $ FeedRecord-                    { feedName    = label-                    , feedUrl     = url-                    , feedOn      = True-                    , feedPrevIDs = map itemID $ take maxNumIDs items-                    , feedUpdated = listToMaybe items >>= itemTime+            in  return rec+                    { feedPrevIDs  = map itemID $ take maxNumIDs items+                    , feedUpdated  = listToMaybe items >>= itemTime                     }-        Left e -> do-            logError e-            return $ FeedRecord-                { feedName    = label-                , feedUrl     = url-                , feedOn      = True-                , feedPrevIDs = []-                , feedUpdated = Nothing-                }+        Left e -> logError (fcLabel fc) e >> return rec  -- Execute a control command-exec :: MonadIO m => (Error -> m ()) -> Manager -> Command -> State -> m State-exec logError manager command state@State { records = rs } =+exec :: MonadIO m+     => (Label -> Error -> m ())+     -> Manager+     -> (Label -> FilePath)+     -> Command+     -> State+     -> m State+exec logError manager mklog command state@State { records = rs } =     case command of-        AddFeed label url       -> do-            rec <- initRec logError manager label url+        AddFeed fc -> do+            rec <- initRec logError manager (mklog $ fcLabel fc) fc             return state { records = rs ++ [rec] }-        RemoveFeed label        ->+        RemoveFeed label ->             return state { records = filter ((== label) . feedName) rs }-        FeedActive label active ->-            let rs' = [r { feedOn = active } | r <- rs, feedName r == label]-            in  return state { records = rs' }-        SetInterval usec        -> return state { usecInterval = usec }-        SetMaxPerVisit nitems   -> return state { maxItemsPerVisit = nitems }+        SetFeedActive label active ->+            let update rec =+                    if feedName rec == label+                        then rec { feedOn = active }+                        else rec+            in  return state { records = map update rs }+        SetInterval usec -> return state { usecInterval = usec }+        SetMaxPerVisit nitems -> return state { maxItemsPerVisit = nitems }+        SetFeedDebug label debug ->+            let update rec =+                    if feedName rec == label+                        then rec { feedDebug = debug }+                        else rec+            in  return state { records = map update rs }+        SetGeneralDebug debug -> return state { stDebug = debug }  foldrM :: Monad m => (a -> b -> m b) -> b -> [a] -> m b foldrM _ v []     = return v foldrM f v (x:xs) = f x =<< foldrM f v xs +makeLine :: Command -> String+makeLine (AddFeed fc)            = "Add feed " ++ fcLabel fc+makeLine (RemoveFeed l)          = "Remove feed " ++ l+makeLine (SetFeedActive l True)  = "Enable feed " ++ l+makeLine (SetFeedActive l False) = "Disable feed " ++ l+makeLine (SetInterval usec)      = "Set interval to " ++ show usec ++ "usec"+makeLine (SetMaxPerVisit n)      = "Set max items to " ++ show n+makeLine (SetFeedDebug l True)   = "Enable debug for feed " ++ l+makeLine (SetFeedDebug l False)  = "Disable debug for feed " ++ l+makeLine (SetGeneralDebug True)  = "Enable general debug"+makeLine (SetGeneralDebug False) = "Disable general debug"+ -- Execute all commands waiting in the queue execAll :: MonadIO m-        => (Error -> m ())+        => (Label -> Error -> m ())         -> Manager+        -> (Label -> FilePath)         -> CommandQueue         -> State-        -> m State-execAll logError manager cq state = do+        -> m (State, [String])+execAll logError manager mklog cq state = do     cmds <- liftIO $ modifyMVar (cqMVar cq) $ \ l -> return ([], l)-    foldrM (exec logError manager) state cmds+    state' <- foldrM (exec logError manager mklog) state cmds+    return (state', map makeLine cmds) -run' :: (TimeUnit t, MonadIO m)-     => Bool-     -> (Label -> Url -> Feed -> Item -> m ())-     -> Maybe (Label -> Url -> Feed -> [Item] -> m ())-     -> (Error -> m ())-     -> Maybe CommandQueue-     -> t-     -> Int-     -> [(Label, Url)]-     -> m ()-run' debug collect mCollectMany logError mq interval maxPerVisit sources = do-    let collectMany-            = fromMaybe (\ l u f -> mapM_ $ collect l u f) mCollectMany+-- | Visit a feed, collect new items and return an updated feed record and the+-- number of new collected items. Note that the feed's active setting is+-- ignored: It will be visited even if marked as disabled. Therefore, check the+-- setting before you call this function.+visitFeed+    :: MonadIO m+    => Manager+    -- ^ HTTP connection manager.+    -> (Label -> Url -> Feed -> [Item] -> m ())+    -- ^ Multi-item collector function.+    -> (Label -> Error -> m ())+    -- ^ Error logging function.+    -> Int+    -- ^ Maximal number of new items to collect and remember for this visit.+    -- Remaining new items will be detected in the next visit.+    -> FeedRecord+    -- ^ Details of the feed to visit.+    -> m (FeedRecord, Int)+visitFeed manager collectMany logError maxitems rec = do+    efeed <- liftIO $ fetch manager (feedUrl rec)+    case efeed of+        Right feed -> do+            let (items, rec', report) = detectNewItems maxitems rec feed+                ritems = reverse items+            when (feedDebug rec) $ liftIO report+            collectMany (feedName rec) (feedUrl rec) feed ritems+            return (rec', length ritems)+        Left e -> do+            logError (feedName rec) e+            return (rec, -1)++-- | A single watcher loop iteration.+runIteration+    :: MonadIO m+    => (Int -> FeedRecord -> m (FeedRecord, Int))+    -> (State -> m (State, [String]))+    -> FilePath+    -> State+    -> m State+runIteration visit execCmds logfile state = do+    liftIO $ threadDelay $ usecInterval state+    let (recsOn, recsOff) = partition feedOn $ records state+    pairs <- mapM (visit $ maxItemsPerVisit state) recsOn+    let recsOn' = map fst pairs+        stateCollected = state { records = recsOn' ++ recsOff }+    (stateExec, actions) <- execCmds stateCollected+    liftIO $ when (stDebug state) $ withFile logfile AppendMode $ \ h -> do+        let line = hPutStrLn h+            fline label s = line $ label ++ ": " ++ s+            nl = hPutChar h '\n'+        t <- getZonedTime+        line $ showTime t+        line $ "Feeds: " ++ show (length $ records stateExec)+        let info n+                | n == 0    = "No new items"+                | n == -1   = "Error"+                | otherwise = show n ++ " new items"+        mapM_ (\ (r, n) -> fline (feedName r) $ info n) pairs+        mapM_ (\ r -> fline (feedName r) "Disabled") recsOff+        line $ "Commands: " ++ show (length actions)+        mapM_ line actions+        nl+    return stateExec++-- | Watch feeds and perform the given action on received feed items.+run :: MonadIO m => WatcherConfig m -> m ()+run wc = do+    let mapCollect l u f = mapM_ $ (wcCollect wc) l u f+        collectMany = fromMaybe mapCollect $ wcCollectMany wc+        logError = wcLogError wc+        dc = wcDebug wc+        mklog = dcFeedLog dc     manager <- liftIO $ newManager tlsManagerSettings-    initialRecords <--        mapM (\ (label, url) -> initRec logError manager label url) sources+    let mkRecord fc = initRec logError manager (mklog $ fcLabel fc) fc+    initialRecords <- mapM mkRecord $ wcFeeds wc     let initialState = State-            { usecInterval     = fromInteger $ toMicroseconds interval-            , maxItemsPerVisit = maxPerVisit+            { usecInterval     =+                fromInteger $ microseconds $ wcVisitInterval wc+            , maxItemsPerVisit = wcMaxItems wc             , records          = initialRecords+            , stDebug          = dcDebugCycle dc             }         execCmds st =-            case mq of-                Just cq -> execAll logError manager cq st-                Nothing -> return st-        visit record = applyIf' record feedOn $ \ rec -> do-            efeed <- liftIO $ fetch manager (feedName rec) (feedUrl rec)-            case efeed of-                Right feed -> do-                    let (items, rec', report) =-                            detectNewItems maxPerVisit rec feed-                        ritems = reverse items-                    when debug $ liftIO report-                    collectMany (feedName rec) (feedUrl rec) feed ritems-                    return rec'-                Left e -> do-                    logError e-                    return rec-        loop state = do-            liftIO $ threadDelay $ usecInterval state-            recs <- mapM visit $ records state-            let stateCollected = state { records = recs }-            stateExec <- execCmds stateCollected-            loop stateExec+            case wcCommandQueue wc of+                Just cq -> execAll logError manager mklog cq st+                Nothing -> return (st, [])+        visit = visitFeed manager collectMany logError+        iter = runIteration visit execCmds (dcGeneralLog dc)+        loop state = iter state >>= loop     loop initialState --- | Watch feeds and perform the given action on received feed items.-run :: (TimeUnit t, MonadIO m)-    => (Label -> Url -> Feed -> Item -> m ())-    -- ^ Collector, i.e. action to perform when receiving a feed item.-    -> Maybe (Label -> Url -> Feed -> [Item] -> m ())-    -- ^ Action to perform when receiving feed items. This is just a chance to-    -- provide an efficient shortcut instead of repeated use of the previous-    -- parameter. If there is no such shortcut, simply pass 'Nothing'.-    -> (Error -> m ())-    -- ^ Error logging action. It will be called when an error occurs while-    -- trying to download and parse a feed. Such an error doesn't cause-    -- anything to stop. Execution simply goes on to read the next feed, and-    -- will try the erronous feed again in the next round.-    -> Maybe CommandQueue-    -- ^ A command queue you can use to change settings while the program runs.-    -- For example, you can add a new feed or change the interval between polls-    -- without relaunching 'run'.-    -> t-    -- ^ Time interval between visits of a watched feed.-    -> Int-    -- ^ Maximal number of items to collect per visit (if more are available,-    -- they will be collected in the next visit)-    -> [(Label, Url)]-    -- ^ List of short feed labels (for easy reference and logging), and their-    -- URLs to watch.-    -> m ()-run = run' False---- | Like 'run', but writes detailed reports into a file named \"debug.log\".--- This should help you understand which feeds items are being received and why--- new items aren't being detected in the way you expect.------ For some feeds, the new item detection method used by this library may fail.--- In that case, please report the issue, and then the method can be updated--- and extended to support more cases.-runDebug :: (TimeUnit t, MonadIO m)-         => (Label -> Url -> Feed -> Item -> m ())-         -> Maybe (Label -> Url -> Feed -> [Item] -> m ())-         -> (Error -> m ())-         -> Maybe CommandQueue-         -> t-         -> Int-         -> [(Label, Url)]-         -> m ()-runDebug = run' True- -- | Create a new empty command queue. newCommandQueue :: IO CommandQueue newCommandQueue = liftM CommandQueue $ newMVar []@@ -613,7 +797,7 @@     modifyMVar_ (cqMVar cq) $ \ l -> return $ reverse cmds ++ l  -- | Add a new feed to watch.-addFeed :: Label -> Url -> Command+addFeed :: FeedConfig -> Command addFeed = AddFeed  -- | Remove a previously added feed.@@ -621,8 +805,8 @@ removeFeed = RemoveFeed  -- | Set whether a given feed should be watched (active) or not (inactive).-feedActive :: Label -> Bool -> Command-feedActive = FeedActive+setFeedActive :: Label -> Bool -> Command+setFeedActive = SetFeedActive  -- | Set the interval, in microseconds, between feed scans. setInterval :: TimeUnit t => t -> Command@@ -632,3 +816,11 @@ -- more new items are found, they wait for the next scan. setMaxPerVisit :: Int -> Command setMaxPerVisit = SetMaxPerVisit++-- | Enable or disable debug logs for a given feed.+setFeedDebug :: Label -> Bool -> Command+setFeedDebug = SetFeedDebug++-- | Enable or disable general (i.e. not feed-specific) debug logs.+setGeneralDebug :: Bool -> Command+setGeneralDebug = SetGeneralDebug