From f008ab0a3211c0d5912fe0b99b936d8770fada17 Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Mon, 30 May 2022 17:20:01 +1000 Subject: fixed a few things - redundant imports and deps - check file existence --- f2md.cabal | 6 +++--- src/F2Md/Config.hs | 22 ++++++++++------------ src/F2Md/Import.hs | 2 -- src/Main.hs | 38 +++++++++++++++++++++++++------------- 4 files changed, 38 insertions(+), 30 deletions(-) diff --git a/f2md.cabal b/f2md.cabal index fd242d0..10f88e4 100644 --- a/f2md.cabal +++ b/f2md.cabal @@ -27,8 +27,8 @@ executable f2md F2Md.Utils build-depends: - base, uuid, syb, feed, time, text, unix, hostname, random, filepath, - directory, extra, xml-types, process, aeson, bytestring, - unordered-containers, monad-logger, cryptonite, optparse-applicative + base, syb, feed, time, text, unix, hostname, filepath, directory, + extra, xml-types, process, aeson, unordered-containers, monad-logger, + cryptonite, optparse-applicative, random hs-source-dirs: src default-language: Haskell2010 diff --git a/src/F2Md/Config.hs b/src/F2Md/Config.hs index c952d09..c17a55f 100644 --- a/src/F2Md/Config.hs +++ b/src/F2Md/Config.hs @@ -24,7 +24,6 @@ module F2Md.Config ( getUserdata , FeedUserdata(..) , updateLastUpdated - , updateLastUpdated' ) where import Control.Monad @@ -37,6 +36,7 @@ import Data.Time import GHC.Generics import qualified Data.HashMap.Strict as HM import Data.Aeson +import System.Posix.Files data Config = Config { dbPath :: String @@ -52,7 +52,7 @@ data FeedUserdata = FeedUserdata getUserdata :: FilePath -> IO ([FeedUserdata], Maybe FilePath, Maybe FilePath) getUserdata file = do - config <- decodeFileStrict file + config <- decodeFileStrict =<< expandPath file case config of Nothing -> return ([], Nothing, Nothing) Just config' -> do @@ -67,11 +67,14 @@ getUserdata' (Config dbPath _ feeds) = do 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 feed msgs = +getLastUpdatedMap dbPath = do + exists <- fileExist =<< expandPath dbPath + if exists then + fromMaybe (HM.fromList []) <$> (decodeFileStrict =<< expandPath dbPath) + else return $ HM.fromList [] + +updateLastUpdated :: FilePath -> FeedUserdata -> [Message] -> IO () +updateLastUpdated path feed msgs = unless (null msgs) $ do decoded <- getLastUpdatedMap path encodeFile path $ @@ -80,8 +83,3 @@ updateLastUpdated' path feed msgs = (utcToZonedTime (zonedTimeZone $ mDate $ head msgs) . maximum $ zonedTimeToUTC . mDate <$> msgs) decoded - -updateLastUpdated :: FilePath -> [FeedUserdata] -> [[Message]] -> IO () -updateLastUpdated path feeds feedMsgs = do - mapM_ (uncurry (updateLastUpdated' path)) - (zip feeds feedMsgs) diff --git a/src/F2Md/Import.hs b/src/F2Md/Import.hs index 80dfa54..eb6d014 100644 --- a/src/F2Md/Import.hs +++ b/src/F2Md/Import.hs @@ -27,8 +27,6 @@ import Data.Text.Encoding import Control.Monad import Data.Time import System.Process -import Data.UUID -import Data.UUID.V4 import Data.Char import Data.Text (Text) import Text.Feed.Types diff --git a/src/Main.hs b/src/Main.hs index cf0f1af..ca71b29 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -30,36 +30,48 @@ import F2Md.Types import F2Md.Import import F2Md.Export import F2Md.Config +import Data.Maybe import System.FilePath main :: IO () main = do options <- execParser opts - (feeds, maildir, dbPath) <- getUserdata $ configPath options - whenJust maildir $ \root -> do - mapM_ (createDirectoryIfMissing True) - [root "new", root "cur", root "tmp"] - mapM_ (runStdoutLoggingT . processFeed root dbPath) feeds + (feeds, mbMaildir, mbDbPath) <- getUserdata $ oConfigPath options + let root = fromMaybe (oMaildir options) mbMaildir + mapM_ (createDirectoryIfMissing True) + [root "new", root "cur", root "tmp"] + let dbPath = fromMaybe (oDbPath options) mbDbPath + mapM_ (runStdoutLoggingT . processFeed root dbPath) feeds where opts = info (progParser <**> helper) (fullDesc <> progDesc "f2md feeds to maildir" <> header "f2md - a utility to pull new items \ \from feeds and write them to maildir") -- TODO: update db on interruption with the latest date -processFeed :: FilePath -> Maybe FilePath -> FeedUserdata -> LoggingT IO () +processFeed :: FilePath -> FilePath -> FeedUserdata -> LoggingT IO () processFeed root dbPath feed = do logInfoN $ "Fetching " <> fuUrl feed <> "..." msgs <- liftIO $ toMessagesFromUrl (fuUrl feed) (fuLastUpdated feed) logInfoN $ "Writing " <> T.pack (show $ length msgs) <> " messages..." liftIO $ mapM_ (writeMessage root) msgs - whenJust dbPath $ \dbPath' -> liftIO $ updateLastUpdated' dbPath' feed msgs + liftIO $ updateLastUpdated dbPath feed msgs data Options = Options - { configPath :: FilePath } + { oConfigPath :: FilePath + , oDbPath :: FilePath + , oMaildir :: FilePath + } progParser :: Parser Options -progParser = - Options <$> strOption (long "config" <> short 'c' <> metavar "CONFIG" - <> value "~/.f2md.json" <> showDefault - <> help "Config file storing feeds, maildir \ - \location and timestamp file location.") +progParser = Options + <$> strOption (long "config" <> short 'c' <> metavar "CONFIG" + <> value "~/.f2md.json" <> showDefault + <> help "Config file storing feeds, maildir \ + \location and timestamp file location.") + <*> strOption (long "db" <> short 'd' <> metavar "DB" + <> value "~/.f2mdb.json" <> showDefault + <> help "Path to db file storing timestamps of feeds.") + <*> strOption (long "maildir" <> short 'm' <> metavar "MAILDIR" + <> value "~/mail/f2md" <> showDefault + <> help "Path to maildir root to deposit the maildir \ + \message files.") -- cgit v1.2.3