{-# language DataKinds #-}
{-# language DuplicateRecordFields #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language LambdaCase #-}
{-# language MultiParamTypeClasses #-}
{-# language NamedFieldPuns #-}
{-# language PolyKinds #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
{-# language UndecidableSuperClasses #-}

module Rel8.Schema.Insert
  ( Insert(..)
  , OnConflict(..)
  , Col( I, unI )
  , Inserts
  , Create(..)
  )
where

-- base
import Data.Functor.Identity ( Identity )
import Data.Kind ( Constraint, Type )
import Prelude

-- rel8
import Rel8.Aggregate ( Aggregate )
import Rel8.Expr ( Expr )
import Rel8.Kind.Necessity ( Necessity(Optional, Required), KnownNecessity )
import Rel8.Schema.Context ( Interpretation(..) )
import Rel8.Schema.Context.Label ( Labelable(..) )
import Rel8.Schema.Context.Nullify
  ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
  , runTag, unnull
  )
import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
import Rel8.Schema.Name ( Name, Selects )
import Rel8.Schema.Null ( Sql )
import Rel8.Schema.Reify ( notReify )
import Rel8.Schema.Result ( Result )
import Rel8.Schema.Spec ( SSpec(SSpec, nullity), Spec(Spec) )
import Rel8.Schema.Table ( TableSchema )
import Rel8.Statement.Returning ( Returning )
import Rel8.Table
  ( Table, Context, Columns, fromColumns, toColumns
  , reify, unreify
  )
import Rel8.Table.Recontextualize ( Recontextualize )
import Rel8.Table.Tag ( Tag(..), fromExpr )
import Rel8.Type ( DBType )


-- | @OnConflict@ allows you to add an @ON CONFLICT@ clause to an @INSERT@
-- statement.
data OnConflict
  = Abort     -- ^ @ON CONFLICT ABORT@
  | DoNothing -- ^ @ON CONFLICT DO NOTHING@


-- | The constituent parts of a SQL @INSERT@ statement.
type Insert :: k -> Type
data Insert a where
  Insert :: (Selects names exprs, Inserts exprs inserts) =>
    { ()
into :: TableSchema names
      -- ^ Which table to insert into.
    , ()
rows :: [inserts]
      -- ^ The rows to insert.
    , Insert a -> OnConflict
onConflict :: OnConflict
      -- ^ What to do if the inserted rows conflict with data already in the
      -- table.
    , ()
returning :: Returning names a
      -- ^ What information to return on completion.
    }
    -> Insert a


instance Interpretation Insert where
  data Col Insert _spec where
    I :: {Col Insert ('Spec labels necessity a) -> Create necessity a
unI :: !(Create necessity a)} -> Col Insert ('Spec labels necessity a)


type Create :: Necessity -> Type -> Type
data Create necessity a where
  Default :: Create 'Optional a
  Value :: Expr a -> Create necessity a


instance (KnownNecessity necessity, Sql DBType a) =>
  Table Insert (Create necessity a)
 where
  type Columns (Create necessity a) = HIdentity ('Spec '[] necessity a)
  type Context (Create necessity a) = Insert

  toColumns :: Create necessity a -> Columns (Create necessity a) (Col Insert)
toColumns = Col Insert ('Spec '[] necessity a)
-> HIdentity ('Spec '[] necessity a) (Col Insert)
forall (spec :: Spec) (context :: HContext).
context spec -> HIdentity spec context
HIdentity (Col Insert ('Spec '[] necessity a)
 -> HIdentity ('Spec '[] necessity a) (Col Insert))
-> (Create necessity a -> Col Insert ('Spec '[] necessity a))
-> Create necessity a
-> HIdentity ('Spec '[] necessity a) (Col Insert)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Create necessity a -> Col Insert ('Spec '[] necessity a)
forall (necessity :: Necessity) a (labels :: Labels).
Create necessity a -> Col Insert ('Spec labels necessity a)
I
  fromColumns :: Columns (Create necessity a) (Col Insert) -> Create necessity a
fromColumns (HIdentity (I a)) = Create necessity a
Create necessity a
a
  reify :: (Insert :~: Reify ctx)
-> Unreify (Create necessity a) -> Create necessity a
reify = (Insert :~: Reify ctx)
-> Unreify (Create necessity a) -> Create necessity a
forall (context :: Context) (ctx :: Context) a.
NotReify context =>
(context :~: Reify ctx) -> a
notReify
  unreify :: (Insert :~: Reify ctx)
-> Create necessity a -> Unreify (Create necessity a)
unreify = (Insert :~: Reify ctx)
-> Create necessity a -> Unreify (Create necessity a)
forall (context :: Context) (ctx :: Context) a.
NotReify context =>
(context :~: Reify ctx) -> a
notReify


instance Sql DBType a =>
  Recontextualize Aggregate Insert (Aggregate a) (Create 'Required a)


instance Sql DBType a => Recontextualize Expr Insert (Expr a) (Create 'Required a)


instance Sql DBType a =>
  Recontextualize Result Insert (Identity a) (Create 'Required a)


instance Sql DBType a =>
  Recontextualize Insert Aggregate (Create 'Required a) (Aggregate a)


instance Sql DBType a => Recontextualize Insert Expr (Create 'Required a) (Expr a)


instance Sql DBType a =>
  Recontextualize Insert Result (Create 'Required a) (Identity a)


instance Sql DBType a => Recontextualize Insert Insert (Create 'Required a) (Create 'Required a)


instance Sql DBType a => Recontextualize Insert Name (Create 'Required a) (Name a)


instance Sql DBType a => Recontextualize Name Insert (Name a) (Create 'Required a)


instance Labelable Insert where
  labeler :: Col Insert ('Spec labels necessity a)
-> Col Insert ('Spec (label : labels) necessity a)
labeler (I a) = Create necessity a
-> Col Insert ('Spec (label : labels) necessity a)
forall (necessity :: Necessity) a (labels :: Labels).
Create necessity a -> Col Insert ('Spec labels necessity a)
I Create necessity a
a
  unlabeler :: Col Insert ('Spec (label : labels) necessity a)
-> Col Insert ('Spec labels necessity a)
unlabeler (I a) = Create necessity a -> Col Insert ('Spec labels necessity a)
forall (necessity :: Necessity) a (labels :: Labels).
Create necessity a -> Col Insert ('Spec labels necessity a)
I Create necessity a
a


instance Nullifiable Insert where
  encodeTag :: Tag label a -> Col Insert ('Spec labels 'Required a)
encodeTag = Create 'Required a -> Col Insert ('Spec labels 'Required a)
forall (necessity :: Necessity) a (labels :: Labels).
Create necessity a -> Col Insert ('Spec labels necessity a)
I (Create 'Required a -> Col Insert ('Spec labels 'Required a))
-> (Tag label a -> Create 'Required a)
-> Tag label a
-> Col Insert ('Spec labels 'Required a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr a -> Create 'Required a
forall a (necessity :: Necessity). Expr a -> Create necessity a
Value (Expr a -> Create 'Required a)
-> (Tag label a -> Expr a) -> Tag label a -> Create 'Required a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag label a -> Expr a
forall (label :: Symbol) a. Tag label a -> Expr a
expr

  decodeTag :: Col Insert ('Spec labels 'Required a) -> Tag label a
decodeTag (I (Value a)) = Expr a -> Tag label a
forall (label :: Symbol) a.
(KnownSymbol label, Taggable a) =>
Expr a -> Tag label a
fromExpr Expr a
a

  nullifier :: Tag label a
-> (Expr a -> Expr Bool)
-> SSpec ('Spec labels necessity x)
-> Col Insert ('Spec labels necessity x)
-> Col Insert ('Spec labels necessity (Nullify x))
nullifier Tag {Expr a
expr :: Expr a
expr :: forall (label :: Symbol) a. Tag label a -> Expr a
expr} Expr a -> Expr Bool
test SSpec {Nullity a
nullity :: Nullity a
nullity :: forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a) -> Nullity a
nullity} = \case
    I Default -> Create 'Optional (Nullify x)
-> Col Insert ('Spec labels 'Optional (Nullify x))
forall (necessity :: Necessity) a (labels :: Labels).
Create necessity a -> Col Insert ('Spec labels necessity a)
I Create 'Optional (Nullify x)
forall a. Create 'Optional a
Default
    I (Value a) -> Create necessity (Nullify x)
-> Col Insert ('Spec labels necessity (Nullify x))
forall (necessity :: Necessity) a (labels :: Labels).
Create necessity a -> Col Insert ('Spec labels necessity a)
I (Create necessity (Nullify x)
 -> Col Insert ('Spec labels necessity (Nullify x)))
-> Create necessity (Nullify x)
-> Col Insert ('Spec labels necessity (Nullify x))
forall a b. (a -> b) -> a -> b
$ Expr (Nullify x) -> Create necessity (Nullify x)
forall a (necessity :: Necessity). Expr a -> Create necessity a
Value (Expr (Nullify x) -> Create necessity (Nullify x))
-> Expr (Nullify x) -> Create necessity (Nullify x)
forall a b. (a -> b) -> a -> b
$ Nullity a -> Expr Bool -> Expr a -> Expr (Nullify a)
forall a. Nullity a -> Expr Bool -> Expr a -> Expr (Nullify a)
runTag Nullity a
nullity Expr Bool
condition Expr a
Expr a
a
    where
      condition :: Expr Bool
condition = Expr a -> Expr Bool
test Expr a
expr

  unnullifier :: SSpec ('Spec labels necessity x)
-> Col Insert ('Spec labels necessity (Nullify x))
-> Col Insert ('Spec labels necessity x)
unnullifier SSpec {Nullity a
nullity :: Nullity a
nullity :: forall (labels :: Labels) (necessity :: Necessity) a.
SSpec ('Spec labels necessity a) -> Nullity a
nullity} = \case
    I Default -> Create 'Optional x -> Col Insert ('Spec labels 'Optional x)
forall (necessity :: Necessity) a (labels :: Labels).
Create necessity a -> Col Insert ('Spec labels necessity a)
I Create 'Optional x
forall a. Create 'Optional a
Default
    I (Value a) -> Create necessity a -> Col Insert ('Spec labels necessity a)
forall (necessity :: Necessity) a (labels :: Labels).
Create necessity a -> Col Insert ('Spec labels necessity a)
I (Create necessity a -> Col Insert ('Spec labels necessity a))
-> Create necessity a -> Col Insert ('Spec labels necessity a)
forall a b. (a -> b) -> a -> b
$ Expr a -> Create necessity a
forall a (necessity :: Necessity). Expr a -> Create necessity a
Value (Expr a -> Create necessity a) -> Expr a -> Create necessity a
forall a b. (a -> b) -> a -> b
$ Nullity a -> Expr (Nullify a) -> Expr a
forall a. Nullity a -> Expr (Nullify a) -> Expr a
unnull Nullity a
nullity Expr a
Expr (Nullify a)
a

  {-# INLINABLE encodeTag #-}
  {-# INLINABLE decodeTag #-}
  {-# INLINABLE nullifier #-}
  {-# INLINABLE unnullifier #-}


-- | @Inserts a b@ means that the columns in @a@ are compatible for inserting
-- with the table @b@.
type Inserts :: Type -> Type -> Constraint
class Recontextualize Expr Insert exprs inserts => Inserts exprs inserts
instance Recontextualize Expr Insert exprs inserts => Inserts exprs inserts