imm 0.6.0.0 → 0.6.0.1

raw patch · 13 files changed

+176/−184 lines, 13 filesdep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• Imm/Boot.hs +33/−30
• Imm/Config.hs +43/−24
• Imm/Core.hs +23/−25
• Imm/Database.hs +1/−2
• Imm/Dyre.hs +6/−6
• Imm/Error.hs +2/−2
• Imm/Feed.hs +11/−9
• Imm/HTTP.hs +1/−27
• Imm/Mail.hs +12/−10
• Imm/Maildir.hs +24/−13
• Imm/Options.hs +15/−32
• Imm/Util.hs +1/−1
• imm.cabal +4/−3

@@ -6,21 +6,23 @@ import Imm.Config import Imm.Database import Imm.Dyre as Dyre-import Imm.Error import qualified Imm.Feed as Feed-import Imm.Options (Action(..), OptionsReader(..))+import Imm.Options (Action(..)) import qualified Imm.Options as Options import Imm.Util  import Control.Lens hiding (Action, (??))-import Control.Monad.Error hiding(when)-import Control.Monad.Reader hiding(when)+import Control.Monad.Error hiding(mapM_, when)+-- import Control.Monad.Reader hiding(mapM_, when)+import Control.Monad.Trans.Maybe +import Data.Foldable import Data.Version  import Network.URI as N  import Paths_imm+import Prelude hiding (mapM_)  import System.Log.Logger import System.Exit@@ -31,30 +33,41 @@  -- | Main function to call in the configuration file. imm :: [ConfigFeed] -> IO ()-imm feedsFromConfig = Options.run $ readOptions Options.action >>= dispatch1 feedsFromConfig+imm feedsFromConfig = void . runMaybeT $ do+    options <- Options.get+    let dataDir          = view Options.dataDirectory options+        dyreMode         = view Options.dyreMode      options+        feedsFromOptions = view Options.feedsList     options+        logLevel         = view Options.logLevel      options +    action <- handleSpecialActions $ view Options.action        options -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+    io . updateGlobalLogger rootLoggerName $ setLevel logLevel+    io . debugM "imm.options" $ "Commandline options: " ++ show options      io $ Dyre.wrap dyreMode 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+handleSpecialActions :: Options.Action -> MaybeT IO Feed.Action+handleSpecialActions Help         = (io $ putStrLn Options.usage) >> mzero+handleSpecialActions ShowVersion  = (io . putStrLn $ showVersion version) >> mzero+handleSpecialActions Recompile    = (io $ Dyre.recompile >>= mapM_ putStrLn) >> mzero+handleSpecialActions Import       = io getContents >>= Core.importOPML >> mzero+handleSpecialActions (Run action) = return action  +realMain :: (Feed.Action, Maybe FilePath, [URI], [ConfigFeed]) -> IO ()+realMain (action, dataDir, feedsFromOptions, feedsFromConfig) = do+    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)++    Core.dispatch baseConfig action feedsOK+  where+    (errors, feedsOK) = validateFeeds feedsFromConfig feedsFromOptions+    baseConfig        = maybe id (set (fileDatabase . directory)) dataDir++ validateFeeds :: [ConfigFeed] -> [URI] -> ([String], Core.FeedList) validateFeeds feedsFromConfig feedsFromOptions = (errors ++ errors', null feedsFromOptions ? feedsOK ?? feedsOK')   where@@ -62,13 +75,3 @@     validateFromOptions uri   = maybe (Left ("URI from commandline option has no configuration entry: " ++ show uri)) Right . listToMaybe . filter ((== uri) . snd) $ feedsOK     (errors,  feedsOK)        = partitionEithers $ map validateFromConfig  feedsFromConfig     (errors', feedsOK')       = partitionEithers $ map validateFromOptions feedsFromOptions---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-    -- io . debugM "imm.boot" . unlines $ "Feeds to be processed:":(map (show . snd) feedsOK)--    withError . withConfig (maybe id (set (fileDatabase . directory)) dataDir) $ dispatch2 action feedsOK

@@ -12,7 +12,6 @@     formatSubject,     formatBody,     decoder,-    ConfigReader(..),     withConfig, -- * Misc     addFeeds,@@ -23,6 +22,7 @@ import Imm.Error import Imm.Feed (FeedParser) import qualified Imm.Feed as F+import Imm.Maildir (Maildir, MaildirWriter(..)) import Imm.HTTP (Decoder(..)) import qualified Imm.Mail as Mail import Imm.Util@@ -38,6 +38,8 @@ import Data.Time.RFC2822 import Data.Time.RFC3339 +import Prelude hiding(init)+ import Text.Feed.Query as F -- import Text.Feed.Types as F @@ -67,13 +69,13 @@  -- | The only exported constructor is through 'Default' class. data Config = Config {-    _maildir        :: FilePath,       -- ^ Where mails will be written-    _fileDatabase   :: FileDatabase,   -- ^ Database configuration, used to store resilient information (basically: last update time)+    _maildir        :: Maildir,                    -- ^ Where mails will be written+    _fileDatabase   :: FileDatabase,               -- ^ Database configuration, used to store resilient information (basically: last update time)     _dateParsers    :: [String -> Maybe UTCTime],  -- ^ List of date parsing functions, will be tried sequentially until one succeeds-    _formatFrom     :: FromFormat,     -- ^ Called to write the From: header of feed mails-    _formatSubject  :: SubjectFormat,  -- ^ Called to write the Subject: header of feed mails-    _formatBody     :: BodyFormat,     -- ^ Called to write the body of feed mails (sic!)-    _decoder        :: String          -- ^ 'Converter' name used to decode the HTTP response from a feed URI+    _formatFrom     :: FromFormat,                 -- ^ Called to write the From: header of feed mails+    _formatSubject  :: SubjectFormat,              -- ^ Called to write the Subject: header of feed mails+    _formatBody     :: BodyFormat,                 -- ^ Called to write the body of feed mails (sic!)+    _decoder        :: String                      -- ^ 'Converter' name used to decode the HTTP response from a feed URI }  makeLenses ''Config@@ -111,26 +113,24 @@ instance (MonadBase IO m) => DatabaseReader (ReaderT Config m) where     getLastCheck = withReaderT (view fileDatabase) . getLastCheck -instance (MonadBase IO m) => DatabaseWriter (ReaderT Config (ErrorT ImmError m)) where+instance (MonadError ImmError m, MonadBase IO m) => DatabaseWriter (ReaderT Config m) where     storeLastCheck uri = withReaderT (view fileDatabase) . storeLastCheck uri     forget             = withReaderT (view fileDatabase) . forget +instance (MonadBase IO m, MonadError ImmError m) => MaildirWriter (ReaderT Config m) where+    init       = do+        theMaildir <- asks $ view maildir+        lift $ runReaderT init theMaildir+    write mail = do+        theMaildir <- asks $ view maildir+        lift $ runReaderT (write mail) theMaildir+ instance (Monad m) => Mail.MailFormatter (ReaderT Config m) where     formatFrom    = asks $ unFromFormat    . view formatFrom     formatSubject = asks $ unSubjectFormat . view formatSubject     formatBody    = asks $ unBodyFormat    . view formatBody  --- | 'MonadReader' for 'Config'-class ConfigReader m where-    readConfig  :: Simple Lens Config a -> m a-    localConfig :: (Config -> Config) -> m a -> m a--instance (Monad m) => ConfigReader (ReaderT Config m) where-    readConfig l = return . view l =<< ask-    localConfig  = local-- withConfig :: (MonadBase IO m) => (Config -> Config) -> ReaderT Config m a -> m a withConfig f g = do     theConfig <- f <$> io def@@ -138,15 +138,34 @@ -- }}}  --- | Return the Haskell code to write in the configuration file to add a feed.+-- | Return the Haskell code to write in the configuration file to add feeds. addFeeds :: (MonadBase IO m) => [(String, [String])] -> m ()-addFeeds feeds = forM_ feeds addFeedsGroup+addFeeds feeds = do+    io . putStrLn . unlines $+        "import Imm":+        "import Control.Lens":+        "import System.FilePath":+        "":+        "main :: IO ()":+        "main = imm myFeeds":+        "":+        "maildirRoot = \"/home/<user>/feeds\"   -- TODO: fill <user>":+        "":+        ("myFeeds = concat $ " ++ intercalate ":" (map (map toLower . concat . words . fst) feeds) ++ ":[]"):+        [] +    forM_ feeds addFeedsGroup+ addFeedsGroup :: (MonadBase IO m) => (String, [String]) -> m () addFeedsGroup (groupTitle, uris) = io $ do     -- guard (not $ null uris)-    putStrLn $ "-- Group " ++ groupTitle-    putStrLn $ map toLower (concat . words $ groupTitle) ++ " = ["-    putStrLn . ("    " ++) . intercalate ",\n    " $ map show uris-    putStrLn "]"+    putStr . unlines $+        ("-- Group " ++ groupTitle):+        (groupID ++ "Config = set maildir (maildirRoot </> \"" ++ groupID ++ "\")"):+        (groupID ++ "       = zip (repeat " ++ groupID ++ "Config) $"):+        []+    putStr . unlines $ map (\u -> "    " ++ show u ++ ":") uris+    putStrLn "    []"     putStrLn ""+  where+    groupID = map toLower . concat . words $ groupTitle

@@ -4,6 +4,7 @@     FeedConfig,     FeedList, -- * Actions+    dispatch,     importOPML,     check,     showStatus,@@ -18,7 +19,7 @@ import Imm.Error import Imm.Feed (FeedParser(..)) import qualified Imm.Feed as Feed-import qualified Imm.HTTP as HTTP+import Imm.Maildir (MaildirWriter(..)) import qualified Imm.Maildir as Maildir import Imm.Mail (MailFormatter(..)) import qualified Imm.Mail as Mail@@ -29,7 +30,6 @@ 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 Data.Foldable hiding(foldr) import Data.Time as T@@ -48,40 +48,41 @@ -- }}}  -importOPML :: (MonadBase IO m, MonadPlus m) => String -> m ()-importOPML = mapM_ addFeeds . OPML.read+dispatch :: (Config -> Config) -> Feed.Action -> FeedList -> IO ()+dispatch baseConfig Feed.Check        feeds = void $ mapConcurrently (check baseConfig) feeds+dispatch baseConfig Feed.ShowStatus   feeds = mapM_ (showStatus baseConfig) feeds+dispatch baseConfig Feed.MarkAsRead   feeds = mapM_ (markAsRead baseConfig) feeds+dispatch baseConfig Feed.MarkAsUnread feeds = mapM_ (markAsUnread baseConfig) feeds+dispatch baseConfig Feed.Update       feeds = void $ mapConcurrently (update baseConfig) feeds  -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+importOPML :: (MonadBase IO m, MonadPlus m) => String -> m ()+importOPML = mapM_ addFeeds . OPML.read  -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)+check :: (Config -> Config) -> FeedConfig -> IO ()+check baseConfig (f, feedID) = withError "imm.core". withConfig (f . baseConfig) $ Feed.download feedID >>= Feed.check  -markAsRead :: (MonadBase IO m, ConfigReader m, DatabaseState m, MonadError ImmError m) => FeedConfig -> m ()-markAsRead (f, feedID) = localConfig f . localError "imm.core" $ Feed.markAsRead feedID+showStatus :: (Config -> Config) -> FeedConfig -> IO ()+showStatus baseConfig (f, feedID) = withConfig (f . baseConfig) $ (io . noticeM "imm.core" =<< Feed.showStatus feedID)  -markAsUnread :: (MonadBase IO m, ConfigReader m, DatabaseState m, MonadError ImmError m) => FeedConfig -> m ()-markAsUnread (f, feedID) = localConfig f . localError "imm.core" $ Feed.markAsUnread feedID+markAsRead :: (Config -> Config) -> FeedConfig -> IO ()+markAsRead baseConfig (f, feedID) = withError "imm.core" . withConfig (f . baseConfig) $ Feed.markAsRead feedID  -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+markAsUnread :: (Config -> Config) -> FeedConfig -> IO ()+markAsUnread baseConfig (f, feedID) = withError "imm.core" . withConfig (f . baseConfig) $ Feed.markAsUnread feedID   -- | 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, HTTP.Decoder m, MonadError ImmError m) => FeedConfig -> m ()-updateFeed (f, feedID) = localConfig f . localError "imm.core" $ do+update :: (Config -> Config) -> FeedConfig -> IO ()+update baseConfig (f, feedID) = withError "imm.core" . withConfig (f . baseConfig) $ do     -- io . noticeM "imm.core" $ "Updating: " ++ show feedID     (uri, feed) <- Feed.download feedID -    Maildir.create =<< readConfig maildir+    Maildir.init      io . debugM "imm.core" $ Feed.describe feed @@ -93,10 +94,7 @@     Feed.markAsRead uri  -updateItem :: (Applicative m, ConfigReader m, FeedParser m, MailFormatter m, MonadBase IO m, MonadError ImmError m) => (Item, Feed) -> m ()+updateItem :: (Applicative m, FeedParser m, MaildirWriter m, MailFormatter m, MonadBase IO m, MonadError ImmError m) => (Item, Feed) -> m () updateItem (item, feed) = do     timeZone <- io getCurrentTimeZone-    dir <- readConfig maildir--    io . debugM "imm.core" $ "Adding following item to maildir [" ++ dir ++ "]:\n" ++ Feed.describeItem item-    Maildir.add dir =<< Mail.build timeZone (item, feed)+    Maildir.write =<< Mail.build timeZone (item, feed)

@@ -40,8 +40,7 @@ instance (Error e, DatabaseReader m) => DatabaseReader (ErrorT e m) where     getLastCheck = getLastCheck --class (MonadError ImmError m) => DatabaseWriter m where+class DatabaseWriter m where     -- | Write the last update time in the data file.     storeLastCheck :: FeedID -> UTCTime -> m ()     -- | Remove state file as if no update was ever done.

@@ -34,12 +34,12 @@ showPaths :: MonadBase IO m => m String showPaths = io $ do     (a, b, c, d, e) <- getPaths $ parameters nullMain-    return . unlines $ [-        "Current binary:  " ++ a,-        "Custom binary:   " ++ b,-        "Config file:     " ++ c,-        "Cache directory: " ++ d,-        "Lib directory:   " ++ e, []]+    return . unlines $+        ("Current binary:  " ++ a):+        ("Custom binary:   " ++ b):+        ("Config file:     " ++ c):+        ("Cache directory: " ++ d):+        ("Lib directory:   " ++ e):[]  -- | Dynamic reconfiguration settings parameters :: (a -> IO ()) -> Params (Either String a)

@@ -65,8 +65,8 @@     strMsg = OtherError  -withError :: (Error e, Show e, MonadBase IO m) => ErrorT e m () -> m ()-withError = runErrorT >=> either (io . print) return+withError :: (Error e, Show e, MonadBase IO m) => String -> ErrorT e m () -> m ()+withError category = runErrorT >=> either (io . errorM category . show) return  localError :: (MonadBase IO m, MonadError ImmError m) => String -> m () -> m () localError category f = f `catchError` (io . errorM category . show)

@@ -76,25 +76,27 @@     feed <- parse . TL.unpack =<< HTTP.get uri     return (uri, feed) --- |+-- | Count the list of unread items for given feed. check :: (FeedParser m, DatabaseReader m, MonadBase IO m, MonadError ImmError m) => ImmFeed -> m () check (feedID, feed) = do     lastCheck       <- getLastCheck feedID-    (errors, dates) <- partitionEithers <$> forM (feedItems feed) (\item -> (return . Right =<< getDate item) `catchError` (return . Left))+    (errors, dates) <- partitionEithers <$> mapM (runErrorT . getDate) (feedItems feed)+    let newItems     = filter (> lastCheck) dates+     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) for <" ++ show feedID ++ ">" - -- | Simply set the last check time to now.-markAsRead :: (MonadBase IO m, MonadError ImmError m, DatabaseState m) => URI -> m ()-markAsRead uri = io getCurrentTime >>= storeLastCheck uri >> (io . debugM "imm.feed" $ "Feed " ++ show uri ++ " marked as read.")+markAsRead :: (MonadBase IO m, MonadError ImmError m, DatabaseWriter m) => URI -> m ()+markAsRead uri = do+    io getCurrentTime >>= storeLastCheck uri+    io . noticeM "imm.feed" $ "Feed <" ++ show uri ++ "> marked as read."  -- | Simply remove the state file. markAsUnread ::  (MonadBase IO m, MonadError ImmError m, DatabaseState m) => URI -> m () markAsUnread uri = do     forget uri-    io . noticeM "imm.feed" $ "Feed " ++ show uri ++ " marked as unread."+    io . noticeM "imm.feed" $ "Feed <" ++ show uri ++ "> marked as unread."  -- | Return a 'String' describing the last update for a given feed. showStatus :: (DatabaseReader m, MonadBase IO m) => URI -> m String@@ -108,8 +110,8 @@ getItemContent :: Item -> String getItemContent (AtomItem i) = length theContent < length theSummary ? theSummary ?? theContent   where-    theContent = maybe "" extractHtml $ Atom.entryContent i-    theSummary = maybe "No content" Atom.txtToString $ Atom.entrySummary i+    theContent = fromMaybe "" $ (extractHtml <$> Atom.entryContent i)+    theSummary = fromMaybe "No content" $ (Atom.txtToString <$> Atom.entrySummary i) getItemContent (RSSItem  i) = length theContent < length theDescription ? theDescription ?? theContent   where     theContent     = dropWhile isSpace . concatMap concat . map (map cdData . onlyText . elContent) . RSS.rssItemOther $ i

