{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}

-- |
-- Module      : Database.Relational.Sequence
-- Copyright   : 2017-2018 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module provides structures about sequence tables.
module Database.Relational.Sequence (
  Sequence, seqTable, seqExtract, seqKey, seqRelation,
  unsafeSpecifySequence,

  SeqBinding, boundTable, boundKey, boundSequence,
  unsafeSpecifyBinding, primaryBinding,

  SequenceDerivable (..),

  Binding (..), fromRelation,

  Number, unsafeSpecifyNumber, extractNumber,
  ($$!), ($$),

  updateNumber', updateNumber,
  ) where

import Prelude hiding (seq)

import Database.Record (PersistableWidth)
import Database.Relational.Internal.Config (Config, defaultConfig)
import Database.Relational.Monad.Class (wheres)
import Database.Relational.Monad.BaseType (Relation)
import Database.Relational.Monad.Trans.Assigning ((<-#))
import Database.Relational.Table (TableDerivable, derivedTable, Table)
import Database.Relational.Pi (Pi)
import Database.Relational.Constraint
  (HasConstraintKey (..), Key, Primary, projectionKey)
import Database.Relational.Projectable ((.<=.), value, unitPH, (!))
import Database.Relational.ProjectableClass (LiteralSQL)
import Database.Relational.Relation (tableOf)
import qualified Database.Relational.Relation as Relation
import Database.Relational.Type (Update, typedUpdate')


-- | Basic record to express sequence-table.
--   actual sequence-table is a table which has only one column
--   of integer type.
data Sequence s i =
  Sequence
  { forall s i. Sequence s i -> Table s
seqTable    :: Table s   -- ^ actual sequence-table
  , forall s i. Sequence s i -> s -> i
seqExtract  :: s -> i    -- ^ sequence number selector for sequence record
  , forall s i. Sequence s i -> Pi s i
seqKey      :: Pi s i    -- ^ sequence number projection for sequence record
  }

-- | Unsafely specify sequence table.
unsafeSpecifySequence :: TableDerivable s => (s -> i) -> Pi s i -> Sequence s i
unsafeSpecifySequence :: forall s i. TableDerivable s => (s -> i) -> Pi s i -> Sequence s i
unsafeSpecifySequence = forall s i. Table s -> (s -> i) -> Pi s i -> Sequence s i
Sequence forall r. TableDerivable r => Table r
derivedTable

-- | Infer 'Relation' of sequence table
seqRelation :: TableDerivable s => Sequence s i -> Relation () s
seqRelation :: forall s i. TableDerivable s => Sequence s i -> Relation () s
seqRelation = forall r. Table r -> Relation () r
Relation.table forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s i. Sequence s i -> Table s
seqTable

-- | 'Sequence' derivation rule
class TableDerivable s => SequenceDerivable s i | s -> i where
  derivedSequence :: Sequence s i

-- | Record to express binding between normal-table and sequence-table.
data SeqBinding r s i =
  SeqBinding
  { forall r s i. SeqBinding r s i -> Table r
boundTable     :: Table r       -- ^ normal-table bound to sequence-table
  , forall r s i. SeqBinding r s i -> Pi r i
boundKey       :: Pi r i        -- ^ sequence key projection for bound record
  , forall r s i. SeqBinding r s i -> Sequence s i
boundSequence  :: Sequence s i  -- ^ sequence table record
  }

-- | Unsafely specify binding between normal-table and sequence-table.
unsafeSpecifyBinding :: (TableDerivable r, SequenceDerivable s i)
                     => Pi r i -> SeqBinding r s i
unsafeSpecifyBinding :: forall r s i.
(TableDerivable r, SequenceDerivable s i) =>
Pi r i -> SeqBinding r s i
unsafeSpecifyBinding Pi r i
k = forall r s i. Table r -> Pi r i -> Sequence s i -> SeqBinding r s i
SeqBinding forall r. TableDerivable r => Table r
derivedTable Pi r i
k forall s i. SequenceDerivable s i => Sequence s i
derivedSequence

-- | Derive binding using primary key.
primaryBinding :: (TableDerivable r, SequenceDerivable s i,
                   HasConstraintKey Primary r i)
               => SeqBinding r s i
primaryBinding :: forall r s i.
(TableDerivable r, SequenceDerivable s i,
 HasConstraintKey Primary r i) =>
SeqBinding r s i
primaryBinding = forall r s i.
(TableDerivable r, SequenceDerivable s i) =>
Pi r i -> SeqBinding r s i
unsafeSpecifyBinding forall a b. (a -> b) -> a -> b
$ forall r ct. Key Primary r ct -> Pi r ct
primaryKey forall c r ct. HasConstraintKey c r ct => Key c r ct
constraintKey
  where
    primaryKey :: Key Primary r ct -> Pi r ct
    primaryKey :: forall r ct. Key Primary r ct -> Pi r ct
primaryKey = forall c r ct. Key c r ct -> Pi r ct
projectionKey

-- | Derivation rule for binding between 'Table' and 'Sequence'
class (TableDerivable r, SequenceDerivable s i)
      => Binding r s i | r -> s  where
  binding :: SeqBinding r s i

  default binding :: HasConstraintKey Primary r i => SeqBinding r s i
  binding = forall r s i.
(TableDerivable r, SequenceDerivable s i,
 HasConstraintKey Primary r i) =>
SeqBinding r s i
primaryBinding

fromTable :: Binding r s i => Table r -> Sequence s i
fromTable :: forall r s i. Binding r s i => Table r -> Sequence s i
fromTable = forall a b. a -> b -> a
const forall s i. SequenceDerivable s i => Sequence s i
derivedSequence

-- | Derive 'Sequence' from corresponding 'Relation'
fromRelation :: Binding r s i
             => Relation () r
             -> Sequence s i
fromRelation :: forall r s i. Binding r s i => Relation () r -> Sequence s i
fromRelation = forall r s i. Binding r s i => Table r -> Sequence s i
fromTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. TableDerivable r => Relation () r -> Table r
tableOf

-- | Sequence number type for record type 'r'
newtype Number r i = Number i deriving (Number r i -> Number r i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall r i. Eq i => Number r i -> Number r i -> Bool
/= :: Number r i -> Number r i -> Bool
$c/= :: forall r i. Eq i => Number r i -> Number r i -> Bool
== :: Number r i -> Number r i -> Bool
$c== :: forall r i. Eq i => Number r i -> Number r i -> Bool
Eq, Number r i -> Number r i -> Bool
Number r i -> Number r i -> Ordering
Number r i -> Number r i -> Number r i
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {r} {i}. Ord i => Eq (Number r i)
forall r i. Ord i => Number r i -> Number r i -> Bool
forall r i. Ord i => Number r i -> Number r i -> Ordering
forall r i. Ord i => Number r i -> Number r i -> Number r i
min :: Number r i -> Number r i -> Number r i
$cmin :: forall r i. Ord i => Number r i -> Number r i -> Number r i
max :: Number r i -> Number r i -> Number r i
$cmax :: forall r i. Ord i => Number r i -> Number r i -> Number r i
>= :: Number r i -> Number r i -> Bool
$c>= :: forall r i. Ord i => Number r i -> Number r i -> Bool
> :: Number r i -> Number r i -> Bool
$c> :: forall r i. Ord i => Number r i -> Number r i -> Bool
<= :: Number r i -> Number r i -> Bool
$c<= :: forall r i. Ord i => Number r i -> Number r i -> Bool
< :: Number r i -> Number r i -> Bool
$c< :: forall r i. Ord i => Number r i -> Number r i -> Bool
compare :: Number r i -> Number r i -> Ordering
$ccompare :: forall r i. Ord i => Number r i -> Number r i -> Ordering
Ord, Int -> Number r i -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall r i. Show i => Int -> Number r i -> ShowS
forall r i. Show i => [Number r i] -> ShowS
forall r i. Show i => Number r i -> String
showList :: [Number r i] -> ShowS
$cshowList :: forall r i. Show i => [Number r i] -> ShowS
show :: Number r i -> String
$cshow :: forall r i. Show i => Number r i -> String
showsPrec :: Int -> Number r i -> ShowS
$cshowsPrec :: forall r i. Show i => Int -> Number r i -> ShowS
Show)

-- | Unsafely specify sequence number.
unsafeSpecifyNumber :: Binding r s i => i -> Number r i
unsafeSpecifyNumber :: forall r s i. Binding r s i => i -> Number r i
unsafeSpecifyNumber = forall r i. i -> Number r i
Number

-- | Get untyped sequence number.
extractNumber :: Number r i -> i
extractNumber :: forall r i. Number r i -> i
extractNumber (Number i
i) = i
i

-- | Unsafely apply sequence number.
($$!) :: (i -> r)    -- ^ sequence number should be passed to proper field of record
      -> Number r i
      -> r
$$! :: forall i r. (i -> r) -> Number r i -> r
($$!) = (forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r i. Number r i -> i
extractNumber)

-- | Unsafely apply sequence number. Only safe to build corresponding record type.
($$) :: Binding r s i
     => (i -> r)   -- ^ sequence number should be passed to proper field of record
     -> Number r i
     -> r
$$ :: forall r s i. Binding r s i => (i -> r) -> Number r i -> r
($$) = forall i r. (i -> r) -> Number r i -> r
($$!)

-- | Update statement for sequence table
updateNumber' :: (PersistableWidth s, Integral i, LiteralSQL i)
              => Config
              -> i            -- ^ sequence number to set. expect not SQL injectable.
              -> Sequence s i -- ^ sequence table
              -> Update ()
updateNumber' :: forall s i.
(PersistableWidth s, Integral i, LiteralSQL i) =>
Config -> i -> Sequence s i -> Update ()
updateNumber' Config
config i
i Sequence s i
seqt = forall r p.
Config
-> Table r
-> (Record Flat r -> Assign r (PlaceHolders p))
-> Update p
typedUpdate' Config
config (forall s i. Sequence s i -> Table s
seqTable Sequence s i
seqt) forall a b. (a -> b) -> a -> b
$ \ Record Flat s
proj -> do
  let iv :: Record Flat i
iv = forall t c. (LiteralSQL t, OperatorContext c) => t -> Record c t
value i
i
  forall s i. Sequence s i -> Pi s i
seqKey Sequence s i
seqt forall (m :: * -> *) r v.
Monad m =>
AssignTarget r v -> Record Flat v -> Assignings r m ()
<-# Record Flat i
iv
  forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres forall a b. (a -> b) -> a -> b
$ Record Flat s
proj forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! forall s i. Sequence s i -> Pi s i
seqKey Sequence s i
seqt forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.<=. Record Flat i
iv -- fool proof
  forall (m :: * -> *) a. Monad m => a -> m a
return PlaceHolders ()
unitPH

-- | Update statement for sequence table
updateNumber :: (PersistableWidth s, Integral i, LiteralSQL i)
             => i            -- ^ sequence number to set. expect not SQL injectable.
             -> Sequence s i -- ^ sequence table
             -> Update ()
updateNumber :: forall s i.
(PersistableWidth s, Integral i, LiteralSQL i) =>
i -> Sequence s i -> Update ()
updateNumber = forall s i.
(PersistableWidth s, Integral i, LiteralSQL i) =>
Config -> i -> Sequence s i -> Update ()
updateNumber' Config
defaultConfig