{-# language AllowAmbiguousTypes #-}
{-# language ConstraintKinds #-}
{-# language DataKinds #-}
{-# language DeriveAnyClass #-}
{-# language DeriveFunctor #-}
{-# language DeriveGeneric #-}
{-# language DerivingVia #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language LambdaCase #-}
{-# language MultiParamTypeClasses #-}
{-# language NamedFieldPuns #-}
{-# language RankNTypes #-}
{-# language RecordWildCards #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}

module Rel8.Schema.HTable.Vectorize
  ( HVectorize
  , hvectorize, hvectorizeA, hunvectorize
  , hnullify
  , happend, hempty
  , hproject
  , htraverseVectorP
  , hcolumn
  , First (..)
  )
where

-- base
import Data.Kind ( Constraint, Type )
import Data.List.NonEmpty ( NonEmpty )
import qualified Data.Semigroup as Base
import GHC.Generics (Generic)
import Prelude

-- product-profunctors
import Data.Profunctor.Product (ProductProfunctor)

-- profunctors
import Data.Profunctor (dimap)

-- rel8
import Rel8.FCF ( Eval, Exp )
import Rel8.Schema.Dict ( Dict( Dict ) )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.HTable
  ( HField, HTable, hfield, htabulate, htabulateA, hspecs
  , htraversePWithField
  )
import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
import Rel8.Schema.HTable.MapTable
  ( HMapTable( HMapTable ), HMapTableField( HMapTableField )
  , MapSpec, mapInfo
  , Precompose( Precompose )
  )
import qualified Rel8.Schema.HTable.MapTable as HMapTable ( hproject )
import Rel8.Schema.HTable.Nullify (HNullify (HNullify))
import Rel8.Schema.Null (Nullify, Unnullify, NotNull, Nullity (NotNull))
import Rel8.Schema.Spec ( Spec(..) )
import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )
import Rel8.Type.Information ( TypeInformation )

-- semialign
import Data.Align (Semialign, alignWith)
import Data.Zip (Unzip, Zip, Zippy(..), zipWith)

-- semigroupoids
import Data.Functor.Apply (Apply)


type Vector :: (Type -> Type) -> Constraint
class Vector list where
  listNotNull :: proxy a -> Dict NotNull (list a)
  vectorTypeInformation :: ()
    => Nullity a
    -> TypeInformation (Unnullify a)
    -> TypeInformation (list a)


instance Vector [] where
  listNotNull :: forall (proxy :: * -> *) a. proxy a -> Dict NotNull [a]
listNotNull proxy a
_ = Dict NotNull [a]
forall {a} (c :: a -> Constraint) (a1 :: a). c a1 => Dict c a1
Dict
  vectorTypeInformation :: forall a.
Nullity a -> TypeInformation (Unnullify a) -> TypeInformation [a]
vectorTypeInformation = Nullity a -> TypeInformation (Unnullify a) -> TypeInformation [a]
forall a.
Nullity a -> TypeInformation (Unnullify a) -> TypeInformation [a]
listTypeInformation


instance Vector NonEmpty where
  listNotNull :: forall (proxy :: * -> *) a. proxy a -> Dict NotNull (NonEmpty a)
listNotNull proxy a
_ = Dict NotNull (NonEmpty a)
forall {a} (c :: a -> Constraint) (a1 :: a). c a1 => Dict c a1
Dict
  vectorTypeInformation :: forall a.
Nullity a
-> TypeInformation (Unnullify a) -> TypeInformation (NonEmpty a)
vectorTypeInformation = Nullity a
-> TypeInformation (Unnullify a) -> TypeInformation (NonEmpty a)
forall a.
Nullity a
-> TypeInformation (Unnullify a) -> TypeInformation (NonEmpty a)
nonEmptyTypeInformation


type HVectorize :: (Type -> Type) -> K.HTable -> K.HTable
newtype HVectorize list table context = HVectorize (HMapTable (Vectorize list) table context)
  deriving stock (forall x.
 HVectorize list table context
 -> Rep (HVectorize list table context) x)
-> (forall x.
    Rep (HVectorize list table context) x
    -> HVectorize list table context)
-> Generic (HVectorize list table context)
forall x.
Rep (HVectorize list table context) x
-> HVectorize list table context
forall x.
HVectorize list table context
-> Rep (HVectorize list table context) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (list :: * -> *) (table :: HTable) (context :: * -> *) x.
Rep (HVectorize list table context) x
-> HVectorize list table context
forall (list :: * -> *) (table :: HTable) (context :: * -> *) x.
HVectorize list table context
-> Rep (HVectorize list table context) x
$cfrom :: forall (list :: * -> *) (table :: HTable) (context :: * -> *) x.
HVectorize list table context
-> Rep (HVectorize list table context) x
from :: forall x.
HVectorize list table context
-> Rep (HVectorize list table context) x
$cto :: forall (list :: * -> *) (table :: HTable) (context :: * -> *) x.
Rep (HVectorize list table context) x
-> HVectorize list table context
to :: forall x.
Rep (HVectorize list table context) x
-> HVectorize list table context
Generic
  deriving anyclass HVectorize list table Spec
(forall (context :: * -> *) a.
 HVectorize list table context
 -> HField (HVectorize list table) a -> context a)
-> (forall (context :: * -> *).
    (forall a. HField (HVectorize list table) a -> context a)
    -> HVectorize list table context)
-> (forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
    Apply m =>
    (forall a. f a -> m (g a))
    -> HVectorize list table f -> m (HVectorize list table g))
-> (forall (c :: * -> Constraint).
    HConstrainTable (HVectorize list table) c =>
    HVectorize list table (Dict c))
-> HVectorize list table Spec
-> HTable (HVectorize list table)
forall (context :: * -> *).
(forall a. HField (HVectorize list table) a -> context a)
-> HVectorize list table context
forall (context :: * -> *) a.
HVectorize list table context
-> HField (HVectorize list table) a -> context a
forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
Apply m =>
(forall a. f a -> m (g a))
-> HVectorize list table f -> m (HVectorize list table g)
forall (list :: * -> *) (table :: HTable).
(HTable table, Vector list) =>
HVectorize list table Spec
forall (list :: * -> *) (table :: HTable) (context :: * -> *).
(HTable table, Vector list) =>
(forall a. HField (HVectorize list table) a -> context a)
-> HVectorize list table context
forall (list :: * -> *) (table :: HTable) (context :: * -> *) a.
(HTable table, Vector list) =>
HVectorize list table context
-> HField (HVectorize list table) a -> context a
forall (list :: * -> *) (table :: HTable) (m :: * -> *)
       (f :: * -> *) (g :: * -> *).
(HTable table, Vector list, Apply m) =>
(forall a. f a -> m (g a))
-> HVectorize list table f -> m (HVectorize list table g)
forall (list :: * -> *) (table :: HTable) (c :: * -> Constraint).
(HTable table, Vector list,
 HConstrainTable (HVectorize list table) c) =>
HVectorize list table (Dict c)
forall (c :: * -> Constraint).
HConstrainTable (HVectorize list table) c =>
HVectorize list table (Dict c)
forall (t :: HTable).
(forall (context :: * -> *) a.
 t context -> HField t a -> context a)
-> (forall (context :: * -> *).
    (forall a. HField t a -> context a) -> t context)
-> (forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
    Apply m =>
    (forall a. f a -> m (g a)) -> t f -> m (t g))
-> (forall (c :: * -> Constraint).
    HConstrainTable t c =>
    t (Dict c))
-> t Spec
-> HTable t
$chfield :: forall (list :: * -> *) (table :: HTable) (context :: * -> *) a.
(HTable table, Vector list) =>
HVectorize list table context
-> HField (HVectorize list table) a -> context a
hfield :: forall (context :: * -> *) a.
HVectorize list table context
-> HField (HVectorize list table) a -> context a
$chtabulate :: forall (list :: * -> *) (table :: HTable) (context :: * -> *).
(HTable table, Vector list) =>
(forall a. HField (HVectorize list table) a -> context a)
-> HVectorize list table context
htabulate :: forall (context :: * -> *).
(forall a. HField (HVectorize list table) a -> context a)
-> HVectorize list table context
$chtraverse :: forall (list :: * -> *) (table :: HTable) (m :: * -> *)
       (f :: * -> *) (g :: * -> *).
(HTable table, Vector list, Apply m) =>
(forall a. f a -> m (g a))
-> HVectorize list table f -> m (HVectorize list table g)
htraverse :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *).
Apply m =>
(forall a. f a -> m (g a))
-> HVectorize list table f -> m (HVectorize list table g)
$chdicts :: forall (list :: * -> *) (table :: HTable) (c :: * -> Constraint).
(HTable table, Vector list,
 HConstrainTable (HVectorize list table) c) =>
HVectorize list table (Dict c)
hdicts :: forall (c :: * -> Constraint).
HConstrainTable (HVectorize list table) c =>
HVectorize list table (Dict c)
$chspecs :: forall (list :: * -> *) (table :: HTable).
(HTable table, Vector list) =>
HVectorize list table Spec
hspecs :: HVectorize list table Spec
HTable


data Vectorize :: (Type -> Type) -> Type -> Exp Type


type instance Eval (Vectorize list a) = list a


instance Vector list => MapSpec (Vectorize list) where
  mapInfo :: forall x. Spec x -> Spec (Eval (Vectorize list x))
mapInfo = \case
    Spec {[String]
Nullity x
TypeInformation (Unnullify x)
labels :: [String]
info :: TypeInformation (Unnullify x)
nullity :: Nullity x
labels :: forall a. Spec a -> [String]
info :: forall a. Spec a -> TypeInformation (Unnullify a)
nullity :: forall a. Spec a -> Nullity a
..} -> case forall (list :: * -> *) (proxy :: * -> *) a.
Vector list =>
proxy a -> Dict NotNull (list a)
listNotNull @list Nullity x
nullity of
      Dict NotNull (list x)
Dict -> Spec
        { nullity :: Nullity (list x)
nullity = Nullity (list x)
forall a. NotNull a => Nullity a
NotNull
        , info :: TypeInformation (Unnullify (list x))
info = Nullity x
-> TypeInformation (Unnullify x) -> TypeInformation (list x)
forall a.
Nullity a
-> TypeInformation (Unnullify a) -> TypeInformation (list a)
forall (list :: * -> *) a.
Vector list =>
Nullity a
-> TypeInformation (Unnullify a) -> TypeInformation (list a)
vectorTypeInformation Nullity x
nullity TypeInformation (Unnullify x)
info
        , [String]
labels :: [String]
labels :: [String]
..
        }


hvectorize :: (HTable t, Unzip f, Vector list)
  => (forall a. Spec a -> f (context a) -> context' (list a))
  -> f (t context)
  -> HVectorize list t context'
hvectorize :: forall (t :: HTable) (f :: * -> *) (list :: * -> *)
       (context :: * -> *) (context' :: * -> *).
(HTable t, Unzip f, Vector list) =>
(forall a. Spec a -> f (context a) -> context' (list a))
-> f (t context) -> HVectorize list t context'
hvectorize forall a. Spec a -> f (context a) -> context' (list a)
vectorizer f (t context)
as = HMapTable (Vectorize list) t context' -> HVectorize list t context'
forall (list :: * -> *) (table :: HTable) (context :: * -> *).
HMapTable (Vectorize list) table context
-> HVectorize list table context
HVectorize (HMapTable (Vectorize list) t context'
 -> HVectorize list t context')
-> HMapTable (Vectorize list) t context'
-> HVectorize list t context'
forall a b. (a -> b) -> a -> b
$ (forall a. HField (HMapTable (Vectorize list) t) a -> context' a)
-> HMapTable (Vectorize list) t context'
forall (context :: * -> *).
(forall a. HField (HMapTable (Vectorize list) t) a -> context a)
-> HMapTable (Vectorize list) t context
forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate ((forall a. HField (HMapTable (Vectorize list) t) a -> context' a)
 -> HMapTable (Vectorize list) t context')
-> (forall a.
    HField (HMapTable (Vectorize list) t) a -> context' a)
-> HMapTable (Vectorize list) t context'
forall a b. (a -> b) -> a -> b
$ \(HMapTableField HField t a
field) ->
  case t Spec -> HField t a -> Spec a
forall (context :: * -> *) a. t context -> HField t a -> context a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield t Spec
forall (t :: HTable). HTable t => t Spec
hspecs HField t a
field of
    Spec a
spec -> Spec a -> f (context a) -> context' (list a)
forall a. Spec a -> f (context a) -> context' (list a)
vectorizer Spec a
spec ((t context -> context a) -> f (t context) -> f (context a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t context -> HField t a -> context a
forall (context :: * -> *) a. t context -> HField t a -> context a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
`hfield` HField t a
field) f (t context)
as)
{-# INLINABLE hvectorize #-}


hvectorizeA :: (HTable t, Apply f, Vector list)
  => (forall a. Spec a -> HField t a -> f (context' (list a)))
  -> f (HVectorize list t context')
hvectorizeA :: forall (t :: HTable) (f :: * -> *) (list :: * -> *)
       (context' :: * -> *).
(HTable t, Apply f, Vector list) =>
(forall a. Spec a -> HField t a -> f (context' (list a)))
-> f (HVectorize list t context')
hvectorizeA forall a. Spec a -> HField t a -> f (context' (list a))
vectorizer = (HMapTable (Vectorize list) t context'
 -> HVectorize list t context')
-> f (HMapTable (Vectorize list) t context')
-> f (HVectorize list t context')
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HMapTable (Vectorize list) t context' -> HVectorize list t context'
forall (list :: * -> *) (table :: HTable) (context :: * -> *).
HMapTable (Vectorize list) table context
-> HVectorize list table context
HVectorize (f (HMapTable (Vectorize list) t context')
 -> f (HVectorize list t context'))
-> f (HMapTable (Vectorize list) t context')
-> f (HVectorize list t context')
forall a b. (a -> b) -> a -> b
$
  (forall a.
 HField (HMapTable (Vectorize list) t) a -> f (context' a))
-> f (HMapTable (Vectorize list) t context')
forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA ((forall a.
  HField (HMapTable (Vectorize list) t) a -> f (context' a))
 -> f (HMapTable (Vectorize list) t context'))
-> (forall a.
    HField (HMapTable (Vectorize list) t) a -> f (context' a))
-> f (HMapTable (Vectorize list) t context')
forall a b. (a -> b) -> a -> b
$ \(HMapTableField HField t a
field) ->
    case t Spec -> HField t a -> Spec a
forall (context :: * -> *) a. t context -> HField t a -> context a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield t Spec
forall (t :: HTable). HTable t => t Spec
hspecs HField t a
field of
      Spec a
spec -> Spec a -> HField t a -> f (context' (list a))
forall a. Spec a -> HField t a -> f (context' (list a))
vectorizer Spec a
spec HField t a
field
{-# INLINABLE hvectorizeA #-}


hunvectorize :: (HTable t, Zip f, Vector list)
  => (forall a. Spec a -> context (list a) -> f (context' a))
  -> HVectorize list t context
  -> f (t context')
hunvectorize :: forall (t :: HTable) (f :: * -> *) (list :: * -> *)
       (context :: * -> *) (context' :: * -> *).
(HTable t, Zip f, Vector list) =>
(forall a. Spec a -> context (list a) -> f (context' a))
-> HVectorize list t context -> f (t context')
hunvectorize forall a. Spec a -> context (list a) -> f (context' a)
unvectorizer (HVectorize HMapTable (Vectorize list) t context
table) =
  Zippy f (t context') -> f (t context')
forall (f :: * -> *) a. Zippy f a -> f a
getZippy (Zippy f (t context') -> f (t context'))
-> Zippy f (t context') -> f (t context')
forall a b. (a -> b) -> a -> b
$ (forall a. HField t a -> Zippy f (context' a))
-> Zippy f (t context')
forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA ((forall a. HField t a -> Zippy f (context' a))
 -> Zippy f (t context'))
-> (forall a. HField t a -> Zippy f (context' a))
-> Zippy f (t context')
forall a b. (a -> b) -> a -> b
$ \HField t a
field -> case t Spec -> HField t a -> Spec a
forall (context :: * -> *) a. t context -> HField t a -> context a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield t Spec
forall (t :: HTable). HTable t => t Spec
hspecs HField t a
field of
    Spec a
spec -> case HMapTable (Vectorize list) t context
-> HField (HMapTable (Vectorize list) t) (list a)
-> context (list a)
forall (context :: * -> *) a.
HMapTable (Vectorize list) t context
-> HField (HMapTable (Vectorize list) t) a -> context a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield HMapTable (Vectorize list) t context
table (HField t a
-> HMapTableField (Vectorize list) t (Eval (Vectorize list a))
forall (t :: HTable) a (f :: * -> * -> *).
HField t a -> HMapTableField f t (Eval (f a))
HMapTableField HField t a
field) of
      context (list a)
a -> f (context' a) -> Zippy f (context' a)
forall (f :: * -> *) a. f a -> Zippy f a
Zippy (Spec a -> context (list a) -> f (context' a)
forall a. Spec a -> context (list a) -> f (context' a)
unvectorizer Spec a
spec context (list a)
a)
{-# INLINABLE hunvectorize #-}


happend :: (HTable t, Vector list)
  => (forall a. Spec a -> context (list a) -> context (list a) -> context (list a))
  -> HVectorize list t context
  -> HVectorize list t context
  -> HVectorize list t context
happend :: forall (t :: HTable) (list :: * -> *) (context :: * -> *).
(HTable t, Vector list) =>
(forall a.
 Spec a -> context (list a) -> context (list a) -> context (list a))
-> HVectorize list t context
-> HVectorize list t context
-> HVectorize list t context
happend forall a.
Spec a -> context (list a) -> context (list a) -> context (list a)
append (HVectorize HMapTable (Vectorize list) t context
as) (HVectorize HMapTable (Vectorize list) t context
bs) = HMapTable (Vectorize list) t context -> HVectorize list t context
forall (list :: * -> *) (table :: HTable) (context :: * -> *).
HMapTable (Vectorize list) table context
-> HVectorize list table context
HVectorize (HMapTable (Vectorize list) t context -> HVectorize list t context)
-> HMapTable (Vectorize list) t context
-> HVectorize list t context
forall a b. (a -> b) -> a -> b
$
  (forall a. HField (HMapTable (Vectorize list) t) a -> context a)
-> HMapTable (Vectorize list) t context
forall (context :: * -> *).
(forall a. HField (HMapTable (Vectorize list) t) a -> context a)
-> HMapTable (Vectorize list) t context
forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate ((forall a. HField (HMapTable (Vectorize list) t) a -> context a)
 -> HMapTable (Vectorize list) t context)
-> (forall a. HField (HMapTable (Vectorize list) t) a -> context a)
-> HMapTable (Vectorize list) t context
forall a b. (a -> b) -> a -> b
$ \field :: HField (HMapTable (Vectorize list) t) a
field@(HMapTableField HField t a
j) -> case (HMapTable (Vectorize list) t context
-> HField (HMapTable (Vectorize list) t) (list a)
-> context (list a)
forall (context :: * -> *) a.
HMapTable (Vectorize list) t context
-> HField (HMapTable (Vectorize list) t) a -> context a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield HMapTable (Vectorize list) t context
as HField (HMapTable (Vectorize list) t) a
HField (HMapTable (Vectorize list) t) (list a)
field, HMapTable (Vectorize list) t context
-> HField (HMapTable (Vectorize list) t) (list a)
-> context (list a)
forall (context :: * -> *) a.
HMapTable (Vectorize list) t context
-> HField (HMapTable (Vectorize list) t) a -> context a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield HMapTable (Vectorize list) t context
bs HField (HMapTable (Vectorize list) t) a
HField (HMapTable (Vectorize list) t) (list a)
field) of
    (context (list a)
a, context (list a)
b) -> case t Spec -> HField t a -> Spec a
forall (context :: * -> *) a. t context -> HField t a -> context a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield t Spec
forall (t :: HTable). HTable t => t Spec
hspecs HField t a
j of
      Spec a
spec -> Spec a -> context (list a) -> context (list a) -> context (list a)
forall a.
Spec a -> context (list a) -> context (list a) -> context (list a)
append Spec a
spec context (list a)
a context (list a)
b


hempty :: HTable t
  => (forall a. Spec a -> context [a])
  -> HVectorize [] t context
hempty :: forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. Spec a -> context [a]) -> HVectorize [] t context
hempty forall a. Spec a -> context [a]
empty = HMapTable (Vectorize []) t context -> HVectorize [] t context
forall (list :: * -> *) (table :: HTable) (context :: * -> *).
HMapTable (Vectorize list) table context
-> HVectorize list table context
HVectorize (HMapTable (Vectorize []) t context -> HVectorize [] t context)
-> HMapTable (Vectorize []) t context -> HVectorize [] t context
forall a b. (a -> b) -> a -> b
$ (forall a. HField (HMapTable (Vectorize []) t) a -> context a)
-> HMapTable (Vectorize []) t context
forall (context :: * -> *).
(forall a. HField (HMapTable (Vectorize []) t) a -> context a)
-> HMapTable (Vectorize []) t context
forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate ((forall a. HField (HMapTable (Vectorize []) t) a -> context a)
 -> HMapTable (Vectorize []) t context)
-> (forall a. HField (HMapTable (Vectorize []) t) a -> context a)
-> HMapTable (Vectorize []) t context
forall a b. (a -> b) -> a -> b
$ \(HMapTableField HField t a
field) ->
  Spec a -> context [a]
forall a. Spec a -> context [a]
empty (t Spec -> HField t a -> Spec a
forall (context :: * -> *) a. t context -> HField t a -> context a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield t Spec
forall (t :: HTable). HTable t => t Spec
hspecs HField t a
field)


hproject :: ()
  => (forall ctx. t ctx -> t' ctx)
  -> HVectorize list t context -> HVectorize list t' context
hproject :: forall (t :: HTable) (t' :: HTable) (list :: * -> *)
       (context :: * -> *).
(forall (ctx :: * -> *). t ctx -> t' ctx)
-> HVectorize list t context -> HVectorize list t' context
hproject forall (ctx :: * -> *). t ctx -> t' ctx
f (HVectorize HMapTable (Vectorize list) t context
a) = HMapTable (Vectorize list) t' context -> HVectorize list t' context
forall (list :: * -> *) (table :: HTable) (context :: * -> *).
HMapTable (Vectorize list) table context
-> HVectorize list table context
HVectorize ((forall (ctx :: * -> *). t ctx -> t' ctx)
-> HMapTable (Vectorize list) t context
-> HMapTable (Vectorize list) t' context
forall (t :: HTable) (t' :: HTable) (f :: * -> * -> *)
       (context :: * -> *).
(forall (ctx :: * -> *). t ctx -> t' ctx)
-> HMapTable f t context -> HMapTable f t' context
HMapTable.hproject t ctx -> t' ctx
forall (ctx :: * -> *). t ctx -> t' ctx
f HMapTable (Vectorize list) t context
a)


htraverseVectorP :: (HTable t, ProductProfunctor p)
  => (forall a. HField t a -> p (f (list a)) (g (list' a)))
  -> p (HVectorize list t f) (HVectorize list' t g)
htraverseVectorP :: forall (t :: HTable) (p :: * -> * -> *) (f :: * -> *)
       (list :: * -> *) (g :: * -> *) (list' :: * -> *).
(HTable t, ProductProfunctor p) =>
(forall a. HField t a -> p (f (list a)) (g (list' a)))
-> p (HVectorize list t f) (HVectorize list' t g)
htraverseVectorP forall a. HField t a -> p (f (list a)) (g (list' a))
f =
  (HVectorize list t f -> t (Precompose (Vectorize list) f))
-> (t (Precompose (Vectorize list') g) -> HVectorize list' t g)
-> p (t (Precompose (Vectorize list) f))
     (t (Precompose (Vectorize list') g))
-> p (HVectorize list t f) (HVectorize list' t g)
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (\(HVectorize (HMapTable t (Precompose (Vectorize list) f)
a)) -> t (Precompose (Vectorize list) f)
a) (HMapTable (Vectorize list') t g -> HVectorize list' t g
forall (list :: * -> *) (table :: HTable) (context :: * -> *).
HMapTable (Vectorize list) table context
-> HVectorize list table context
HVectorize (HMapTable (Vectorize list') t g -> HVectorize list' t g)
-> (t (Precompose (Vectorize list') g)
    -> HMapTable (Vectorize list') t g)
-> t (Precompose (Vectorize list') g)
-> HVectorize list' t g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (Precompose (Vectorize list') g)
-> HMapTable (Vectorize list') t g
forall (f :: * -> * -> *) (t :: HTable) (context :: * -> *).
t (Precompose f context) -> HMapTable f t context
HMapTable) (p (t (Precompose (Vectorize list) f))
   (t (Precompose (Vectorize list') g))
 -> p (HVectorize list t f) (HVectorize list' t g))
-> p (t (Precompose (Vectorize list) f))
     (t (Precompose (Vectorize list') g))
-> p (HVectorize list t f) (HVectorize list' t g)
forall a b. (a -> b) -> a -> b
$
    (forall a.
 HField t a
 -> p (Precompose (Vectorize list) f a)
      (Precompose (Vectorize list') g a))
-> p (t (Precompose (Vectorize list) f))
     (t (Precompose (Vectorize list') g))
forall (t :: HTable) (p :: * -> * -> *) (f :: * -> *)
       (g :: * -> *).
(HTable t, ProductProfunctor p) =>
(forall a. HField t a -> p (f a) (g a)) -> p (t f) (t g)
htraversePWithField ((forall a.
  HField t a
  -> p (Precompose (Vectorize list) f a)
       (Precompose (Vectorize list') g a))
 -> p (t (Precompose (Vectorize list) f))
      (t (Precompose (Vectorize list') g)))
-> (forall a.
    HField t a
    -> p (Precompose (Vectorize list) f a)
         (Precompose (Vectorize list') g a))
-> p (t (Precompose (Vectorize list) f))
     (t (Precompose (Vectorize list') g))
forall a b. (a -> b) -> a -> b
$ \HField t a
field ->
      (Precompose (Vectorize list) f a -> f (list a))
-> (g (list' a) -> Precompose (Vectorize list') g a)
-> p (f (list a)) (g (list' a))
-> p (Precompose (Vectorize list) f a)
     (Precompose (Vectorize list') g a)
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (\(Precompose f (Eval (Vectorize list a))
a) -> f (list a)
f (Eval (Vectorize list a))
a) g (list' a) -> Precompose (Vectorize list') g a
g (Eval (Vectorize list' a)) -> Precompose (Vectorize list') g a
forall (f :: * -> * -> *) (g :: * -> *) x.
g (Eval (f x)) -> Precompose f g x
Precompose (HField t a -> p (f (list a)) (g (list' a))
forall a. HField t a -> p (f (list a)) (g (list' a))
f HField t a
field)


hcolumn :: HVectorize list (HIdentity a) context -> context (list a)
hcolumn :: forall (list :: * -> *) a (context :: * -> *).
HVectorize list (HIdentity a) context -> context (list a)
hcolumn (HVectorize (HMapTable (HIdentity (Precompose context (Eval (Vectorize list a))
a)))) = context (list a)
context (Eval (Vectorize list a))
a


hnullify :: forall t list context. (HTable t, Vector list)
  => (forall a. Spec a -> context (list a) -> context (Nullify a))
  -> HVectorize list t context
  -> HNullify t context
hnullify :: forall (t :: HTable) (list :: * -> *) (context :: * -> *).
(HTable t, Vector list) =>
(forall a. Spec a -> context (list a) -> context (Nullify a))
-> HVectorize list t context -> HNullify t context
hnullify forall a. Spec a -> context (list a) -> context (Nullify a)
f (HVectorize HMapTable (Vectorize list) t context
table) = HMapTable Nullify t context -> HNullify t context
forall (table :: HTable) (context :: * -> *).
HMapTable Nullify table context -> HNullify table context
HNullify (HMapTable Nullify t context -> HNullify t context)
-> HMapTable Nullify t context -> HNullify t context
forall a b. (a -> b) -> a -> b
$
  (forall a. HField (HMapTable Nullify t) a -> context a)
-> HMapTable Nullify t context
forall (context :: * -> *).
(forall a. HField (HMapTable Nullify t) a -> context a)
-> HMapTable Nullify t context
forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate ((forall a. HField (HMapTable Nullify t) a -> context a)
 -> HMapTable Nullify t context)
-> (forall a. HField (HMapTable Nullify t) a -> context a)
-> HMapTable Nullify t context
forall a b. (a -> b) -> a -> b
$ \(HMapTableField HField t a
field) -> case t Spec -> HField t a -> Spec a
forall (context :: * -> *) a. t context -> HField t a -> context a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield t Spec
forall (t :: HTable). HTable t => t Spec
hspecs HField t a
field of
    Spec a
spec -> case HMapTable (Vectorize list) t context
-> HField (HMapTable (Vectorize list) t) (list a)
-> context (list a)
forall (context :: * -> *) a.
HMapTable (Vectorize list) t context
-> HField (HMapTable (Vectorize list) t) a -> context a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield HMapTable (Vectorize list) t context
table (HField t a
-> HMapTableField (Vectorize list) t (Eval (Vectorize list a))
forall (t :: HTable) a (f :: * -> * -> *).
HField t a -> HMapTableField f t (Eval (f a))
HMapTableField HField t a
field) of
      context (list a)
a -> Spec a
-> context (list a) -> context (Maybe (Unnullify' (IsMaybe a) a))
forall a. Spec a -> context (list a) -> context (Nullify a)
f Spec a
spec context (list a)
a


newtype First a b = First {forall a b. First a b -> a
getFirst :: a}
  deriving stock (forall a b. (a -> b) -> First a a -> First a b)
-> (forall a b. a -> First a b -> First a a) -> Functor (First a)
forall a b. a -> First a b -> First a a
forall a b. (a -> b) -> First a a -> First a b
forall a a b. a -> First a b -> First a a
forall a a b. (a -> b) -> First a a -> First a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b. (a -> b) -> First a a -> First a b
fmap :: forall a b. (a -> b) -> First a a -> First a b
$c<$ :: forall a a b. a -> First a b -> First a a
<$ :: forall a b. a -> First a b -> First a a
Functor
  deriving (NonEmpty (First a b) -> First a b
First a b -> First a b -> First a b
(First a b -> First a b -> First a b)
-> (NonEmpty (First a b) -> First a b)
-> (forall b. Integral b => b -> First a b -> First a b)
-> Semigroup (First a b)
forall b. Integral b => b -> First a b -> First a b
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall b a. NonEmpty (First a b) -> First a b
forall b a. First a b -> First a b -> First a b
forall b a b. Integral b => b -> First a b -> First a b
$c<> :: forall b a. First a b -> First a b -> First a b
<> :: First a b -> First a b -> First a b
$csconcat :: forall b a. NonEmpty (First a b) -> First a b
sconcat :: NonEmpty (First a b) -> First a b
$cstimes :: forall b a b. Integral b => b -> First a b -> First a b
stimes :: forall b. Integral b => b -> First a b -> First a b
Semigroup) via (Base.First a)


instance Semialign (First a) where
  alignWith :: forall a b c.
(These a b -> c) -> First a a -> First a b -> First a c
alignWith These a b -> c
_ (First a
a) First a b
_ = a -> First a c
forall a b. a -> First a b
First a
a


instance Zip (First a) where
  zipWith :: forall a b c. (a -> b -> c) -> First a a -> First a b -> First a c
zipWith a -> b -> c
_ (First a
a) First a b
_ = a -> First a c
forall a b. a -> First a b
First a
a