paul/yore
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Factor out doIndex

Browse Source
This commit is contained in:
Paul Brinkmeier 2025-09-22 11:58:41 +02:00
parent 82d8ce63d8
commit dbea1c549f
1 changed files with 24 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
app/Main.hs
View File

@ -96,36 +96,33 @@ main = do
pure c pure c
db <- DB.initDB cfg.yoreDb db <- DB.initDB cfg.yoreDb
_ <-
runExceptT $ _ <- runExceptT $ doIndex cfg db
catchE
( DB.withConn db $ \conn -> do
dayThen <- getTodayWithYearOffset (-100)
indexDay cfg dayThen conn
)
(Log.error . show)
_ <- forkIO $ runIndexer cfg db _ <- forkIO $ runIndexer cfg db
runServer cfg db runServer cfg db
runIndexer :: Config -> DB -> IO () runIndexer :: Config -> DB -> IO ()
runIndexer cfg db = schedule shouldRunAt $ do runIndexer cfg db =
_ <- schedule shouldRunAt $ runExceptT $ doIndex cfg db
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 ()
where where
shouldRunAt zt = case localTimeOfDay $ zonedTimeToLocalTime zt of shouldRunAt zt = case localTimeOfDay $ zonedTimeToLocalTime zt of
TimeOfDay 3 0 _ -> True TimeOfDay 3 0 _ -> True
_ -> False _ -> 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 :: Config -> DB -> IO ()
runServer cfg db = runServer cfg db =
Warp.runSettings settings $ serve (Proxy @API) $ hoistServer (Proxy @API) nt $ server 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") contentType _ = "text" // "html" /: ("charset", "utf-8")
get100YearsAgo :: IO (Either Error Day) get100YearsAgo :: IO (Either Error Day)
get100YearsAgo = runExceptT $ getTodayWithYearOffset (-100) get100YearsAgo = runExceptT $ getTodayWithOffset (-100) 0
getTodayWithYearOffset :: Integer -> ExceptT Error IO Day getTodayWithOffset :: Integer -> Integer -> ExceptT Error IO Day
getTodayWithYearOffset offset = getTodayWithOffset yearOffset dayOffset =
ExceptT $ 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 :: Config -> Day -> Opium.Connection -> ExceptT Error IO ()
indexDay cfg dayThen conn = do indexDay cfg dayThen conn = do