imm 0.6.0.1 → 0.6.0.2

raw patch · 7 files changed

+45/−41 lines, 7 filesdep ~feeddep ~http-conduitdep ~tlsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: feed, http-conduit, tls

API changes (from Hackage documentation)

Files

• Imm/Boot.hs +2/−2
• Imm/Core.hs +2/−2
• Imm/Error.hs +18/−16
• Imm/Feed.hs +8/−6
• Imm/HTTP.hs +2/−2
• Imm/Mail.hs +9/−9
• imm.cabal +4/−4

@@ -40,7 +40,7 @@         feedsFromOptions = view Options.feedsList     options         logLevel         = view Options.logLevel      options -    action <- handleSpecialActions $ view Options.action        options+    action <- handleSpecialActions $ view Options.action options      io . updateGlobalLogger rootLoggerName $ setLevel logLevel     io . debugM "imm.options" $ "Commandline options: " ++ show options@@ -49,7 +49,7 @@   handleSpecialActions :: Options.Action -> MaybeT IO Feed.Action-handleSpecialActions Help         = (io $ putStrLn Options.usage) >> mzero+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

@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, TemplateHaskell, TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-} module Imm.Core ( -- * Types     FeedConfig,@@ -65,7 +65,7 @@   showStatus :: (Config -> Config) -> FeedConfig -> IO ()-showStatus baseConfig (f, feedID) = withConfig (f . baseConfig) $ (io . noticeM "imm.core" =<< Feed.showStatus feedID)+showStatus baseConfig (f, feedID) = withConfig (f . baseConfig) (io . noticeM "imm.core" =<< Feed.showStatus feedID)   markAsRead :: (Config -> Config) -> FeedConfig -> IO ()

@@ -1,4 +1,14 @@-module Imm.Error where+module Imm.Error (+-- * Types+    ImmError(..),+    withError,+    localError,+-- * Functions redefinition+    try,+    timeout,+    parseURI,+    parseTime,+) where  -- {{{ Imports import qualified Control.Exception as E@@ -6,18 +16,17 @@  import Control.Monad.Error -import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import Data.Text.Encoding as T import Data.Text.Encoding.Error-import qualified Data.Text.Lazy as TL-import Data.Text.Lazy.Encoding as TL-import Data.Time as T+import Data.Time (UTCTime)+import qualified Data.Time as T  import Network.HTTP.Conduit hiding(HandshakeFailed) import Network.HTTP.Types.Status import Network.TLS hiding(DecodeError)-import Network.URI as N+import Network.URI (URI)+import qualified Network.URI as N  import System.IO.Error @@ -26,13 +35,13 @@  import System.Locale import System.Log.Logger-import System.Timeout as S+import qualified System.Timeout as S -- }}}  data ImmError =     OtherError         String   | HTTPError          HttpException-  | TLSError           HandshakeFailed+  | TLSError           TLSException   | UnicodeError       UnicodeException   | ParseUriError      String   | ParseTimeError     String@@ -54,7 +63,7 @@         "/!\\ Cannot parse date from item: ",         "    title: "       ++ (show $ getItemTitle item),         "    link:"         ++ (show $ getItemLink item),-        "    publish date:" ++ (show $ getItemPublishDate item),+        "    publish date:" ++ (show (getItemPublishDate item :: Maybe (Maybe UTCTime))),         "    date:"         ++ (show $ getItemDate item)]     show (ParseTimeError raw)      = "/!\\ Cannot parse time: " ++ raw     show (ParseFeedError raw)      = "/!\\ Cannot parse feed: " ++ raw@@ -79,12 +88,6 @@ timeout :: (MonadBase IO m, MonadError ImmError m) => Int -> IO a -> m a timeout n f = maybe (throwError TimeOut) (io . return) =<< (io $ S.timeout n (io f)) ---- {{{ Monad-agnostic version of various error-prone functions--- | Monad-agnostic version of Data.Text.Encoding.decodeUtf8-decodeUtf8 :: MonadError ImmError m => BL.ByteString -> m TL.Text-decodeUtf8 = either (throwError . UnicodeError) return . TL.decodeUtf8'- -- | Monad-agnostic version of 'Network.URI.parseURI' parseURI :: (MonadError ImmError m) => String -> m URI parseURI uri = maybe (throwError $ ParseUriError uri) return $ N.parseURI uri@@ -92,4 +95,3 @@ -- | Monad-agnostic version of 'Data.Time.Format.parseTime' parseTime :: (MonadError ImmError m) => String -> m UTCTime parseTime string = maybe (throwError $ ParseTimeError string) return $ T.parseTime defaultTimeLocale "%c" string--- }}}

@@ -1,3 +1,4 @@+{-# LANGUAGE TupleSections #-} module Imm.Feed where  -- {{{ Imports@@ -73,18 +74,19 @@ download :: (HTTP.Decoder m, MonadBase IO m, MonadError ImmError m) => URI -> m ImmFeed download uri = do     io . debugM "imm.feed" $ "Downloading " ++ show uri-    feed <- parse . TL.unpack =<< HTTP.get uri-    return (uri, feed)+    fmap (uri,) . parse . TL.unpack =<< HTTP.get uri  -- | 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 <$> mapM (runErrorT . getDate) (feedItems feed)+    (errors, dates) <- tryGetDates $ feedItems feed     let newItems     = filter (> lastCheck) dates      unless (null errors) . io . errorM "imm.feed" . unlines $ map show errors     io . noticeM "imm.feed" $ show (length newItems) ++ " new item(s) for <" ++ show feedID ++ ">"+  where+    tryGetDates = fmap partitionEithers . mapM (runErrorT . getDate)  -- | Simply set the last check time to now. markAsRead :: (MonadBase IO m, MonadError ImmError m, DatabaseWriter m) => URI -> m ()@@ -93,7 +95,7 @@     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 ::  (MonadBase IO m, MonadError ImmError m, DatabaseWriter m) => URI -> m () markAsUnread uri = do     forget uri     io . noticeM "imm.feed" $ "Feed <" ++ show uri ++ "> marked as unread."@@ -110,8 +112,8 @@ getItemContent :: Item -> String getItemContent (AtomItem i) = length theContent < length theSummary ? theSummary ?? theContent   where-    theContent = fromMaybe "" $ (extractHtml <$> Atom.entryContent i)-    theSummary = fromMaybe "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

@@ -50,13 +50,13 @@     either throwError return res  -- | Monad-agnostic version of 'parseUrl'-parseURL :: (MonadBase IO m, MonadError ImmError m) => String -> m (Request m')+parseURL :: (MonadBase IO m, MonadError ImmError m) => String -> m Request parseURL uri = do     result <- io $ (Right <$> parseUrl uri) `catch` (return . Left . HTTPError)     either throwError return result  -- | Build an HTTP request for given URI-request :: (MonadBase IO m, MonadError ImmError m) => String -> m (Request a)+request :: (MonadBase IO m, MonadError ImmError m) => String -> m Request request uri = do     req <- parseURL uri     return $ req { requestHeaders = [

@@ -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

@@ -1,5 +1,5 @@ Name:                imm-Version:             0.6.0.1+Version:             0.6.0.2 Synopsis:            Retrieve RSS/Atom feeds and write one mail per new item in a maildir. Description:         Cf README --Homepage:@@ -46,10 +46,10 @@         data-default,         directory,         dyre,-        feed,+        feed == 0.3.9.2,         filepath,         hslogger,-        http-conduit >= 1.9.0,+        http-conduit >= 2.0 && < 2.2,         http-types,         lens,         mime-mail,@@ -66,7 +66,7 @@         transformers,         time,         timerep >= 1.0.3,-        tls,+        tls >= 1.2 && < 1.3,         utf8-string,         xdg-basedir,         xml