Index current day in main

app/Main.hs

@@ -58,9 +58,13 @@ import Yore.DB (DayFile (..))
 import Yore.Error (Error (..))
 import Yore.Time (addYears, getCurrentDay, getSecondsUntilMidnight)
 
+import Control.Monad (forM, forM_)
+import Data.Bifunctor (Bifunctor (..))
 import qualified Envy
 import qualified Yore.DB as DB
+import Yore.Download (downloadInto)
 import qualified Yore.Log as Log
+import Yore.Scrape (Issue (..), getIssuesByDay)
 
 newtype ConnectionString = ConnectionString String
   deriving (Show)
@@ -101,6 +105,10 @@ main = do
         ]
 
   db <- DB.initDB cfg.yoreDb
+  DB.withConn db (runExceptT . indexDayWithOffset cfg (-100)) >>= \case
+    Left err -> Log.error $ show err
+    Right _ -> pure ()
+
   Warp.runSettings settings $ serve (Proxy @API) $ hoistServer (Proxy @API) nt $ server cfg db
   where
     logger req status _ = do
@@ -165,13 +173,13 @@ server cfg db = rootR :<|> todayR :<|> apiTodayR
 
     todayR issue = do
       dateThen <- ExceptT get100YearsAgo
-      count <- ExceptT $ DB.withConn db $ DB.getNumberOfIssues dateThen
-      dayFile <- ExceptT $ DB.withConn db $ DB.getDayFileByIssue dateThen issue
+      count <- ExceptT $ DB.withConn' db $ DB.getNumberOfIssues dateThen
+      dayFile <- ExceptT $ DB.withConn' db $ DB.getDayFileByIssue dateThen issue
       pure $ RootModel dateThen dayFile issue count
 
     apiTodayR issue = handlerToRaw $ do
       dateThen <- ExceptT get100YearsAgo
-      dayFile <- ExceptT $ DB.withConn db $ DB.getDayFileByIssue dateThen issue
+      dayFile <- ExceptT $ DB.withConn' db $ DB.getDayFileByIssue dateThen issue
       let fullPath = cfg.yoreDownloadDir </> dayFile.relative_path
       secondsUntilMidnight <- liftIO getSecondsUntilMidnight
       pure $
@@ -223,5 +231,36 @@ instance Accept HTML where
   contentType _ = "text" // "html" /: ("charset", "utf-8")
 
 get100YearsAgo :: IO (Either Error Day)
-get100YearsAgo =
-  either (Left . GenericError . ("can't go back 100 years: " <>)) Right . addYears (-100) <$> getCurrentDay
+get100YearsAgo = getTodayWithYearOffset (-100)
+
+getTodayWithYearOffset :: Integer -> IO (Either Error Day)
+getTodayWithYearOffset offset =
+  first (GenericError . (Text.pack (printf "can't go back %s years: " (-offset)) <>)) . addYears offset <$> getCurrentDay
+
+indexDayWithOffset :: Config -> Integer -> Opium.Connection -> ExceptT Error IO ()
+indexDayWithOffset cfg offset conn = do
+  dayThen <- ExceptT $ getTodayWithYearOffset offset
+  runDb $ Opium.execute_ "BEGIN" conn
+  -- Transaction-level lock released automatically after transaction
+  runDb $ Opium.execute_ "SELECT pg_advisory_xact_lock(42);" conn
+  mbDi <- runDb $ DB.readDayIndex dayThen conn
+  case mbDi of
+    Just _ ->
+      liftIO $ Log.info $ printf "index for %s already exists." (show dayThen)
+    Nothing -> do
+      liftIO $ Log.info $ printf "scraping issues for %s" (show dayThen)
+      issues <- liftIO $ getIssuesByDay dayThen
+      paths <- forM issues $ \issue -> do
+        liftIO $ Log.info $ printf "downloading %s" issue.url
+        path <- liftIO $ downloadInto cfg.yoreDownloadDir issue.url
+        pure (issue.label, path)
+      liftIO $ Log.info "creating DB entries"
+      dayIndex <- runDb $ DB.createDayIndex dayThen conn
+      forM_ paths $ \(text, url) ->
+        runDb $ DB.createDayFile dayIndex.day_index_id text url conn
+      runDb $ Opium.execute_ "COMMIT" conn
+      liftIO $ Log.info "done."
+
+runDb :: IO (Either Opium.Error a) -> ExceptT Error IO a
+runDb f =
+  ExceptT $ first DBError <$> f