{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language NamedFieldPuns #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}

module Rel8.Table.NonEmpty
  ( NonEmptyTable(..)
  , nonEmptyTable, insertNonEmptyTable, 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.Insert ( Inserts )
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.Insert ( toInsert )
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) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> Identity
      (Dict (ConstrainDBType DBEq) ('Spec labels necessity a))
 -> Dict
      (ConstrainDBType DBEq) ('Spec labels 'Required (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) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> f (context ('Spec labels necessity a))
 -> context' ('Spec labels 'Required (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize
      (\SSpec {} (Identity dict) -> case Dict (ConstrainDBType DBEq) ('Spec labels necessity a)
-> Dict DBEq (Unnullify a)
forall (c :: * -> Constraint) (l :: Labels) (n :: Necessity) a.
Dict (ConstrainDBType c) ('Spec l n a) -> Dict c (Unnullify a)
dbTypeDict Dict (ConstrainDBType DBEq) ('Spec labels necessity a)
dict of
          Dict DBEq (Unnullify a)
Dict -> case Dict (ConstrainDBType DBEq) ('Spec labels necessity a) -> Nullity a
forall (c :: * -> Constraint) (l :: Labels) (n :: Necessity) a.
Dict (ConstrainDBType c) ('Spec l n a) -> Nullity a
dbTypeNullity Dict (ConstrainDBType DBEq) ('Spec labels necessity a)
dict of
            Nullity a
Null -> Dict (ConstrainDBType DBEq) ('Spec labels 'Required (NonEmpty a))
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
            Nullity a
NotNull -> Dict (ConstrainDBType DBEq) ('Spec labels 'Required (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) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> Identity
      (Dict (ConstrainDBType DBOrd) ('Spec labels necessity a))
 -> Dict
      (ConstrainDBType DBOrd) ('Spec labels 'Required (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) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> f (context ('Spec labels necessity a))
 -> context' ('Spec labels 'Required (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize
      (\SSpec {} (Identity dict) -> case Dict (ConstrainDBType DBOrd) ('Spec labels necessity a)
-> Dict DBOrd (Unnullify a)
forall (c :: * -> Constraint) (l :: Labels) (n :: Necessity) a.
Dict (ConstrainDBType c) ('Spec l n a) -> Dict c (Unnullify a)
dbTypeDict Dict (ConstrainDBType DBOrd) ('Spec labels necessity a)
dict of
          Dict DBOrd (Unnullify a)
Dict -> case Dict (ConstrainDBType DBOrd) ('Spec labels necessity a)
-> Nullity a
forall (c :: * -> Constraint) (l :: Labels) (n :: Necessity) a.
Dict (ConstrainDBType c) ('Spec l n a) -> Nullity a
dbTypeNullity Dict (ConstrainDBType DBOrd) ('Spec labels necessity a)
dict of
            Nullity a
Null -> Dict (ConstrainDBType DBOrd) ('Spec labels 'Required (NonEmpty a))
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
            Nullity a
NotNull -> Dict (ConstrainDBType DBOrd) ('Spec labels 'Required (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) (necessity :: Necessity) a.
 Nullity a
 -> TypeInformation (Unnullify a)
 -> Col Expr ('Spec labels necessity (NonEmpty a))
 -> Col Expr ('Spec labels necessity (NonEmpty a))
 -> Col Expr ('Spec labels necessity (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) (necessity :: Necessity) a.
 Nullity a
 -> TypeInformation (Unnullify a)
 -> context ('Spec labels necessity (list a))
 -> context ('Spec labels necessity (list a))
 -> context ('Spec labels necessity (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 necessity (NonEmpty a))
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity 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) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> NonEmpty (Col Expr ('Spec labels necessity a))
 -> Col Expr ('Spec labels 'Required (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) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> f (context ('Spec labels necessity a))
 -> context' ('Spec labels 'Required (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize (\SSpec {TypeInformation (Unnullify a)
info :: forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a) -> TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info} -> Expr (NonEmpty a) -> Col Expr ('Spec labels 'Required (NonEmpty a))
forall a (labels :: Labels) (necessity :: Necessity).
Expr a -> Col Expr ('Spec labels necessity a)
E (Expr (NonEmpty a)
 -> Col Expr ('Spec labels 'Required (NonEmpty a)))
-> (NonEmpty (Col Expr ('Spec labels necessity a))
    -> Expr (NonEmpty a))
-> NonEmpty (Col Expr ('Spec labels necessity a))
-> Col Expr ('Spec labels 'Required (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 necessity a))
    -> NonEmpty (Expr a))
-> NonEmpty (Col Expr ('Spec labels necessity a))
-> Expr (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Col Expr ('Spec labels necessity a) -> Expr a)
-> NonEmpty (Col Expr ('Spec labels necessity a))
-> NonEmpty (Expr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Col Expr ('Spec labels necessity a) -> Expr a
forall (labels :: Labels) (necessity :: Necessity) a.
Col Expr ('Spec labels necessity 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


insertNonEmptyTable :: Inserts exprs inserts
  => NonEmpty exprs -> NonEmptyTable inserts
insertNonEmptyTable :: NonEmpty exprs -> NonEmptyTable inserts
insertNonEmptyTable = NonEmptyTable exprs -> NonEmptyTable inserts
forall exprs inserts. Inserts exprs inserts => exprs -> inserts
toInsert (NonEmptyTable exprs -> NonEmptyTable inserts)
-> (NonEmpty exprs -> NonEmptyTable exprs)
-> NonEmpty exprs
-> NonEmptyTable inserts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty exprs -> NonEmptyTable exprs
forall a. Table Expr a => NonEmpty a -> NonEmptyTable a
nonEmptyTable


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) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> Identity (Col Name ('Spec labels necessity a))
 -> Col Name ('Spec labels 'Required (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) (necessity :: Necessity) a.
 SSpec ('Spec labels necessity a)
 -> f (context ('Spec labels necessity a))
 -> context' ('Spec labels 'Required (list a)))
-> f (t context) -> HVectorize list t context'
hvectorize (\SSpec ('Spec labels necessity a)
_ (Identity (N (Name a))) -> Name (NonEmpty a) -> Col Name ('Spec labels 'Required (NonEmpty a))
forall a (labels :: Labels) (necessity :: Necessity).
Name a -> Col Name ('Spec labels necessity 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