diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/F2Md/Config.hs | 35 | ||||
| -rw-r--r-- | src/Main.hs | 42 |
2 files changed, 40 insertions, 37 deletions
diff --git a/src/F2Md/Config.hs b/src/F2Md/Config.hs index c17a55f..5832981 100644 --- a/src/F2Md/Config.hs +++ b/src/F2Md/Config.hs @@ -23,6 +23,7 @@ License along with f2md. If not, see <https://www.gnu.org/licenses/>. module F2Md.Config ( getUserdata , FeedUserdata(..) + , ExtConf(..) , updateLastUpdated ) where @@ -50,21 +51,27 @@ data FeedUserdata = FeedUserdata { fuUrl :: Text , fuLastUpdated :: Maybe ZonedTime } deriving (Show) -getUserdata :: FilePath -> IO ([FeedUserdata], Maybe FilePath, Maybe FilePath) -getUserdata file = do - config <- decodeFileStrict =<< expandPath file - case config of - Nothing -> return ([], Nothing, Nothing) - Just config' -> do - feedData <- getUserdata' config' - maildir' <- expandPath $ maildir config' - dbPath' <- expandPath $ dbPath config' - return (feedData, Just maildir', Just dbPath') - -getUserdata' :: Config -> IO [FeedUserdata] -getUserdata' (Config dbPath _ feeds) = do +data ExtConf = ExtConf + { eDbPath :: FilePath + , eMaildir :: FilePath + , eFeeds :: [FeedUserdata] + } + +getUserdata :: FilePath -> IO [ExtConf] +getUserdata confPath = do + configs <- decodeFileStrict =<< expandPath confPath + case configs of + Nothing -> return [] + Just configs' -> mapM getUserdata' configs' + +getUserdata' :: Config -> IO ExtConf +getUserdata' (Config dbPath maildir feeds) = do decoded <- getLastUpdatedMap dbPath - return $ map (\url -> FeedUserdata url $ HM.lookup url decoded) feeds + dbPath' <- expandPath dbPath + maildir' <- expandPath maildir + return $ + ExtConf dbPath' maildir' + (map (\url -> FeedUserdata url $ HM.lookup url decoded) feeds) getLastUpdatedMap :: FilePath -> IO (HM.HashMap Text ZonedTime) getLastUpdatedMap dbPath = do diff --git a/src/Main.hs b/src/Main.hs index e5b33d4..060a823 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -34,24 +34,33 @@ import F2Md.Config import Data.Maybe import System.FilePath +-- TODO: kill on double C-c main :: IO () main = do options <- execParser opts - (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_ (\feed -> - catch (runStdoutLoggingT $ processFeed root dbPath feed) - (\e -> runStderrLoggingT $ logErrorN $ - (T.pack $ show (e :: SomeException)) <> "\n")) - feeds + extConfs <- getUserdata $ oConfigPath options + mapM_ processConfig extConfs 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") +processConfig :: ExtConf -> IO () +processConfig (ExtConf dbPath maildir feeds) = do + mapM_ (createDirectoryIfMissing True) + [maildir </> "new", maildir </> "cur", maildir </> "tmp"] + runStdoutLoggingT $ + logInfoN $ "Updating " <> T.pack (show $ length feeds) <> + " feeds for " <> T.pack maildir <> "..." + mapM_ (\feed -> + catch (runStdoutLoggingT $ processFeed maildir dbPath feed) + (\e -> runStdoutLoggingT $ logErrorN $ T.pack (show (e :: SomeException)))) + feeds + +data Options = Options + { oConfigPath :: FilePath + } + -- TODO: update db on interruption with the latest date processFeed :: FilePath -> FilePath -> FeedUserdata -> LoggingT IO () processFeed root dbPath feed = do @@ -61,22 +70,9 @@ processFeed root dbPath feed = do liftIO $ mapM_ (writeMessage root) msgs liftIO $ updateLastUpdated dbPath feed msgs -data Options = Options - { 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.") - <*> 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.") |