feat(users/Profpatsch/MonadPostgres): add unzipPGArray fns
Change-Id: I47ae3520998c1da7a8ad34231fd5af39240a771d Reviewed-on: https://cl.tvl.fyi/c/depot/+/12471 Tested-by: BuildkiteCI Reviewed-by: Profpatsch <mail@profpatsch.de>
This commit is contained in:
		
							parent
							
								
									f49e047588
								
							
						
					
					
						commit
						9d02fc4ff1
					
				
					 2 changed files with 75 additions and 8 deletions
				
			
		| 
						 | 
					@ -34,7 +34,7 @@ import Database.PostgreSQL.Simple qualified as Postgres
 | 
				
			||||||
import Database.PostgreSQL.Simple.FromRow qualified as PG
 | 
					import Database.PostgreSQL.Simple.FromRow qualified as PG
 | 
				
			||||||
import Database.PostgreSQL.Simple.ToField (ToField)
 | 
					import Database.PostgreSQL.Simple.ToField (ToField)
 | 
				
			||||||
import Database.PostgreSQL.Simple.ToRow (ToRow (toRow))
 | 
					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.IO.Handle (Handle)
 | 
				
			||||||
import GHC.Records (getField)
 | 
					import GHC.Records (getField)
 | 
				
			||||||
import Label
 | 
					import Label
 | 
				
			||||||
| 
						 | 
					@ -930,6 +930,70 @@ withEvent span start end act = do
 | 
				
			||||||
    )
 | 
					    )
 | 
				
			||||||
  pure res
 | 
					  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
 | 
					instance (ToField t1) => ToRow (Label l1 t1) where
 | 
				
			||||||
  toRow t2 = toRow $ PG.Only $ getField @l1 t2
 | 
					  toRow t2 = toRow $ PG.Only $ getField @l1 t2
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -275,20 +275,23 @@ redactedSearchAndInsert extraArguments = do
 | 
				
			||||||
            , torrent_id
 | 
					            , torrent_id
 | 
				
			||||||
            , full_json_result)
 | 
					            , full_json_result)
 | 
				
			||||||
          |]
 | 
					          |]
 | 
				
			||||||
        ( [ ( dat.torrentGroupIdPg :: Int,
 | 
					        ( [ T3
 | 
				
			||||||
              group.torrentId :: Int,
 | 
					              (getLabel @"torrentGroupIdPg" dat)
 | 
				
			||||||
              group.fullJsonResult :: Json.Value
 | 
					              (getLabel @"torrentId" group)
 | 
				
			||||||
            )
 | 
					              (getLabel @"fullJsonResult" group)
 | 
				
			||||||
            | dat <- dats,
 | 
					            | dat <- dats,
 | 
				
			||||||
              group <- dat.torrents
 | 
					              group <- dat.torrents
 | 
				
			||||||
          ]
 | 
					          ]
 | 
				
			||||||
            & unzip3PGArray
 | 
					            & unzip3PGArray
 | 
				
			||||||
 | 
					              @"torrentGroupIdPg"
 | 
				
			||||||
 | 
					              @Int
 | 
				
			||||||
 | 
					              @"torrentId"
 | 
				
			||||||
 | 
					              @Int
 | 
				
			||||||
 | 
					              @"fullJsonResult"
 | 
				
			||||||
 | 
					              @Json.Value
 | 
				
			||||||
        )
 | 
					        )
 | 
				
			||||||
      pure ()
 | 
					      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 ::
 | 
					redactedGetTorrentFileAndInsert ::
 | 
				
			||||||
  ( HasField "torrentId" r Int,
 | 
					  ( HasField "torrentId" r Int,
 | 
				
			||||||
    MonadPostgres m,
 | 
					    MonadPostgres m,
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue