diff options
| -rw-r--r-- | src/F2Md/Config.hs | 4 | ||||
| -rw-r--r-- | src/F2Md/Export.hs | 2 | ||||
| -rw-r--r-- | src/F2Md/Import.hs | 23 | ||||
| -rw-r--r-- | src/F2Md/Utils.hs | 2 | ||||
| -rw-r--r-- | src/Main.hs | 6 |
5 files changed, 17 insertions, 20 deletions
diff --git a/src/F2Md/Config.hs b/src/F2Md/Config.hs index 33380fa..c952d09 100644 --- a/src/F2Md/Config.hs +++ b/src/F2Md/Config.hs @@ -78,10 +78,10 @@ updateLastUpdated' path feed msgs = HM.insert (fuUrl feed) (utcToZonedTime (zonedTimeZone $ mDate $ head msgs) . maximum $ - (zonedTimeToUTC . mDate) <$> msgs) + zonedTimeToUTC . mDate <$> msgs) decoded updateLastUpdated :: FilePath -> [FeedUserdata] -> [[Message]] -> IO () updateLastUpdated path feeds feedMsgs = do - mapM_ (\(feed, msgs) -> updateLastUpdated' path feed msgs) + mapM_ (uncurry (updateLastUpdated' path)) (zip feeds feedMsgs) diff --git a/src/F2Md/Export.hs b/src/F2Md/Export.hs index b06155c..d3ed45a 100644 --- a/src/F2Md/Export.hs +++ b/src/F2Md/Export.hs @@ -35,7 +35,7 @@ import System.FilePath formatMessage :: Message -> Text formatMessage (Message from subject date messageId body _) = - "MIME-Version: 1.0\n" <> "Date: " <> (T.pack $ show date) <> "\nSubject: " <> subject <> + "MIME-Version: 1.0\n" <> "Date: " <> T.pack (show date) <> "\nSubject: " <> subject <> "\nFrom: " <> from <> "\nMessage-ID: " <> messageId <> "\nContent-Type: text/html" <> "\n\n" <> body diff --git a/src/F2Md/Import.hs b/src/F2Md/Import.hs index 7c8110c..80dfa54 100644 --- a/src/F2Md/Import.hs +++ b/src/F2Md/Import.hs @@ -39,17 +39,16 @@ import Data.Generics import Text.RSS.Syntax hiding (RSSItem) import Data.XML.Types import Text.Feed.Import -import Text.Feed.Types import F2Md.Types import Crypto.Hash toMessagesFromUrl :: Text -> Maybe ZonedTime -> IO [Message] toMessagesFromUrl url after = do - feed <- parseFeedString <$> (fetchFeed $ T.unpack url) + feed <- parseFeedString <$> fetchFeed (T.unpack url) case feed of Nothing -> return [] Just feed' -> return $ - sortOn (\msg -> zonedTimeToUTC (mDate msg)) $ catMaybes $ + sortOn (zonedTimeToUTC . mDate) $ catMaybes $ toMessage' after (toFeedMetadata feed' url) <$> getFeedItems feed' wgetCommand :: String @@ -76,12 +75,12 @@ toMessage (FeedMetadata title author home url) item = body url where body = - (formatBody (getItemLink item) (getItemEnclosure item) $ + formatBody (getItemLink item) (getItemEnclosure item) $ (getItemContent item) `orElse` (getItemContent' item) `orElse` - (getItemDescription item)) + (getItemDescription item) messageId = - "<" <> (T.pack $ show $ hashWith MD5 (encodeUtf8 body)) <> "@" <> - (T.map hyphenateNonAlNum url) <> ".gnu" <> ">" + "<" <> T.pack (show $ hashWith MD5 (encodeUtf8 body)) <> "@" <> + T.map hyphenateNonAlNum url <> ".gnu" <> ">" getItemAuthor' :: Item -> Maybe Text @@ -92,8 +91,7 @@ getItemAuthor' item = case getItemAuthor item of getItemContent' :: Item -> Maybe Text getItemContent' (RSSItem item) = - (fmap (T.concat . elementText) . listToMaybe . - filter (\e -> namePrefix (elementName e) == Just "content")) + (fmap (T.concat . elementText) . find (\e -> namePrefix (elementName e) == Just "content")) $ rssItemOther item getItemContent' _ = Nothing @@ -110,13 +108,12 @@ formatBody link encl desc = Just (url, Just ty, Just len) -> urlPt url <> " (" <> ty <> ", " <> lenPt len <> ")\n\n" where urlPt url = "Enclosure: <" <> url <> ">" - lenPt len = (T.pack $ show len) <> " bytes" + lenPt len = T.pack (show len) <> " bytes" in - linkText <> enclText <> (fromMaybe "" desc) + linkText <> enclText <> fromMaybe "" desc toFeedMetadata :: Feed -> Text -> FeedMetadata -toFeedMetadata feed url = - FeedMetadata (getFeedTitle feed) (getFeedAuthor feed) (getFeedHome feed) url +toFeedMetadata feed = FeedMetadata (getFeedTitle feed) (getFeedAuthor feed) (getFeedHome feed) hyphenateNonAlNum :: Char -> Char hyphenateNonAlNum c diff --git a/src/F2Md/Utils.hs b/src/F2Md/Utils.hs index 25bf63a..33abe00 100644 --- a/src/F2Md/Utils.hs +++ b/src/F2Md/Utils.hs @@ -28,5 +28,5 @@ expandPath path = let (pre, post) = break (=='/') path in case pre of "~" -> (++ post) <$> getHomeDirectory - '~' : user -> (++ post) <$> homeDirectory <$> getUserEntryForName user + '~' : user -> (++ post) . homeDirectory <$> getUserEntryForName user _ -> return path diff --git a/src/Main.hs b/src/Main.hs index 0907a9c..cf0f1af 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -34,7 +34,7 @@ import System.FilePath main :: IO () main = do - options <- execParser $ opts + options <- execParser opts (feeds, maildir, dbPath) <- getUserdata $ configPath options whenJust maildir $ \root -> do mapM_ (createDirectoryIfMissing True) @@ -48,9 +48,9 @@ main = do -- TODO: update db on interruption with the latest date processFeed :: FilePath -> Maybe FilePath -> FeedUserdata -> LoggingT IO () processFeed root dbPath feed = do - logInfoN $ "Fetching " <> (fuUrl feed) <> "..." + logInfoN $ "Fetching " <> fuUrl feed <> "..." msgs <- liftIO $ toMessagesFromUrl (fuUrl feed) (fuLastUpdated feed) - logInfoN $ "Writing " <> (T.pack $ show $ length msgs) <> " messages..." + logInfoN $ "Writing " <> T.pack (show $ length msgs) <> " messages..." liftIO $ mapM_ (writeMessage root) msgs whenJust dbPath $ \dbPath' -> liftIO $ updateLastUpdated' dbPath' feed msgs |