{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}
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')
data Sequence s i =
Sequence
{ Sequence s i -> Table s
seqTable :: Table s
, :: s -> i
, Sequence s i -> Pi s i
seqKey :: Pi s i
}
unsafeSpecifySequence :: TableDerivable s => (s -> i) -> Pi s i -> Sequence s i
unsafeSpecifySequence :: (s -> i) -> Pi s i -> Sequence s i
unsafeSpecifySequence = Table s -> (s -> i) -> Pi s i -> Sequence s i
forall s i. Table s -> (s -> i) -> Pi s i -> Sequence s i
Sequence Table s
forall r. TableDerivable r => Table r
derivedTable
seqRelation :: TableDerivable s => Sequence s i -> Relation () s
seqRelation :: Sequence s i -> Relation () s
seqRelation = Table s -> Relation () s
forall r. Table r -> Relation () r
Relation.table (Table s -> Relation () s)
-> (Sequence s i -> Table s) -> Sequence s i -> Relation () s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sequence s i -> Table s
forall s i. Sequence s i -> Table s
seqTable
class TableDerivable s => SequenceDerivable s i | s -> i where
derivedSequence :: Sequence s i
data SeqBinding r s i =
SeqBinding
{ SeqBinding r s i -> Table r
boundTable :: Table r
, SeqBinding r s i -> Pi r i
boundKey :: Pi r i
, SeqBinding r s i -> Sequence s i
boundSequence :: Sequence s i
}
unsafeSpecifyBinding :: (TableDerivable r, SequenceDerivable s i)
=> Pi r i -> SeqBinding r s i
unsafeSpecifyBinding :: Pi r i -> SeqBinding r s i
unsafeSpecifyBinding Pi r i
k = Table r -> Pi r i -> Sequence s i -> SeqBinding r s i
forall r s i. Table r -> Pi r i -> Sequence s i -> SeqBinding r s i
SeqBinding Table r
forall r. TableDerivable r => Table r
derivedTable Pi r i
k Sequence s i
forall s i. SequenceDerivable s i => Sequence s i
derivedSequence
primaryBinding :: (TableDerivable r, SequenceDerivable s i,
HasConstraintKey Primary r i)
=> SeqBinding r s i
primaryBinding :: SeqBinding r s i
primaryBinding = Pi r i -> SeqBinding r s i
forall r s i.
(TableDerivable r, SequenceDerivable s i) =>
Pi r i -> SeqBinding r s i
unsafeSpecifyBinding (Pi r i -> SeqBinding r s i) -> Pi r i -> SeqBinding r s i
forall a b. (a -> b) -> a -> b
$ Key Primary r i -> Pi r i
forall r ct. Key Primary r ct -> Pi r ct
primaryKey Key Primary r i
forall c r ct. HasConstraintKey c r ct => Key c r ct
constraintKey
where
primaryKey :: Key Primary r ct -> Pi r ct
primaryKey :: Key Primary r ct -> Pi r ct
primaryKey = Key Primary r ct -> Pi r ct
forall c r ct. Key c r ct -> Pi r ct
projectionKey
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 = SeqBinding r s i
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 :: Table r -> Sequence s i
fromTable = Sequence s i -> Table r -> Sequence s i
forall a b. a -> b -> a
const Sequence s i
forall s i. SequenceDerivable s i => Sequence s i
derivedSequence
fromRelation :: Binding r s i
=> Relation () r
-> Sequence s i
fromRelation :: Relation () r -> Sequence s i
fromRelation = Table r -> Sequence s i
forall r s i. Binding r s i => Table r -> Sequence s i
fromTable (Table r -> Sequence s i)
-> (Relation () r -> Table r) -> Relation () r -> Sequence s i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation () r -> Table r
forall r. TableDerivable r => Relation () r -> Table r
tableOf
newtype Number r i = Number i deriving (Number r i -> Number r i -> Bool
(Number r i -> Number r i -> Bool)
-> (Number r i -> Number r i -> Bool) -> Eq (Number r i)
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, Eq (Number r i)
Eq (Number r i)
-> (Number r i -> Number r i -> Ordering)
-> (Number r i -> Number r i -> Bool)
-> (Number r i -> Number r i -> Bool)
-> (Number r i -> Number r i -> Bool)
-> (Number r i -> Number r i -> Bool)
-> (Number r i -> Number r i -> Number r i)
-> (Number r i -> Number r i -> Number r i)
-> Ord (Number r i)
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
$cp1Ord :: forall r i. Ord i => Eq (Number r i)
Ord, Int -> Number r i -> ShowS
[Number r i] -> ShowS
Number r i -> String
(Int -> Number r i -> ShowS)
-> (Number r i -> String)
-> ([Number r i] -> ShowS)
-> Show (Number r i)
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)
unsafeSpecifyNumber :: Binding r s i => i -> Number r i
unsafeSpecifyNumber :: i -> Number r i
unsafeSpecifyNumber = i -> Number r i
forall r i. i -> Number r i
Number
extractNumber :: Number r i -> i
(Number i
i) = i
i
($$!) :: (i -> r)
-> Number r i
-> r
$$! :: (i -> r) -> Number r i -> r
($$!) = ((i -> r) -> (Number r i -> i) -> Number r i -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Number r i -> i
forall r i. Number r i -> i
extractNumber)
($$) :: Binding r s i
=> (i -> r)
-> Number r i
-> r
$$ :: (i -> r) -> Number r i -> r
($$) = (i -> r) -> Number r i -> r
forall i r. (i -> r) -> Number r i -> r
($$!)
updateNumber' :: (PersistableWidth s, Integral i, LiteralSQL i)
=> Config
-> i
-> Sequence s i
-> Update ()
updateNumber' :: Config -> i -> Sequence s i -> Update ()
updateNumber' Config
config i
i Sequence s i
seqt = Config
-> Table s
-> (Record Flat s -> Assign s (PlaceHolders ()))
-> Update ()
forall r p.
Config
-> Table r
-> (Record Flat r -> Assign r (PlaceHolders p))
-> Update p
typedUpdate' Config
config (Sequence s i -> Table s
forall s i. Sequence s i -> Table s
seqTable Sequence s i
seqt) ((Record Flat s -> Assign s (PlaceHolders ())) -> Update ())
-> (Record Flat s -> Assign s (PlaceHolders ())) -> Update ()
forall a b. (a -> b) -> a -> b
$ \ Record Flat s
proj -> do
let iv :: Record Flat i
iv = i -> Record Flat i
forall t c. (LiteralSQL t, OperatorContext c) => t -> Record c t
value i
i
Sequence s i -> Pi s i
forall s i. Sequence s i -> Pi s i
seqKey Sequence s i
seqt Pi s i -> Record Flat i -> Assignings s Restrict ()
forall (m :: * -> *) r v.
Monad m =>
AssignTarget r v -> Record Flat v -> Assignings r m ()
<-# Record Flat i
iv
Predicate Flat -> Assignings s Restrict ()
forall (m :: * -> *).
MonadRestrict Flat m =>
Predicate Flat -> m ()
wheres (Predicate Flat -> Assignings s Restrict ())
-> Predicate Flat -> Assignings s Restrict ()
forall a b. (a -> b) -> a -> b
$ Record Flat s
proj Record Flat s -> Pi s i -> Record Flat i
forall a c b.
PersistableWidth a =>
Record c a -> Pi a b -> Record c b
! Sequence s i -> Pi s i
forall s i. Sequence s i -> Pi s i
seqKey Sequence s i
seqt Record Flat i -> Record Flat i -> Predicate Flat
forall c ft.
OperatorContext c =>
Record c ft -> Record c ft -> Record c (Maybe Bool)
.<=. Record Flat i
iv
PlaceHolders () -> Assign s (PlaceHolders ())
forall (m :: * -> *) a. Monad m => a -> m a
return PlaceHolders ()
unitPH
updateNumber :: (PersistableWidth s, Integral i, LiteralSQL i)
=> i
-> Sequence s i
-> Update ()
updateNumber :: i -> Sequence s i -> Update ()
updateNumber = Config -> i -> Sequence s i -> Update ()
forall s i.
(PersistableWidth s, Integral i, LiteralSQL i) =>
Config -> i -> Sequence s i -> Update ()
updateNumber' Config
defaultConfig