{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      : Database.Relational.Derives
-- Copyright   : 2013-2017 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines typed SQLs derived from type information.
module Database.Relational.Derives (
  -- * Query derivation
  specifiedKey,

  uniqueSelect,
  primarySelect,

  -- * Update derivation
  updateByConstraintKey,
  primaryUpdate,

  updateValuesWithKey,

  -- * Derived objects from table
  derivedUniqueRelation,

  -- * Deprecated
  unique,
  primary', primary,
  ) where

import Database.Record (PersistableWidth, ToSql)
import Database.Record.ToSql (unsafeUpdateValuesWithIndexes)

import Database.Relational.SqlSyntax (Record)

import Database.Relational.Table (Table, TableDerivable)
import Database.Relational.Pi (Pi, expandIndexes)
import qualified Database.Relational.Record as Record
import Database.Relational.Projectable (placeholder, (.=.), (!))
import Database.Relational.Monad.Class (wheres)
import Database.Relational.Monad.BaseType (Relation, relationWidth)
import Database.Relational.Relation
  (derivedRelation, relation, relation', query, UniqueRelation, unsafeUnique)
import Database.Relational.Constraint
   (Key, Primary, Unique, projectionKey, uniqueKey,
    HasConstraintKey(constraintKey))
import qualified Database.Relational.Constraint as Constraint
import Database.Relational.Type (KeyUpdate, typedKeyUpdate)


-- | Query restricted with specified key.
specifiedKey :: PersistableWidth p
             => Pi a p        -- ^ Projection path
             -> Relation () a -- ^ 'Relation' to add restriction.
             -> Relation p a  -- ^ Result restricted 'Relation'
specifiedKey :: forall p a.
PersistableWidth p =>
Pi a p -> Relation () a -> Relation p a
specifiedKey Pi a p
key Relation () a
rel = forall p r. SimpleQuery p r -> Relation p r
relation' forall a b. (a -> b) -> a -> b
$ do
  Record Flat a
q <- forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query Relation () a
rel
  (PlaceHolders p
param, ()) <- forall t c (m :: * -> *) a.
(PersistableWidth t, SqlContext c, Monad m) =>
(Record c t -> m a) -> m (PlaceHolders t, a)
placeholder (\Record Flat p
ph -> forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ forall a c b.
PersistableRecordWidth a -> Record c a -> Pi a b -> Record c b
Record.wpi (forall p r. Relation p r -> PersistableRecordWidth r
relationWidth Relation () a
rel) Record Flat a
q Pi a p
key forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. Record Flat p
ph)
  forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders p
param, Record Flat a
q)

-- | Query restricted with specified unique key.
uniqueSelect :: PersistableWidth p
             => Key Unique a p -- ^ Unique key proof object which record type is 'a' and key type is 'p'.
             -> Relation () a  -- ^ 'Relation' to add restriction.
             -> Relation p a   -- ^ Result restricted 'Relation'
uniqueSelect :: forall p a.
PersistableWidth p =>
Key Unique a p -> Relation () a -> Relation p a
uniqueSelect =  forall p a.
PersistableWidth p =>
Pi a p -> Relation () a -> Relation p a
specifiedKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c r ct. Key c r ct -> Pi r ct
projectionKey

{-# DEPRECATED unique "use `uniqueSelect` instead of this." #-}
-- | Deprecated.
unique :: PersistableWidth p
       => Key Unique a p
       -> Relation () a
       -> Relation p a
unique :: forall p a.
PersistableWidth p =>
Key Unique a p -> Relation () a -> Relation p a
unique = forall p a.
PersistableWidth p =>
Key Unique a p -> Relation () a -> Relation p a
uniqueSelect

{-# DEPRECATED primary' "use `primarySelect` instead of this." #-}
-- | Deprecated.
primary' :: PersistableWidth p
         => Key Primary a p -- ^ Primary key proof object which record type is 'a' and key type is 'p'.
         -> Relation () a   -- ^ 'Relation' to add restriction.
         -> Relation p a    -- ^ Result restricted 'Relation'
primary' :: forall p a.
PersistableWidth p =>
Key Primary a p -> Relation () a -> Relation p a
primary' =  forall p a.
PersistableWidth p =>
Pi a p -> Relation () a -> Relation p a
specifiedKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c r ct. Key c r ct -> Pi r ct
projectionKey

-- | Query restricted with inferred primary key.
primarySelect :: HasConstraintKey Primary a p
              => Relation () a -- ^ 'Relation' to add restriction.
              -> Relation p a  -- ^ Result restricted 'Relation'
primarySelect :: forall a p.
HasConstraintKey Primary a p =>
Relation () a -> Relation p a
primarySelect =  forall p a.
PersistableWidth p =>
Key Primary a p -> Relation () a -> Relation p a
primary' forall c r ct. HasConstraintKey c r ct => Key c r ct
constraintKey

{-# DEPRECATED primary "use `primarySelect` instead of this." #-}
-- | Deprecated.
primary :: HasConstraintKey Primary a p
        => Relation () a
        -> Relation p a
primary :: forall a p.
HasConstraintKey Primary a p =>
Relation () a -> Relation p a
primary = forall a p.
HasConstraintKey Primary a p =>
Relation () a -> Relation p a
primarySelect

-- | Convert from Haskell type `r` into SQL value `q` list expected by update form like
--
-- /UPDATE <table> SET c0 = ?, c1 = ?, ..., cn = ? WHERE key0 = ? AND key1 = ? AND key2 = ? ... /
--
--   using derived 'RecordToSql' proof object.
updateValuesWithKey :: ToSql q r
                    => Pi r p
                    -> r
                    -> [q]
updateValuesWithKey :: forall q r p. ToSql q r => Pi r p -> r -> [q]
updateValuesWithKey =  forall q ra. ToSql q ra => [Int] -> ra -> [q]
unsafeUpdateValuesWithIndexes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. PersistableWidth a => Pi a b -> [Int]
expandIndexes

-- | Typed 'KeyUpdate' using specified constraint key.
updateByConstraintKey :: Table r       -- ^ 'Table' to update
                      -> Key c r p     -- ^ Key with constraint 'c', record type 'r' and columns type 'p'
                      -> KeyUpdate p r -- ^ Result typed 'Update'
updateByConstraintKey :: forall r c p. Table r -> Key c r p -> KeyUpdate p r
updateByConstraintKey Table r
table' = forall a p. Table a -> Pi a p -> KeyUpdate p a
typedKeyUpdate Table r
table' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c r ct. Key c r ct -> Pi r ct
Constraint.projectionKey

-- | Typed 'KeyUpdate' using inferred primary key.
primaryUpdate :: (HasConstraintKey Primary r p)
              => Table r       -- ^ 'Table' to update
              -> KeyUpdate p r -- ^ Result typed 'Update'
primaryUpdate :: forall r p.
HasConstraintKey Primary r p =>
Table r -> KeyUpdate p r
primaryUpdate Table r
table' = forall r c p. Table r -> Key c r p -> KeyUpdate p r
updateByConstraintKey Table r
table' (forall ct r.
PersistableWidth ct =>
Key Primary r ct -> Key Unique r ct
uniqueKey forall c r ct. HasConstraintKey c r ct => Key c r ct
constraintKey)

-- | 'UniqueRelation' inferred from table.
derivedUniqueRelation :: TableDerivable r
                      => Key Unique r k        -- ^ Unique key proof object which record type is 'a' and key type is 'p'.
                      -> Record c k            -- ^ Unique key value to specify.
                      -> UniqueRelation () c r -- ^ Result restricted 'Relation'
derivedUniqueRelation :: forall r k c.
TableDerivable r =>
Key Unique r k -> Record c k -> UniqueRelation () c r
derivedUniqueRelation Key Unique r k
uk Record c k
kp = forall p r c. Relation p r -> UniqueRelation p c r
unsafeUnique forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. QuerySimple (Record Flat r) -> Relation () r
relation forall a b. (a -> b) -> a -> b
$ do
  Record Flat r
r <- forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query forall r. TableDerivable r => Relation () r
derivedRelation
  forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat r
r forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! forall c r ct. Key c r ct -> Pi r ct
projectionKey Key Unique r k
uk forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.=. forall c r c'. Record c r -> Record c' r
Record.unsafeChangeContext Record c k
kp
  forall (m :: * -> *) a. Monad m => a -> m a
return Record Flat r
r