From 20231d809b57c3050fb1cd812ea4c6e66cdaf6fb Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Sat, 28 May 2022 00:48:52 +1000 Subject: time and map updates --- src/F2Md/Config.hs | 54 ++++++++++++++++++++++++++++++++++++++++++------------ src/F2Md/Export.hs | 4 ++-- src/F2Md/Import.hs | 24 ++++++++++++------------ src/F2Md/Types.hs | 21 ++++++++++++--------- src/Main.hs | 9 +++++---- 5 files changed, 73 insertions(+), 39 deletions(-) diff --git a/src/F2Md/Config.hs b/src/F2Md/Config.hs index ccb1871..ef209dc 100644 --- a/src/F2Md/Config.hs +++ b/src/F2Md/Config.hs @@ -1,15 +1,20 @@ {-# LANGUAGE DeriveGeneric #-} -module F2Md.Config (getUserdata, FeedUserdata(..)) where +module F2Md.Config + ( getUserdata + , FeedUserdata(..) + , updateLastUpdated + ) where +import Data.List import F2Md.Utils +import F2Md.Types import Data.Maybe import Data.Text (Text) import Data.Time import GHC.Generics import qualified Data.HashMap.Strict as HM import Data.Aeson -import qualified Data.ByteString.Lazy as BSL data Config = Config { dbPath :: String @@ -20,22 +25,47 @@ data Config = Config instance FromJSON Config data FeedUserdata = FeedUserdata - { url :: Text - , lastUpdated :: Maybe ZonedTime } deriving (Generic, Show) + { fuUrl :: Text + , fuLastUpdated :: Maybe ZonedTime } deriving (Show) -getUserdata :: FilePath -> IO ([FeedUserdata], Maybe FilePath) +getUserdata :: FilePath -> IO ([FeedUserdata], Maybe FilePath, Maybe FilePath) getUserdata file = do - config <- decode <$> BSL.readFile file + config <- decodeFileStrict file case config of - Nothing -> return ([], Nothing) + Nothing -> return ([], Nothing, Nothing) Just config' -> do feedData <- getUserdata' config' maildir' <- expandPath $ maildir config' - return (feedData, Just maildir') + dbPath' <- expandPath $ dbPath config' + return (feedData, Just maildir', Just dbPath') getUserdata' :: Config -> IO [FeedUserdata] getUserdata' (Config dbPath _ feeds) = do - decoded <- decode <$> (BSL.readFile =<< expandPath dbPath) - let decoded' = fromMaybe (HM.fromList []) decoded - return $ - map (\url -> FeedUserdata url $ HM.lookup url decoded') feeds + decoded <- getLastUpdatedMap dbPath + return $ map (\url -> FeedUserdata url $ HM.lookup url decoded) feeds + +getLastUpdatedMap :: FilePath -> IO (HM.HashMap Text ZonedTime) +getLastUpdatedMap dbPath = + fromMaybe (HM.fromList []) <$> (decodeFileStrict =<< expandPath dbPath) + +updateLastUpdated :: FilePath -> [FeedUserdata] -> [[Message]] -> IO () +updateLastUpdated path feeds feedMsgs = do + decoded <- getLastUpdatedMap path + encodeFile path $ foldl' + (\hm (feed, msgs) -> + case msgs of + [] -> hm + h : _ -> HM.insert (fuUrl feed) + (utcToZonedTime (zonedTimeZone $ mDate h) . maximum $ + (zonedTimeToUTC . mDate) <$> msgs) + hm) + decoded (zip feeds feedMsgs) + -- HM.fromList $ + -- mapMaybe + -- (\(feed, msgs) -> + -- case msgs of + -- [] -> fuLastUpdated feed >>= \date -> return (fuUrl feed, date) + -- h : _ -> + -- Just (fuUrl feed, + -- utcToZonedTime (zonedTimeZone $ mDate h) . maximum $ + -- (zonedTimeToUTC . mDate) <$> msgs)) $ zip feeds feedMsgs diff --git a/src/F2Md/Export.hs b/src/F2Md/Export.hs index 284ab22..83da783 100644 --- a/src/F2Md/Export.hs +++ b/src/F2Md/Export.hs @@ -14,8 +14,8 @@ import System.FilePath formatMessage :: Message -> Text -formatMessage (Message from subject date messageId body) = - "MIME-Version: 1.0\n" <> "Date: " <> date <> "\nSubject: " <> subject <> +formatMessage (Message from subject date messageId body _) = + "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 ee68578..3ed4d2f 100644 --- a/src/F2Md/Import.hs +++ b/src/F2Md/Import.hs @@ -20,13 +20,13 @@ import Text.Feed.Import import Text.Feed.Types import F2Md.Types -toMessagesFromFile :: FilePath -> IO [Message] -toMessagesFromFile file = do +toMessagesFromFile :: Text -> FilePath -> IO [Message] +toMessagesFromFile url file = do feed <- parseFeedFromFile file case feed of Nothing -> return [] Just feed' -> - mapM (\msg -> toMessage (toFeedMetadata feed') msg) (getFeedItems feed') + mapM (\msg -> toMessage (toFeedMetadata feed' url) msg) (getFeedItems feed') toMessagesFromUrl :: Text -> Maybe ZonedTime -> IO [Message] toMessagesFromUrl url after = do @@ -34,7 +34,7 @@ toMessagesFromUrl url after = do case feed of Nothing -> return [] Just feed' -> catMaybes <$> - mapM (\msg -> toMessage' after (toFeedMetadata feed') msg) (getFeedItems feed') + mapM (\msg -> toMessage' after (toFeedMetadata feed' url) msg) (getFeedItems feed') wgetCommand :: String wgetCommand = "wget -O- 2>/dev/null" @@ -44,24 +44,24 @@ fetchFeed url = readCreateProcess (shell $ wgetCommand ++ " " ++ url) "" toMessage' :: Maybe ZonedTime -> FeedMetadata -> Item -> IO (Maybe Message) toMessage' after feed item + | isNothing date = return Nothing | isNothing after = toMessage feed item >>= return . Just - | isNothing date || zonedTimeToUTC (fromJust after) >= fromJust date = - return Nothing + | zonedTimeToUTC (fromJust after) >= fromJust date = return Nothing | otherwise = toMessage feed item >>= return . Just where date = join $ getItemPublishDate item toMessage :: FeedMetadata -> Item -> IO Message -toMessage (FeedMetadata title author home) item = do +toMessage (FeedMetadata title author home url) item = do messageId <- genMessageId (fromMaybe "" home) (snd <$> getItemId item) return $ Message (fromMaybe title $ orElse (getItemAuthor' item) author) (fromMaybe "Untitled" $ getItemTitle item) - (fromMaybe "" $ getItemDate item) -- default should be current date + (fromJust $ join $ getItemPublishDate item) -- default should be current date messageId (formatBody (getItemLink item) $ (getItemContent item) `orElse` (getItemContent' item) `orElse` (getItemDescription item)) --- title + url getItemAuthor' :: Item -> Maybe Text getItemAuthor' item = case getItemAuthor item of @@ -83,9 +83,9 @@ formatBody link desc = Just link' -> "Link: " <> link' <> "\n\n" in linkText <> (fromMaybe "" desc) -toFeedMetadata :: Feed -> FeedMetadata -toFeedMetadata feed = - FeedMetadata (getFeedTitle feed) (getFeedAuthor feed) (getFeedHome feed) +toFeedMetadata :: Feed -> Text -> FeedMetadata +toFeedMetadata feed url = + FeedMetadata (getFeedTitle feed) (getFeedAuthor feed) (getFeedHome feed) url genMessageId :: Text -> Maybe Text -> IO Text genMessageId feedLink guid = do diff --git a/src/F2Md/Types.hs b/src/F2Md/Types.hs index cd579ce..de63985 100644 --- a/src/F2Md/Types.hs +++ b/src/F2Md/Types.hs @@ -4,18 +4,21 @@ import Data.Text (Text) import Data.Time data FeedMetadata = FeedMetadata - { title :: Text, - author :: Maybe Text, - home :: Maybe Text + { fTitle :: Text + , fAuthor :: Maybe Text + , fHome :: Maybe Text + , fUrl :: Text } deriving (Show) data Message = Message - { from :: Text, - subject :: Text, - date :: Text, - messageId :: Text, - body :: Text --- newsGroup :: Text + { mFrom :: Text + , mSubject :: Text + , mDate :: ZonedTime + , mMessageId :: Text + , mBody :: Text + , mFeed :: Text } deriving (Show) + +-- date format: Sun, 08 May 2022 09:23:01 +0000 diff --git a/src/Main.hs b/src/Main.hs index f3f8a5a..133d155 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -10,10 +10,11 @@ import System.FilePath main :: IO () main = do - (feeds, maildir) <- getUserdata "./.f2m.json" + (feeds, maildir, dbPath) <- getUserdata "./.f2m.json" whenJust maildir $ \root -> do mapM_ (createDirectoryIfMissing True) [root "new", root "cur", root "tmp"] - messages <- (fmap concat . sequence) $ - (\feed -> toMessagesFromUrl (url feed) (lastUpdated feed)) <$> feeds - mapM_ (writeMessage root) messages + feedMessages <- sequence $ + (\feed -> toMessagesFromUrl (fuUrl feed) (fuLastUpdated feed)) <$> feeds + mapM_ (writeMessage root) $ concat feedMessages + whenJust dbPath $ \dbPath' -> updateLastUpdated dbPath' feeds feedMessages -- cgit v1.2.3