{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

{-|
Module      : Polytropos.Rel8
Description : rel8 Rel8able instances and columnar schemas over Polytropos open rows
Copyright   : (c) 2026 The Polytropos Authors
License     : EUPL-1.2 OR Apache-2.0
Maintainer  : nadia.yvette.chambers@ik.me
Stability   : experimental
Portability : non-portable (GHC extensions)

Integration of @polytropos@ open rows with Oliver Charles' @rel8@ PostgreSQL
framework.

= Architectural Overview & Rationale

@t'PolyRow'@ provides rel8's 'Rel8able' for the product row @r@:
* Its column schema is a right-nested 'H.HProduct' tree of 'H.HLabel'ed 'H.HIdentity'
  columns built directly from the row's type-level field list.
* The flat 'Data.Primitive.SmallArray.SmallArray' payload of the underlying @t'Polytropos.Core.Rep'@
  is read and written slot by slot — one slot per column, in row order.
* Conversion to and from rel8's columnar representation never materialises an
  intermediate tuple and is unbounded in arity, completely avoiding GHC's 62-column
  tuple limit.

= When to Use This Module

* When defining database schemas and type-safe SQL queries with @rel8@ where rows
  are modelled as open @polytropos@ records.

= Worked Example

= Worked Example

> {-# LANGUAGE DataKinds #-}
> {-# LANGUAGE TypeApplications #-}
> {-# OPTIONS_GHC -fplugin=Polytropos.Plugin #-}
>
> import Rel8
> import Polytropos
> import Polytropos.Rel8
>
> type AccountRow = '["id" ':= Int64, "balance" ':= Double]
> type AccountTable = PolyRow AccountRow
>
> -- Lift a record to a Rel8 SQL expression row:
> rec :: Record AccountRow
> rec = REC { id = 42 :: Int64, balance = 1000.50 :: Double }
>
> sqlExpr :: AccountTable Expr
> sqlExpr = litRecord rec
-}
module Polytropos.Rel8
  ( -- * A rel8 Table from an Open Row
    PolyRow (..)
  , toRecord
  , fromRecord

    -- * Schema & Rel8able Row Class
  , Rel8able
  , Rel8ableRow (..)
  , RowHTable
  , AllSql

    -- * Entry points for Identity/Result
  , rowToColumns
  , columnsToRow

    -- * Lifting to SQL Expressions
  , litPolyRow
  , litRecord

    -- * Columnar Combinators
  , hfield
  , hfieldAt
  , htabulate
  , hmap
  , htraverse
  , hzipWith
  ) where

import Data.Kind (Type, Constraint)
import Data.Functor.Identity (Identity (..))
import Data.Primitive.SmallArray
  ( SmallArray
  , indexSmallArray
  , sizeofSmallArray
  , smallArrayFromList
  )
import GHC.Exts (Any)
import GHC.TypeLits (KnownSymbol)
import Unsafe.Coerce (unsafeCoerce)

import Rel8 (Rel8able, Expr, lit)
import qualified Rel8.Internal.Generic.Rel8able as G
import Rel8.Internal.Generic.Rel8able (GColumns, GFromExprs)
import qualified Rel8.Internal.Schema.HTable as H
import qualified Rel8.Internal.Schema.HTable.Identity as H
import qualified Rel8.Internal.Schema.HTable.Product as H
import qualified Rel8.Internal.Schema.HTable.Label as H
import qualified Rel8.Internal.Schema.Kind as K
import Rel8.Internal.Schema.Null (Sql)
import Rel8.Internal.Schema.Result (Result)
import Rel8.Internal.Type (DBType)

import Polytropos (Record)
import Polytropos.Core
  ( Row
  , RowRep (..)
  , RowType (..)
  , Rep (..)
  , Pair (..)
  , Field (..)
  , FieldIndex (..)
  )

{-------------------------------------------------------------------------------
  Schema: row -> HTable (closed type family)
-------------------------------------------------------------------------------}

-- | Map a polytropos product row to rel8's HTable: a right-nested 'H.HProduct'
-- tree of 'H.HLabel'ed 'H.HIdentity' columns, one per field, named by the field's
-- 'GHC.TypeLits.Symbol'.
type RowHTable :: Row -> K.HTable
type family RowHTable r where
  RowHTable '[n ':= a] = H.HLabel n (H.HIdentity a)
  RowHTable (n ':= a ': r) = H.HProduct (H.HLabel n (H.HIdentity a)) (RowHTable r)

-- | Constraint: every field label has a 'GHC.TypeLits.KnownSymbol' instance and its type is a PostgreSQL
-- 'Sql' 'DBType'.
type AllSql :: Row -> Constraint
type family AllSql r where
  AllSql '[] = ()
  AllSql '[n ':= a] = (KnownSymbol n, Sql DBType a)
  AllSql (n ':= a ': r) = (KnownSymbol n, Sql DBType a, AllSql r)

{-------------------------------------------------------------------------------
  Rel8ableRow class
-------------------------------------------------------------------------------}

-- | Type class providing bidirectional conversion between a flat 'SmallArray'
-- of slots and the nested rel8 'RowHTable' column tree.
class (AllSql r, H.HTable (RowHTable r)) => Rel8ableRow (r :: Row) where
  -- | Convert a flat array into the nested HTable tree at a given starting offset.
  toHTable :: forall context. SmallArray (context Any) -> Int -> (RowHTable r context, Int)

  -- | Unroll the nested HTable tree into a list of erased column context slots.
  fromHTable :: forall context. RowHTable r context -> [context Any]

  -- | Lift column values at 'Result' (t'Data.Functor.Identity.Identity') into PostgreSQL expressions ('Expr').
  litHTable :: RowHTable r Result -> RowHTable r Expr

  -- | Arity (number of columns).
  rowArity :: Int

instance (KnownSymbol n, Sql DBType a) => Rel8ableRow '[n ':= a] where
  rowArity :: Int
rowArity = Int
1
  toHTable :: forall (context :: * -> *).
SmallArray (context Any)
-> Int -> (RowHTable '[n ':= a] context, Int)
toHTable SmallArray (context Any)
arr Int
offset =
    let val :: context a
val = context Any -> context a
forall a b. a -> b
unsafeCoerce (SmallArray (context Any) -> Int -> context Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (context Any)
arr Int
offset) :: context a
    in (HIdentity a context -> HLabel n (HIdentity a) context
forall (label :: Symbol) (table :: HTable) (context :: * -> *).
table context -> HLabel label table context
H.HLabel (context a -> HIdentity a context
forall a (context :: * -> *). context a -> HIdentity a context
H.HIdentity context a
val), Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  fromHTable :: forall (context :: * -> *).
RowHTable '[n ':= a] context -> [context Any]
fromHTable (H.HLabel (H.HIdentity context a
val)) =
    [context a -> context Any
forall a b. a -> b
unsafeCoerce context a
val]
  litHTable :: RowHTable '[n ':= a] Result -> RowHTable '[n ':= a] Expr
litHTable (H.HLabel (H.HIdentity (Identity a
a))) =
    HIdentity a Expr -> HLabel n (HIdentity a) Expr
forall (label :: Symbol) (table :: HTable) (context :: * -> *).
table context -> HLabel label table context
H.HLabel (Expr a -> HIdentity a Expr
forall a (context :: * -> *). context a -> HIdentity a context
H.HIdentity (a -> Expr a
forall exprs a. Serializable exprs a => a -> exprs
lit a
a))

