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

src/Yore/DB.hs

@@ -9,6 +9,7 @@ module Yore.DB
   , Error (..)
   , initDB
   , withConn
+  , withConn'
   , DayIndex (..)
   , DayFile (..)
   , createDayFile
@@ -28,6 +29,7 @@ import GHC.Generics (Generic)
 
 import qualified Database.PostgreSQL.Opium as Opium
 
+import Data.Bifunctor (Bifunctor (..))
 import Yore.Error (Error (..))
 
 newtype DB = DB (Pool (Either Opium.ConnectionError Opium.Connection))
@@ -45,13 +47,24 @@ initDB connString = do
           maxResources
       )
 
-withConn :: DB -> (Opium.Connection -> IO (Either Opium.Error a)) -> IO (Either Error a)
+-- TODO: This should probably also do something like bracket...
+-- For now let's assume no exceptions are thrown in f.
+withConn :: DB -> (Opium.Connection -> IO (Either Error a)) -> IO (Either Error a)
 withConn (DB connPool) f =
   withResource connPool $ \case
     Left connectionError ->
       pure $ Left $ ConnectionError connectionError
     Right conn ->
-      either (Left . DBError) Right <$> f conn
+      f conn >>= \case
+        Left err -> do
+          -- rollback open transactions and release transaction level locks.
+          _ <- Opium.execute_ "ROLLBACK" conn
+          pure $ Left err
+        Right x ->
+          pure $ Right x
+
+withConn' :: DB -> (Opium.Connection -> IO (Either Opium.Error a)) -> IO (Either Error a)
+withConn' db f = withConn db $ fmap (first DBError) . f
 
 data DayIndex = DayIndex
   { day_index_id :: Int

src/Yore/Index.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE OverloadedStrings #-}
 
 module Yore.Index (createEntries) where
 
@@ -14,11 +13,9 @@ import qualified Yore.DB as DB
 
 createEntries :: Day -> [(Text, FilePath)] -> Opium.Connection -> IO ()
 createEntries date urls conn = do
-  confidently $ Opium.execute_ "BEGIN" conn
   dayIndex <- confidently $ DB.createDayIndex date conn
   forM_ urls $ \(text, url) ->
     confidently $ DB.createDayFile dayIndex.day_index_id text url conn
-  confidently $ Opium.execute_ "COMMIT" conn
 
 confidently :: (Exception e) => IO (Either e a) -> IO a
 confidently action = action >>= either throwIO pure