Anonymous avatar Anonymous committed 94ad430

Clean-up.

Comments (0)

Files changed (10)

 handleSpecialActions (Run action) = return action
 
 
-validateFeeds :: [ConfigFeed] -> [URI] -> ([String], Core.FeedList)
-validateFeeds feedsFromConfig feedsFromOptions = (errors ++ errors', null feedsFromOptions ? feedsOK ?? feedsOK')
-  where
-    validateFromConfig (x, u) = maybe (Left ("Invalid feed URI: " ++ u)) (Right . (x,)) $ N.parseURI u
-    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
     unless (null errors)  . errorM   "imm.boot" $ unlines errors
   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
+    validateFromConfig (x, u) = maybe (Left ("Invalid feed URI: " ++ u)) (Right . (x,)) $ N.parseURI u
+    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
     formatSubject,
     formatBody,
     decoder,
-    ConfigReader(..),
     withConfig,
 -- * Misc
     addFeeds,
         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
         "":
         "maildirRoot = \"/home/<user>/feeds\"   -- TODO: fill <user>":
         "":
-        ("myFeeds = concat [" ++ intercalate ", " (map (map toLower . concat . words . fst) feeds) ++ "]"):
+        ("myFeeds = concat $ " ++ intercalate ":" (map (map toLower . concat . words . fst) feeds) ++ ":[]"):
         []
 
     forM_ feeds addFeedsGroup
 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)
     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, DatabaseWriter m) => URI -> m ()
-markAsRead uri = io getCurrentTime >>= storeLastCheck uri >> (io . noticeM "imm.feed" $ "Feed <" ++ show uri ++ "> marked as read.")
+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 ()
 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
 
 -- | 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
         _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
     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
     init = do
         theMaildir <- ask
         io . debugM "imm.maildir" $ "Creating maildir [" ++ theMaildir ++ "]"
-        try $ createDirectoryIfMissing True theMaildir
-        try $ createDirectoryIfMissing True (theMaildir </> "cur")
-        try $ createDirectoryIfMissing True (theMaildir </> "new")
-        try $ createDirectoryIfMissing True (theMaildir </> "tmp")
+        try . mapM_ (createDirectoryIfMissing True) $
+            theMaildir:
+            (theMaildir </> "cur"):
+            (theMaildir </> "new"):
+            (theMaildir </> "tmp"):[]
     write mail = do
         fileName   <- io getUniqueName
         theMaildir <- ask
     hostname <- getHostName
     rand     <- show <$> (getStdRandom $ randomR (1,100000) :: IO Int)
 
-    return . concat $ [time, ".", rand, ".", hostname]
+    return . concat $ time:".":rand:".":hostname:[]
 {-# LANGUAGE TemplateHaskell #-}
--- | Commandline options tools. Designed to be imported as @qualified@.
 module Imm.Options (
     CliOptions,
     action,
     _dyreMode       :: Dyre.Mode,
     _dataDirectory  :: Maybe FilePath,
     _feedsList      :: [URI],
-    _logLevel       :: Log.Priority,
-    _dyreDebug      :: Bool}
+    _logLevel       :: Log.Priority}
     deriving(Eq)
 
 makeLenses ''CliOptions
         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 {
         _dyreMode      = def,
         _logLevel      = Log.INFO,
         _dataDirectory = Nothing,
-        _feedsList     = [],
-        _dyreDebug     = False}
+        _feedsList     = []}
 -- }}}
 
 description :: [OptDescr (CliOptions -> CliOptions)]
 
 -- | 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
     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
 module Main where
 
--- {{{ Imports
 import Imm
--- }}}
 
 -- The 'main' function must call 'imm' with a feed list
 main :: IO ()
         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,
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.