time and map updates

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