imm 0.5.1.0 → 0.6.0.0

raw patch · 8 files changed

+128/−81 lines, 8 filesdep +asyncPVP ok

version bump matches the API change (PVP)

Dependencies added: async

API changes (from Hackage documentation)

Files

• Imm/Boot.hs +24/−23
• Imm/Core.hs +35/−21
• Imm/Database.hs +2/−1
• Imm/Dyre.hs +11/−2
• Imm/Feed.hs +6/−3
• Imm/HTTP.hs +26/−0
• Imm/Options.hs +22/−30
• imm.cabal +2/−1

@@ -7,7 +7,8 @@ import Imm.Database import Imm.Dyre as Dyre import Imm.Error-import Imm.Options (Action(..), Configuration(..), OptionsReader(..))+import qualified Imm.Feed as Feed+import Imm.Options (Action(..), OptionsReader(..)) import qualified Imm.Options as Options import Imm.Util @@ -30,19 +31,30 @@  -- | Main function to call in the configuration file. imm :: [ConfigFeed] -> IO ()-imm feedsFromConfig = Options.run $ do-    action           <- readOptions Options.action-    configuration    <- readOptions Options.configuration+imm feedsFromConfig = Options.run $ readOptions Options.action >>= dispatch1 feedsFromConfig+++dispatch1 :: [ConfigFeed] -> Options.Action -> ReaderT Options.CliOptions IO ()+dispatch1 _ Help        = io $ putStrLn Options.usage >> exitSuccess+dispatch1 _ ShowVersion = io $ putStrLn (showVersion version) >> exitSuccess+dispatch1 _ Recompile   = io $ Dyre.recompile >>= maybe exitSuccess (\e -> putStrLn e >> exitFailure)+dispatch1 _ Import      = io getContents >>= Core.importOPML >> io exitSuccess+dispatch1 feedsFromConfig (Run action) = do+    dyreMode         <- readOptions Options.dyreMode     feedsFromOptions <- readOptions Options.feedsList     dataDir          <- readOptions Options.dataDirectory -    when (action == Help)        . io $ putStrLn Options.usage >> exitSuccess-    when (action == ShowVersion) . io $ putStrLn (showVersion version) >> exitSuccess-    when (action == Recompile)   . io $ Dyre.recompile >>= maybe exitSuccess (\e -> putStrLn e >> exitFailure)+    io $ Dyre.wrap dyreMode realMain (action, dataDir, feedsFromOptions, feedsFromConfig) -    io $ Dyre.wrap (configuration == Vanilla) realMain (action, dataDir, feedsFromOptions, feedsFromConfig) +dispatch2 :: Feed.Action -> Core.FeedList -> ReaderT Config (ErrorT ImmError IO) ()+dispatch2 Feed.Check        feeds = Core.check feeds+dispatch2 Feed.ShowStatus   feeds = mapM_ Core.showStatus feeds+dispatch2 Feed.MarkAsRead   feeds = mapM_ Core.markAsRead feeds+dispatch2 Feed.MarkAsUnread feeds = mapM_ Core.markAsUnread feeds+dispatch2 Feed.Update       feeds = Core.update feeds + validateFeeds :: [ConfigFeed] -> [URI] -> ([String], Core.FeedList) validateFeeds feedsFromConfig feedsFromOptions = (errors ++ errors', null feedsFromOptions ? feedsOK ?? feedsOK')   where@@ -52,22 +64,11 @@     (errors', feedsOK')       = partitionEithers $ map validateFromOptions feedsFromOptions  -realMain :: (Action, Maybe FilePath, [URI], [ConfigFeed]) -> IO ()+realMain :: (Feed.Action, Maybe FilePath, [URI], [ConfigFeed]) -> IO () realMain (action, dataDir, feedsFromOptions, feedsFromConfig) = do     let (errors, feedsOK) = validateFeeds feedsFromConfig feedsFromOptions-    unless (null errors) . errorM "imm.boot" $ unlines errors--    when (null feedsOK) $ warningM "imm.boot" "Nothing to process. Exiting..." >> exitFailure+    unless (null errors)  . errorM   "imm.boot" $ unlines errors+    when   (null feedsOK) $ warningM "imm.boot"   "Nothing to process. Exiting..." >> exitFailure     -- io . debugM "imm.boot" . unlines $ "Feeds to be processed:":(map (show . snd) feedsOK) -    withError . withConfig (maybe id (set (fileDatabase . directory)) dataDir) $ dispatch action feedsOK---dispatch :: Action -> Core.FeedList -> ReaderT Config (ErrorT ImmError IO) ()-dispatch CheckFeeds   feeds = mapM_ Core.check feeds-dispatch ListFeeds    feeds = mapM_ Core.list feeds-dispatch MarkAsRead   feeds = mapM_ Core.markAsRead feeds-dispatch MarkAsUnread feeds = mapM_ Core.markAsUnread feeds-dispatch UpdateFeeds  feeds = mapM_ Core.update feeds-dispatch ImportFeeds  _     = Core.importOPML =<< io getContents-dispatch _            _     = io $ putStrLn Options.usage+    withError . withConfig (maybe id (set (fileDatabase . directory)) dataDir) $ dispatch2 action feedsOK

@@ -1,11 +1,22 @@-{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}-module Imm.Core where+{-# LANGUAGE ScopedTypeVariables, TemplateHaskell, TypeFamilies #-}+module Imm.Core (+-- * Types+    FeedConfig,+    FeedList,+-- * Actions+    importOPML,+    check,+    showStatus,+    markAsRead,+    markAsUnread,+    update,+) where  -- {{{ Imports import Imm.Config import Imm.Database import Imm.Error-import Imm.Feed (ImmFeed, FeedParser(..))+import Imm.Feed (FeedParser(..)) import qualified Imm.Feed as Feed import qualified Imm.HTTP as HTTP import qualified Imm.Maildir as Maildir@@ -14,13 +25,13 @@ import Imm.OPML as OPML import Imm.Util --- import Control.Lens hiding((??))+import Control.Concurrent.Async import Control.Monad hiding(forM_, mapM_) import Control.Monad.Error hiding(forM_, mapM_) -- import Control.Monad.Reader hiding(forM_, mapM_)--- import Control.Monad.Trans.Control+import Control.Monad.Trans.Control -import Data.Foldable+import Data.Foldable hiding(foldr) import Data.Time as T  import Prelude hiding(log, mapM_, sum)@@ -37,20 +48,21 @@ -- }}}  -check :: (MonadBase IO m, FeedParser m, ConfigReader m, DatabaseReader m, HTTP.Decoder m, MonadError ImmError m) => FeedConfig -> m ()-check (f, feedID) = localConfig f . localError "imm.core" $ do-    io . noticeM "imm.core" $ "Checking: " ++ show feedID-    Feed.download feedID >>= Feed.check-- importOPML :: (MonadBase IO m, MonadPlus m) => String -> m () importOPML = mapM_ addFeeds . OPML.read  -list :: (MonadBase IO m, ConfigReader m, DatabaseReader m, MonadError ImmError m) => FeedConfig -> m ()-list (f, feedID) = localConfig f . localError "imm.core" $ (io . noticeM "imm.core" =<< Feed.showStatus feedID)+check :: (MonadBaseControl IO m, FeedParser m, ConfigReader m, DatabaseReader m, HTTP.Decoder m, MonadError ImmError m) => FeedList -> m ()+check feeds = void . liftBaseWith $ \runInIO -> mapConcurrently (runInIO . checkFeed) feeds +checkFeed :: (MonadBase IO m, FeedParser m, ConfigReader m, DatabaseReader m, HTTP.Decoder m, MonadError ImmError m) => FeedConfig -> m ()+checkFeed (f, feedID) = localConfig f . localError "imm.core" $ Feed.download feedID >>= Feed.check ++showStatus :: (MonadBase IO m, ConfigReader m, DatabaseReader m, MonadError ImmError m) => FeedConfig -> m ()+showStatus (f, feedID) = localConfig f . localError "imm.core" $ (io . noticeM "imm.core" =<< Feed.showStatus feedID)++ markAsRead :: (MonadBase IO m, ConfigReader m, DatabaseState m, MonadError ImmError m) => FeedConfig -> m () markAsRead (f, feedID) = localConfig f . localError "imm.core" $ Feed.markAsRead feedID @@ -59,14 +71,16 @@ markAsUnread (f, feedID) = localConfig f . localError "imm.core" $ Feed.markAsUnread feedID  -update :: (MonadBase IO m, ConfigReader m, DatabaseState m, MonadError ImmError m, FeedParser m, MailFormatter m, HTTP.Decoder m) => FeedConfig -> m ()-update (f, feedID) = localConfig f . localError "imm.core" $ do-    io . noticeM "imm.core" $ "Updating: " ++ show feedID-    Feed.download feedID >>= updateFeed+update :: (MonadBaseControl IO m, ConfigReader m, DatabaseState m, MonadError ImmError m, FeedParser m, MailFormatter m, HTTP.Decoder m) => FeedList -> m ()+update feeds = void . liftBaseWith $ \runInIO -> mapConcurrently (runInIO . updateFeed) feeds + -- | Write mails for each new item, and update the last check time in state file.-updateFeed :: (Applicative m, ConfigReader m, DatabaseState m, FeedParser m, MailFormatter m, MonadBase IO m, MonadError ImmError m) => ImmFeed -> m ()-updateFeed (uri, feed) = do+updateFeed :: (Applicative m, ConfigReader m, DatabaseState m, FeedParser m, MailFormatter m, MonadBase IO m, HTTP.Decoder m, MonadError ImmError m) => FeedConfig -> m ()+updateFeed (f, feedID) = localConfig f . localError "imm.core" $ do+    -- io . noticeM "imm.core" $ "Updating: " ++ show feedID+    (uri, feed) <- Feed.download feedID+     Maildir.create =<< readConfig maildir      io . debugM "imm.core" $ Feed.describe feed@@ -75,7 +89,7 @@     (results :: [Integer]) <- forM (feedItems feed) $ \item -> do         date <- Feed.getDate item         (date > lastCheck) ? (updateItem (item, feed) >> return 1) ?? return 0-    io . noticeM "imm.core" $ "==> " ++ show (sum results) ++ " new item(s)"+    io . noticeM "imm.core" $ "==> " ++ show (sum results) ++ " new item(s) for <" ++ show feedID ++ ">"     Feed.markAsRead uri  

@@ -75,11 +75,12 @@         dataFileGetter <- asks (view getDataFile)          let dataFile = dataDirectory </> dataFileGetter feedUri+        io . debugM "imm.database" $ "Reading last check time from: " ++ dataFile          result <- runErrorT $ do             content <- try $ readFile dataFile             parseTime content-        either (const $ io (warningM "imm.database" "Unable to read last update time.") >> return timeZero) return result+        either (const $ io (debugM "imm.database" "Unable to read last update time.") >> return timeZero) return result       where         timeZero = posixSecondsToUTCTime 0 

@@ -1,4 +1,5 @@ module Imm.Dyre (+    Mode(..),     wrap,     recompile, ) where@@ -17,7 +18,15 @@ import System.Log.Logger -- }}} +-- | How dynamic reconfiguration process should behave.+-- Default is 'Normal', that is: use custom configuration file and recompile if change detected.+data Mode = Normal | Vanilla | ForceReconfiguration | IgnoreReconfiguration+    deriving(Eq, Show) +instance Default Mode where+    def = Normal++ nullMain :: a -> IO () nullMain = const $ return () @@ -47,8 +56,8 @@         debugM "imm.dyre" =<< showPaths         main x -wrap :: (MonadBaseControl IO m) => Bool -> (a -> m ()) -> a -> m ()-wrap vanilla main args = liftBaseWith $ \runInIO -> wrapMain ((parameters (void . runInIO . main)) { configCheck = not vanilla }) $ Right args+wrap :: (MonadBaseControl IO m) => Mode -> (a -> m ()) -> a -> m ()+wrap mode main args = liftBaseWith $ \runInIO -> wrapMain ((parameters (void . runInIO . main)) { configCheck = (mode /= Vanilla) }) $ Right args  -- | Launch a recompilation of the configuration file recompile :: IO (Maybe String)

