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

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

View file

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