Factor out doIndex

app/Main.hs

@@ -96,36 +96,33 @@ main = do
         pure c
 
   db <- DB.initDB cfg.yoreDb
-  _ <-
-    runExceptT $
-      catchE
-        ( DB.withConn db $ \conn -> do
-            dayThen <- getTodayWithYearOffset (-100)
-            indexDay cfg dayThen conn
-        )
-        (Log.error . show)
+
+  _ <- runExceptT $ doIndex cfg db
 
   _ <- forkIO $ runIndexer cfg db
   runServer cfg db
 
 runIndexer :: Config -> DB -> IO ()
-runIndexer cfg db = schedule shouldRunAt $ do
-  _ <-
-    runExceptT $
-      catchE
-        ( DB.withTransaction db $ \conn -> do
-            dayThen <- getTodayWithYearOffset (-100)
-            indexDay cfg dayThen conn
-            dayThen2 <- addDays 1 <$> getTodayWithYearOffset (-100)
-            indexDay cfg dayThen2 conn
-        )
-        (Log.error . show)
-  pure ()
+runIndexer cfg db =
+  schedule shouldRunAt $ runExceptT $ doIndex cfg db
   where
     shouldRunAt zt = case localTimeOfDay $ zonedTimeToLocalTime zt of
       TimeOfDay 3 0 _ -> True
       _ -> False
 
+doIndex :: Config -> DB -> ExceptT Error IO ()
+doIndex cfg db =
+  catchE
+    ( DB.withTransaction db $ \conn -> do
+        dayThen <- getTodayWithOffset (-100) 0
+        indexDay cfg dayThen conn
+        dayThen2 <- getTodayWithOffset (-100) 1
+        indexDay cfg dayThen2 conn
+        dayThen3 <- getTodayWithOffset (-100) 2
+        indexDay cfg dayThen3 conn
+    )
+    (Log.error . show)
+
 runServer :: Config -> DB -> IO ()
 runServer cfg db =
   Warp.runSettings settings $ serve (Proxy @API) $ hoistServer (Proxy @API) nt $ server cfg db
@@ -260,12 +257,15 @@ instance Accept HTML where
   contentType _ = "text" // "html" /: ("charset", "utf-8")
 
 get100YearsAgo :: IO (Either Error Day)
-get100YearsAgo = runExceptT $ getTodayWithYearOffset (-100)
+get100YearsAgo = runExceptT $ getTodayWithOffset (-100) 0
 
-getTodayWithYearOffset :: Integer -> ExceptT Error IO Day
-getTodayWithYearOffset offset =
+getTodayWithOffset :: Integer -> Integer -> ExceptT Error IO Day
+getTodayWithOffset yearOffset dayOffset =
   ExceptT $
-    first (GenericError . (Text.pack (printf "can't go back %s years: " (-offset)) <>)) . addYears offset <$> getCurrentDay
+    first (GenericError . (Text.pack (printf "can't go back %d years and go forward %d days: " (-yearOffset) dayOffset) <>))
+      . addYears yearOffset
+      . addDays dayOffset
+      <$> getCurrentDay
 
 indexDay :: Config -> Day -> Opium.Connection -> ExceptT Error IO ()
 indexDay cfg dayThen conn = do