@@ -29,6 +29,9 @@ -- }}}  -- {{{ Types+data Action = Check | ShowStatus | MarkAsRead | MarkAsUnread | Update+    deriving(Eq, Show)+ type ImmFeed = (FeedID, Feed)  class FeedParser m where@@ -75,12 +78,12 @@  -- | check :: (FeedParser m, DatabaseReader m, MonadBase IO m, MonadError ImmError m) => ImmFeed -> m ()-check (uri, feed) = do-    lastCheck       <- getLastCheck uri+check (feedID, feed) = do+    lastCheck       <- getLastCheck feedID     (errors, dates) <- partitionEithers <$> forM (feedItems feed) (\item -> (return . Right =<< getDate item) `catchError` (return . Left))     unless (null errors) . io . errorM "imm.feed" . unlines $ map show errors     let newItems = filter (> lastCheck) dates-    io . noticeM "imm.feed" $ "==> " ++ show (length newItems) ++ " new item(s) "+    io . noticeM "imm.feed" $ show (length newItems) ++ " new item(s) for <" ++ show feedID ++ ">"   -- | Simply set the last check time to now.

@@ -30,7 +30,33 @@  instance (Error e, Decoder m) => Decoder (ErrorT e m) where     converter = lift converter++-- | HTTP client+-- data Client = Client {+    -- _manager       :: Manager,+    -- _state         :: BrowserState}++-- makeLenses ''Client++-- run :: (MonadBase IO m) => ReaderT (IORef Client) m a -> m a+-- run f = do+    -- theInput <- newEmptyMVar+    -- threadID <- fork worker+    -- manager' <- io $ newManager def+    -- ref      <- io . newIORef $ Client manager' (defaultState manager')+    -- result   <- runReaderT f ref+    -- io $ closeManager manager'+    -- return result++-- worker = do+    -- (theOrder, theResultMVar) <- takeMVar order+    -- putMVar theResultMVar result+    -- result <- work theOrder+ -- }}}++-- getRaw = do+    -- putMVar  -- | Perform an HTTP GET request and return the response body as raw 'ByteString' getRaw :: (MonadBase IO m, MonadError ImmError m) => URI -> m BL.ByteString

@@ -3,17 +3,18 @@ module Imm.Options (     CliOptions,     action,-    configuration,+    dyreMode,     feedsList,     dataDirectory,     OptionsReader(..),     Action(..),-    Configuration(..),     run,     usage, ) where  -- {{{ Imports+import Imm.Dyre as Dyre+import qualified Imm.Feed as Feed import Imm.Util  import Control.Lens as L  hiding(Action, (??))@@ -35,26 +36,17 @@ -- {{{ Types -- | Mutually exclusive actions. -- Default is 'PrintHelp'.-data Action = Help | ShowVersion | Recompile | CheckFeeds | ImportFeeds | ListFeeds | MarkAsRead | MarkAsUnread | UpdateFeeds+data Action = Help | ShowVersion | Recompile | Import | Run Feed.Action     deriving(Eq, Show)  instance Default Action where     def = Help --- | How dynamic reconfiguration process should behave.--- Default is 'Normal', that is: use custom configuration file and recompile if change detected.-data Configuration = Normal | Vanilla | ForceReconfiguration | IgnoreReconfiguration-    deriving(Eq, Show)--instance Default Configuration where-    def = Normal-- -- | Available commandline options data CliOptions = CliOptions {     _action         :: Action,-    _configuration  :: Configuration,-    _dataDirectory :: Maybe FilePath,+    _dyreMode       :: Dyre.Mode,+    _dataDirectory  :: Maybe FilePath,     _feedsList      :: [URI],     _logLevel       :: Log.Priority,     _dyreDebug      :: Bool}@@ -65,7 +57,7 @@ instance Show CliOptions where     show opts = unwords $ catMaybes [         return . ("ACTION=" ++) . show $ view action opts,-        return . ("CONFIGURATION=" ++) . show $ view configuration opts,+        return . ("RECONFIGURATION_MODE=" ++) . show $ view dyreMode opts,         null (view feedsList opts) ? Nothing ?? Just ("FEED_URI=[" ++ (unwords . map show $ view feedsList opts) ++ "]"),         return . ("DATA_DIR=" ++) =<< view dataDirectory opts,         return . ("LOG_LEVEL=" ++) . show $ view logLevel opts,@@ -73,12 +65,12 @@  instance Default CliOptions where     def = CliOptions {-        _action         = def,-        _configuration  = def,-        _logLevel       = Log.INFO,+        _action        = def,+        _dyreMode      = def,+        _logLevel      = Log.INFO,         _dataDirectory = Nothing,-        _feedsList      = [],-        _dyreDebug      = False}+        _feedsList     = [],+        _dyreDebug     = False}  -- | 'MonadReader' for 'CliOptions' class OptionsReader m where@@ -102,20 +94,20 @@ description :: [OptDescr (CliOptions -> CliOptions)] description = [ -- Action-    Option "c"     ["check"]              (NoArg (set action CheckFeeds))                   "Check availability and validity of all feed sources currently configured, without writing any mail",-    Option "l"     ["list"]               (NoArg (set action ListFeeds))                    "List all feed sources currently configured, along with their status",-    Option "R"     ["mark-read"]          (NoArg (set action MarkAsRead))                   "Mark every item of processed feeds as read, ie set last update as now without writing any mail",-    Option "U"     ["mark-unread"]        (NoArg (set action MarkAsUnread))                 "Mark every item of processed feeds as unread, ie delete corresponding state files",-    Option "u"     ["update"]             (NoArg (set action UpdateFeeds))                  "Update list of feeds (mostly used option)",-    Option "i"     ["import"]             (NoArg (set action ImportFeeds))                  "Import feeds list from an OPML descriptor (read from stdin)",+    Option "c"     ["check"]              (NoArg (set action $ Run Feed.Check))             "Check availability and validity of all feed sources currently configured, without writing any mail",+    Option "l"     ["list"]               (NoArg (set action $ Run Feed.ShowStatus))        "List all feed sources currently configured, along with their status",+    Option "R"     ["mark-read"]          (NoArg (set action $ Run Feed.MarkAsRead))        "Mark every item of processed feeds as read, ie set last update as now without writing any mail",+    Option "U"     ["mark-unread"]        (NoArg (set action $ Run Feed.MarkAsUnread))      "Mark every item of processed feeds as unread, ie delete corresponding state files",+    Option "u"     ["update"]             (NoArg (set action $ Run Feed.Update))            "Update list of feeds (mostly used option)",+    Option "i"     ["import"]             (NoArg (set action Import))                       "Import feeds list from an OPML descriptor (read from stdin)",     Option "h"     ["help"]               (NoArg (set action Help))                         "Print this help",     Option "V"     ["version"]            (NoArg (set action ShowVersion))                  "Print version",     Option "r"     ["recompile"]          (NoArg (set action Recompile))                    "Only recompile configuration", -- Dynamic configuration-    Option "1"     ["vanilla"]            (NoArg (set configuration Vanilla))               "Do not read custom configuration file",-    Option []        ["force-reconf"]       (NoArg (set configuration ForceReconfiguration))  "Recompile configuration before starting the program",-    Option []        ["deny-reconf"]        (NoArg (set configuration IgnoreReconfiguration)) "Do not recompile configuration even if it has changed",-    Option []        ["dyre-debug"]         (NoArg id)                                        "Use './cache/' as the cache directory and ./ as the configuration directory. Useful to debug the program",+    Option "1"     ["vanilla"]            (NoArg (set dyreMode Vanilla))                    "Do not read custom configuration file",+    Option []      ["force-reconf"]       (NoArg (set dyreMode ForceReconfiguration))       "Recompile configuration before starting the program",+    Option []      ["deny-reconf"]        (NoArg (set dyreMode IgnoreReconfiguration))      "Do not recompile configuration even if it has changed",+    Option []      ["dyre-debug"]         (NoArg id)                                        "Use './cache/' as the cache directory and ./ as the configuration directory. Useful to debug the program", -- Log level     Option "q"     ["quiet"]              (NoArg (set logLevel Log.ERROR))                  "Do not print any log",     Option "v"     ["verbose"]            (NoArg (set logLevel Log.DEBUG))                  "Print detailed logs",

@@ -1,5 +1,5 @@ Name:                imm-Version:             0.5.1.0+Version:             0.6.0.0 Synopsis:            Retrieve RSS/Atom feeds and write one mail per new item in a maildir. Description:         Cf README --Homepage:@@ -38,6 +38,7 @@         Imm.Dyre,         Paths_imm     Build-depends:+        async,         base == 4.*,         bytestring,         case-insensitive,