{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language NamedFieldPuns #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
module Rel8.Table.NonEmpty
( NonEmptyTable(..)
, nonEmptyTable, nameNonEmptyTable
)
where
import Data.Functor.Identity ( Identity( Identity ) )
import Data.Kind ( Type )
import Data.List.NonEmpty ( NonEmpty )
import Data.Type.Equality ( (:~:)( Refl ) )
import Prelude
import Rel8.Expr ( Expr, Col( E, unE ) )
import Rel8.Expr.Array ( sappend1, snonEmptyOf )
import Rel8.Schema.Dict ( Dict( Dict ) )
import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
import Rel8.Schema.HTable.Vectorize ( happend, hvectorize )
import Rel8.Schema.Name ( Col( N ), Name( Name ) )
import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
import Rel8.Schema.Reify ( hreify, hunreify )
import Rel8.Schema.Spec ( SSpec(..) )
import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
import Rel8.Table
( Table, Context, Columns, fromColumns, toColumns
, reify, unreify
)
import Rel8.Table.Alternative ( AltTable, (<|>:) )
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 )
type NonEmptyTable :: Type -> Type
newtype NonEmptyTable a =
NonEmptyTable (HNonEmptyTable (Columns a) (Col (Context a)))
instance (Table context a, Unreifies context a) =>
Table context (NonEmptyTable a)
where
type Columns (NonEmptyTable a) = HNonEmptyTable (Columns a)
type Context (NonEmptyTable a) = Context a
fromColumns :: Columns (NonEmptyTable a) (Col context) -> NonEmptyTable a
fromColumns = Columns (NonEmptyTable a) (Col context) -> NonEmptyTable a
forall a.
HNonEmptyTable (Columns a) (Col (Context a)) -> NonEmptyTable a
NonEmptyTable
toColumns :: NonEmptyTable a -> Columns (NonEmptyTable a) (Col context)
toColumns (NonEmptyTable HNonEmptyTable (Columns a) (Col (Context a))
a) = HNonEmptyTable (Columns a) (Col (Context a))
Columns (NonEmptyTable a) (Col context)
a
reify :: (context :~: Reify ctx)
-> Unreify (NonEmptyTable a) -> NonEmptyTable a
reify context :~: Reify ctx
Refl (NonEmptyTable a) = HNonEmptyTable (Columns a) (Col (Context a)) -> NonEmptyTable a
forall a.
HNonEmptyTable (Columns a) (Col (Context a)) -> NonEmptyTable a
NonEmptyTable (HVectorize NonEmpty (Columns a) (Col ctx)
-> HVectorize NonEmpty (Columns a) (Col (Reify ctx))
forall (t :: HTable) (context :: Context).
HTable t =>
t (Col context) -> t (Col (Reify context))
hreify HVectorize NonEmpty (Columns a) (Col ctx)
HNonEmptyTable (Columns (Unreify a)) (Col (Context (Unreify a)))
a)
unreify :: (context :~: Reify ctx)
-> NonEmptyTable a -> Unreify (NonEmptyTable a)
unreify context :~: Reify ctx
Refl (NonEmptyTable HNonEmptyTable (Columns a) (Col (Context a))
a) = HNonEmptyTable (Columns (Unreify a)) (Col (Context (Unreify a)))
-> NonEmptyTable (Unreify a)
forall a.
HNonEmptyTable (Columns a) (Col (Context a)) -> NonEmptyTable a
NonEmptyTable (HVectorize NonEmpty (Columns a) (Col (Reify ctx))
-> HVectorize NonEmpty (Columns a) (Col ctx)
forall (t :: HTable) (context :: Context).
HTable t =>
t (Col (Reify context)) -> t (Col context)
hunreify HVectorize NonEmpty (Columns a) (Col (Reify ctx))
HNonEmptyTable (Columns a) (Col (Context a))
a)
instance
( Unreifies from a, Unreifies to b
, Recontextualize from to a b
)
=> Recontextualize from to (NonEmptyTable a) (NonEmptyTable b)
instance EqTable a => EqTable (NonEmptyTable a) where
eqTable :: Columns (NonEmptyTable a) (Dict (ConstrainDBType DBEq))
eqTable =
(forall (labels :: Labels) a.
SSpec ('Spec labels a)
-> Identity (Dict (ConstrainDBType DBEq) ('Spec labels a))
-> Dict (ConstrainDBType DBEq) ('Spec labels (NonEmpty a)))
-> Identity (Columns a (Dict (ConstrainDBType DBEq)))
-> HVectorize NonEmpty (Columns a) (Dict (ConstrainDBType DBEq))
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
(context :: HContext) (context' :: HContext).
(HTable t, Unzip f, Vector list) =>
(forall (labels :: Labels) a.
SSpec ('Spec labels a)
-> f (context ('Spec labels a))
-> context' ('Spec labels (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize
(\SSpec {} (Identity dict) -> case Dict (ConstrainDBType DBEq) ('Spec labels a)
-> Dict DBEq (Unnullify a)
forall (c :: * -> Constraint) (l :: Labels) a.
Dict (ConstrainDBType c) ('Spec l a) -> Dict c (Unnullify a)
dbTypeDict Dict (ConstrainDBType DBEq) ('Spec labels a)
dict of
Dict DBEq (Unnullify a)
Dict -> case Dict (ConstrainDBType DBEq) ('Spec labels a) -> Nullity a
forall (c :: * -> Constraint) (l :: Labels) a.
Dict (ConstrainDBType c) ('Spec l a) -> Nullity a
dbTypeNullity Dict (ConstrainDBType DBEq) ('Spec labels a)
dict of
Nullity a
Null -> Dict (ConstrainDBType DBEq) ('Spec labels (NonEmpty a))
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
Nullity a
NotNull -> Dict (ConstrainDBType DBEq) ('Spec labels (NonEmpty a))
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict)
(Columns a (Dict (ConstrainDBType DBEq))
-> Identity (Columns a (Dict (ConstrainDBType DBEq)))
forall a. a -> Identity a
Identity (EqTable a => Columns a (Dict (ConstrainDBType DBEq))
forall a. EqTable a => Columns a (Dict (ConstrainDBType DBEq))
eqTable @a))
instance OrdTable a => OrdTable (NonEmptyTable a) where
ordTable :: Columns (NonEmptyTable a) (Dict (ConstrainDBType DBOrd))
ordTable =
(forall (labels :: Labels) a.
SSpec ('Spec labels a)
-> Identity (Dict (ConstrainDBType DBOrd) ('Spec labels a))
-> Dict (ConstrainDBType DBOrd) ('Spec labels (NonEmpty a)))
-> Identity (Columns a (Dict (ConstrainDBType DBOrd)))
-> HVectorize NonEmpty (Columns a) (Dict (ConstrainDBType DBOrd))
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
(context :: HContext) (context' :: HContext).
(HTable t, Unzip f, Vector list) =>
(forall (labels :: Labels) a.
SSpec ('Spec labels a)
-> f (context ('Spec labels a))
-> context' ('Spec labels (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize
(\SSpec {} (Identity dict) -> case Dict (ConstrainDBType DBOrd) ('Spec labels a)
-> Dict DBOrd (Unnullify a)
forall (c :: * -> Constraint) (l :: Labels) a.
Dict (ConstrainDBType c) ('Spec l a) -> Dict c (Unnullify a)
dbTypeDict Dict (ConstrainDBType DBOrd) ('Spec labels a)
dict of
Dict DBOrd (Unnullify a)
Dict -> case Dict (ConstrainDBType DBOrd) ('Spec labels a) -> Nullity a
forall (c :: * -> Constraint) (l :: Labels) a.
Dict (ConstrainDBType c) ('Spec l a) -> Nullity a
dbTypeNullity Dict (ConstrainDBType DBOrd) ('Spec labels a)
dict of
Nullity a
Null -> Dict (ConstrainDBType DBOrd) ('Spec labels (NonEmpty a))
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
Nullity a
NotNull -> Dict (ConstrainDBType DBOrd) ('Spec labels (NonEmpty a))
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict)
(Columns a (Dict (ConstrainDBType DBOrd))
-> Identity (Columns a (Dict (ConstrainDBType DBOrd)))
forall a. a -> Identity a
Identity (OrdTable a => Columns a (Dict (ConstrainDBType DBOrd))
forall a. OrdTable a => Columns a (Dict (ConstrainDBType DBOrd))
ordTable @a))
type instance FromExprs (NonEmptyTable a) = NonEmpty (FromExprs a)
instance ToExprs exprs a => ToExprs (NonEmptyTable exprs) (NonEmpty a)
where
fromResult :: Columns (NonEmptyTable exprs) (Col Result) -> NonEmpty a
fromResult = (Columns exprs (Col Result) -> a)
-> NonEmpty (Columns exprs (Col Result)) -> NonEmpty a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ToExprs exprs a => Columns exprs (Col Result) -> a
forall exprs a. ToExprs exprs a => Columns exprs (Col Result) -> a
fromResult @exprs) (NonEmpty (Columns exprs (Col Result)) -> NonEmpty a)
-> (HVectorize NonEmpty (Columns exprs) (Col Result)
-> NonEmpty (Columns exprs (Col Result)))
-> HVectorize NonEmpty (Columns exprs) (Col Result)
-> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HVectorize NonEmpty (Columns exprs) (Col Result)
-> NonEmpty (Columns exprs (Col Result))
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns
toResult :: NonEmpty a -> Columns (NonEmptyTable exprs) (Col Result)
toResult = NonEmpty (Columns exprs (Col Result))
-> HVectorize NonEmpty (Columns exprs) (Col Result)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns (NonEmpty (Columns exprs (Col Result))
-> HVectorize NonEmpty (Columns exprs) (Col Result))
-> (NonEmpty a -> NonEmpty (Columns exprs (Col Result)))
-> NonEmpty a
-> HVectorize NonEmpty (Columns exprs) (Col Result)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Columns exprs (Col Result))
-> NonEmpty a -> NonEmpty (Columns exprs (Col Result))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ToExprs exprs a => a -> Columns exprs (Col Result)
forall exprs a. ToExprs exprs a => a -> Columns exprs (Col Result)
toResult @exprs)
instance AltTable NonEmptyTable where
<|>: :: NonEmptyTable a -> NonEmptyTable a -> NonEmptyTable a
(<|>:) = NonEmptyTable a -> NonEmptyTable a -> NonEmptyTable a
forall a. Semigroup a => a -> a -> a
(<>)
instance Table Expr a => Semigroup (NonEmptyTable a) where
NonEmptyTable HNonEmptyTable (Columns a) (Col (Context a))
as <> :: NonEmptyTable a -> NonEmptyTable a -> NonEmptyTable a
<> NonEmptyTable HNonEmptyTable (Columns a) (Col (Context a))
bs = HNonEmptyTable (Columns a) (Col (Context a)) -> NonEmptyTable a
forall a.
HNonEmptyTable (Columns a) (Col (Context a)) -> NonEmptyTable a
NonEmptyTable (HNonEmptyTable (Columns a) (Col (Context a)) -> NonEmptyTable a)
-> HNonEmptyTable (Columns a) (Col (Context a)) -> NonEmptyTable a
forall a b. (a -> b) -> a -> b
$
(forall (labels :: Labels) a.
Nullity a
-> TypeInformation (Unnullify a)
-> Col Expr ('Spec labels (NonEmpty a))
-> Col Expr ('Spec labels (NonEmpty a))
-> Col Expr ('Spec labels (NonEmpty a)))
-> HVectorize NonEmpty (Columns a) (Col Expr)
-> HVectorize NonEmpty (Columns a) (Col Expr)
-> HVectorize NonEmpty (Columns a) (Col Expr)
forall (t :: HTable) (list :: * -> *) (context :: HContext).
(HTable t, Vector list) =>
(forall (labels :: Labels) a.
Nullity a
-> TypeInformation (Unnullify a)
-> context ('Spec labels (list a))
-> context ('Spec labels (list a))
-> context ('Spec labels (list a)))
-> HVectorize list t context
-> HVectorize list t context
-> HVectorize list t context
happend (\Nullity a
_ TypeInformation (Unnullify a)
_ (E a) (E b) -> Expr (NonEmpty a) -> Col Expr ('Spec labels (NonEmpty a))
forall a (labels :: Labels). Expr a -> Col Expr ('Spec labels a)
E (Expr (NonEmpty a) -> Expr (NonEmpty a) -> Expr (NonEmpty a)
forall a.
Expr (NonEmpty a) -> Expr (NonEmpty a) -> Expr (NonEmpty a)
sappend1 Expr a
Expr (NonEmpty a)
a Expr a
Expr (NonEmpty a)
b)) HVectorize NonEmpty (Columns a) (Col Expr)
HNonEmptyTable (Columns a) (Col (Context a))
as HVectorize NonEmpty (Columns a) (Col Expr)
HNonEmptyTable (Columns a) (Col (Context a))
bs
nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable a
nonEmptyTable :: NonEmpty a -> NonEmptyTable a
nonEmptyTable =
HVectorize NonEmpty (Columns a) (Col Expr) -> NonEmptyTable a
forall a.
HNonEmptyTable (Columns a) (Col (Context a)) -> NonEmptyTable a
NonEmptyTable (HVectorize NonEmpty (Columns a) (Col Expr) -> NonEmptyTable a)
-> (NonEmpty a -> HVectorize NonEmpty (Columns a) (Col Expr))
-> NonEmpty a
-> NonEmptyTable a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall (labels :: Labels) a.
SSpec ('Spec labels a)
-> NonEmpty (Col Expr ('Spec labels a))
-> Col Expr ('Spec labels (NonEmpty a)))
-> NonEmpty (Columns a (Col Expr))
-> HVectorize NonEmpty (Columns a) (Col Expr)
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
(context :: HContext) (context' :: HContext).
(HTable t, Unzip f, Vector list) =>
(forall (labels :: Labels) a.
SSpec ('Spec labels a)
-> f (context ('Spec labels a))
-> context' ('Spec labels (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize (\SSpec {TypeInformation (Unnullify a)
info :: forall (labels :: Labels) a.
SSpec ('Spec labels a) -> TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info} -> Expr (NonEmpty a) -> Col Expr ('Spec labels (NonEmpty a))
forall a (labels :: Labels). Expr a -> Col Expr ('Spec labels a)
E (Expr (NonEmpty a) -> Col Expr ('Spec labels (NonEmpty a)))
-> (NonEmpty (Col Expr ('Spec labels a)) -> Expr (NonEmpty a))
-> NonEmpty (Col Expr ('Spec labels a))
-> Col Expr ('Spec labels (NonEmpty a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInformation (Unnullify a)
-> NonEmpty (Expr a) -> Expr (NonEmpty a)
forall a.
TypeInformation (Unnullify a)
-> NonEmpty (Expr a) -> Expr (NonEmpty a)
snonEmptyOf TypeInformation (Unnullify a)
TypeInformation (Unnullify a)
info (NonEmpty (Expr a) -> Expr (NonEmpty a))
-> (NonEmpty (Col Expr ('Spec labels a)) -> NonEmpty (Expr a))
-> NonEmpty (Col Expr ('Spec labels a))
-> Expr (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Col Expr ('Spec labels a) -> Expr a)
-> NonEmpty (Col Expr ('Spec labels a)) -> NonEmpty (Expr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Col Expr ('Spec labels a) -> Expr a
forall (labels :: Labels) a. Col Expr ('Spec labels a) -> Expr a
unE) (NonEmpty (Columns a (Col Expr))
-> HVectorize NonEmpty (Columns a) (Col Expr))
-> (NonEmpty a -> NonEmpty (Columns a (Col Expr)))
-> NonEmpty a
-> HVectorize NonEmpty (Columns a) (Col Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(a -> Columns a (Col Expr))
-> NonEmpty a -> NonEmpty (Columns a (Col Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns
nameNonEmptyTable
:: Table Name a
=> a
-> NonEmptyTable a
nameNonEmptyTable :: a -> NonEmptyTable a
nameNonEmptyTable =
HVectorize NonEmpty (Columns a) (Col Name) -> NonEmptyTable a
forall a.
HNonEmptyTable (Columns a) (Col (Context a)) -> NonEmptyTable a
NonEmptyTable (HVectorize NonEmpty (Columns a) (Col Name) -> NonEmptyTable a)
-> (a -> HVectorize NonEmpty (Columns a) (Col Name))
-> a
-> NonEmptyTable a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall (labels :: Labels) a.
SSpec ('Spec labels a)
-> Identity (Col Name ('Spec labels a))
-> Col Name ('Spec labels (NonEmpty a)))
-> Identity (Columns a (Col Name))
-> HVectorize NonEmpty (Columns a) (Col Name)
forall (t :: HTable) (f :: * -> *) (list :: * -> *)
(context :: HContext) (context' :: HContext).
(HTable t, Unzip f, Vector list) =>
(forall (labels :: Labels) a.
SSpec ('Spec labels a)
-> f (context ('Spec labels a))
-> context' ('Spec labels (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize (\SSpec ('Spec labels a)
_ (Identity (N (Name a))) -> Name (NonEmpty a) -> Col Name ('Spec labels (NonEmpty a))
forall a (labels :: Labels). Name a -> Col Name ('Spec labels a)
N (String -> Name (NonEmpty a)
forall k (a :: k). (k ~ *) => String -> Name a
Name String
a)) (Identity (Columns a (Col Name))
-> HVectorize NonEmpty (Columns a) (Col Name))
-> (a -> Identity (Columns a (Col Name)))
-> a
-> HVectorize NonEmpty (Columns a) (Col Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Columns a (Col Name) -> Identity (Columns a (Col Name))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Columns a (Col Name) -> Identity (Columns a (Col Name)))
-> (a -> Columns a (Col Name))
-> a
-> Identity (Columns a (Col Name))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
a -> Columns a (Col Name)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns