Commits

Anonymous committed 31e3ba1

Clean-up.

Comments (0)

Files changed (6)

         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
 
 
 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
-{-# LANGUAGE ScopedTypeVariables, TemplateHaskell, TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}
 module Imm.Core (
 -- * Types
     FeedConfig,
 
 
 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 ()
-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
 
 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
 
 
 import System.Locale
 import System.Log.Logger
-import System.Timeout as S
+import qualified System.Timeout as S
 -- }}}
 
 data ImmError =
 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
 -- | 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
--- }}}
+{-# LANGUAGE TupleSections #-}
 module Imm.Feed where
 
 -- {{{ Imports
 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 ()
     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."
 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
         _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
 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: