feat(users/Profpatsch/my-prelude): update libraries

The latest and greatest!

Change-Id: I34c0e9f41b3b3cc727d9ea89c7ce6a43271b3170
Reviewed-on: https://cl.tvl.fyi/c/depot/+/11169
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>
This commit is contained in:
Profpatsch 2024-03-16 23:26:49 +01:00 committed by clbot
parent 8335076173
commit 11a2098e0b
7 changed files with 513 additions and 145 deletions

View file

@ -119,12 +119,12 @@ recordException span dat = liftIO $ do
instance (MonadThrow m, MonadUnliftIO m) => MonadPostgres (AppT m) where
execute = executeImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
execute_ = executeImpl_ (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
executeMany = executeManyImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
executeManyReturningWith = executeManyReturningWithImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
queryWith = queryWithImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
queryWith_ = queryWithImpl_ (AppT ask)
foldRows = foldRowsImpl (AppT ask)
foldRowsWithAcc = foldRowsWithAccImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
runTransaction = runPGTransaction
runPGTransaction :: (MonadUnliftIO m) => Transaction (AppT m) a -> AppT m a

View file

@ -35,6 +35,7 @@ import Json.Enc (Enc)
import Json.Enc qualified as Enc
import Label
import Multipart2 qualified as Multipart
import MyPrelude
import Network.HTTP.Client.Conduit qualified as Http
import Network.HTTP.Simple qualified as Http
import Network.HTTP.Types
@ -50,7 +51,6 @@ import OpenTelemetry.Trace qualified as Otel hiding (getTracer, inSpan, inSpan')
import OpenTelemetry.Trace.Monad qualified as Otel
import Parse (Parse)
import Parse qualified
import PossehlAnalyticsPrelude
import Postgres.Decoder qualified as Dec
import Postgres.MonadPostgres
import Pretty
@ -848,7 +848,9 @@ redactedSearchAndInsert extraArguments = do
pure $
(firstPage : otherPages)
& concatMap (.tourGroups)
& insertTourGroupsAndTorrents
& \case
IsNonEmpty tgs -> tgs & insertTourGroupsAndTorrents
IsEmpty -> pure ()
where
go mpage =
redactedSearch
@ -893,12 +895,13 @@ redactedSearchAndInsert extraArguments = do
)
)
insertTourGroupsAndTorrents ::
[ T2
"tourGroup"
(T3 "groupId" Int "groupName" Text "fullJsonResult" Json.Value)
"torrents"
[T2 "torrentId" Int "fullJsonResult" Json.Value]
] ->
NonEmpty
( T2
"tourGroup"
(T3 "groupId" Int "groupName" Text "fullJsonResult" Json.Value)
"torrents"
[T2 "torrentId" Int "fullJsonResult" Json.Value]
) ->
Transaction m ()
insertTourGroupsAndTorrents dat = do
let tourGroups = dat <&> (.tourGroup)
@ -909,23 +912,22 @@ redactedSearchAndInsert extraArguments = do
zipT2 $
T2
(label @"torrentGroupIdPg" $ res <&> (.tourGroupIdPg))
(label @"torrents" torrents)
(label @"torrents" (torrents & toList))
)
insertTourGroups ::
[ T3
"groupId"
Int
"groupName"
Text
"fullJsonResult"
Json.Value
] ->
NonEmpty
( 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
]
dats <&> \dat -> [fmt|{dat.groupId}: {dat.groupName}|]
logInfo [fmt|Inserting tour groups for {showPretty groupNames}|]
_ <-
execute
@ -933,7 +935,7 @@ redactedSearchAndInsert extraArguments = do
DELETE FROM redacted.torrent_groups
WHERE group_id = ANY (?::integer[])
|]
(Only $ (dats <&> (.groupId) & PGArray :: PGArray Int))
(Only $ (dats <&> (.groupId) & toList & PGArray :: PGArray Int))
executeManyReturningWith
[fmt|
INSERT INTO redacted.torrent_groups (
@ -1082,7 +1084,7 @@ migrate ::
) =>
Transaction m (Label "numberOfRowsAffected" Natural)
migrate = inSpan "Database Migration" $ do
execute_
execute
[sql|
CREATE SCHEMA IF NOT EXISTS redacted;
@ -1134,6 +1136,7 @@ migrate = inSpan "Database Migration" $ do
CREATE INDEX IF NOT EXISTS torrents_json_seeding ON redacted.torrents_json(((full_json_result->'seeding')::integer));
CREATE INDEX IF NOT EXISTS torrents_json_snatches ON redacted.torrents_json(((full_json_result->'snatches')::integer));
|]
()
data TorrentData transmissionInfo = TorrentData
{ groupId :: Int,