Adding support to multiple maildirs

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.")