{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Data.DataFrame.Internal.Column where

import qualified Data.ByteString.Char8 as C
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Vector.Algorithms.Merge as VA
import qualified Data.Vector.Generic as VG
import qualified Data.Vector as VB
import qualified Data.Vector.Mutable as VBM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM

import Control.Monad.ST (runST)
import Data.DataFrame.Internal.Function
import Data.DataFrame.Internal.Types
import Data.DataFrame.Internal.Parsing
import Data.Int
import Data.Maybe
import Data.Text.Encoding (decodeUtf8Lenient)
import Data.Type.Equality (type (:~:)(Refl), TestEquality (..))
import Data.Typeable (Typeable)
import Data.Word
import Type.Reflection

-- | Our representation of a column is a GADT that can store data in either
-- a vector with boxed elements or
data Column where
  BoxedColumn :: Columnable a => VB.Vector a -> Column
  UnboxedColumn :: (Columnable a, VU.Unbox a) => VU.Vector a -> Column
  OptionalColumn :: Columnable a => VB.Vector (Maybe a) -> Column
  GroupedBoxedColumn :: Columnable a => VB.Vector (VB.Vector a) -> Column
  GroupedUnboxedColumn :: (Columnable a, VU.Unbox a) => VB.Vector (VU.Vector a) -> Column
  GroupedOptionalColumn :: (Columnable a) => VB.Vector (VB.Vector (Maybe a)) -> Column
  MutableBoxedColumn :: Columnable a => VBM.IOVector a -> Column
  MutableUnboxedColumn :: (Columnable a, VU.Unbox a) => VUM.IOVector a -> Column

-- Functions about column metadata.
isGrouped :: Column -> Bool
isGrouped :: Column -> Bool
isGrouped (GroupedBoxedColumn Vector (Vector a)
column) = Bool
True
isGrouped (GroupedUnboxedColumn Vector (Vector a)
column) = Bool
True
isGrouped Column
_ = Bool
False

columnVersionString :: Column -> String
columnVersionString :: Column -> String
columnVersionString Column
column = case Column
column of
  BoxedColumn Vector a
_ -> String
"Boxed"
  UnboxedColumn Vector a
_ -> String
"Unboxed"
  OptionalColumn Vector (Maybe a)
_ -> String
"Optional"
  GroupedBoxedColumn Vector (Vector a)
_ -> String
"Grouped Boxed"
  GroupedUnboxedColumn Vector (Vector a)
_ -> String
"Grouped Unboxed"
  GroupedOptionalColumn Vector (Vector (Maybe a))
_ -> String
"Grouped Optional"

columnTypeString :: Column -> String
columnTypeString :: Column -> String
columnTypeString Column
column = case Column
column of
  BoxedColumn (Vector a
column :: VB.Vector a) -> TypeRep a -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)
  UnboxedColumn (Vector a
column :: VU.Vector a) -> TypeRep a -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)
  OptionalColumn (Vector (Maybe a)
column :: VB.Vector a) -> TypeRep (Maybe a) -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)
  GroupedBoxedColumn (Vector (Vector a)
column :: VB.Vector a) -> TypeRep (Vector a) -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)
  GroupedUnboxedColumn (Vector (Vector a)
column :: VB.Vector a) -> TypeRep (Vector a) -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)
  GroupedOptionalColumn (Vector (Vector (Maybe a))
column :: VB.Vector a) -> TypeRep (Vector (Maybe a)) -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)

instance Show Column where
  show :: Column -> String
  show :: Column -> String
show (BoxedColumn Vector a
column) = Vector a -> String
forall a. Show a => a -> String
show Vector a
column
  show (UnboxedColumn Vector a
column) = Vector a -> String
forall a. Show a => a -> String
show Vector a
column
  show (OptionalColumn Vector (Maybe a)
column) = Vector (Maybe a) -> String
forall a. Show a => a -> String
show Vector (Maybe a)
column
  show (GroupedBoxedColumn Vector (Vector a)
column) = Vector (Vector a) -> String
forall a. Show a => a -> String
show Vector (Vector a)
column
  show (GroupedUnboxedColumn Vector (Vector a)
column) = Vector (Vector a) -> String
forall a. Show a => a -> String
show Vector (Vector a)
column

instance Eq Column where
  (==) :: Column -> Column -> Bool
  == :: Column -> Column -> Bool
(==) (BoxedColumn (Vector a
a :: VB.Vector t1)) (BoxedColumn (Vector a
b :: VB.Vector t2)) =
    case TypeRep a -> TypeRep a -> Maybe (a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t1) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t2) of
      Maybe (a :~: a)
Nothing -> Bool
False
      Just a :~: a
Refl -> Vector a
a Vector a -> Vector a -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a
Vector a
b
  (==) (OptionalColumn (Vector (Maybe a)
a :: VB.Vector t1)) (OptionalColumn (Vector (Maybe a)
b :: VB.Vector t2)) =
    case TypeRep (Maybe a)
-> TypeRep (Maybe a) -> Maybe (Maybe a :~: Maybe a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t1) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t2) of
      Maybe (Maybe a :~: Maybe a)
Nothing -> Bool
False
      Just Maybe a :~: Maybe a
Refl -> Vector (Maybe a)
a Vector (Maybe a) -> Vector (Maybe a) -> Bool
forall a. Eq a => a -> a -> Bool
== Vector (Maybe a)
Vector (Maybe a)
b
  (==) (UnboxedColumn (Vector a
a :: VU.Vector t1)) (UnboxedColumn (Vector a
b :: VU.Vector t2)) =
    case TypeRep a -> TypeRep a -> Maybe (a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t1) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t2) of
      Maybe (a :~: a)
Nothing -> Bool
False
      Just a :~: a
Refl -> Vector a
a Vector a -> Vector a -> Bool
forall a. Eq a => a -> a -> Bool
== Vector a
Vector a
b
  -- Note: comparing grouped columns is expensive. We do this for stable tests
  -- but also you should probably aggregate grouped columns soon after creating them.
  (==) (GroupedBoxedColumn (Vector (Vector a)
a :: VB.Vector t1)) (GroupedBoxedColumn (Vector (Vector a)
b :: VB.Vector t2)) =
    case TypeRep (Vector a)
-> TypeRep (Vector a) -> Maybe (Vector a :~: Vector a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t1) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t2) of
      Maybe (Vector a :~: Vector a)
Nothing -> Bool
False
      Just Vector a :~: Vector a
Refl -> (Vector a -> [a]) -> Vector (Vector a) -> Vector [a]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map ([a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort ([a] -> [a]) -> (Vector a -> [a]) -> Vector a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall (v :: * -> *) a. Vector v a => v a -> [a]
VG.toList) Vector (Vector a)
a Vector [a] -> Vector [a] -> Bool
forall a. Eq a => a -> a -> Bool
== (Vector a -> [a]) -> Vector (Vector a) -> Vector [a]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map ([a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort ([a] -> [a]) -> (Vector a -> [a]) -> Vector a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall (v :: * -> *) a. Vector v a => v a -> [a]
VG.toList) Vector (Vector a)
Vector (Vector a)
b
  (==) (GroupedUnboxedColumn (Vector (Vector a)
a :: VB.Vector t1)) (GroupedUnboxedColumn (Vector (Vector a)
b :: VB.Vector t2)) =
    case TypeRep (Vector a)
-> TypeRep (Vector a) -> Maybe (Vector a :~: Vector a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t1) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t2) of
      Maybe (Vector a :~: Vector a)
Nothing -> Bool
False
      Just Vector a :~: Vector a
Refl -> (Vector a -> [a]) -> Vector (Vector a) -> Vector [a]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map ([a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort ([a] -> [a]) -> (Vector a -> [a]) -> Vector a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall (v :: * -> *) a. Vector v a => v a -> [a]
VG.toList) Vector (Vector a)
a Vector [a] -> Vector [a] -> Bool
forall a. Eq a => a -> a -> Bool
== (Vector a -> [a]) -> Vector (Vector a) -> Vector [a]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map ([a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort ([a] -> [a]) -> (Vector a -> [a]) -> Vector a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall (v :: * -> *) a. Vector v a => v a -> [a]
VG.toList) Vector (Vector a)
Vector (Vector a)
b
  (==) (GroupedOptionalColumn (Vector (Vector (Maybe a))
a :: VB.Vector t1)) (GroupedOptionalColumn (Vector (Vector (Maybe a))
b :: VB.Vector t2)) =
    case TypeRep (Vector (Maybe a))
-> TypeRep (Vector (Maybe a))
-> Maybe (Vector (Maybe a) :~: Vector (Maybe a))
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t1) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t2) of
      Maybe (Vector (Maybe a) :~: Vector (Maybe a))
Nothing -> Bool
False
      Just Vector (Maybe a) :~: Vector (Maybe a)
Refl -> (Vector (Maybe a) -> [Maybe a])
-> Vector (Vector (Maybe a)) -> Vector [Maybe a]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map ([Maybe a] -> [Maybe a]
forall a. Ord a => [a] -> [a]
L.sort ([Maybe a] -> [Maybe a])
-> (Vector (Maybe a) -> [Maybe a]) -> Vector (Maybe a) -> [Maybe a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Maybe a) -> [Maybe a]
forall (v :: * -> *) a. Vector v a => v a -> [a]
VG.toList) Vector (Vector (Maybe a))
a Vector [Maybe a] -> Vector [Maybe a] -> Bool
forall a. Eq a => a -> a -> Bool
== (Vector (Maybe a) -> [Maybe a])
-> Vector (Vector (Maybe a)) -> Vector [Maybe a]
forall a b. (a -> b) -> Vector a -> Vector b
VB.map ([Maybe a] -> [Maybe a]
forall a. Ord a => [a] -> [a]
L.sort ([Maybe a] -> [Maybe a])
-> (Vector (Maybe a) -> [Maybe a]) -> Vector (Maybe a) -> [Maybe a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Maybe a) -> [Maybe a]
forall (v :: * -> *) a. Vector v a => v a -> [a]
VG.toList) Vector (Vector (Maybe a))
Vector (Vector (Maybe a))
b
  (==) Column
_ Column
_ = Bool
False

class (Columnable a) => Columnify a where
  -- | Converts a boxed vector to a column making sure to put
  -- the vector into an appropriate column type by reflection on the
  -- vector's type parameter.
  toColumn' :: VB.Vector a -> Column

instance (Columnable a) => Columnify (Maybe a) where
  toColumn' :: Vector (Maybe a) -> Column
toColumn' = Vector (Maybe a) -> Column
forall a. Columnable a => Vector (Maybe a) -> Column
OptionalColumn

instance (Columnable a) => Columnify (VB.Vector a) where
  toColumn' :: Vector (Vector a) -> Column
toColumn' = Vector (Vector a) -> Column
forall a. Columnable a => Vector (Vector a) -> Column
GroupedBoxedColumn

instance (Columnable a, VU.Unbox a) => Columnify (VU.Vector a) where
  toColumn' :: Vector (Vector a) -> Column
toColumn' = Vector (Vector a) -> Column
forall a. (Columnable a, Unbox a) => Vector (Vector a) -> Column
GroupedUnboxedColumn

instance {-# INCOHERENT #-} (Columnable a) => Columnify a where
  toColumn' :: Vector a -> Column
toColumn' Vector a
xs = case TypeRep a -> TypeRep Int -> Maybe (a :~: Int)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Int) of
    Just a :~: Int
Refl -> Vector a -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
VU.convert Vector a
xs)
    Maybe (a :~: Int)
Nothing -> case TypeRep a -> TypeRep Double -> Maybe (a :~: Double)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Double) of
      Just a :~: Double
Refl -> Vector a -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
VU.convert Vector a
xs)
      Maybe (a :~: Double)
Nothing -> case TypeRep a -> TypeRep Float -> Maybe (a :~: Float)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Float) of
        Just a :~: Float
Refl -> Vector a -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
VU.convert Vector a
xs)
        Maybe (a :~: Float)
Nothing -> Vector a -> Column
forall a. Columnable a => Vector a -> Column
BoxedColumn Vector a
xs

class (Columnable a) => ColumnifyList a where
  -- | Converts a boxed vector to a column making sure to put
  -- the vector into an appropriate column type by reflection on the
  -- vector's type parameter.
  toColumn :: [a] -> Column

instance (Columnable a) => ColumnifyList (Maybe a) where
  toColumn :: [Maybe a] -> Column
toColumn = Vector (Maybe a) -> Column
forall a. Columnable a => Vector (Maybe a) -> Column
OptionalColumn (Vector (Maybe a) -> Column)
-> ([Maybe a] -> Vector (Maybe a)) -> [Maybe a] -> Column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe a] -> Vector (Maybe a)
forall a. [a] -> Vector a
VB.fromList

instance {-# INCOHERENT #-} (Columnable a) => ColumnifyList a where
  toColumn :: [a] -> Column
toColumn [a]
xs = case TypeRep a -> TypeRep Int -> Maybe (a :~: Int)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Int) of
    Just a :~: Int
Refl -> Vector a -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn ([a] -> Vector a
forall a. Unbox a => [a] -> Vector a
VU.fromList [a]
xs)
    Maybe (a :~: Int)
Nothing -> case TypeRep a -> TypeRep Double -> Maybe (a :~: Double)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Double) of
      Just a :~: Double
Refl -> Vector a -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn ([a] -> Vector a
forall a. Unbox a => [a] -> Vector a
VU.fromList [a]
xs)
      Maybe (a :~: Double)
Nothing -> case TypeRep a -> TypeRep Float -> Maybe (a :~: Float)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Float) of
        Just a :~: Float
Refl -> Vector a -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn ([a] -> Vector a
forall a. Unbox a => [a] -> Vector a
VU.fromList [a]
xs)
        Maybe (a :~: Float)
Nothing -> Vector a -> Column
forall a. Columnable a => Vector a -> Column
BoxedColumn ([a] -> Vector a
forall a. [a] -> Vector a
VB.fromList [a]
xs)

-- | Converts a an unboxed vector to a column making sure to put
-- the vector into an appropriate column type by reflection on the
-- vector's type parameter.
toColumnUnboxed :: forall a. (Columnable a, VU.Unbox a) => VU.Vector a -> Column
toColumnUnboxed :: forall a. (Columnable a, Unbox a) => Vector a -> Column
toColumnUnboxed = Vector a -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn

-- Functions that don't depend on column type.
-- | O(1) Gets the number of elements in the column.
columnLength :: Column -> Int
columnLength :: Column -> Int
columnLength (BoxedColumn Vector a
xs) = Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector a
xs
columnLength (UnboxedColumn Vector a
xs) = Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector a
xs
columnLength (OptionalColumn Vector (Maybe a)
xs) = Vector (Maybe a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector (Maybe a)
xs
columnLength (GroupedBoxedColumn Vector (Vector a)
xs) = Vector (Vector a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector (Vector a)
xs
columnLength (GroupedUnboxedColumn Vector (Vector a)
xs) = Vector (Vector a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector (Vector a)
xs
columnLength (GroupedOptionalColumn Vector (Vector (Maybe a))
xs) = Vector (Vector (Maybe a)) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector (Vector (Maybe a))
xs
{-# INLINE columnLength #-}

takeColumn :: Int -> Column -> Column
takeColumn :: Int -> Column -> Column
takeColumn Int
n (BoxedColumn Vector a
xs) = Vector a -> Column
forall a. Columnable a => Vector a -> Column
BoxedColumn (Vector a -> Column) -> Vector a -> Column
forall a b. (a -> b) -> a -> b
$ Int -> Vector a -> Vector a
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
VG.take Int
n Vector a
xs
takeColumn Int
n (UnboxedColumn Vector a
xs) = Vector a -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector a -> Column) -> Vector a -> Column
forall a b. (a -> b) -> a -> b
$ Int -> Vector a -> Vector a
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
VG.take Int
n Vector a
xs
takeColumn Int
n (OptionalColumn Vector (Maybe a)
xs) = Vector (Maybe a) -> Column
forall a. Columnable a => Vector (Maybe a) -> Column
OptionalColumn (Vector (Maybe a) -> Column) -> Vector (Maybe a) -> Column
forall a b. (a -> b) -> a -> b
$ Int -> Vector (Maybe a) -> Vector (Maybe a)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
VG.take Int
n Vector (Maybe a)
xs
takeColumn Int
n (GroupedBoxedColumn Vector (Vector a)
xs) = Vector (Vector a) -> Column
forall a. Columnable a => Vector (Vector a) -> Column
GroupedBoxedColumn (Vector (Vector a) -> Column) -> Vector (Vector a) -> Column
forall a b. (a -> b) -> a -> b
$ Int -> Vector (Vector a) -> Vector (Vector a)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
VG.take Int
n Vector (Vector a)
xs
takeColumn Int
n (GroupedUnboxedColumn Vector (Vector a)
xs) = Vector (Vector a) -> Column
forall a. (Columnable a, Unbox a) => Vector (Vector a) -> Column
GroupedUnboxedColumn (Vector (Vector a) -> Column) -> Vector (Vector a) -> Column
forall a b. (a -> b) -> a -> b
$ Int -> Vector (Vector a) -> Vector (Vector a)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
VG.take Int
n Vector (Vector a)
xs
takeColumn Int
n (GroupedOptionalColumn Vector (Vector (Maybe a))
xs) = Vector (Vector (Maybe a)) -> Column
forall a. Columnable a => Vector (Vector (Maybe a)) -> Column
GroupedOptionalColumn (Vector (Vector (Maybe a)) -> Column)
-> Vector (Vector (Maybe a)) -> Column
forall a b. (a -> b) -> a -> b
$ Int -> Vector (Vector (Maybe a)) -> Vector (Vector (Maybe a))
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
VG.take Int
n Vector (Vector (Maybe a))
xs
{-# INLINE takeColumn #-}

-- TODO: Maybe we can remvoe all this boilerplate and make
-- transform take in a generic vector function.
takeLastColumn :: Int -> Column -> Column
takeLastColumn :: Int -> Column -> Column
takeLastColumn Int
n Column
column = Int -> Int -> Column -> Column
sliceColumn (Column -> Int
columnLength Column
column Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Int
n Column
column
{-# INLINE takeLastColumn #-}

sliceColumn :: Int -> Int -> Column -> Column
sliceColumn :: Int -> Int -> Column -> Column
sliceColumn Int
start Int
n (BoxedColumn Vector a
xs) = Vector a -> Column
forall a. Columnable a => Vector a -> Column
BoxedColumn (Vector a -> Column) -> Vector a -> Column
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector a -> Vector a
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
Int -> Int -> v a -> v a
VG.slice Int
start Int
n Vector a
xs
sliceColumn Int
start Int
n (UnboxedColumn Vector a
xs) = Vector a -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector a -> Column) -> Vector a -> Column
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector a -> Vector a
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
Int -> Int -> v a -> v a
VG.slice Int
start Int
n Vector a
xs
sliceColumn Int
start Int
n (OptionalColumn Vector (Maybe a)
xs) = Vector (Maybe a) -> Column
forall a. Columnable a => Vector (Maybe a) -> Column
OptionalColumn (Vector (Maybe a) -> Column) -> Vector (Maybe a) -> Column
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector (Maybe a) -> Vector (Maybe a)
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
Int -> Int -> v a -> v a
VG.slice Int
start Int
n Vector (Maybe a)
xs
sliceColumn Int
start Int
n (GroupedBoxedColumn Vector (Vector a)
xs) = Vector (Vector a) -> Column
forall a. Columnable a => Vector (Vector a) -> Column
GroupedBoxedColumn (Vector (Vector a) -> Column) -> Vector (Vector a) -> Column
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector (Vector a) -> Vector (Vector a)
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
Int -> Int -> v a -> v a
VG.slice Int
start Int
n Vector (Vector a)
xs
sliceColumn Int
start Int
n (GroupedUnboxedColumn Vector (Vector a)
xs) = Vector (Vector a) -> Column
forall a. (Columnable a, Unbox a) => Vector (Vector a) -> Column
GroupedUnboxedColumn (Vector (Vector a) -> Column) -> Vector (Vector a) -> Column
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector (Vector a) -> Vector (Vector a)
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
Int -> Int -> v a -> v a
VG.slice Int
start Int
n Vector (Vector a)
xs
sliceColumn Int
start Int
n (GroupedOptionalColumn Vector (Vector (Maybe a))
xs) = Vector (Vector (Maybe a)) -> Column
forall a. Columnable a => Vector (Vector (Maybe a)) -> Column
GroupedOptionalColumn (Vector (Vector (Maybe a)) -> Column)
-> Vector (Vector (Maybe a)) -> Column
forall a b. (a -> b) -> a -> b
$ Int
-> Int -> Vector (Vector (Maybe a)) -> Vector (Vector (Maybe a))
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
Int -> Int -> v a -> v a
VG.slice Int
start Int
n Vector (Vector (Maybe a))
xs
{-# INLINE sliceColumn #-}

-- TODO: We can probably generalize this to `applyVectorFunction`.
atIndices :: S.Set Int -> Column -> Column
atIndices :: Set Int -> Column -> Column
atIndices Set Int
indexes (BoxedColumn Vector a
column) = Vector a -> Column
forall a. Columnable a => Vector a -> Column
BoxedColumn (Vector a -> Column) -> Vector a -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> Bool) -> Vector a -> Vector a
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter (\Int
i a
_ -> Int
i Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Int
indexes) Vector a
column
atIndices Set Int
indexes (OptionalColumn Vector (Maybe a)
column) = Vector (Maybe a) -> Column
forall a. Columnable a => Vector (Maybe a) -> Column
OptionalColumn (Vector (Maybe a) -> Column) -> Vector (Maybe a) -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe a -> Bool) -> Vector (Maybe a) -> Vector (Maybe a)
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter (\Int
i Maybe a
_ -> Int
i Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Int
indexes) Vector (Maybe a)
column
atIndices Set Int
indexes (UnboxedColumn Vector a
column) = Vector a -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector a -> Column) -> Vector a -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> Bool) -> Vector a -> Vector a
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter (\Int
i a
_ -> Int
i Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Int
indexes) Vector a
column
atIndices Set Int
indexes (GroupedBoxedColumn Vector (Vector a)
column) = Vector (Vector a) -> Column
forall a. Columnable a => Vector (Vector a) -> Column
GroupedBoxedColumn (Vector (Vector a) -> Column) -> Vector (Vector a) -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> Vector a -> Bool) -> Vector (Vector a) -> Vector (Vector a)
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter (\Int
i Vector a
_ -> Int
i Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Int
indexes) Vector (Vector a)
column
atIndices Set Int
indexes (GroupedUnboxedColumn Vector (Vector a)
column) = Vector (Vector a) -> Column
forall a. (Columnable a, Unbox a) => Vector (Vector a) -> Column
GroupedUnboxedColumn (Vector (Vector a) -> Column) -> Vector (Vector a) -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> Vector a -> Bool) -> Vector (Vector a) -> Vector (Vector a)
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter (\Int
i Vector a
_ -> Int
i Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Int
indexes) Vector (Vector a)
column
atIndices Set Int
indexes (GroupedOptionalColumn Vector (Vector (Maybe a))
column) = Vector (Vector (Maybe a)) -> Column
forall a. Columnable a => Vector (Vector (Maybe a)) -> Column
GroupedOptionalColumn (Vector (Vector (Maybe a)) -> Column)
-> Vector (Vector (Maybe a)) -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> Vector (Maybe a) -> Bool)
-> Vector (Vector (Maybe a)) -> Vector (Vector (Maybe a))
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter (\Int
i Vector (Maybe a)
_ -> Int
i Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Int
indexes) Vector (Vector (Maybe a))
column
{-# INLINE atIndices #-}

atIndicesStable :: VU.Vector Int -> Column -> Column
atIndicesStable :: Vector Int -> Column -> Column
atIndicesStable Vector Int
indexes (BoxedColumn Vector a
column) = Vector a -> Column
forall a. Columnable a => Vector a -> Column
BoxedColumn (Vector a -> Column) -> Vector a -> Column
forall a b. (a -> b) -> a -> b
$ Vector Int
indexes Vector Int -> Vector a -> Vector a
forall a. Vector Int -> Vector a -> Vector a
`getIndices` Vector a
column
atIndicesStable Vector Int
indexes (UnboxedColumn Vector a
column) = Vector a -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector a -> Column) -> Vector a -> Column
forall a b. (a -> b) -> a -> b
$ Vector Int
indexes Vector Int -> Vector a -> Vector a
forall a. Unbox a => Vector Int -> Vector a -> Vector a
`getIndicesUnboxed` Vector a
column
atIndicesStable Vector Int
indexes (OptionalColumn Vector (Maybe a)
column) = Vector (Maybe a) -> Column
forall a. Columnable a => Vector (Maybe a) -> Column
OptionalColumn (Vector (Maybe a) -> Column) -> Vector (Maybe a) -> Column
forall a b. (a -> b) -> a -> b
$ Vector Int
indexes Vector Int -> Vector (Maybe a) -> Vector (Maybe a)
forall a. Vector Int -> Vector a -> Vector a
`getIndices` Vector (Maybe a)
column
atIndicesStable Vector Int
indexes (GroupedBoxedColumn Vector (Vector a)
column) = Vector (Vector a) -> Column
forall a. Columnable a => Vector (Vector a) -> Column
GroupedBoxedColumn (Vector (Vector a) -> Column) -> Vector (Vector a) -> Column
forall a b. (a -> b) -> a -> b
$ Vector Int
indexes Vector Int -> Vector (Vector a) -> Vector (Vector a)
forall a. Vector Int -> Vector a -> Vector a
`getIndices` Vector (Vector a)
column
atIndicesStable Vector Int
indexes (GroupedUnboxedColumn Vector (Vector a)
column) = Vector (Vector a) -> Column
forall a. (Columnable a, Unbox a) => Vector (Vector a) -> Column
GroupedUnboxedColumn (Vector (Vector a) -> Column) -> Vector (Vector a) -> Column
forall a b. (a -> b) -> a -> b
$ Vector Int
indexes Vector Int -> Vector (Vector a) -> Vector (Vector a)
forall a. Vector Int -> Vector a -> Vector a
`getIndices` Vector (Vector a)
column
atIndicesStable Vector Int
indexes (GroupedOptionalColumn Vector (Vector (Maybe a))
column) = Vector (Vector (Maybe a)) -> Column
forall a. Columnable a => Vector (Vector (Maybe a)) -> Column
GroupedOptionalColumn (Vector (Vector (Maybe a)) -> Column)
-> Vector (Vector (Maybe a)) -> Column
forall a b. (a -> b) -> a -> b
$ Vector Int
indexes Vector Int
-> Vector (Vector (Maybe a)) -> Vector (Vector (Maybe a))
forall a. Vector Int -> Vector a -> Vector a
`getIndices` Vector (Vector (Maybe a))
column
{-# INLINE atIndicesStable #-}

getIndices :: VU.Vector Int -> VB.Vector a -> VB.Vector a
getIndices :: forall a. Vector Int -> Vector a -> Vector a
getIndices Vector Int
indices Vector a
xs = Int -> (Int -> a) -> Vector a
forall a. Int -> (Int -> a) -> Vector a
VB.generate (Vector Int -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector Int
indices) (\Int
i -> Vector a
xs Vector a -> Int -> a
forall a. Vector a -> Int -> a
VB.! (Vector Int
indices Vector Int -> Int -> Int
forall a. Unbox a => Vector a -> Int -> a
VU.! Int
i))
{-# INLINE getIndices #-}

getIndicesUnboxed :: (VU.Unbox a) => VU.Vector Int -> VU.Vector a -> VU.Vector a
getIndicesUnboxed :: forall a. Unbox a => Vector Int -> Vector a -> Vector a
getIndicesUnboxed Vector Int
indices Vector a
xs = Int -> (Int -> a) -> Vector a
forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Vector Int -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector Int
indices) (\Int
i -> Vector a
xs Vector a -> Int -> a
forall a. Unbox a => Vector a -> Int -> a
VU.! (Vector Int
indices Vector Int -> Int -> Int
forall a. Unbox a => Vector a -> Int -> a
VU.! Int
i))
{-# INLINE getIndicesUnboxed #-}

sortedIndexes :: Bool -> Column -> VU.Vector Int
sortedIndexes :: Bool -> Column -> Vector Int
sortedIndexes Bool
asc (BoxedColumn Vector a
column ) = (forall s. ST s (Vector Int)) -> Vector Int
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector Int)) -> Vector Int)
-> (forall s. ST s (Vector Int)) -> Vector Int
forall a b. (a -> b) -> a -> b
$ do
  MVector s (Int, a)
withIndexes <- Vector (Int, a)
-> ST s (Mutable Vector (PrimState (ST s)) (Int, a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.thaw (Vector (Int, a)
 -> ST s (Mutable Vector (PrimState (ST s)) (Int, a)))
-> Vector (Int, a)
-> ST s (Mutable Vector (PrimState (ST s)) (Int, a))
forall a b. (a -> b) -> a -> b
$ Vector a -> Vector (Int, a)
forall (v :: * -> *) a.
(Vector v a, Vector v (Int, a)) =>
v a -> v (Int, a)
VG.indexed Vector a
column
  Comparison (Int, a)
-> MVector (PrimState (ST s)) (Int, a) -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
VA.sortBy (\(Int
a, a
b) (Int
a', a
b') -> (if Bool
asc then a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare else (a -> a -> Ordering) -> a -> a -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) a
b a
b') MVector s (Int, a)
MVector (PrimState (ST s)) (Int, a)
withIndexes
  Vector (Int, a)
sorted <- Mutable Vector (PrimState (ST s)) (Int, a)
-> ST s (Vector (Int, a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze MVector s (Int, a)
Mutable Vector (PrimState (ST s)) (Int, a)
withIndexes
  Vector Int -> ST s (Vector Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Int -> ST s (Vector Int))
-> Vector Int -> ST s (Vector Int)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Vector Int
forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector a
column) (\Int
i -> (Int, a) -> Int
forall a b. (a, b) -> a
fst (Vector (Int, a)
sorted Vector (Int, a) -> Int -> (Int, a)
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
VG.! Int
i))
sortedIndexes Bool
asc (UnboxedColumn Vector a
column) = (forall s. ST s (Vector Int)) -> Vector Int
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector Int)) -> Vector Int)
-> (forall s. ST s (Vector Int)) -> Vector Int
forall a b. (a -> b) -> a -> b
$ do
  MVector s (Int, a)
withIndexes <- Vector (Int, a)
-> ST s (Mutable Vector (PrimState (ST s)) (Int, a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.thaw (Vector (Int, a)
 -> ST s (Mutable Vector (PrimState (ST s)) (Int, a)))
-> Vector (Int, a)
-> ST s (Mutable Vector (PrimState (ST s)) (Int, a))
forall a b. (a -> b) -> a -> b
$ Vector a -> Vector (Int, a)
forall (v :: * -> *) a.
(Vector v a, Vector v (Int, a)) =>
v a -> v (Int, a)
VG.indexed Vector a
column
  Comparison (Int, a)
-> MVector (PrimState (ST s)) (Int, a) -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
VA.sortBy (\(Int
a, a
b) (Int
a', a
b') -> (if Bool
asc then a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare else (a -> a -> Ordering) -> a -> a -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) a
b a
b') MVector s (Int, a)
MVector (PrimState (ST s)) (Int, a)
withIndexes
  Vector (Int, a)
sorted <- Mutable Vector (PrimState (ST s)) (Int, a)
-> ST s (Vector (Int, a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze MVector s (Int, a)
Mutable Vector (PrimState (ST s)) (Int, a)
withIndexes
  Vector Int -> ST s (Vector Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Int -> ST s (Vector Int))
-> Vector Int -> ST s (Vector Int)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Vector Int
forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector a
column) (\Int
i -> (Int, a) -> Int
forall a b. (a, b) -> a
fst (Vector (Int, a)
sorted Vector (Int, a) -> Int -> (Int, a)
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
VG.! Int
i))
sortedIndexes Bool
asc (OptionalColumn Vector (Maybe a)
column ) = (forall s. ST s (Vector Int)) -> Vector Int
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector Int)) -> Vector Int)
-> (forall s. ST s (Vector Int)) -> Vector Int
forall a b. (a -> b) -> a -> b
$ do
  MVector s (Int, Maybe a)
withIndexes <- Vector (Int, Maybe a)
-> ST s (Mutable Vector (PrimState (ST s)) (Int, Maybe a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.thaw (Vector (Int, Maybe a)
 -> ST s (Mutable Vector (PrimState (ST s)) (Int, Maybe a)))
-> Vector (Int, Maybe a)
-> ST s (Mutable Vector (PrimState (ST s)) (Int, Maybe a))
forall a b. (a -> b) -> a -> b
$ Vector (Maybe a) -> Vector (Int, Maybe a)
forall (v :: * -> *) a.
(Vector v a, Vector v (Int, a)) =>
v a -> v (Int, a)
VG.indexed Vector (Maybe a)
column
  Comparison (Int, Maybe a)
-> MVector (PrimState (ST s)) (Int, Maybe a) -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
VA.sortBy (\(Int
a, Maybe a
b) (Int
a', Maybe a
b') -> (if Bool
asc then Maybe a -> Maybe a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare else (Maybe a -> Maybe a -> Ordering) -> Maybe a -> Maybe a -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe a -> Maybe a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) Maybe a
b Maybe a
b') MVector s (Int, Maybe a)
MVector (PrimState (ST s)) (Int, Maybe a)
withIndexes
  Vector (Int, Maybe a)
sorted <- Mutable Vector (PrimState (ST s)) (Int, Maybe a)
-> ST s (Vector (Int, Maybe a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze MVector s (Int, Maybe a)
Mutable Vector (PrimState (ST s)) (Int, Maybe a)
withIndexes
  Vector Int -> ST s (Vector Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Int -> ST s (Vector Int))
-> Vector Int -> ST s (Vector Int)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Vector Int
forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Vector (Maybe a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector (Maybe a)
column) (\Int
i -> (Int, Maybe a) -> Int
forall a b. (a, b) -> a
fst (Vector (Int, Maybe a)
sorted Vector (Int, Maybe a) -> Int -> (Int, Maybe a)
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
VG.! Int
i))
sortedIndexes Bool
asc (GroupedBoxedColumn Vector (Vector a)
column) = (forall s. ST s (Vector Int)) -> Vector Int
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector Int)) -> Vector Int)
-> (forall s. ST s (Vector Int)) -> Vector Int
forall a b. (a -> b) -> a -> b
$ do
  MVector s (Int, Vector a)
withIndexes <- Vector (Int, Vector a)
-> ST s (Mutable Vector (PrimState (ST s)) (Int, Vector a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.thaw (Vector (Int, Vector a)
 -> ST s (Mutable Vector (PrimState (ST s)) (Int, Vector a)))
-> Vector (Int, Vector a)
-> ST s (Mutable Vector (PrimState (ST s)) (Int, Vector a))
forall a b. (a -> b) -> a -> b
$ Vector (Vector a) -> Vector (Int, Vector a)
forall (v :: * -> *) a.
(Vector v a, Vector v (Int, a)) =>
v a -> v (Int, a)
VG.indexed Vector (Vector a)
column
  Comparison (Int, Vector a)
-> MVector (PrimState (ST s)) (Int, Vector a) -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
VA.sortBy (\(Int
a, Vector a
b) (Int
a', Vector a
b') -> (if Bool
asc then Vector a -> Vector a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare else (Vector a -> Vector a -> Ordering)
-> Vector a -> Vector a -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Vector a -> Vector a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) Vector a
b Vector a
b') MVector s (Int, Vector a)
MVector (PrimState (ST s)) (Int, Vector a)
withIndexes
  Vector (Int, Vector a)
sorted <- Mutable Vector (PrimState (ST s)) (Int, Vector a)
-> ST s (Vector (Int, Vector a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze MVector s (Int, Vector a)
Mutable Vector (PrimState (ST s)) (Int, Vector a)
withIndexes
  Vector Int -> ST s (Vector Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Int -> ST s (Vector Int))
-> Vector Int -> ST s (Vector Int)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Vector Int
forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Vector (Vector a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector (Vector a)
column) (\Int
i -> (Int, Vector a) -> Int
forall a b. (a, b) -> a
fst (Vector (Int, Vector a)
sorted Vector (Int, Vector a) -> Int -> (Int, Vector a)
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
VG.! Int
i))
sortedIndexes Bool
asc (GroupedUnboxedColumn Vector (Vector a)
column) = (forall s. ST s (Vector Int)) -> Vector Int
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector Int)) -> Vector Int)
-> (forall s. ST s (Vector Int)) -> Vector Int
forall a b. (a -> b) -> a -> b
$ do
  MVector s (Int, Vector a)
withIndexes <- Vector (Int, Vector a)
-> ST s (Mutable Vector (PrimState (ST s)) (Int, Vector a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.thaw (Vector (Int, Vector a)
 -> ST s (Mutable Vector (PrimState (ST s)) (Int, Vector a)))
-> Vector (Int, Vector a)
-> ST s (Mutable Vector (PrimState (ST s)) (Int, Vector a))
forall a b. (a -> b) -> a -> b
$ Vector (Vector a) -> Vector (Int, Vector a)
forall (v :: * -> *) a.
(Vector v a, Vector v (Int, a)) =>
v a -> v (Int, a)
VG.indexed Vector (Vector a)
column
  Comparison (Int, Vector a)
-> MVector (PrimState (ST s)) (Int, Vector a) -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
VA.sortBy (\(Int
a, Vector a
b) (Int
a', Vector a
b') -> (if Bool
asc then Vector a -> Vector a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare else (Vector a -> Vector a -> Ordering)
-> Vector a -> Vector a -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Vector a -> Vector a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) Vector a
b Vector a
b') MVector s (Int, Vector a)
MVector (PrimState (ST s)) (Int, Vector a)
withIndexes
  Vector (Int, Vector a)
sorted <- Mutable Vector (PrimState (ST s)) (Int, Vector a)
-> ST s (Vector (Int, Vector a))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze MVector s (Int, Vector a)
Mutable Vector (PrimState (ST s)) (Int, Vector a)
withIndexes
  Vector Int -> ST s (Vector Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Int -> ST s (Vector Int))
-> Vector Int -> ST s (Vector Int)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Vector Int
forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Vector (Vector a) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector (Vector a)
column) (\Int
i -> (Int, Vector a) -> Int
forall a b. (a, b) -> a
fst (Vector (Int, Vector a)
sorted Vector (Int, Vector a) -> Int -> (Int, Vector a)
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
VG.! Int
i))
sortedIndexes Bool
asc (GroupedOptionalColumn Vector (Vector (Maybe a))
column) = (forall s. ST s (Vector Int)) -> Vector Int
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector Int)) -> Vector Int)
-> (forall s. ST s (Vector Int)) -> Vector Int
forall a b. (a -> b) -> a -> b
$ do
  MVector s (Int, Vector (Maybe a))
withIndexes <- Vector (Int, Vector (Maybe a))
-> ST s (Mutable Vector (PrimState (ST s)) (Int, Vector (Maybe a)))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.thaw (Vector (Int, Vector (Maybe a))
 -> ST
      s (Mutable Vector (PrimState (ST s)) (Int, Vector (Maybe a))))
-> Vector (Int, Vector (Maybe a))
-> ST s (Mutable Vector (PrimState (ST s)) (Int, Vector (Maybe a)))
forall a b. (a -> b) -> a -> b
$ Vector (Vector (Maybe a)) -> Vector (Int, Vector (Maybe a))
forall (v :: * -> *) a.
(Vector v a, Vector v (Int, a)) =>
v a -> v (Int, a)
VG.indexed Vector (Vector (Maybe a))
column
  Comparison (Int, Vector (Maybe a))
-> MVector (PrimState (ST s)) (Int, Vector (Maybe a)) -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
VA.sortBy (\(Int
a, Vector (Maybe a)
b) (Int
a', Vector (Maybe a)
b') -> (if Bool
asc then Vector (Maybe a) -> Vector (Maybe a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare else (Vector (Maybe a) -> Vector (Maybe a) -> Ordering)
-> Vector (Maybe a) -> Vector (Maybe a) -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Vector (Maybe a) -> Vector (Maybe a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) Vector (Maybe a)
b Vector (Maybe a)
b') MVector s (Int, Vector (Maybe a))
MVector (PrimState (ST s)) (Int, Vector (Maybe a))
withIndexes
  Vector (Int, Vector (Maybe a))
sorted <- Mutable Vector (PrimState (ST s)) (Int, Vector (Maybe a))
-> ST s (Vector (Int, Vector (Maybe a)))
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze MVector s (Int, Vector (Maybe a))
Mutable Vector (PrimState (ST s)) (Int, Vector (Maybe a))
withIndexes
  Vector Int -> ST s (Vector Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Int -> ST s (Vector Int))
-> Vector Int -> ST s (Vector Int)
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Vector Int
forall a. Unbox a => Int -> (Int -> a) -> Vector a
VU.generate (Vector (Vector (Maybe a)) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector (Vector (Maybe a))
column) (\Int
i -> (Int, Vector (Maybe a)) -> Int
forall a b. (a, b) -> a
fst (Vector (Int, Vector (Maybe a))
sorted Vector (Int, Vector (Maybe a)) -> Int -> (Int, Vector (Maybe a))
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
VG.! Int
i))
{-# INLINE sortedIndexes #-}

-- Operations on a column that may change its type.

instance Transformable Column where
  transform :: forall b c . (Columnable b, Columnable c) => (b -> c) -> Column -> Maybe Column
  transform :: forall b c.
(Columnable b, Columnable c) =>
(b -> c) -> Column -> Maybe Column
transform b -> c
f (BoxedColumn (Vector a
column :: VB.Vector a)) = do
    a :~: b
Refl <- TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
    Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector c -> Column
forall a. Columnify a => Vector a -> Column
toColumn' ((b -> c) -> Vector b -> Vector c
forall a b. (a -> b) -> Vector a -> Vector b
VB.map b -> c
f Vector b
Vector a
column))
  transform b -> c
f (OptionalColumn (Vector (Maybe a)
column :: VB.Vector a)) = do
    Maybe a :~: b
Refl <- TypeRep (Maybe a) -> TypeRep b -> Maybe (Maybe a :~: b)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
    Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector c -> Column
forall a. Columnify a => Vector a -> Column
toColumn' ((b -> c) -> Vector b -> Vector c
forall a b. (a -> b) -> Vector a -> Vector b
VB.map b -> c
f Vector b
Vector (Maybe a)
column))
  transform b -> c
f (UnboxedColumn (Vector a
column :: VU.Vector a)) = do
    a :~: b
Refl <- TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
    Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Column -> Maybe Column) -> Column -> Maybe Column
forall a b. (a -> b) -> a -> b
$ if TypeRep c -> Bool
forall a. Typeable a => TypeRep a -> Bool
testUnboxable (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @c) then (b -> c) -> Vector b -> Column
forall a b.
(Columnable a, Unbox a, Columnable b) =>
(a -> b) -> Vector a -> Column
transformUnboxed b -> c
f Vector b
Vector a
column else Vector c -> Column
forall a. Columnify a => Vector a -> Column
toColumn' ((b -> c) -> Vector b -> Vector c
forall a b. (a -> b) -> Vector a -> Vector b
VB.map b -> c
f (Vector b -> Vector b
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
VB.convert Vector b
Vector a
column))
  transform b -> c
f (GroupedBoxedColumn (Vector (Vector a)
column :: VB.Vector (VB.Vector a))) = do
    Vector a :~: b
Refl <- TypeRep (Vector a) -> TypeRep b -> Maybe (Vector a :~: b)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(VB.Vector a)) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
    Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector c -> Column
forall a. Columnify a => Vector a -> Column
toColumn' ((b -> c) -> Vector b -> Vector c
forall a b. (a -> b) -> Vector a -> Vector b
VB.map b -> c
f Vector b
Vector (Vector a)
column))
  transform b -> c
f (GroupedUnboxedColumn (Vector (Vector a)
column :: VB.Vector (VU.Vector a))) = do
    Vector a :~: b
Refl <- TypeRep (Vector a) -> TypeRep b -> Maybe (Vector a :~: b)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(VU.Vector a)) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
    Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector c -> Column
forall a. Columnify a => Vector a -> Column
toColumn' ((b -> c) -> Vector b -> Vector c
forall a b. (a -> b) -> Vector a -> Vector b
VB.map b -> c
f Vector b
Vector (Vector a)
column))
  transform b -> c
f (GroupedOptionalColumn (Vector (Vector (Maybe a))
column :: VB.Vector (VB.Vector a))) = do
    Vector (Maybe a) :~: b
Refl <- TypeRep (Vector (Maybe a))
-> TypeRep b -> Maybe (Vector (Maybe a) :~: b)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(VB.Vector a)) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
    Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector c -> Column
forall a. Columnify a => Vector a -> Column
toColumn' ((b -> c) -> Vector b -> Vector c
forall a b. (a -> b) -> Vector a -> Vector b
VB.map b -> c
f Vector b
Vector (Vector (Maybe a))
column))

-- | Applies a function that returns an unboxed result to an unboxed vector, storing the result in a column.
transformUnboxed :: forall a b . (Columnable a, VU.Unbox a, Columnable b) => (a -> b) -> VU.Vector a -> Column
transformUnboxed :: forall a b.
(Columnable a, Unbox a, Columnable b) =>
(a -> b) -> Vector a -> Column
transformUnboxed a -> b
f = (Int -> a -> b) -> Vector a -> Column
forall a b.
(Columnable a, Unbox a, Columnable b) =>
(Int -> a -> b) -> Vector a -> Column
itransformUnboxed ((a -> b) -> Int -> a -> b
forall a b. a -> b -> a
const a -> b
f)

-- TODO: Make a type class with incoherent instances.
itransformUnboxed :: forall a b . (Columnable a, VU.Unbox a, Columnable b) => (Int -> a -> b) -> VU.Vector a -> Column
itransformUnboxed :: forall a b.
(Columnable a, Unbox a, Columnable b) =>
(Int -> a -> b) -> Vector a -> Column
itransformUnboxed Int -> a -> b
f Vector a
column = case TypeRep b -> TypeRep Int -> Maybe (b :~: Int)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Int) of
  Just b :~: Int
Refl -> Vector b -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector b -> Column) -> Vector b -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap Int -> a -> b
f Vector a
column
  Maybe (b :~: Int)
Nothing -> case TypeRep b -> TypeRep Int8 -> Maybe (b :~: Int8)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Int8) of
    Just b :~: Int8
Refl -> Vector b -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector b -> Column) -> Vector b -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap Int -> a -> b
f Vector a
column
    Maybe (b :~: Int8)
Nothing -> case TypeRep b -> TypeRep Int16 -> Maybe (b :~: Int16)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Int16) of
      Just b :~: Int16
Refl -> Vector b -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector b -> Column) -> Vector b -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap Int -> a -> b
f Vector a
column
      Maybe (b :~: Int16)
Nothing -> case TypeRep b -> TypeRep Int32 -> Maybe (b :~: Int32)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Int32) of
        Just b :~: Int32
Refl -> Vector b -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector b -> Column) -> Vector b -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap Int -> a -> b
f Vector a
column
        Maybe (b :~: Int32)
Nothing -> case TypeRep b -> TypeRep Int64 -> Maybe (b :~: Int64)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Int64) of
          Just b :~: Int64
Refl -> Vector b -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector b -> Column) -> Vector b -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap Int -> a -> b
f Vector a
column
          Maybe (b :~: Int64)
Nothing -> case TypeRep b -> TypeRep Word8 -> Maybe (b :~: Word8)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Word8) of
            Just b :~: Word8
Refl -> Vector b -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector b -> Column) -> Vector b -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap Int -> a -> b
f Vector a
column
            Maybe (b :~: Word8)
Nothing-> case TypeRep b -> TypeRep Word16 -> Maybe (b :~: Word16)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Word16) of
              Just b :~: Word16
Refl -> Vector b -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector b -> Column) -> Vector b -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap Int -> a -> b
f Vector a
column
              Maybe (b :~: Word16)
Nothing -> case TypeRep b -> TypeRep Word32 -> Maybe (b :~: Word32)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Word32) of
                Just b :~: Word32
Refl -> Vector b -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector b -> Column) -> Vector b -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap Int -> a -> b
f Vector a
column
                Maybe (b :~: Word32)
Nothing -> case TypeRep b -> TypeRep Word64 -> Maybe (b :~: Word64)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Word64) of
                  Just b :~: Word64
Refl -> Vector b -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector b -> Column) -> Vector b -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap Int -> a -> b
f Vector a
column
                  Maybe (b :~: Word64)
Nothing -> case TypeRep b -> TypeRep Char -> Maybe (b :~: Char)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Char) of
                    Just b :~: Char
Refl -> Vector b -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector b -> Column) -> Vector b -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap Int -> a -> b
f Vector a
column
                    Maybe (b :~: Char)
Nothing -> case TypeRep b -> TypeRep Bool -> Maybe (b :~: Bool)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Bool) of
                      Just b :~: Bool
Refl -> Vector b -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector b -> Column) -> Vector b -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap Int -> a -> b
f Vector a
column
                      Maybe (b :~: Bool)
Nothing -> case TypeRep b -> TypeRep Float -> Maybe (b :~: Float)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Float) of
                        Just b :~: Float
Refl -> Vector b -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector b -> Column) -> Vector b -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap Int -> a -> b
f Vector a
column
                        Maybe (b :~: Float)
Nothing -> case TypeRep b -> TypeRep Double -> Maybe (b :~: Double)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Double) of
                          Just b :~: Double
Refl -> Vector b -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector b -> Column) -> Vector b -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap Int -> a -> b
f Vector a
column
                          Maybe (b :~: Double)
Nothing -> case TypeRep b -> TypeRep Word -> Maybe (b :~: Word)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Word) of
                            Just b :~: Word
Refl -> Vector b -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector b -> Column) -> Vector b -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b) -> Vector a -> Vector b
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap Int -> a -> b
f Vector a
column
                            Maybe (b :~: Word)
Nothing -> String -> Column
forall a. HasCallStack => String -> a
error String
"Result type is unboxed" -- since we only call this after confirming 

-- | tranform with index.
itransform :: forall b c. (Columnable b, Columnable c) => (Int -> b -> c) -> Column -> Maybe Column
itransform :: forall b c.
(Columnable b, Columnable c) =>
(Int -> b -> c) -> Column -> Maybe Column
itransform Int -> b -> c
f (BoxedColumn (Vector a
column :: VB.Vector a)) = do
  a :~: b
Refl <- TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
  Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector c -> Column
forall a. Columnify a => Vector a -> Column
toColumn' ((Int -> b -> c) -> Vector b -> Vector c
forall a b. (Int -> a -> b) -> Vector a -> Vector b
VB.imap Int -> b -> c
f Vector b
Vector a
column))
itransform Int -> b -> c
f (UnboxedColumn (Vector a
column :: VU.Vector a)) = do
  a :~: b
Refl <- TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
  Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Column -> Maybe Column) -> Column -> Maybe Column
forall a b. (a -> b) -> a -> b
$ if TypeRep c -> Bool
forall a. Typeable a => TypeRep a -> Bool
testUnboxable (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @c) then (Int -> b -> c) -> Vector b -> Column
forall a b.
(Columnable a, Unbox a, Columnable b) =>
(Int -> a -> b) -> Vector a -> Column
itransformUnboxed Int -> b -> c
f Vector b
Vector a
column else Vector c -> Column
forall a. Columnify a => Vector a -> Column
toColumn' ((Int -> b -> c) -> Vector b -> Vector c
forall a b. (Int -> a -> b) -> Vector a -> Vector b
VB.imap Int -> b -> c
f (Vector b -> Vector b
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
VB.convert Vector b
Vector a
column))
itransform Int -> b -> c
f (GroupedBoxedColumn (Vector (Vector a)
column :: VB.Vector (VB.Vector a))) = do
  Vector a :~: b
Refl <- TypeRep (Vector a) -> TypeRep b -> Maybe (Vector a :~: b)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(VB.Vector a)) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
  Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector c -> Column
forall a. Columnify a => Vector a -> Column
toColumn' ((Int -> b -> c) -> Vector b -> Vector c
forall a b. (Int -> a -> b) -> Vector a -> Vector b
VB.imap Int -> b -> c
f Vector b
Vector (Vector a)
column))
itransform Int -> b -> c
f (GroupedUnboxedColumn (Vector (Vector a)
column :: VB.Vector (VU.Vector a))) = do
  Vector a :~: b
Refl <- TypeRep (Vector a) -> TypeRep b -> Maybe (Vector a :~: b)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(VU.Vector a)) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
  Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector c -> Column
forall a. Columnify a => Vector a -> Column
toColumn' ((Int -> b -> c) -> Vector b -> Vector c
forall a b. (Int -> a -> b) -> Vector a -> Vector b
VB.imap Int -> b -> c
f Vector b
Vector (Vector a)
column))

-- | Filter column with index.
ifilterColumn :: forall a . (Columnable a) => (Int -> a -> Bool) -> Column -> Maybe Column
ifilterColumn :: forall a.
Columnable a =>
(Int -> a -> Bool) -> Column -> Maybe Column
ifilterColumn Int -> a -> Bool
f c :: Column
c@(BoxedColumn (Vector a
column :: VB.Vector b)) = do
  a :~: a
Refl <- TypeRep a -> TypeRep a -> Maybe (a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
  Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Column -> Maybe Column) -> Column -> Maybe Column
forall a b. (a -> b) -> a -> b
$ Vector a -> Column
forall a. Columnable a => Vector a -> Column
BoxedColumn (Vector a -> Column) -> Vector a -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> Bool) -> Vector a -> Vector a
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter Int -> a -> Bool
f Vector a
Vector a
column
ifilterColumn Int -> a -> Bool
f c :: Column
c@(UnboxedColumn (Vector a
column :: VU.Vector b)) = do
  a :~: a
Refl <- TypeRep a -> TypeRep a -> Maybe (a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
  Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Column -> Maybe Column) -> Column -> Maybe Column
forall a b. (a -> b) -> a -> b
$ Vector a -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector a -> Column) -> Vector a -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> Bool) -> Vector a -> Vector a
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter Int -> a -> Bool
f Vector a
Vector a
column
ifilterColumn Int -> a -> Bool
f c :: Column
c@(GroupedBoxedColumn (Vector (Vector a)
column :: VB.Vector b)) = do
  a :~: Vector a
Refl <- TypeRep a -> TypeRep (Vector a) -> Maybe (a :~: Vector a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
  Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Column -> Maybe Column) -> Column -> Maybe Column
forall a b. (a -> b) -> a -> b
$ Vector (Vector a) -> Column
forall a. Columnable a => Vector (Vector a) -> Column
GroupedBoxedColumn (Vector (Vector a) -> Column) -> Vector (Vector a) -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> Vector a -> Bool) -> Vector (Vector a) -> Vector (Vector a)
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter Int -> a -> Bool
Int -> Vector a -> Bool
f Vector (Vector a)
column
ifilterColumn Int -> a -> Bool
f c :: Column
c@(GroupedUnboxedColumn (Vector (Vector a)
column :: VB.Vector b)) = do
  a :~: Vector a
Refl <- TypeRep a -> TypeRep (Vector a) -> Maybe (a :~: Vector a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
  Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Column -> Maybe Column) -> Column -> Maybe Column
forall a b. (a -> b) -> a -> b
$ Vector (Vector a) -> Column
forall a. (Columnable a, Unbox a) => Vector (Vector a) -> Column
GroupedUnboxedColumn (Vector (Vector a) -> Column) -> Vector (Vector a) -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> Vector a -> Bool) -> Vector (Vector a) -> Vector (Vector a)
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter Int -> a -> Bool
Int -> Vector a -> Bool
f Vector (Vector a)
column

-- TODO: Expand this to use more predicates.
ifilterColumnF :: Function -> Column -> Maybe Column
ifilterColumnF :: Function -> Column -> Maybe Column
ifilterColumnF (ICond (Int -> a -> Bool
f :: Int -> a -> Bool)) c :: Column
c@(BoxedColumn (Vector a
column :: VB.Vector b)) = do
  a :~: a
Refl <- TypeRep a -> TypeRep a -> Maybe (a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
  Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Column -> Maybe Column) -> Column -> Maybe Column
forall a b. (a -> b) -> a -> b
$ Vector a -> Column
forall a. Columnable a => Vector a -> Column
BoxedColumn (Vector a -> Column) -> Vector a -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> Bool) -> Vector a -> Vector a
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter Int -> a -> Bool
f Vector a
Vector a
column
ifilterColumnF (ICond (Int -> a -> Bool
f :: Int -> a -> Bool)) c :: Column
c@(UnboxedColumn (Vector a
column :: VU.Vector b)) = do
  a :~: a
Refl <- TypeRep a -> TypeRep a -> Maybe (a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
  Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Column -> Maybe Column) -> Column -> Maybe Column
forall a b. (a -> b) -> a -> b
$ Vector a -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector a -> Column) -> Vector a -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> a -> Bool) -> Vector a -> Vector a
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter Int -> a -> Bool
f Vector a
Vector a
column
ifilterColumnF (ICond (Int -> a -> Bool
f :: Int -> a -> Bool)) c :: Column
c@(OptionalColumn (Vector (Maybe a)
column :: VB.Vector b)) = do
  a :~: Maybe a
Refl <- TypeRep a -> TypeRep (Maybe a) -> Maybe (a :~: Maybe a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
  Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Column -> Maybe Column) -> Column -> Maybe Column
forall a b. (a -> b) -> a -> b
$ Vector (Maybe a) -> Column
forall a. Columnable a => Vector (Maybe a) -> Column
OptionalColumn (Vector (Maybe a) -> Column) -> Vector (Maybe a) -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe a -> Bool) -> Vector (Maybe a) -> Vector (Maybe a)
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter Int -> a -> Bool
Int -> Maybe a -> Bool
f Vector (Maybe a)
column
ifilterColumnF (ICond (Int -> a -> Bool
f :: Int -> a -> Bool)) c :: Column
c@(GroupedBoxedColumn (Vector (Vector a)
column :: VB.Vector b)) = do
  a :~: Vector a
Refl <- TypeRep a -> TypeRep (Vector a) -> Maybe (a :~: Vector a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
  Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Column -> Maybe Column) -> Column -> Maybe Column
forall a b. (a -> b) -> a -> b
$ Vector (Vector a) -> Column
forall a. Columnable a => Vector (Vector a) -> Column
GroupedBoxedColumn (Vector (Vector a) -> Column) -> Vector (Vector a) -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> Vector a -> Bool) -> Vector (Vector a) -> Vector (Vector a)
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter Int -> a -> Bool
Int -> Vector a -> Bool
f Vector (Vector a)
column
ifilterColumnF (ICond (Int -> a -> Bool
f :: Int -> a -> Bool)) c :: Column
c@(GroupedUnboxedColumn (Vector (Vector a)
column :: VB.Vector b)) = do
  a :~: Vector a
Refl <- TypeRep a -> TypeRep (Vector a) -> Maybe (a :~: Vector a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @b)
  Column -> Maybe Column
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Column -> Maybe Column) -> Column -> Maybe Column
forall a b. (a -> b) -> a -> b
$ Vector (Vector a) -> Column
forall a. (Columnable a, Unbox a) => Vector (Vector a) -> Column
GroupedUnboxedColumn (Vector (Vector a) -> Column) -> Vector (Vector a) -> Column
forall a b. (a -> b) -> a -> b
$ (Int -> Vector a -> Bool) -> Vector (Vector a) -> Vector (Vector a)
forall (v :: * -> *) a.
Vector v a =>
(Int -> a -> Bool) -> v a -> v a
VG.ifilter Int -> a -> Bool
Int -> Vector a -> Bool
f Vector (Vector a)
column

ifoldrColumn :: forall a b. (Columnable a, Columnable b) => (Int -> a -> b -> b) -> b -> Column -> Maybe b
ifoldrColumn :: forall a b.
(Columnable a, Columnable b) =>
(Int -> a -> b -> b) -> b -> Column -> Maybe b
ifoldrColumn Int -> a -> b -> b
f b
acc c :: Column
c@(BoxedColumn (Vector a
column :: VB.Vector d)) = do
  a :~: a
Refl <- TypeRep a -> TypeRep a -> Maybe (a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @d)
  b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b -> b) -> b -> Vector a -> b
forall (v :: * -> *) a b.
Vector v a =>
(Int -> a -> b -> b) -> b -> v a -> b
VG.ifoldr Int -> a -> b -> b
f b
acc Vector a
Vector a
column
ifoldrColumn Int -> a -> b -> b
f b
acc c :: Column
c@(OptionalColumn (Vector (Maybe a)
column :: VB.Vector d)) = do
  a :~: Maybe a
Refl <- TypeRep a -> TypeRep (Maybe a) -> Maybe (a :~: Maybe a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @d)
  b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b -> b) -> b -> Vector a -> b
forall (v :: * -> *) a b.
Vector v a =>
(Int -> a -> b -> b) -> b -> v a -> b
VG.ifoldr Int -> a -> b -> b
f b
acc Vector a
Vector (Maybe a)
column
ifoldrColumn Int -> a -> b -> b
f b
acc c :: Column
c@(UnboxedColumn (Vector a
column :: VU.Vector d)) = do
  a :~: a
Refl <- TypeRep a -> TypeRep a -> Maybe (a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @d)
  b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b -> b) -> b -> Vector a -> b
forall (v :: * -> *) a b.
Vector v a =>
(Int -> a -> b -> b) -> b -> v a -> b
VG.ifoldr Int -> a -> b -> b
f b
acc Vector a
Vector a
column
ifoldrColumn Int -> a -> b -> b
f b
acc c :: Column
c@(GroupedBoxedColumn (Vector (Vector a)
column :: VB.Vector d)) = do
  a :~: Vector a
Refl <- TypeRep a -> TypeRep (Vector a) -> Maybe (a :~: Vector a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @d)
  b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b -> b) -> b -> Vector a -> b
forall (v :: * -> *) a b.
Vector v a =>
(Int -> a -> b -> b) -> b -> v a -> b
VG.ifoldr Int -> a -> b -> b
f b
acc Vector a
Vector (Vector a)
column
ifoldrColumn Int -> a -> b -> b
f b
acc c :: Column
c@(GroupedUnboxedColumn (Vector (Vector a)
column :: VB.Vector d)) = do
  a :~: Vector a
Refl <- TypeRep a -> TypeRep (Vector a) -> Maybe (a :~: Vector a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @d)
  b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ (Int -> a -> b -> b) -> b -> Vector a -> b
forall (v :: * -> *) a b.
Vector v a =>
(Int -> a -> b -> b) -> b -> v a -> b
VG.ifoldr Int -> a -> b -> b
f b
acc Vector a
Vector (Vector a)
column

ifoldlColumn :: forall a b . (Columnable a, Columnable b) => (b -> Int -> a -> b) -> b -> Column -> Maybe b
ifoldlColumn :: forall a b.
(Columnable a, Columnable b) =>
(b -> Int -> a -> b) -> b -> Column -> Maybe b
ifoldlColumn b -> Int -> a -> b
f b
acc c :: Column
c@(BoxedColumn (Vector a
column :: VB.Vector d)) = do
  a :~: a
Refl <- TypeRep a -> TypeRep a -> Maybe (a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @d)
  b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ (b -> Int -> a -> b) -> b -> Vector a -> b
forall (v :: * -> *) b a.
Vector v b =>
(a -> Int -> b -> a) -> a -> v b -> a
VG.ifoldl' b -> Int -> a -> b
f b
acc Vector a
Vector a
column
ifoldlColumn b -> Int -> a -> b
f b
acc c :: Column
c@(OptionalColumn (Vector (Maybe a)
column :: VB.Vector d)) = do
  a :~: Maybe a
Refl <- TypeRep a -> TypeRep (Maybe a) -> Maybe (a :~: Maybe a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @d)
  b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ (b -> Int -> a -> b) -> b -> Vector a -> b
forall (v :: * -> *) b a.
Vector v b =>
(a -> Int -> b -> a) -> a -> v b -> a
VG.ifoldl' b -> Int -> a -> b
f b
acc Vector a
Vector (Maybe a)
column
ifoldlColumn b -> Int -> a -> b
f b
acc c :: Column
c@(UnboxedColumn (Vector a
column :: VU.Vector d)) = do
  a :~: a
Refl <- TypeRep a -> TypeRep a -> Maybe (a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @d)
  b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ (b -> Int -> a -> b) -> b -> Vector a -> b
forall (v :: * -> *) b a.
Vector v b =>
(a -> Int -> b -> a) -> a -> v b -> a
VG.ifoldl' b -> Int -> a -> b
f b
acc Vector a
Vector a
column
ifoldlColumn b -> Int -> a -> b
f b
acc c :: Column
c@(GroupedBoxedColumn (Vector (Vector a)
column :: VB.Vector d)) = do
  a :~: Vector a
Refl <- TypeRep a -> TypeRep (Vector a) -> Maybe (a :~: Vector a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @d)
  b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ (b -> Int -> a -> b) -> b -> Vector a -> b
forall (v :: * -> *) b a.
Vector v b =>
(a -> Int -> b -> a) -> a -> v b -> a
VG.ifoldl' b -> Int -> a -> b
f b
acc Vector a
Vector (Vector a)
column
ifoldlColumn b -> Int -> a -> b
f b
acc c :: Column
c@(GroupedUnboxedColumn (Vector (Vector a)
column :: VB.Vector d)) = do
  a :~: Vector a
Refl <- TypeRep a -> TypeRep (Vector a) -> Maybe (a :~: Vector a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @d)
  b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ (b -> Int -> a -> b) -> b -> Vector a -> b
forall (v :: * -> *) b a.
Vector v b =>
(a -> Int -> b -> a) -> a -> v b -> a
VG.ifoldl' b -> Int -> a -> b
f b
acc Vector a
Vector (Vector a)
column

reduceColumn :: forall a b. Columnable a => (a -> b) -> Column -> b
{-# SPECIALIZE reduceColumn ::
    (VU.Vector (Double, Double) -> Double) -> Column -> Double,
    (VU.Vector Double -> Double) -> Column -> Double #-}
reduceColumn :: forall a b. Columnable a => (a -> b) -> Column -> b
reduceColumn a -> b
f (BoxedColumn (Vector a
column :: c)) = case TypeRep (Vector a) -> TypeRep a -> Maybe (Vector a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @c) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) of
  Just Vector a :~: a
Refl -> a -> b
f a
Vector a
column
  Maybe (Vector a :~: a)
Nothing -> String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
"Can't reduce. Incompatible types: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)
reduceColumn a -> b
f (UnboxedColumn (Vector a
column :: c)) = case TypeRep (Vector a) -> TypeRep a -> Maybe (Vector a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @c) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) of
  Just Vector a :~: a
Refl -> a -> b
f a
Vector a
column
  Maybe (Vector a :~: a)
Nothing -> String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
"Can't reduce. Incompatible types: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)
reduceColumn a -> b
f (OptionalColumn (Vector (Maybe a)
column :: c)) = case TypeRep (Vector (Maybe a))
-> TypeRep a -> Maybe (Vector (Maybe a) :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @c) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) of
  Just Vector (Maybe a) :~: a
Refl -> a -> b
f a
Vector (Maybe a)
column
  Maybe (Vector (Maybe a) :~: a)
Nothing -> String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
"Can't reduce. Incompatible types: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)
{-# INLINE reduceColumn #-}

safeReduceColumn :: forall a b. (Typeable a) => (a -> b) -> Column -> Maybe b
safeReduceColumn :: forall a b. Typeable a => (a -> b) -> Column -> Maybe b
safeReduceColumn a -> b
f (BoxedColumn (Vector a
column :: c)) = do
  Vector a :~: a
Refl <- TypeRep (Vector a) -> TypeRep a -> Maybe (Vector a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @c) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)
  b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
Vector a
column
safeReduceColumn a -> b
f (UnboxedColumn (Vector a
column :: c)) = do
  Vector a :~: a
Refl <- TypeRep (Vector a) -> TypeRep a -> Maybe (Vector a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @c) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)
  b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
Vector a
column
safeReduceColumn a -> b
f (OptionalColumn (Vector (Maybe a)
column :: c)) = do
  Vector (Maybe a) :~: a
Refl <- TypeRep (Vector (Maybe a))
-> TypeRep a -> Maybe (Vector (Maybe a) :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @c) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)
  b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
Vector (Maybe a)
column
{-# INLINE safeReduceColumn #-}

zipColumns :: Column -> Column -> Column
zipColumns :: Column -> Column -> Column
zipColumns (BoxedColumn Vector a
column) (BoxedColumn Vector a
other) = Vector (a, a) -> Column
forall a. Columnable a => Vector a -> Column
BoxedColumn (Vector a -> Vector a -> Vector (a, a)
forall (v :: * -> *) a b.
(Vector v a, Vector v b, Vector v (a, b)) =>
v a -> v b -> v (a, b)
VG.zip Vector a
column Vector a
other)
zipColumns (BoxedColumn Vector a
column) (UnboxedColumn Vector a
other) = Vector (a, a) -> Column
forall a. Columnable a => Vector a -> Column
BoxedColumn (Int -> (Int -> (a, a)) -> Vector (a, a)
forall a. Int -> (Int -> a) -> Vector a
VB.generate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector a
column) (Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector a
other)) (\Int
i -> (Vector a
column Vector a -> Int -> a
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
VG.! Int
i, Vector a
other Vector a -> Int -> a
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
VG.! Int
i)))
zipColumns (UnboxedColumn Vector a
column) (BoxedColumn Vector a
other) = Vector (a, a) -> Column
forall a. Columnable a => Vector a -> Column
BoxedColumn (Int -> (Int -> (a, a)) -> Vector (a, a)
forall a. Int -> (Int -> a) -> Vector a
VB.generate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector a
column) (Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length Vector a
other)) (\Int
i -> (Vector a
column Vector a -> Int -> a
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
VG.! Int
i, Vector a
other Vector a -> Int -> a
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
VG.! Int
i)))
zipColumns (UnboxedColumn Vector a
column) (UnboxedColumn Vector a
other) = Vector (a, a) -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector a -> Vector a -> Vector (a, a)
forall (v :: * -> *) a b.
(Vector v a, Vector v b, Vector v (a, b)) =>
v a -> v b -> v (a, b)
VG.zip Vector a
column Vector a
other)
{-# INLINE zipColumns #-}

-- Functions for mutable columns (intended for IO).
-- Clean this up.
writeColumn :: Int -> T.Text -> Column -> IO (Either T.Text Bool)
writeColumn :: Int -> Text -> Column -> IO (Either Text Bool)
writeColumn Int
i Text
value (MutableBoxedColumn (IOVector a
col :: VBM.IOVector a)) = let
  in case TypeRep a -> TypeRep Text -> Maybe (a :~: Text)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @T.Text) of
      Just a :~: Text
Refl -> (if Text -> Bool
isNullish Text
value
                    then MVector (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
VBM.unsafeWrite IOVector a
MVector (PrimState IO) a
col Int
i a
"" IO () -> IO (Either Text Bool) -> IO (Either Text Bool)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Text Bool -> IO (Either Text Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text Bool
forall a b. a -> Either a b
Left (Text -> Either Text Bool) -> Text -> Either Text Bool
forall a b. (a -> b) -> a -> b
$! Text
value)
                    else MVector (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
VBM.unsafeWrite IOVector a
MVector (PrimState IO) a
col Int
i a
Text
value IO () -> IO (Either Text Bool) -> IO (Either Text Bool)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Text Bool -> IO (Either Text Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True))
      Maybe (a :~: Text)
Nothing -> Either Text Bool -> IO (Either Text Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text Bool
forall a b. a -> Either a b
Left Text
value)
writeColumn Int
i Text
value (MutableUnboxedColumn (IOVector a
col :: VUM.IOVector a)) =
  case TypeRep a -> TypeRep Int -> Maybe (a :~: Int)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Int) of
      Just a :~: Int
Refl -> case HasCallStack => Text -> Maybe Int
Text -> Maybe Int
readInt Text
value of
        Just Int
v -> MVector (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VUM.unsafeWrite IOVector a
MVector (PrimState IO) a
col Int
i a
Int
v IO () -> IO (Either Text Bool) -> IO (Either Text Bool)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Text Bool -> IO (Either Text Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True)
        Maybe Int
Nothing -> MVector (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VUM.unsafeWrite IOVector a
MVector (PrimState IO) a
col Int
i a
0 IO () -> IO (Either Text Bool) -> IO (Either Text Bool)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Text Bool -> IO (Either Text Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text Bool
forall a b. a -> Either a b
Left Text
value)
      Maybe (a :~: Int)
Nothing -> case TypeRep a -> TypeRep Double -> Maybe (a :~: Double)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Double) of
          Maybe (a :~: Double)
Nothing -> Either Text Bool -> IO (Either Text Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text Bool
forall a b. a -> Either a b
Left (Text -> Either Text Bool) -> Text -> Either Text Bool
forall a b. (a -> b) -> a -> b
$! Text
value)
          Just a :~: Double
Refl -> case HasCallStack => Text -> Maybe Double
Text -> Maybe Double
readDouble Text
value of
            Just Double
v -> MVector (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VUM.unsafeWrite IOVector a
MVector (PrimState IO) a
col Int
i a
Double
v IO () -> IO (Either Text Bool) -> IO (Either Text Bool)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Text Bool -> IO (Either Text Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Either Text Bool
forall a b. b -> Either a b
Right Bool
True)
            Maybe Double
Nothing -> MVector (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VUM.unsafeWrite IOVector a
MVector (PrimState IO) a
col Int
i a
0 IO () -> IO (Either Text Bool) -> IO (Either Text Bool)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Text Bool -> IO (Either Text Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text Bool
forall a b. a -> Either a b
Left (Text -> Either Text Bool) -> Text -> Either Text Bool
forall a b. (a -> b) -> a -> b
$! Text
value)
{-# INLINE writeColumn #-}

freezeColumn' :: [(Int, T.Text)] -> Column -> IO Column
freezeColumn' :: [(Int, Text)] -> Column -> IO Column
freezeColumn' [(Int, Text)]
nulls (MutableBoxedColumn IOVector a
col)
  | [(Int, Text)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Text)]
nulls = Vector a -> Column
forall a. Columnable a => Vector a -> Column
BoxedColumn (Vector a -> Column) -> IO (Vector a) -> IO Column
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState IO) a -> IO (Vector a)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
VB.unsafeFreeze IOVector a
MVector (PrimState IO) a
col
  | ((Int, Text) -> Bool) -> [(Int, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Bool
isNullish (Text -> Bool) -> ((Int, Text) -> Text) -> (Int, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Text
forall a b. (a, b) -> b
snd) [(Int, Text)]
nulls = Vector (Maybe a) -> Column
forall a. Columnable a => Vector (Maybe a) -> Column
OptionalColumn (Vector (Maybe a) -> Column)
-> (Vector a -> Vector (Maybe a)) -> Vector a -> Column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> Maybe a) -> Vector a -> Vector (Maybe a)
forall a b. (Int -> a -> b) -> Vector a -> Vector b
VB.imap (\Int
i a
v -> if Int
i Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Int, Text) -> Int) -> [(Int, Text)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Text) -> Int
forall a b. (a, b) -> a
fst [(Int, Text)]
nulls then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
v) (Vector a -> Column) -> IO (Vector a) -> IO Column
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState IO) a -> IO (Vector a)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
VB.unsafeFreeze IOVector a
MVector (PrimState IO) a
col
  | Bool
otherwise  = Vector (Either Text a) -> Column
forall a. Columnable a => Vector a -> Column
BoxedColumn (Vector (Either Text a) -> Column)
-> (Vector a -> Vector (Either Text a)) -> Vector a -> Column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> Either Text a) -> Vector a -> Vector (Either Text a)
forall a b. (Int -> a -> b) -> Vector a -> Vector b
VB.imap (\Int
i a
v -> if Int
i Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Int, Text) -> Int) -> [(Int, Text)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Text) -> Int
forall a b. (a, b) -> a
fst [(Int, Text)]
nulls then Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
forall a. HasCallStack => String -> a
error String
"") (Int -> [(Int, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i [(Int, Text)]
nulls)) else a -> Either Text a
forall a b. b -> Either a b
Right a
v) (Vector a -> Column) -> IO (Vector a) -> IO Column
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState IO) a -> IO (Vector a)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
VB.unsafeFreeze IOVector a
MVector (PrimState IO) a
col
freezeColumn' [(Int, Text)]
nulls (MutableUnboxedColumn IOVector a
col)
  | [(Int, Text)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Text)]
nulls = Vector a -> Column
forall a. (Columnable a, Unbox a) => Vector a -> Column
UnboxedColumn (Vector a -> Column) -> IO (Vector a) -> IO Column
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState IO) a -> IO (Vector a)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VU.unsafeFreeze IOVector a
MVector (PrimState IO) a
col
  | ((Int, Text) -> Bool) -> [(Int, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Bool
isNullish (Text -> Bool) -> ((Int, Text) -> Text) -> (Int, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Text
forall a b. (a, b) -> b
snd) [(Int, Text)]
nulls = MVector (PrimState IO) a -> IO (Vector a)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VU.unsafeFreeze IOVector a
MVector (PrimState IO) a
col IO (Vector a) -> (Vector a -> IO Column) -> IO Column
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Vector a
c -> Column -> IO Column
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Column -> IO Column) -> Column -> IO Column
forall a b. (a -> b) -> a -> b
$ Vector (Maybe a) -> Column
forall a. Columnable a => Vector (Maybe a) -> Column
OptionalColumn (Vector (Maybe a) -> Column) -> Vector (Maybe a) -> Column
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Maybe a) -> Vector (Maybe a)
forall a. Int -> (Int -> a) -> Vector a
VB.generate (Vector a -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector a
c) (\Int
i -> if Int
i Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Int, Text) -> Int) -> [(Int, Text)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Text) -> Int
forall a b. (a, b) -> a
fst [(Int, Text)]
nulls then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just (Vector a
c Vector a -> Int -> a
forall a. Unbox a => Vector a -> Int -> a
VU.! Int
i))
  | Bool
otherwise  = MVector (PrimState IO) a -> IO (Vector a)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VU.unsafeFreeze IOVector a
MVector (PrimState IO) a
col IO (Vector a) -> (Vector a -> IO Column) -> IO Column
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Vector a
c -> Column -> IO Column
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Column -> IO Column) -> Column -> IO Column
forall a b. (a -> b) -> a -> b
$ Vector (Either Text a) -> Column
forall a. Columnable a => Vector a -> Column
BoxedColumn (Vector (Either Text a) -> Column)
-> Vector (Either Text a) -> Column
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Either Text a) -> Vector (Either Text a)
forall a. Int -> (Int -> a) -> Vector a
VB.generate (Vector a -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector a
c) (\Int
i -> if Int
i Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Int, Text) -> Int) -> [(Int, Text)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Text) -> Int
forall a b. (a, b) -> a
fst [(Int, Text)]
nulls then Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
forall a. HasCallStack => String -> a
error String
"") (Int -> [(Int, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i [(Int, Text)]
nulls)) else a -> Either Text a
forall a b. b -> Either a b
Right (Vector a
c Vector a -> Int -> a
forall a. Unbox a => Vector a -> Int -> a
VU.! Int
i))
{-# INLINE freezeColumn' #-}

expandColumn :: Int -> Column -> Column
expandColumn :: Int -> Column -> Column
expandColumn Int
n (OptionalColumn Vector (Maybe a)
col) = Vector (Maybe a) -> Column
forall a. Columnable a => Vector (Maybe a) -> Column
OptionalColumn (Vector (Maybe a) -> Column) -> Vector (Maybe a) -> Column
forall a b. (a -> b) -> a -> b
$ Vector (Maybe a)
col Vector (Maybe a) -> Vector (Maybe a) -> Vector (Maybe a)
forall a. Semigroup a => a -> a -> a
<> Int -> Maybe a -> Vector (Maybe a)
forall a. Int -> a -> Vector a
VB.replicate Int
n Maybe a
forall a. Maybe a
Nothing
expandColumn Int
n (BoxedColumn Vector a
col) = Vector (Maybe a) -> Column
forall a. Columnable a => Vector (Maybe a) -> Column
OptionalColumn (Vector (Maybe a) -> Column) -> Vector (Maybe a) -> Column
forall a b. (a -> b) -> a -> b
$ (a -> Maybe a) -> Vector a -> Vector (Maybe a)
forall a b. (a -> b) -> Vector a -> Vector b
VB.map a -> Maybe a
forall a. a -> Maybe a
Just Vector a
col Vector (Maybe a) -> Vector (Maybe a) -> Vector (Maybe a)
forall a. Semigroup a => a -> a -> a
<> Int -> Maybe a -> Vector (Maybe a)
forall a. Int -> a -> Vector a
VB.replicate Int
n Maybe a
forall a. Maybe a
Nothing
expandColumn Int
n (UnboxedColumn Vector a
col) = Vector (Maybe a) -> Column
forall a. Columnable a => Vector (Maybe a) -> Column
OptionalColumn (Vector (Maybe a) -> Column) -> Vector (Maybe a) -> Column
forall a b. (a -> b) -> a -> b
$ (a -> Maybe a) -> Vector a -> Vector (Maybe a)
forall a b. (a -> b) -> Vector a -> Vector b
VB.map a -> Maybe a
forall a. a -> Maybe a
Just (Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
VU.convert Vector a
col) Vector (Maybe a) -> Vector (Maybe a) -> Vector (Maybe a)
forall a. Semigroup a => a -> a -> a
<> Int -> Maybe a -> Vector (Maybe a)
forall a. Int -> a -> Vector a
VB.replicate Int
n Maybe a
forall a. Maybe a
Nothing
expandColumn Int
n (GroupedBoxedColumn Vector (Vector a)
col) = Vector (Vector a) -> Column
forall a. Columnable a => Vector (Vector a) -> Column
GroupedBoxedColumn (Vector (Vector a) -> Column) -> Vector (Vector a) -> Column
forall a b. (a -> b) -> a -> b
$ Vector (Vector a)
col Vector (Vector a) -> Vector (Vector a) -> Vector (Vector a)
forall a. Semigroup a => a -> a -> a
<> Int -> Vector a -> Vector (Vector a)
forall a. Int -> a -> Vector a
VB.replicate Int
n Vector a
forall a. Vector a
VB.empty
expandColumn Int
n (GroupedUnboxedColumn Vector (Vector a)
col) = Vector (Vector a) -> Column
forall a. (Columnable a, Unbox a) => Vector (Vector a) -> Column
GroupedUnboxedColumn (Vector (Vector a) -> Column) -> Vector (Vector a) -> Column
forall a b. (a -> b) -> a -> b
$ Vector (Vector a)
col Vector (Vector a) -> Vector (Vector a) -> Vector (Vector a)
forall a. Semigroup a => a -> a -> a
<> Int -> Vector a -> Vector (Vector a)
forall a. Int -> a -> Vector a
VB.replicate Int
n Vector a
forall a. Unbox a => Vector a
VU.empty