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

93
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,33 +709,42 @@ 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 ::
insertTourGroup dat = do T2
_ <- "tourGroup"
execute (T3 "groupId" Int "groupName" Text "fullJsonResult" Json.Value)
[fmt| "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
[fmt|
DELETE FROM redacted.torrent_groups DELETE FROM redacted.torrent_groups
WHERE group_id = ?::integer WHERE group_id = ?::integer
|] |]
(Only dat.groupId) (Only dat.groupId)
executeManyReturningWith executeManyReturningWith
[fmt| [fmt|
INSERT INTO redacted.torrent_groups ( INSERT INTO redacted.torrent_groups (
group_id, group_name, full_json_result group_id, group_name, full_json_result
) VALUES ) VALUES
@ -744,39 +755,39 @@ redactedSearchAndInsert extraArguments = do
full_json_result = excluded.full_json_result full_json_result = excluded.full_json_result
RETURNING (id) RETURNING (id)
|] |]
[ ( dat.groupId, [ ( dat.groupId,
dat.groupName, dat.groupName,
dat.fullJsonResult dat.fullJsonResult
) )
] ]
(label @"tourGroupIdPg" <$> Dec.fromField @Int) (label @"tourGroupIdPg" <$> Dec.fromField @Int)
>>= ensureSingleRow >>= ensureSingleRow
insertTorrents dat = do insertTorrents dat = do
_ <- _ <-
execute execute
[sql| [sql|
DELETE FROM redacted.torrents_json DELETE FROM redacted.torrents_json
WHERE torrent_id = ANY (?::integer[]) WHERE torrent_id = ANY (?::integer[])
|] |]
(Only $ dat.torrents & unzipT2 & (.torrentId) & PGArray) (Only $ dat.torrents & unzipT2 & (.torrentId) & PGArray)
execute execute
[sql| [sql|
INSERT INTO redacted.torrents_json INSERT INTO redacted.torrents_json
(torrent_id, torrent_group, full_json_result) (torrent_id, torrent_group, full_json_result)
SELECT inputs.torrent_id, static.torrent_group, inputs.full_json_result FROM SELECT inputs.torrent_id, static.torrent_group, inputs.full_json_result FROM
(SELECT * FROM UNNEST(?::integer[], ?::jsonb[])) AS inputs(torrent_id, full_json_result) (SELECT * FROM UNNEST(?::integer[], ?::jsonb[])) AS inputs(torrent_id, full_json_result)
CROSS JOIN (VALUES(?::integer)) as static(torrent_group) CROSS JOIN (VALUES(?::integer)) as static(torrent_group)
|] |]
( dat.torrents ( dat.torrents
& unzipT2 & unzipT2
& \t -> & \t ->
( t.torrentId & PGArray, ( t.torrentId & PGArray,
t.fullJsonResult & PGArray, t.fullJsonResult & PGArray,
dat.tourGroupIdPg dat.tourGroupIdPg
) )
) )
pure () pure ()
redactedGetTorrentFileAndInsert :: redactedGetTorrentFileAndInsert ::
( HasField "torrentId" r Int, ( HasField "torrentId" r Int,