refactor(users/Profpatsch/whatcd-resolver): more efficient inserts
Instead of inserting torrents and every tour group seperately, insert the tour groups and then the torrents in one go (unzipped). I finally found a good use for list comprehensions, flattening nested lists. Change-Id: I7dfc765ad058dff3afb3b03887141b334a4b1988 Reviewed-on: https://cl.tvl.fyi/c/depot/+/9486 Tested-by: BuildkiteCI Reviewed-by: Profpatsch <mail@profpatsch.de> Autosubmit: Profpatsch <mail@profpatsch.de>
This commit is contained in:
Profpatsch
clbot
parent
6c360f2b64
commit
3863a2ebd6
1 changed files with 101 additions and 39 deletions
|
|
@ -1,6 +1,7 @@
|
|||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module WhatcdResolver where
|
||||
|
||||
|
|
@ -681,7 +682,7 @@ redactedSearchAndInsert extraArguments = do
|
|||
pure $
|
||||
(firstPage : otherPages)
|
||||
& concatMap (.tourGroups)
|
||||
& traverse_ insertTourGroupAndTorrentsNaive
|
||||
& insertTourGroupsAndTorrents
|
||||
where
|
||||
go mpage =
|
||||
redactedSearch
|
||||
|
|
@ -722,27 +723,48 @@ redactedSearchAndInsert extraArguments = do
|
|||
tourGroups
|
||||
)
|
||||
)
|
||||
insertTourGroupAndTorrentsNaive ::
|
||||
T2
|
||||
"tourGroup"
|
||||
(T3 "groupId" Int "groupName" Text "fullJsonResult" Json.Value)
|
||||
"torrents"
|
||||
[T2 "torrentId" Int "fullJsonResult" Json.Value] ->
|
||||
insertTourGroupsAndTorrents ::
|
||||
[ 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"))
|
||||
insertTourGroupsAndTorrents dat = do
|
||||
let tourGroups = dat <&> (.tourGroup)
|
||||
let torrents = dat <&> (.torrents)
|
||||
insertTourGroups tourGroups
|
||||
>>= ( \res ->
|
||||
insertTorrents $
|
||||
zipT2 $
|
||||
T2
|
||||
(label @"torrentGroupIdPg" $ res <&> (.tourGroupIdPg))
|
||||
(label @"torrents" torrents)
|
||||
)
|
||||
insertTourGroup dat = do
|
||||
insertTourGroups ::
|
||||
[ T3
|
||||
"groupId"
|
||||
Int
|
||||
"groupName"
|
||||
Text
|
||||
"fullJsonResult"
|
||||
Json.Value
|
||||
] ->
|
||||
Transaction m [Label "tourGroupIdPg" Int]
|
||||
insertTourGroups dats = do
|
||||
let groupNames =
|
||||
[ [fmt|{dat.groupId}: {dat.groupName}|]
|
||||
| dat <- dats
|
||||
]
|
||||
logInfo [fmt|Inserting tour groups for {showPretty groupNames}|]
|
||||
_ <-
|
||||
execute
|
||||
[fmt|
|
||||
DELETE FROM redacted.torrent_groups
|
||||
WHERE group_id = ?::integer
|
||||
WHERE group_id = ANY (?::integer[])
|
||||
|]
|
||||
(Only dat.groupId)
|
||||
(Only $ (dats <&> (.groupId) & PGArray :: PGArray Int))
|
||||
executeManyReturningWith
|
||||
[fmt|
|
||||
INSERT INTO redacted.torrent_groups (
|
||||
|
|
@ -755,40 +777,67 @@ redactedSearchAndInsert extraArguments = do
|
|||
full_json_result = excluded.full_json_result
|
||||
RETURNING (id)
|
||||
|]
|
||||
[ ( dat.groupId,
|
||||
dat.groupName,
|
||||
dat.fullJsonResult
|
||||
)
|
||||
]
|
||||
( dats <&> \dat ->
|
||||
( dat.groupId,
|
||||
dat.groupName,
|
||||
dat.fullJsonResult
|
||||
)
|
||||
)
|
||||
(label @"tourGroupIdPg" <$> Dec.fromField @Int)
|
||||
>>= ensureSingleRow
|
||||
|
||||
insertTorrents dat = do
|
||||
insertTorrents ::
|
||||
[ T2
|
||||
"torrentGroupIdPg"
|
||||
Int
|
||||
"torrents"
|
||||
[T2 "torrentId" Int "fullJsonResult" Json.Value]
|
||||
] ->
|
||||
Transaction m ()
|
||||
insertTorrents dats = do
|
||||
_ <-
|
||||
execute
|
||||
[sql|
|
||||
DELETE FROM redacted.torrents_json
|
||||
WHERE torrent_id = ANY (?::integer[])
|
||||
|]
|
||||
(Only $ dat.torrents & unzipT2 & (.torrentId) & PGArray)
|
||||
DELETE FROM redacted.torrents_json
|
||||
WHERE torrent_id = ANY (?::integer[])
|
||||
|]
|
||||
( Only $
|
||||
PGArray
|
||||
[ torrent.torrentId
|
||||
| dat <- dats,
|
||||
torrent <- dat.torrents
|
||||
]
|
||||
)
|
||||
|
||||
execute
|
||||
[sql|
|
||||
INSERT INTO redacted.torrents_json
|
||||
(torrent_id, torrent_group, full_json_result)
|
||||
SELECT inputs.torrent_id, static.torrent_group, inputs.full_json_result FROM
|
||||
(SELECT * FROM UNNEST(?::integer[], ?::jsonb[])) AS inputs(torrent_id, full_json_result)
|
||||
CROSS JOIN (VALUES(?::integer)) as static(torrent_group)
|
||||
|]
|
||||
( dat.torrents
|
||||
& unzipT2
|
||||
& \t ->
|
||||
( t.torrentId & PGArray,
|
||||
t.fullJsonResult & PGArray,
|
||||
dat.tourGroupIdPg
|
||||
)
|
||||
INSERT INTO redacted.torrents_json
|
||||
( torrent_group
|
||||
, torrent_id
|
||||
, full_json_result)
|
||||
SELECT *
|
||||
FROM UNNEST(
|
||||
?::integer[]
|
||||
, ?::integer[]
|
||||
, ?::jsonb[]
|
||||
) AS inputs(
|
||||
torrent_group
|
||||
, torrent_id
|
||||
, full_json_result)
|
||||
|]
|
||||
( [ ( dat.torrentGroupIdPg :: Int,
|
||||
group.torrentId :: Int,
|
||||
group.fullJsonResult :: Json.Value
|
||||
)
|
||||
| dat <- dats,
|
||||
group <- dat.torrents
|
||||
]
|
||||
& unzip3PGArray
|
||||
)
|
||||
pure ()
|
||||
|
||||
unzip3PGArray :: [(a1, a2, a3)] -> (PGArray a1, PGArray a2, PGArray a3)
|
||||
unzip3PGArray xs = xs & unzip3 & \(a, b, c) -> (PGArray a, PGArray b, PGArray c)
|
||||
|
||||
redactedGetTorrentFileAndInsert ::
|
||||
( HasField "torrentId" r Int,
|
||||
MonadPostgres m,
|
||||
|
|
@ -989,6 +1038,19 @@ hush :: Either a1 a2 -> Maybe a2
|
|||
hush (Left _) = Nothing
|
||||
hush (Right a) = Just a
|
||||
|
||||
zipT2 ::
|
||||
forall l1 l2 t1 t2.
|
||||
( HasField l1 (T2 l1 [t1] l2 [t2]) [t1],
|
||||
HasField l2 (T2 l1 [t1] l2 [t2]) [t2]
|
||||
) =>
|
||||
T2 l1 [t1] l2 [t2] ->
|
||||
[T2 l1 t1 l2 t2]
|
||||
zipT2 xs =
|
||||
zipWith
|
||||
(\t1 t2 -> T2 (label @l1 t1) (label @l2 t2))
|
||||
(getField @l1 xs)
|
||||
(getField @l2 xs)
|
||||
|
||||
unzipT2 :: forall l1 t1 l2 t2. [T2 l1 t1 l2 t2] -> T2 l1 [t1] l2 [t2]
|
||||
unzipT2 xs = xs <&> toTup & unzip & fromTup
|
||||
where
|
||||
|
|
|
|||
Loading…
Reference in a new issue