about summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs66
-rw-r--r--users/Profpatsch/whatcd-resolver/src/Redacted.hs17
2 files changed, 75 insertions, 8 deletions
diff --git a/users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs b/users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs
index 6ccc45faad0a..87928678a052 100644
--- a/users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs
+++ b/users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs
@@ -34,7 +34,7 @@ import Database.PostgreSQL.Simple qualified as Postgres
 import Database.PostgreSQL.Simple.FromRow qualified as PG
 import Database.PostgreSQL.Simple.ToField (ToField)
 import Database.PostgreSQL.Simple.ToRow (ToRow (toRow))
-import Database.PostgreSQL.Simple.Types (Query (..))
+import Database.PostgreSQL.Simple.Types (PGArray (PGArray), Query (..))
 import GHC.IO.Handle (Handle)
 import GHC.Records (getField)
 import Label
@@ -930,6 +930,70 @@ withEvent span start end act = do
     )
   pure res
 
+unzipPGArray ::
+  forall l1 t1 l2 t2 r.
+  ( HasField l1 r t1,
+    HasField l2 r t2
+  ) =>
+  [r] ->
+  (PGArray t1, PGArray t2)
+{-# INLINEABLE unzipPGArray #-}
+unzipPGArray xs =
+  ( PGArray $ getField @l1 <$> xs,
+    PGArray $ getField @l2 <$> xs
+  )
+
+unzip3PGArray ::
+  forall l1 t1 l2 t2 l3 t3 r.
+  ( HasField l1 r t1,
+    HasField l2 r t2,
+    HasField l3 r t3
+  ) =>
+  [r] ->
+  (PGArray t1, PGArray t2, PGArray t3)
+{-# INLINEABLE unzip3PGArray #-}
+unzip3PGArray xs =
+  ( PGArray $ getField @l1 <$> xs,
+    PGArray $ getField @l2 <$> xs,
+    PGArray $ getField @l3 <$> xs
+  )
+
+unzip4PGArray ::
+  forall l1 t1 l2 t2 l3 t3 l4 t4 r.
+  ( HasField l1 r t1,
+    HasField l2 r t2,
+    HasField l3 r t3,
+    HasField l4 r t4
+  ) =>
+  [r] ->
+  (PGArray t1, PGArray t2, PGArray t3, PGArray t4)
+{-# INLINEABLE unzip4PGArray #-}
+unzip4PGArray xs =
+  ( PGArray $ getField @l1 <$> xs,
+    PGArray $ getField @l2 <$> xs,
+    PGArray $ getField @l3 <$> xs,
+    PGArray $ getField @l4 <$> xs
+  )
+
+unzip5PGArray ::
+  forall l1 t1 l2 t2 l3 t3 l4 t4 l5 t5 r.
+  ( HasField l1 r t1,
+    HasField l2 r t2,
+    HasField l3 r t3,
+    HasField l4 r t4,
+    HasField l5 r t5
+  ) =>
+  [r] ->
+  (PGArray t1, PGArray t2, PGArray t3, PGArray t4, PGArray t5)
+{-# INLINEABLE unzip5PGArray #-}
+unzip5PGArray xs =
+  ( PGArray $ getField @l1 <$> xs,
+    PGArray $ getField @l2 <$> xs,
+    PGArray $ getField @l3 <$> xs,
+    PGArray $ getField @l4 <$> xs,
+    PGArray $ getField @l5 <$> xs
+  )
+
 instance (ToField t1) => ToRow (Label l1 t1) where
   toRow t2 = toRow $ PG.Only $ getField @l1 t2
 
diff --git a/users/Profpatsch/whatcd-resolver/src/Redacted.hs b/users/Profpatsch/whatcd-resolver/src/Redacted.hs
index fda577d2a044..7bf9e8c2ce27 100644
--- a/users/Profpatsch/whatcd-resolver/src/Redacted.hs
+++ b/users/Profpatsch/whatcd-resolver/src/Redacted.hs
@@ -275,20 +275,23 @@ redactedSearchAndInsert extraArguments = do
             , torrent_id
             , full_json_result)
           |]
-        ( [ ( dat.torrentGroupIdPg :: Int,
-              group.torrentId :: Int,
-              group.fullJsonResult :: Json.Value
-            )
+        ( [ T3
+              (getLabel @"torrentGroupIdPg" dat)
+              (getLabel @"torrentId" group)
+              (getLabel @"fullJsonResult" group)
             | dat <- dats,
               group <- dat.torrents
           ]
             & unzip3PGArray
+              @"torrentGroupIdPg"
+              @Int
+              @"torrentId"
+              @Int
+              @"fullJsonResult"
+              @Json.Value
         )
       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,