mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

refactor(users/Profpatsch/whatcd-resolver): naive combined insert

Browse source 
Still n+1, but now we got the IO where we want it to make the database
inserts efficient.

Change-Id: I2ee36ea41bf186cbeb5581b0df802bb3611769fe
Reviewed-on: https://cl.tvl.fyi/c/depot/+/9485
Reviewed-by: Profpatsch <mail@profpatsch.de>
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
This commit is contained in:
Profpatsch 2023-09-27 23:42:10 +02:00 committed by clbot
parent 7bc739ec5f
commit 6c360f2b64
1 changed files with 52 additions and 41 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
View file

@ -678,9 +678,11 @@ redactedSearchAndInsert extraArguments = do
logInfo [fmt|Got the first page, found {remainingPages} more pages|] logInfo [fmt|Got the first page, found {remainingPages} more pages|]
let otherPagesNum = [(2 :: Natural) .. remainingPages] let otherPagesNum = [(2 :: Natural) .. remainingPages]
otherPages <- traverse go (Just <$> otherPagesNum) otherPages <- traverse go (Just <$> otherPagesNum)
pure $ (firstPage : otherPages) & traverse_ (.transaction) pure $
(firstPage : otherPages)
& concatMap (.tourGroups)
& traverse_ insertTourGroupAndTorrentsNaive
where where
go :: Maybe Natural -> m (T2 "pages" Natural "transaction" (Transaction m ()))
go mpage = go mpage =
redactedSearch redactedSearch
( extraArguments ( extraArguments
@ -694,8 +696,8 @@ redactedSearchAndInsert extraArguments = do
Json.key "response" $ do Json.key "response" $ do
pages <- Json.key "pages" (Field.jsonParser (Field.mapError singleError $ Field.jsonNumber >>> Field.boundedScientificIntegral @Int "not an Integer" >>> Field.integralToNatural)) pages <- Json.key "pages" (Field.jsonParser (Field.mapError singleError $ Field.jsonNumber >>> Field.boundedScientificIntegral @Int "not an Integer" >>> Field.integralToNatural))
Json.key "results" $ do Json.key "results" $ do
transaction <- tourGroups <-
sequence_ label @"tourGroups"
<$> ( Json.eachInArray $ do <$> ( Json.eachInArray $ do
groupId <- Json.keyLabel @"groupId" "groupId" (Json.asIntegral @_ @Int) groupId <- Json.keyLabel @"groupId" "groupId" (Json.asIntegral @_ @Int)
groupName <- Json.keyLabel @"groupName" "groupName" Json.asText groupName <- Json.keyLabel @"groupName" "groupName" Json.asText
@ -707,23 +709,32 @@ redactedSearchAndInsert extraArguments = do
<&> Json.Object <&> Json.Object
) )
let tourGroup = T3 groupId groupName fullJsonResult let tourGroup = T3 groupId groupName fullJsonResult
torrents <- Json.key "torrents" $ torrents <- Json.keyLabel @"torrents" "torrents" $
Json.eachInArray $ do Json.eachInArray $ do
torrentId <- Json.keyLabel @"torrentId" "torrentId" (Json.asIntegral @_ @Int) torrentId <- Json.keyLabel @"torrentId" "torrentId" (Json.asIntegral @_ @Int)
fullJsonResultT <- label @"fullJsonResult" <$> Json.asValue fullJsonResultT <- label @"fullJsonResult" <$> Json.asValue
pure $ T2 torrentId fullJsonResultT pure $ T2 torrentId fullJsonResultT
pure pure (T2 (label @"tourGroup" tourGroup) torrents)
( insertTourGroup tourGroup
>>= (\tg -> insertTorrents (T2 (getLabel @"tourGroupIdPg" tg) (label @"torrents" torrents)))
)
) )
pure pure
( T2 ( T2
(label @"pages" pages) (label @"pages" pages)
(label @"transaction" transaction) tourGroups
) )
) )
where insertTourGroupAndTorrentsNaive ::
T2
"tourGroup"
(T3 "groupId" Int "groupName" Text "fullJsonResult" Json.Value)
"torrents"
[T2 "torrentId" Int "fullJsonResult" Json.Value] ->
Transaction m ()
insertTourGroupAndTorrentsNaive dat = do
insertTourGroup dat.tourGroup
>>= ( \tg ->
insertTorrents
(T2 (dat & getLabel @"torrents") (tg & getLabel @"tourGroupIdPg"))
)
insertTourGroup dat = do insertTourGroup dat = do
_ <- _ <-
execute execute