diff options
-rw-r--r-- | users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs | 66 | ||||
-rw-r--r-- | users/Profpatsch/whatcd-resolver/src/Redacted.hs | 17 |
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, |