From 11a2098e0b3a4f202d35a61da06a0bf1c724b8c9 Mon Sep 17 00:00:00 2001
From: Profpatsch <mail@profpatsch.de>
Date: Sat, 16 Mar 2024 23:26:49 +0100
Subject: 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>
---
 users/Profpatsch/whatcd-resolver/src/AppT.hs       |  4 +-
 .../whatcd-resolver/src/WhatcdResolver.hs          | 47 ++++++++++++----------
 2 files changed, 27 insertions(+), 24 deletions(-)

(limited to 'users/Profpatsch/whatcd-resolver/src')

diff --git a/users/Profpatsch/whatcd-resolver/src/AppT.hs b/users/Profpatsch/whatcd-resolver/src/AppT.hs
index 9c6180c9aaed..7bd38a733e53 100644
--- a/users/Profpatsch/whatcd-resolver/src/AppT.hs
+++ b/users/Profpatsch/whatcd-resolver/src/AppT.hs
@@ -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
diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
index ee2ce508b1be..fe0952a5ffab 100644
--- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
+++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
@@ -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,
-- 
cgit 1.4.1