diff --git a/app/Main.hs b/app/Main.hs index 3ee28a5..b5dd251 100644 --- a/app/Main.hs +++ b/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