From ce08dcfeefe6a16a3143ac451755e4beb7aed33a Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Mon, 28 Jun 2021 17:38:46 +0100 Subject: [PATCH 1/6] Attempt 1 --- src/Rel8/Column/List.hs | 48 ++++++--- src/Rel8/Query/List.hs | 12 +-- src/Rel8/Schema/HTable/Vectorize.hs | 2 +- src/Rel8/Table/Aggregate.hs | 2 +- src/Rel8/Table/List.hs | 158 +++++++++++++++++++++------- 5 files changed, 160 insertions(+), 62 deletions(-) diff --git a/src/Rel8/Column/List.hs b/src/Rel8/Column/List.hs index ad9f80e1..a04d94f0 100644 --- a/src/Rel8/Column/List.hs +++ b/src/Rel8/Column/List.hs @@ -30,7 +30,7 @@ import Rel8.Table ( Table, Columns, Congruent, Context, fromColumns, toColumns , Unreify, reify, unreify ) -import Rel8.Table.List ( ListTable( ListTable ) ) +import Rel8.Table.List ( ListTable(..) ) import Rel8.Table.Recontextualize ( Recontextualize ) import Rel8.Table.Unreify ( Unreifiability(..), Unreifiable, unreifiability ) @@ -38,12 +38,12 @@ import Rel8.Table.Unreify ( Unreifiability(..), Unreifiable, unreifiability ) -- | Nest a list within a 'Rel8able'. @HList f a@ will produce a 'ListTable' -- @a@ in the 'Expr' context, and a @[a]@ in the 'Result' context. type HList :: K.Context -> Type -> Type -type family HList context where - HList (Reify context) = AHList context - HList Aggregate = ListTable - HList Expr = ListTable - HList Name = ListTable - HList Result = [] +type family HList context a where + HList (Reify context) a = AHList context a + HList Aggregate a = ListTable Aggregate a + HList Expr a = ListTable Expr a + HList Name a = ListTable Name a + HList Result a = [a] type AHList :: K.Context -> Type -> Type @@ -76,17 +76,24 @@ instance (AHList context' a') -smapList :: Congruent a b +smapList :: (Congruent a b) => SContext context -> (a -> b) -> (HListTable (Columns a) (Col (Context a)) -> HListTable (Columns b) (Col (Context b))) -> AHList context a -> AHList context b smapList = \case - SAggregate -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a)) - SExpr -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a)) + SAggregate -> \f _ -> \case + AHList (ListTable g a) -> AHList (ListTable (f . g) a) + + SExpr -> \f _ -> \case + AHList (ListTable g a) -> AHList (ListTable (f . g) a) + SResult -> \f _ (AHList as) -> AHList (fmap f as) - SName -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a)) + + SName -> \f _ -> \case + AHList (ListTable g a) -> AHList (ListTable (f . g) a) + SReify context -> \f g (AHList as) -> AHList (smapList context f g as) @@ -95,10 +102,10 @@ sfromColumnsList :: Table (Reify context) a -> HListTable (Columns a) (Col (Reify context)) -> AHList context a sfromColumnsList = \case - SAggregate -> AHList . ListTable - SExpr -> AHList . ListTable + SAggregate -> AHList . ListTable (fromColumns . hreify) . hunreify + SExpr -> AHList . ListTable (fromColumns . hreify) . hunreify SResult -> AHList . fmap (fromColumns . hreify) . fromColumns . hunreify - SName -> AHList . ListTable + SName -> AHList . ListTable (fromColumns . hreify) . hunreify SReify context -> AHList . smapList context (fromColumns . hreify) hreify . @@ -111,11 +118,18 @@ stoColumnsList :: Table (Reify context) a -> AHList context a -> HListTable (Columns a) (Col (Reify context)) stoColumnsList = \case - SAggregate -> \(AHList (ListTable a)) -> a - SExpr -> \(AHList (ListTable a)) -> a + SAggregate -> + hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a) + + SExpr -> + hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a) + SResult -> hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a) - SName -> \(AHList (ListTable a)) -> a + + SName -> + hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a) + SReify context -> hreify . stoColumnsList context . diff --git a/src/Rel8/Query/List.hs b/src/Rel8/Query/List.hs index f2736aa0..433cccde 100644 --- a/src/Rel8/Query/List.hs +++ b/src/Rel8/Query/List.hs @@ -31,7 +31,7 @@ import Rel8.Schema.Null ( Sql, Unnullify ) import Rel8.Schema.Spec ( SSpec( SSpec, info ) ) import Rel8.Table ( Table, fromColumns, toColumns ) import Rel8.Table.Aggregate ( listAgg, nonEmptyAgg ) -import Rel8.Table.List ( ListTable( ListTable ) ) +import Rel8.Table.List ( ListTable ) import Rel8.Table.Maybe ( maybeTable ) import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) ) import Rel8.Type ( DBType, typeInformation ) @@ -46,9 +46,9 @@ import Rel8.Type.Information ( TypeInformation ) -- -- @many@ is analogous to 'Control.Applicative.many' from -- @Control.Applicative@. -many :: Table Expr a => Query a -> Query (ListTable a) +many :: Table Expr a => Query a -> Query (ListTable Expr a) many = - fmap (maybeTable mempty (\(ListTable a) -> ListTable a)) . + fmap (maybeTable mempty (fromColumns . toColumns)) . optional . aggregate . fmap (listAgg . toColumns) @@ -83,9 +83,9 @@ someExpr = aggregate . fmap nonEmptyAggExpr -- element of the given @ListTable@. -- -- @catListTable@ is an inverse to 'many'. -catListTable :: Table Expr a => ListTable a -> Query a -catListTable (ListTable as) = rebind $ fromColumns $ runIdentity $ - hunvectorize (\SSpec {info} -> pure . E . sunnest info . unE) as +catListTable :: Table Expr a => ListTable Expr a -> Query a +catListTable as = rebind $ fromColumns $ runIdentity $ + hunvectorize (\SSpec {info} -> pure . E . sunnest info . unE) (toColumns as) -- | Expand a 'NonEmptyTable' into a 'Query', where each row in the query is an diff --git a/src/Rel8/Schema/HTable/Vectorize.hs b/src/Rel8/Schema/HTable/Vectorize.hs index 52e7bec0..d959e00a 100644 --- a/src/Rel8/Schema/HTable/Vectorize.hs +++ b/src/Rel8/Schema/HTable/Vectorize.hs @@ -20,7 +20,7 @@ {-# language UndecidableInstances #-} module Rel8.Schema.HTable.Vectorize - ( HVectorize + ( HVectorize(..) , hvectorize, hunvectorize , happend, hempty ) diff --git a/src/Rel8/Table/Aggregate.hs b/src/Rel8/Table/Aggregate.hs index 2acc1ce4..75d1b6df 100644 --- a/src/Rel8/Table/Aggregate.hs +++ b/src/Rel8/Table/Aggregate.hs @@ -66,7 +66,7 @@ hgroupBy eqs exprs = fromColumns $ htabulate $ \field -> -- items <- aggregate $ listAgg <$> itemsFromOrder order -- return (order, items) -- @ -listAgg :: Aggregates aggregates exprs => exprs -> ListTable aggregates +listAgg :: Aggregates aggregates exprs => exprs -> ListTable Aggregate aggregates listAgg (toColumns -> exprs) = fromColumns $ hvectorize (\SSpec {info} (Identity (E a)) -> A $ slistAggExpr info a) diff --git a/src/Rel8/Table/List.hs b/src/Rel8/Table/List.hs index eb641e2e..0a392808 100644 --- a/src/Rel8/Table/List.hs +++ b/src/Rel8/Table/List.hs @@ -1,5 +1,9 @@ +{-# language BlockArguments #-} +{-# language DataKinds #-} {-# language FlexibleContexts #-} {-# language FlexibleInstances #-} +{-# language GADTs #-} +{-# language LambdaCase #-} {-# language MultiParamTypeClasses #-} {-# language NamedFieldPuns #-} {-# language ScopedTypeVariables #-} @@ -15,24 +19,30 @@ module Rel8.Table.List where -- base -import Data.Functor.Identity ( Identity( Identity ) ) +import Control.Applicative ( Const(..) ) +import Data.Functor.Identity ( Identity( Identity ), runIdentity ) import Data.Kind ( Type ) import Data.Type.Equality ( (:~:)( Refl ) ) import Prelude +import Data.List ( intercalate ) -- rel8 -import Rel8.Expr ( Expr, Col( E, unE ) ) +import Rel8.Aggregate ( Aggregate ) +import Rel8.Expr ( Expr(..), Col( E, unE ) ) import Rel8.Expr.Array ( sappend, sempty, slistOf ) +import Rel8.Expr.Opaleye ( unsafeLiteral, fromPrimExpr, toPrimExpr ) import Rel8.Schema.Dict ( Dict( Dict ) ) +import qualified Rel8.Schema.Kind as K +import Rel8.Schema.HTable ( HTable, htabulate, hfield, hspecs, htraverse, hmap ) import Rel8.Schema.HTable.List ( HListTable ) -import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize ) -import Rel8.Schema.Name ( Col( N ), Name( Name ) ) +import Rel8.Schema.HTable.Vectorize ( HVectorize(..), happend, hempty, hunvectorize, hvectorize ) +import Rel8.Schema.Name ( Col( N ), Name( Name ), unN ) import Rel8.Schema.Null ( Nullity( Null, NotNull ) ) -import Rel8.Schema.Spec ( SSpec(..) ) +import Rel8.Schema.Spec ( Spec(..), SSpec(..) ) import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity ) -import Rel8.Schema.Reify ( hreify, hunreify ) +import Rel8.Schema.Reify ( UnwrapReify, hreify, hunreify ) import Rel8.Table - ( Table, Context, Columns, fromColumns, toColumns + ( Table, Context, Columns, Unreify, fromColumns, toColumns , reify, unreify ) import Rel8.Table.Alternative @@ -43,36 +53,110 @@ import Rel8.Table.Eq ( EqTable, eqTable ) import Rel8.Table.Ord ( OrdTable, ordTable ) import Rel8.Table.Recontextualize ( Recontextualize ) import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult ) -import Rel8.Table.Unreify ( Unreifies ) +import Control.Monad.Trans.State.Strict ( evalState, get, put, State ) +import qualified Opaleye.Internal.HaskellDB.PrimQuery as O +import qualified Opaleye.Internal.HaskellDB.Sql.Default as O +import qualified Opaleye.Internal.HaskellDB.Sql.Print as O +import qualified Opaleye.Internal.HaskellDB.Sql.Generate as O -- | A @ListTable@ value contains zero or more instances of @a@. You construct -- @ListTable@s with 'Rel8.many' or 'Rel8.listAgg'. -type ListTable :: Type -> Type -newtype ListTable a = ListTable (HListTable (Columns a) (Col (Context a))) +type ListTable :: K.Context -> Type -> Type +data ListTable context a where + ListTable :: HTable f + => (f (Col context) -> b) + -> HListTable f (Col context) + -> ListTable context b -instance (Table context a, Unreifies context a) => - Table context (ListTable a) +instance Functor (ListTable i) where + fmap f (ListTable g cols) = ListTable (f . g) cols + + +class ListContext context where + mapColumns + :: (HTable f, HTable g) + => (f (Col context) -> g (Col context)) + -> HListTable f (Col context) + -> HListTable g (Col context) + + +instance ListContext Expr where + mapColumns f i = hvectorize vectorizer $ pure $ htabulate \field -> + case hfield hspecs field of + SSpec{ info } -> + hfield (f exprs) field + where + names = evalState (htraverse freshName i) 0 + + namesList = getConst $ htraverse (\(N (Name x)) -> Const [x]) names + + vectorizer :: SSpec ('Spec a) -> Identity (Col Expr ('Spec a)) -> Col Expr ('Spec [a]) + vectorizer SSpec{info} (Identity (E (Expr yuck))) = + E $ unsafeLiteral $ + "(SELECT array_agg(" <> show (O.ppSqlExpr (O.sqlExpr O.defaultSqlGenerator yuck)) <> ") FROM " <> + "(SELECT " <> unnests <> ") q(" <> intercalate "," namesList <> "))" + vectorizer SSpec{info} (Identity (E (Expr other))) = error $ show other + + unnests :: String + unnests = intercalate "," $ getConst $ htraverse unnest i + where + unnest :: Col Expr a -> Const [String] (Col Expr a) + unnest (E (Expr yuck)) = + Const [ "unnest(" <> show (O.ppSqlExpr (O.sqlExpr O.defaultSqlGenerator yuck)) <> ")" ] + + freshName :: Col Expr a -> State Int (Col Name a) + freshName (E _) = do + n <- get + put (n + 1) + return $ N $ Name $ "x" <> show n + + exprs = runIdentity $ hunvectorize (\SSpec{info} -> pure . E . fromPrimExpr . toPrimExpr . unE) (hmap projectName names) + where + projectName :: Col Name a -> Col Expr a + projectName (N (Name name)) = + E $ fromPrimExpr $ O.BaseTableAttrExpr name + + +instance ListContext Aggregate where + mapColumns f i = undefined + + +instance ListContext Name where + mapColumns f = + hvectorize (\_ -> rename . runIdentity) . + fmap f . + hunvectorize (\_ -> pure . rename) + where rename = N . (\(Name x) -> Name x) . unN + + +instance (Table context a, c ~ context, Context a ~ c, ListContext context) => + Table context (ListTable c a) where - type Columns (ListTable a) = HListTable (Columns a) - type Context (ListTable a) = Context a + type Columns (ListTable c a) = HListTable (Columns a) + type Context (ListTable c a) = c + type Unreify (ListTable c a) = ListTable (UnwrapReify c) (Unreify a) + + fromColumns c = ListTable fromColumns c + + toColumns (ListTable f cols) = mapColumns (toColumns . f . fromColumns) cols - fromColumns = ListTable - toColumns (ListTable a) = a + reify Refl (ListTable f cols) = ListTable (reify Refl . f . hunreify) (hreify cols) - reify Refl (ListTable a) = ListTable (hreify a) - unreify Refl (ListTable a) = ListTable (hunreify a) + unreify Refl (ListTable f cols) = ListTable (unreify Refl . f . hreify) (hunreify cols) instance - ( Unreifies from a, Unreifies to b - , Recontextualize from to a b + ( Recontextualize from to a b + , ListContext from, ListContext to + , from ~ from' + , to ~ to' ) - => Recontextualize from to (ListTable a) (ListTable b) + => Recontextualize from to (ListTable from' a) (ListTable to' b) -instance EqTable a => EqTable (ListTable a) where +instance (context ~ Expr, EqTable a) => EqTable (ListTable context a) where eqTable = hvectorize (\SSpec {} (Identity dict) -> case dbTypeDict dict of @@ -82,7 +166,7 @@ instance EqTable a => EqTable (ListTable a) where (Identity (eqTable @a)) -instance OrdTable a => OrdTable (ListTable a) where +instance (context ~ Expr, OrdTable a) => OrdTable (ListTable context a) where ordTable = hvectorize (\SSpec {} (Identity dict) -> case dbTypeDict dict of @@ -92,35 +176,35 @@ instance OrdTable a => OrdTable (ListTable a) where (Identity (ordTable @a)) -type instance FromExprs (ListTable a) = [FromExprs a] +type instance FromExprs (ListTable _ a) = [FromExprs a] -instance ToExprs exprs a => ToExprs (ListTable exprs) [a] where +instance (context ~ Expr, ToExprs exprs a) => ToExprs (ListTable context exprs) [a] where fromResult = fmap (fromResult @exprs) . fromColumns toResult = toColumns . fmap (toResult @exprs) -instance AltTable ListTable where +instance context ~ Expr => AltTable (ListTable context) where (<|>:) = (<>) -instance AlternativeTable ListTable where +instance context ~ Expr => AlternativeTable (ListTable context) where emptyTable = mempty -instance Table Expr a => Semigroup (ListTable a) where - ListTable as <> ListTable bs = ListTable $ - happend (\_ _ (E a) (E b) -> E (sappend a b)) as bs +instance (context ~ Expr, Table Expr a) => Semigroup (ListTable context a) where + as <> bs = ListTable fromColumns $ + happend (\_ _ (E a) (E b) -> E (sappend a b)) (toColumns as) (toColumns bs) -instance Table Expr a => Monoid (ListTable a) where - mempty = ListTable $ hempty $ \_ -> E . sempty +instance (context ~ Expr, Table Expr a) => Monoid (ListTable context a) where + mempty = ListTable fromColumns $ hempty $ \_ -> E . sempty -- | Construct a @ListTable@ from a list of expressions. -listTable :: Table Expr a => [a] -> ListTable a +listTable :: forall a. Table Expr a => [a] -> ListTable Expr a listTable = - ListTable . + ListTable fromColumns . hvectorize (\SSpec {info} -> E . slistOf info . fmap unE) . fmap toColumns @@ -129,11 +213,11 @@ listTable = -- have a 'ListTable' that you are storing in a table and need to construct a -- 'TableSchema'. nameListTable - :: Table Name a + :: forall a. Table Name a => a -- ^ The names of the columns of elements of the list. - -> ListTable a + -> ListTable Name a nameListTable = - ListTable . + ListTable fromColumns . hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) . pure . toColumns From 47d7fbdf79068a16696d158d42cbfc6b8713053f Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Tue, 29 Jun 2021 12:50:29 +0100 Subject: [PATCH 2/6] Update List.hs --- src/Rel8/Column/List.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Rel8/Column/List.hs b/src/Rel8/Column/List.hs index a04d94f0..f49d6717 100644 --- a/src/Rel8/Column/List.hs +++ b/src/Rel8/Column/List.hs @@ -38,12 +38,12 @@ import Rel8.Table.Unreify ( Unreifiability(..), Unreifiable, unreifiability ) -- | Nest a list within a 'Rel8able'. @HList f a@ will produce a 'ListTable' -- @a@ in the 'Expr' context, and a @[a]@ in the 'Result' context. type HList :: K.Context -> Type -> Type -type family HList context a where - HList (Reify context) a = AHList context a - HList Aggregate a = ListTable Aggregate a - HList Expr a = ListTable Expr a - HList Name a = ListTable Name a - HList Result a = [a] +type family HList context where + HList (Reify context) a = AHList context + HList Aggregate a = ListTable Aggregate + HList Expr a = ListTable Expr + HList Name a = ListTable Name + HList Result = [] type AHList :: K.Context -> Type -> Type From 0c759c4c1ffae4c26dd8169dcbb8035a07905623 Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Tue, 29 Jun 2021 12:50:43 +0100 Subject: [PATCH 3/6] Update List.hs --- src/Rel8/Column/List.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Rel8/Column/List.hs b/src/Rel8/Column/List.hs index f49d6717..88a466cb 100644 --- a/src/Rel8/Column/List.hs +++ b/src/Rel8/Column/List.hs @@ -39,10 +39,10 @@ import Rel8.Table.Unreify ( Unreifiability(..), Unreifiable, unreifiability ) -- @a@ in the 'Expr' context, and a @[a]@ in the 'Result' context. type HList :: K.Context -> Type -> Type type family HList context where - HList (Reify context) a = AHList context - HList Aggregate a = ListTable Aggregate - HList Expr a = ListTable Expr - HList Name a = ListTable Name + HList (Reify context) = AHList context + HList Aggregate = ListTable Aggregate + HList Expr = ListTable Expr + HList Name = ListTable Name HList Result = [] From fa55b9094dcb06c72f283cd67c3d4f184493bb12 Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Tue, 29 Jun 2021 12:50:57 +0100 Subject: [PATCH 4/6] Update List.hs --- src/Rel8/Column/List.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Rel8/Column/List.hs b/src/Rel8/Column/List.hs index 88a466cb..d0e8623a 100644 --- a/src/Rel8/Column/List.hs +++ b/src/Rel8/Column/List.hs @@ -76,7 +76,7 @@ instance (AHList context' a') -smapList :: (Congruent a b) +smapList :: Congruent a b => SContext context -> (a -> b) -> (HListTable (Columns a) (Col (Context a)) -> HListTable (Columns b) (Col (Context b))) From cc206937c1b433cb7d710fe4ba7a18684d4b701f Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Tue, 29 Jun 2021 12:52:16 +0100 Subject: [PATCH 5/6] Update List.hs --- src/Rel8/Table/List.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Rel8/Table/List.hs b/src/Rel8/Table/List.hs index 0a392808..d5d63b5d 100644 --- a/src/Rel8/Table/List.hs +++ b/src/Rel8/Table/List.hs @@ -202,7 +202,7 @@ instance (context ~ Expr, Table Expr a) => Monoid (ListTable context a) where -- | Construct a @ListTable@ from a list of expressions. -listTable :: forall a. Table Expr a => [a] -> ListTable Expr a +listTable :: Table Expr a => [a] -> ListTable Expr a listTable = ListTable fromColumns . hvectorize (\SSpec {info} -> E . slistOf info . fmap unE) . @@ -213,7 +213,7 @@ listTable = -- have a 'ListTable' that you are storing in a table and need to construct a -- 'TableSchema'. nameListTable - :: forall a. Table Name a + :: Table Name a => a -- ^ The names of the columns of elements of the list. -> ListTable Name a nameListTable = From b2bee8da29f2ac682c51e06f8c22e229eaad9ebc Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Tue, 6 Jul 2021 16:48:20 +0100 Subject: [PATCH 6/6] Tidying --- src/Rel8/Column/List.hs | 2 +- src/Rel8/Table/List.hs | 33 ++++++++++++++++++--------------- 2 files changed, 19 insertions(+), 16 deletions(-) diff --git a/src/Rel8/Column/List.hs b/src/Rel8/Column/List.hs index 68535287..069092b2 100644 --- a/src/Rel8/Column/List.hs +++ b/src/Rel8/Column/List.hs @@ -23,7 +23,7 @@ import Rel8.Table.List ( ListTable ) -- | Nest a list within a 'Rel8able'. @HList f a@ will produce a 'ListTable' -- @a@ in the 'Expr' context, and a @[a]@ in the 'Result' context. type HList :: K.Context -> Type -> Type -type family HList context where +type family HList context = list | list -> context where HList Aggregate = ListTable Aggregate HList Expr = ListTable Expr HList Name = ListTable Name diff --git a/src/Rel8/Table/List.hs b/src/Rel8/Table/List.hs index e8fee213..869d6855 100644 --- a/src/Rel8/Table/List.hs +++ b/src/Rel8/Table/List.hs @@ -134,17 +134,15 @@ instance ListContext Name where where rename = N . (\(Name x) -> Name x) . unN -instance (Table context a, c ~ context, Context a ~ c, ListContext context) => - Table context (ListTable c a) +instance (Table context a, context ~ context', ListContext context') => + Table context' (ListTable context a) where - type Columns (ListTable c a) = HListTable (Columns a) - type Context (ListTable c a) = Context a - type FromExprs (ListTable c a) = [FromExprs a] - - fromColumns c = ListTable fromColumns c + type Columns (ListTable context a) = HListTable (Columns a) + type Context (ListTable context a) = Context a + type FromExprs (ListTable context a) = [FromExprs a] + fromColumns = ListTable fromColumns toColumns (ListTable f cols) = mapColumns (toColumns . f) cols - fromResult = fmap (fromResult @_ @a) . hunvectorize unvectorizer toResult = hvectorize vectorizer . fmap (toResult @_ @a) @@ -171,7 +169,8 @@ instance (OrdTable a, context ~ Expr) => OrdTable (ListTable context a) where (Identity (ordTable @a)) -instance (context ~ Expr, ToExprs exprs a) => ToExprs (ListTable context exprs) [a] where +instance (ToExprs exprs a, context ~ Expr) => + ToExprs (ListTable context exprs) [a] instance context ~ Expr => AltTable (ListTable context) where @@ -182,19 +181,23 @@ instance context ~ Expr => AlternativeTable (ListTable context) where emptyTable = mempty -instance (context ~ Expr, Table Expr a) => Semigroup (ListTable context a) where - as <> bs = ListTable fromColumns $ +instance (context ~ Expr, Table Expr a) => + Semigroup (ListTable context a) + where + as <> bs = fromColumns $ happend (\_ _ (E a) (E b) -> E (sappend a b)) (toColumns as) (toColumns bs) -instance (context ~ Expr, Table Expr a) => Monoid (ListTable context a) where - mempty = ListTable fromColumns $ hempty $ \_ -> E . sempty +instance (context ~ Expr, Table Expr a) => + Monoid (ListTable context a) + where + mempty = fromColumns $ hempty $ \_ -> E . sempty -- | Construct a @ListTable@ from a list of expressions. listTable :: Table Expr a => [a] -> ListTable Expr a listTable = - ListTable fromColumns . + fromColumns . hvectorize (\SSpec {info} -> E . slistOf info . fmap unE) . fmap toColumns @@ -207,7 +210,7 @@ nameListTable => a -- ^ The names of the columns of elements of the list. -> ListTable Name a nameListTable = - ListTable fromColumns . + fromColumns . hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) . pure . toColumns