instance (KnownSymbol n, Sql DBType a, Rel8ableRow (r1 ': rs)) => Rel8ableRow (n ':= a ': r1 ': rs) where
  rowArity :: Int
rowArity = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ forall (r :: Row). Rel8ableRow r => Int
rowArity @(r1 ': rs)
  toHTable :: forall (context :: * -> *).
SmallArray (context Any)
-> Int -> (RowHTable ((n ':= a) : r1 : rs) context, Int)
toHTable SmallArray (context Any)
arr Int
offset =
    let val :: context a
val = context Any -> context a
forall a b. a -> b
unsafeCoerce (SmallArray (context Any) -> Int -> context Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (context Any)
arr Int
offset) :: context a
        (RowHTable (r1 : rs) context
rest, Int
nextOffset) = forall (r :: Row) (context :: * -> *).
Rel8ableRow r =>
SmallArray (context Any) -> Int -> (RowHTable r context, Int)
toHTable @(r1 ': rs) SmallArray (context Any)
arr (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    in (HLabel n (HIdentity a) context
-> RowHTable (r1 : rs) context
-> HProduct (HLabel n (HIdentity a)) (RowHTable (r1 : rs)) context
forall (a :: HTable) (b :: HTable) (context :: * -> *).
a context -> b context -> HProduct a b context
H.HProduct (HIdentity a context -> HLabel n (HIdentity a) context
forall (label :: Symbol) (table :: HTable) (context :: * -> *).
table context -> HLabel label table context
H.HLabel (context a -> HIdentity a context
forall a (context :: * -> *). context a -> HIdentity a context
H.HIdentity context a
val)) RowHTable (r1 : rs) context
rest, Int
nextOffset)
  fromHTable :: forall (context :: * -> *).
RowHTable ((n ':= a) : r1 : rs) context -> [context Any]
fromHTable (H.HProduct (H.HLabel (H.HIdentity context a
val)) RowHTable (r1 : rs) context
rest) =
    context a -> context Any
forall a b. a -> b
unsafeCoerce context a
val context Any -> [context Any] -> [context Any]
forall a. a -> [a] -> [a]
: forall (r :: Row) (context :: * -> *).
Rel8ableRow r =>
RowHTable r context -> [context Any]
fromHTable @(r1 ': rs) RowHTable (r1 : rs) context
rest
  litHTable :: RowHTable ((n ':= a) : r1 : rs) Result
-> RowHTable ((n ':= a) : r1 : rs) Expr
litHTable (H.HProduct (H.HLabel (H.HIdentity (Identity a
a))) RowHTable (r1 : rs) Result
rest) =
    HLabel n (HIdentity a) Expr
-> RowHTable (r1 : rs) Expr
-> HProduct (HLabel n (HIdentity a)) (RowHTable (r1 : rs)) Expr
forall (a :: HTable) (b :: HTable) (context :: * -> *).
a context -> b context -> HProduct a b context
H.HProduct (HIdentity a Expr -> HLabel n (HIdentity a) Expr
forall (label :: Symbol) (table :: HTable) (context :: * -> *).
table context -> HLabel label table context
H.HLabel (Expr a -> HIdentity a Expr
forall a (context :: * -> *). context a -> HIdentity a context
H.HIdentity (a -> Expr a
forall exprs a. Serializable exprs a => a -> exprs
lit a
a))) (forall (r :: Row).
Rel8ableRow r =>
RowHTable r Result -> RowHTable r Expr
litHTable @(r1 ': rs) RowHTable (r1 : rs) Result
rest)

{-------------------------------------------------------------------------------
  The Rel8able
-------------------------------------------------------------------------------}

-- | A rel8 table row backed by an open polytropos product row @r@.
--
-- The newtype is polymorphic in the rel8 context functor @context@ so that rel8
-- can use the same 'Rel8able' at 'Result', 'Expr', 'Rel8.Name', etc.
newtype PolyRow (r :: Row) (context :: Type -> Type) = PolyRow
  { forall (r :: Row) (context :: * -> *).
PolyRow r context -> RowRep context 'ProductRowT r ()
unPolyRow :: RowRep context 'ProductRowT r ()
  }

-- | Convert a @t'PolyRow' r 'Result'@ to a polytropos @'Record' r@.
toRecord :: PolyRow r Result -> Record r
toRecord :: forall (r :: Row). PolyRow r Result -> Record r
toRecord (PolyRow RowRep Result 'ProductRowT r ()
rep) = RowRep Result 'ProductRowT r ()
rep

-- | Wrap a polytropos @'Record' r@ as a @t'PolyRow' r 'Result'@.
fromRecord :: Record r -> PolyRow r Result
fromRecord :: forall (r :: Row). Record r -> PolyRow r Result
fromRecord Record r
rep = Record r -> PolyRow r Result
forall (r :: Row) (context :: * -> *).
RowRep context 'ProductRowT r () -> PolyRow r context
PolyRow Record r
rep

instance Eq (Record r) => Eq (PolyRow r Result) where
  PolyRow Record r
a == :: PolyRow r Result -> PolyRow r Result -> Bool
== PolyRow Record r
b = Record r
a Record r -> Record r -> Bool
forall a. Eq a => a -> a -> Bool
== Record r
b

instance Show (Record r) => Show (PolyRow r Result) where
  showsPrec :: Int -> PolyRow r Result -> ShowS
showsPrec Int
d (PolyRow Record r
a) = Int -> Record r -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d Record r
a

instance Rel8ableRow r => Rel8able (PolyRow r) where
  type GColumns (PolyRow r) = RowHTable r
  type GFromExprs (PolyRow r) = PolyRow r Result

  gfromColumns :: forall (context :: * -> *).
SContext context
-> GColumns (PolyRow r) context -> PolyRow r context
gfromColumns SContext context
_ GColumns (PolyRow r) context
cols =
    RowRep context 'ProductRowT r () -> PolyRow r context
forall (r :: Row) (context :: * -> *).
RowRep context 'ProductRowT r () -> PolyRow r context
PolyRow (Rep context () -> RowRep context 'ProductRowT r ()
forall {k} k1 (f :: * -> *) (r :: RowType) (row :: k1) (a :: k).
Rep f a -> RowRep f r row a
RowRep (Word -> SmallArray (context Any) -> Rep context ()
forall {k} (f :: * -> *) (a :: k).
Word -> SmallArray (f Any) -> Rep f a
Rep Word
0 ([context Any] -> SmallArray (context Any)
forall a. [a] -> SmallArray a
smallArrayFromList (forall (r :: Row) (context :: * -> *).
Rel8ableRow r =>
RowHTable r context -> [context Any]
fromHTable @r GColumns (PolyRow r) context
RowHTable r context
cols))))
  gtoColumns :: forall (context :: * -> *).
SContext context
-> PolyRow r context -> GColumns (PolyRow r) context
gtoColumns SContext context
_ (PolyRow (RowRep (Rep Word
_ SmallArray (context Any)
arr))) =
    (RowHTable r context, Int) -> RowHTable r context
forall a b. (a, b) -> a
fst (forall (r :: Row) (context :: * -> *).
Rel8ableRow r =>
SmallArray (context Any) -> Int -> (RowHTable r context, Int)
toHTable @r SmallArray (context Any)
arr Int
0)
  gfromResult :: GColumns (PolyRow r) Result -> GFromExprs (PolyRow r)
gfromResult GColumns (PolyRow r) Result
cols =
    RowRep Result 'ProductRowT r () -> PolyRow r Result
forall (r :: Row) (context :: * -> *).
RowRep context 'ProductRowT r () -> PolyRow r context
PolyRow (Rep Result () -> RowRep Result 'ProductRowT r ()
forall {k} k1 (f :: * -> *) (r :: RowType) (row :: k1) (a :: k).
Rep f a -> RowRep f r row a
RowRep (Word -> SmallArray (Result Any) -> Rep Result ()
forall {k} (f :: * -> *) (a :: k).
Word -> SmallArray (f Any) -> Rep f a
Rep Word
0 ([Result Any] -> SmallArray (Result Any)
forall a. [a] -> SmallArray a
smallArrayFromList (forall (r :: Row) (context :: * -> *).
Rel8ableRow r =>
RowHTable r context -> [context Any]
fromHTable @r GColumns (PolyRow r) Result
RowHTable r Result
cols))))
  gtoResult :: GFromExprs (PolyRow r) -> GColumns (PolyRow r) Result
gtoResult (PolyRow (RowRep (Rep Word
_ SmallArray (Result Any)
arr))) =
    (RowHTable r Result, Int) -> RowHTable r Result
forall a b. (a, b) -> a
fst (forall (r :: Row) (context :: * -> *).
Rel8ableRow r =>
SmallArray (context Any) -> Int -> (RowHTable r context, Int)
toHTable @r SmallArray (Result Any)
arr Int
0)

{-------------------------------------------------------------------------------
  Identity / Result round-trip entry points
-------------------------------------------------------------------------------}

-- | Pack a @'Record' r@ into its rel8 column tree at t'Data.Functor.Identity.Identity'.
rowToColumns :: forall r. Rel8ableRow r => Record r -> RowHTable r Identity
rowToColumns :: forall (r :: Row). Rel8ableRow r => Record r -> RowHTable r Result
rowToColumns (RowRep (Rep Word
_ SmallArray (Result Any)
arr)) = (RowHTable r Result, Int) -> RowHTable r Result
forall a b. (a, b) -> a
fst (forall (r :: Row) (context :: * -> *).
Rel8ableRow r =>
SmallArray (context Any) -> Int -> (RowHTable r context, Int)
toHTable @r SmallArray (Result Any)
arr Int
0)

-- | Unpack rel8 columns (at t'Data.Functor.Identity.Identity') back into a @'Record' r@.
columnsToRow :: forall r. Rel8ableRow r => RowHTable r Identity -> Record r
columnsToRow :: forall (r :: Row). Rel8ableRow r => RowHTable r Result -> Record r
columnsToRow RowHTable r Result
cols = Rep Result () -> RowRep Result 'ProductRowT r ()
forall {k} k1 (f :: * -> *) (r :: RowType) (row :: k1) (a :: k).
Rep f a -> RowRep f r row a
RowRep (Word -> SmallArray (Result Any) -> Rep Result ()
forall {k} (f :: * -> *) (a :: k).
Word -> SmallArray (f Any) -> Rep f a
Rep Word
0 ([Result Any] -> SmallArray (Result Any)
forall a. [a] -> SmallArray a
smallArrayFromList (forall (r :: Row) (context :: * -> *).
Rel8ableRow r =>
RowHTable r context -> [context Any]
fromHTable @r RowHTable r Result
cols)))

{-------------------------------------------------------------------------------
  Lifting to SQL Expressions
-------------------------------------------------------------------------------}

-- | Lift a @t'PolyRow' r 'Result'@ to a @t'PolyRow' r 'Expr'@.
litPolyRow :: forall r. Rel8ableRow r => PolyRow r Result -> PolyRow r Expr
litPolyRow :: forall (r :: Row).
Rel8ableRow r =>
PolyRow r Result -> PolyRow r Expr
litPolyRow (PolyRow (RowRep (Rep Word
_ SmallArray (Result Any)
arr))) =
  let (RowHTable r Result
resCols, Int
_) = forall (r :: Row) (context :: * -> *).
Rel8ableRow r =>
SmallArray (context Any) -> Int -> (RowHTable r context, Int)
toHTable @r SmallArray (Result Any)
arr Int
0
      exprCols :: RowHTable r Expr
exprCols = forall (r :: Row).
Rel8ableRow r =>
RowHTable r Result -> RowHTable r Expr
litHTable @r RowHTable r Result
resCols
  in RowRep Expr 'ProductRowT r () -> PolyRow r Expr
forall (r :: Row) (context :: * -> *).
RowRep context 'ProductRowT r () -> PolyRow r context
PolyRow (Rep Expr () -> RowRep Expr 'ProductRowT r ()
forall {k} k1 (f :: * -> *) (r :: RowType) (row :: k1) (a :: k).
Rep f a -> RowRep f r row a
RowRep (Word -> SmallArray (Expr Any) -> Rep Expr ()
forall {k} (f :: * -> *) (a :: k).
Word -> SmallArray (f Any) -> Rep f a
Rep Word
0 ([Expr Any] -> SmallArray (Expr Any)
forall a. [a] -> SmallArray a
smallArrayFromList (forall (r :: Row) (context :: * -> *).
Rel8ableRow r =>
RowHTable r context -> [context Any]
fromHTable @r RowHTable r Expr
exprCols))))

-- | Lift a polytropos @'Record' r@ directly into a @t'PolyRow' r 'Expr'@.
litRecord :: forall r. Rel8ableRow r => Record r -> PolyRow r Expr
litRecord :: forall (r :: Row). Rel8ableRow r => Record r -> PolyRow r Expr
litRecord = PolyRow r Result -> PolyRow r Expr
forall (r :: Row).
Rel8ableRow r =>
PolyRow r Result -> PolyRow r Expr
litPolyRow (PolyRow r Result -> PolyRow r Expr)
-> (Record r -> PolyRow r Result) -> Record r -> PolyRow r Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record r -> PolyRow r Result
forall (r :: Row). Record r -> PolyRow r Result
fromRecord

{-------------------------------------------------------------------------------
  Columnar Combinators
-------------------------------------------------------------------------------}

-- | Read a field by name using 'FieldIndex'.
hfield :: forall name r context a. FieldIndex name r a
  => Field name -> PolyRow r context -> context a
hfield :: forall (name :: Symbol) (r :: Row) (context :: * -> *) a.
FieldIndex name r a =>
Field name -> PolyRow r context -> context a
hfield Field name
_ (PolyRow (RowRep (Rep Word
_ SmallArray (context Any)
arr))) =
  context Any -> context a
forall a b. a -> b
unsafeCoerce (SmallArray (context Any) -> Int -> context Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (context Any)
arr (forall {kn} k {ka} (n :: kn) (row :: k) (a :: ka).
FieldIndex n row a =>
Int
forall k {ka} (n :: Symbol) (row :: k) (a :: ka).
FieldIndex n row a =>
Int
fieldIndex @_ @name @r @a))

-- | Read a field at a slot index from a t'PolyRow'.
hfieldAt :: Int -> PolyRow r context -> context Any
hfieldAt :: forall (r :: Row) (context :: * -> *).
Int -> PolyRow r context -> context Any
hfieldAt Int
i (PolyRow (RowRep (Rep Word
_ SmallArray (context Any)
arr))) = SmallArray (context Any) -> Int -> context Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (context Any)
arr Int
i

-- | Build a t'PolyRow' by evaluating a generator across each column slot.
htabulate :: forall r context. Rel8ableRow r
  => (Int -> context Any) -> PolyRow r context
htabulate :: forall (r :: Row) (context :: * -> *).
Rel8ableRow r =>
(Int -> context Any) -> PolyRow r context
htabulate Int -> context Any
f =
  let n :: Int
n = forall (r :: Row). Rel8ableRow r => Int
rowArity @r
      vals :: [context Any]
vals = [Int -> context Any
f Int
i | Int
i <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
  in RowRep context 'ProductRowT r () -> PolyRow r context
forall (r :: Row) (context :: * -> *).
RowRep context 'ProductRowT r () -> PolyRow r context
PolyRow (Rep context () -> RowRep context 'ProductRowT r ()
forall {k} k1 (f :: * -> *) (r :: RowType) (row :: k1) (a :: k).
Rep f a -> RowRep f r row a
RowRep (Word -> SmallArray (context Any) -> Rep context ()
forall {k} (f :: * -> *) (a :: k).
Word -> SmallArray (f Any) -> Rep f a
Rep Word
0 ([context Any] -> SmallArray (context Any)
forall a. [a] -> SmallArray a
smallArrayFromList [context Any]
vals)))

-- | Map a natural transformation across all columns in a t'PolyRow'.
hmap :: forall r f g. Rel8ableRow r
  => (forall a. f a -> g a) -> PolyRow r f -> PolyRow r g
hmap :: forall (r :: Row) (f :: * -> *) (g :: * -> *).
Rel8ableRow r =>
(forall a. f a -> g a) -> PolyRow r f -> PolyRow r g
hmap forall a. f a -> g a
f (PolyRow (RowRep (Rep Word
_ SmallArray (f Any)
arr))) =
  let n :: Int
n = SmallArray (f Any) -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray (f Any)
arr
      vals :: [g Any]
vals = [g (ZonkAny 2) -> g Any
forall a b. a -> b
unsafeCoerce (f (ZonkAny 2) -> g (ZonkAny 2)
forall a. f a -> g a
f (f Any -> f (ZonkAny 2)
forall a b. a -> b
unsafeCoerce (SmallArray (f Any) -> Int -> f Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (f Any)
arr Int
i))) | Int
i <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
  in RowRep g 'ProductRowT r () -> PolyRow r g
forall (r :: Row) (context :: * -> *).
RowRep context 'ProductRowT r () -> PolyRow r context
PolyRow (Rep g () -> RowRep g 'ProductRowT r ()
forall {k} k1 (f :: * -> *) (r :: RowType) (row :: k1) (a :: k).
Rep f a -> RowRep f r row a
RowRep (Word -> SmallArray (g Any) -> Rep g ()
forall {k} (f :: * -> *) (a :: k).
Word -> SmallArray (f Any) -> Rep f a
Rep Word
0 ([g Any] -> SmallArray (g Any)
forall a. [a] -> SmallArray a
smallArrayFromList [g Any]
vals)))

-- | Traverse all columnar fields in a t'PolyRow'.
htraverse :: forall r f g m. (Applicative m, Rel8ableRow r)
  => (forall a. f a -> m (g a)) -> PolyRow r f -> m (PolyRow r g)
htraverse :: forall (r :: Row) (f :: * -> *) (g :: * -> *) (m :: * -> *).
(Applicative m, Rel8ableRow r) =>
(forall a. f a -> m (g a)) -> PolyRow r f -> m (PolyRow r g)
htraverse forall a. f a -> m (g a)
f (PolyRow (RowRep (Rep Word
_ SmallArray (f Any)
arr))) =
  let n :: Int
n = SmallArray (f Any) -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray (f Any)
arr
      go :: Int -> m [g (ZonkAny 1)]
go Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n    = [g (ZonkAny 1)] -> m [g (ZonkAny 1)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        | Bool
otherwise = (:) (g (ZonkAny 1) -> [g (ZonkAny 1)] -> [g (ZonkAny 1)])
-> m (g (ZonkAny 1)) -> m ([g (ZonkAny 1)] -> [g (ZonkAny 1)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (ZonkAny 1) -> m (g (ZonkAny 1))
forall a. f a -> m (g a)
f (f Any -> f (ZonkAny 1)
forall a b. a -> b
unsafeCoerce (SmallArray (f Any) -> Int -> f Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (f Any)
arr Int
i)) m ([g (ZonkAny 1)] -> [g (ZonkAny 1)])
-> m [g (ZonkAny 1)] -> m [g (ZonkAny 1)]
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> m [g (ZonkAny 1)]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  in ([g (ZonkAny 1)] -> PolyRow r g)
-> m [g (ZonkAny 1)] -> m (PolyRow r g)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[g (ZonkAny 1)]
res -> RowRep g 'ProductRowT r () -> PolyRow r g
forall (r :: Row) (context :: * -> *).
RowRep context 'ProductRowT r () -> PolyRow r context
PolyRow (Rep g () -> RowRep g 'ProductRowT r ()
forall {k} k1 (f :: * -> *) (r :: RowType) (row :: k1) (a :: k).
Rep f a -> RowRep f r row a
RowRep (Word -> SmallArray (g Any) -> Rep g ()
forall {k} (f :: * -> *) (a :: k).
Word -> SmallArray (f Any) -> Rep f a
Rep Word
0 ([g Any] -> SmallArray (g Any)
forall a. [a] -> SmallArray a
smallArrayFromList ((g (ZonkAny 1) -> g Any) -> [g (ZonkAny 1)] -> [g Any]
forall a b. (a -> b) -> [a] -> [b]
map g (ZonkAny 1) -> g Any
forall a b. a -> b
unsafeCoerce [g (ZonkAny 1)]
res))))) (Int -> m [g (ZonkAny 1)]
go Int
0)

-- | Zip two columnar records slot-by-slot in a tight vector loop.
hzipWith :: forall r f g h. Rel8ableRow r
  => (forall a. f a -> g a -> h a) -> PolyRow r f -> PolyRow r g -> PolyRow r h
hzipWith :: forall (r :: Row) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Rel8ableRow r =>
(forall a. f a -> g a -> h a)
-> PolyRow r f -> PolyRow r g -> PolyRow r h
hzipWith forall a. f a -> g a -> h a
f (PolyRow (RowRep (Rep Word
_ SmallArray (f Any)
a))) (PolyRow (RowRep (Rep Word
_ SmallArray (g Any)
b))) =
  let n :: Int
n = SmallArray (f Any) -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray (f Any)
a
      vals :: [h Any]
vals = [h (ZonkAny 0) -> h Any
forall a b. a -> b
unsafeCoerce (f (ZonkAny 0) -> g (ZonkAny 0) -> h (ZonkAny 0)
forall a. f a -> g a -> h a
f (f Any -> f (ZonkAny 0)
forall a b. a -> b
unsafeCoerce (SmallArray (f Any) -> Int -> f Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (f Any)
a Int
i)) (g Any -> g (ZonkAny 0)
forall a b. a -> b
unsafeCoerce (SmallArray (g Any) -> Int -> g Any
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (g Any)
b Int
i))) | Int
i <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
  in RowRep h 'ProductRowT r () -> PolyRow r h
forall (r :: Row) (context :: * -> *).
RowRep context 'ProductRowT r () -> PolyRow r context
PolyRow (Rep h () -> RowRep h 'ProductRowT r ()
forall {k} k1 (f :: * -> *) (r :: RowType) (row :: k1) (a :: k).
Rep f a -> RowRep f r row a
RowRep (Word -> SmallArray (h Any) -> Rep h ()
forall {k} (f :: * -> *) (a :: k).
Word -> SmallArray (f Any) -> Rep f a
Rep Word
0 ([h Any] -> SmallArray (h Any)
forall a. [a] -> SmallArray a
smallArrayFromList [h Any]
vals)))