{-# 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

-- base
import Data.Functor.Identity ( Identity( Identity ) )
import Data.Kind ( Type )
import Data.List.NonEmpty ( NonEmpty )
import Data.Type.Equality ( (:~:)( Refl ) )
import Prelude

-- rel8
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 )


-- | A @NonEmptyTable@ value contains one or more instances of @a@. You
-- construct @NonEmptyTable@s with 'Rel8.some' or 'nonEmptyAgg'.
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


-- | Construct a @NonEmptyTable@ from a non-empty list of expressions.
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


-- | Construct a 'NonEmptyTable' in the 'Name' context. This can be useful if
-- you have a 'NonEmptyTable' that you are storing in a table and need to
-- construct a 'TableSchema'.
nameNonEmptyTable
  :: Table Name a
  => a -- ^ The names of the columns of elements of the list.
  -> 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