@@ -30,34 +30,8 @@  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 getRaw uri = do@@ -67,7 +41,7 @@  -- | Same as 'getRaw' with additional decoding get :: (Decoder m, MonadBase IO m, MonadError ImmError m) => URI -> m TL.Text-get uri = decode =<< getRaw uri+get uri = getRaw uri >>= decode  -- | Monad-agnostic version of 'withManager' withManager' :: (MonadError ImmError m, MonadBase IO m) => (Manager -> ResourceT IO b) -> m b

@@ -43,15 +43,15 @@         _returnPath         = "<imm@noreply>"}  instance Show Mail where-    show mail = unlines [-        "Return-Path: " ++ view returnPath mail,-        maybe "" (("Date: " ++) . showRFC2822) . view date $ mail,-        "From: " ++ view from mail,-        "Subject: " ++ view subject mail,-        "Content-Type: " ++ view mime mail ++ "; charset=" ++ view charset mail,-        "Content-Disposition: " ++ view contentDisposition mail,-        "",-        view body mail]+    show mail = unlines $+        ("Return-Path: " ++ view returnPath mail):+        (maybe "" (("Date: " ++) . showRFC2822) $ view date mail):+        ("From: " ++ view from mail):+        ("Subject: " ++ view subject mail):+        ("Content-Type: " ++ view mime mail ++ "; charset=" ++ view charset mail):+        ("Content-Disposition: " ++ view contentDisposition mail):+        "":+        (view body mail):[]   type Format = (Item, Feed) -> String@@ -68,5 +68,7 @@     from'    <- formatFrom    <*> return (item, feed)     subject' <- formatSubject <*> return (item, feed)     body'    <- formatBody    <*> return (item, feed)-    date'    <- return . either (const Nothing) (Just . utcToZonedTime timeZone) =<< runErrorT (getDate item)+    date'    <- runErrorT' (utcToZonedTime timeZone <$> getDate item)     return . set date date' . set from from' . set subject subject' . set body body' $ def+  where+    runErrorT' = (return . either (const Nothing) Just) <=< runErrorT

@@ -6,6 +6,7 @@ import Imm.Util  import Control.Monad.Error+import Control.Monad.Reader  import qualified Data.Text.Lazy.IO as T import qualified Data.Text.Lazy as TL@@ -15,23 +16,33 @@  import System.Directory import System.FilePath+import System.Log.Logger import System.Random -- }}} --- | Build a maildir with subdirectories cur, new and tmp.-create :: (MonadBase IO m, MonadError ImmError m) => FilePath -> m ()-create directory = do-    try $ createDirectoryIfMissing True directory-    try $ createDirectoryIfMissing True (directory </> "cur")-    try $ createDirectoryIfMissing True (directory </> "new")-    try $ createDirectoryIfMissing True (directory </> "tmp")+type Maildir = FilePath --- | Add a mail to the maildir-add :: (MonadBase IO m, MonadError ImmError m) => FilePath -> Mail -> m ()-add directory mail = do-    fileName <- io getUniqueName-    try $ T.writeFile (directory </> "new" </> fileName) (TL.pack $ show mail)+class MaildirWriter m where+    -- | Build a maildir with subdirectories cur, new and tmp.+    init :: m ()+    -- | Add a mail to the maildir+    write  :: Mail -> m () +instance (MonadBase IO m, MonadError ImmError m) => MaildirWriter (ReaderT Maildir m) where+    init = do+        theMaildir <- ask+        io . debugM "imm.maildir" $ "Creating maildir [" ++ theMaildir ++ "]"+        try . mapM_ (createDirectoryIfMissing True) $+            theMaildir:+            (theMaildir </> "cur"):+            (theMaildir </> "new"):+            (theMaildir </> "tmp"):[]+    write mail = do+        fileName   <- io getUniqueName+        theMaildir <- ask+        io . debugM "imm.maildir" $ "Writing new mail in maildir [" ++ theMaildir ++ "]"+        try $ T.writeFile (theMaildir </> "new" </> fileName) (TL.pack $ show mail)+ -- | Return an allegedly unique filename; useful to add new mail files in a maildir. getUniqueName :: MonadBase IO m => m String getUniqueName = io $ do@@ -39,4 +50,4 @@     hostname <- getHostName     rand     <- show <$> (getStdRandom $ randomR (1,100000) :: IO Int) -    return . concat $ [time, ".", rand, ".", hostname]+    return . concat $ time:".":rand:".":hostname:[]

@@ -1,14 +1,13 @@ {-# LANGUAGE TemplateHaskell #-}--- | Commandline options tools. Designed to be imported as @qualified@. module Imm.Options (     CliOptions,     action,     dyreMode,     feedsList,     dataDirectory,-    OptionsReader(..),+    logLevel,     Action(..),-    run,+    get,     usage, ) where @@ -30,7 +29,6 @@ import System.Environment -- import System.Environment.XDG.BaseDir import System.Log as Log-import System.Log.Logger -- }}}  -- {{{ Types@@ -48,8 +46,7 @@     _dyreMode       :: Dyre.Mode,     _dataDirectory  :: Maybe FilePath,     _feedsList      :: [URI],-    _logLevel       :: Log.Priority,-    _dyreDebug      :: Bool}+    _logLevel       :: Log.Priority}     deriving(Eq)  makeLenses ''CliOptions@@ -60,8 +57,7 @@         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,-        view dyreDebug opts ? Just "DYRE_DEBUG" ?? Nothing]+        return $ "LOG_LEVEL=" ++ show (view logLevel opts)]  instance Default CliOptions where     def = CliOptions {@@ -69,26 +65,7 @@         _dyreMode      = def,         _logLevel      = Log.INFO,         _dataDirectory = Nothing,-        _feedsList     = [],-        _dyreDebug     = False}---- | 'MonadReader' for 'CliOptions'-class OptionsReader m where-    readOptions :: Simple Lens CliOptions a -> m a--instance (Monad m) => OptionsReader (ReaderT CliOptions m) where-    readOptions l = return . view l =<< ask--instance OptionsReader ((->) CliOptions) where-    readOptions l = view l---- | Parse commandline options, set the corresponding log level.-run :: (MonadBase IO m) => ReaderT CliOptions m a -> m a-run f = do-    opts <- get-    io . updateGlobalLogger rootLoggerName . setLevel $ view logLevel opts-    io . debugM "imm.options" $ "Commandline options: " ++ show opts-    runReaderT f opts+        _feedsList     = []} -- }}}  description :: [OptDescr (CliOptions -> CliOptions)]@@ -116,15 +93,21 @@  -- | Usage text (printed when using 'Help' action) usage :: String-usage = usageInfo "Usage: imm [OPTIONS] [URI]\n\nConvert items from RSS/Atom feeds to maildir entries. If one or more URI(s) are given, they will be processed instead of the feeds list from configuration\n" description+usage = flip usageInfo description . unlines $+    "Usage: imm [OPTIONS] [URI]":+    "":+    "Convert items from RSS/Atom feeds to maildir entries.":+    "If one or more URI(s) are given, they will be processed instead of the feeds list from configuration.":[]  -- | Get and parse commandline options get :: (MonadBase IO m) => m CliOptions get = io $ do-    options <- getOpt' Permute description <$> getArgs-    case options of+    parsedArgs <- getOpt' Permute description <$> getArgs+    case parsedArgs of         (opts, input, _, []) -> do-            let (errors, valids) = partitionEithers $ map (\uri -> maybe (Left $ "Invalid URI given in commandline: " ++ uri) Right $ N.parseURI uri) input+            let (errors, valids) = partitionEithers $ map parseURI' input             unless (null errors) $ io . putStrLn $ unlines errors             return $ set feedsList valids  (foldl (flip id) def opts)         (_, _, _, _)         -> return def+  where+    parseURI' uri = maybe (Left $ "Invalid URI given in commandline: " ++ uri) Right $ N.parseURI uri

@@ -13,7 +13,7 @@ import Data.Default as X import Data.Either as X import Data.Functor as X-import Data.List as X hiding(foldl, sum)+import Data.List as X hiding(foldl, init, sum) import Data.Maybe as X  import System.FilePath

@@ -1,5 +1,5 @@ Name:                imm-Version:             0.6.0.0+Version:             0.6.0.1 Synopsis:            Retrieve RSS/Atom feeds and write one mail per new item in a maildir. Description:         Cf README --Homepage:@@ -31,11 +31,11 @@         Imm.HTTP,         Imm.Mail,         Imm.Maildir,-        Imm.OPML,-        Imm.Options,         Imm.Util     Other-modules:         Imm.Dyre,+        Imm.OPML,+        Imm.Options,         Paths_imm     Build-depends:         async,@@ -63,6 +63,7 @@         text,         text-icu,         transformers-base,+        transformers,         time,         timerep >= 1.0.3,         tls,