khibino/haskell-relational-record
1
1
Fork 0
mirror of https://github.com/khibino/haskell-relational-record.git synced 2024-11-29 06:37:03 +03:00
Code Issues Projects Releases Wiki Activity

relational-query: add updateNumber' to pass Config.

Browse Source
This commit is contained in:
Kei Hibino 2018-06-18 02:07:16 +09:00
parent feeb31aa1c
commit 665a3c53b4
1 changed files with 15 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
relational-query/src/Database/Relational/Sequence.hs
View File

@ -27,12 +27,13 @@ module Database.Relational.Sequence (
Number, unsafeSpecifyNumber, extractNumber, Number, unsafeSpecifyNumber, extractNumber,
($$!), ($$), ($$!), ($$),
updateNumber, updateNumber', updateNumber,
) where ) where
import Prelude hiding (seq) import Prelude hiding (seq)
import Database.Record (PersistableWidth) import Database.Record (PersistableWidth)
import Database.Relational.Internal.Config (Config, defaultConfig)
import Database.Relational.Monad.Class (wheres) import Database.Relational.Monad.Class (wheres)
import Database.Relational.Monad.BaseType (Relation) import Database.Relational.Monad.BaseType (Relation)
import Database.Relational.Monad.Trans.Assigning ((<-#)) import Database.Relational.Monad.Trans.Assigning ((<-#))
@ -45,7 +46,7 @@ import Database.Relational.ProjectableClass (ShowConstantTermsSQL)
import Database.Relational.Relation (tableOf) import Database.Relational.Relation (tableOf)
import qualified Database.Relational.Relation as Relation import qualified Database.Relational.Relation as Relation
import Database.Relational.Effect (updateTarget') import Database.Relational.Effect (updateTarget')
import Database.Relational.Type (Update, typedUpdate) import Database.Relational.Type (Update, typedUpdate')
-- | Basic record to express sequence-table. -- | Basic record to express sequence-table.
@ -133,21 +134,21 @@ extractNumber (Number i) = i
-> r -> r
($$) = ($$!) ($$) = ($$!)
{- -- | Update statement for sequence table
updateNumber :: PersistableWidth p => Sequence r p -> Update (p, p) updateNumber' :: (PersistableWidth s, Integral i, ShowConstantTermsSQL i)
updateNumber seqt = typedUpdate (table seqt) . updateTarget' $ \ proj -> do => Config
(phv', ()) <- placeholder (\ph -> key seqt <-# ph) -> i -- ^ sequence number to set. expect not SQL injectable.
(phx', ()) <- placeholder (\ph -> wheres $ proj ! key seqt .<=. ph) -> Sequence s i -- ^ sequence table
return $ (,) |$| phv' |*| phx' -> Update ()
-} updateNumber' config i seqt = typedUpdate' config (seqTable seqt) . updateTarget' $ \ proj -> do
let iv = value i
seqKey seqt <-# iv
wheres $ proj ! seqKey seqt .<=. iv -- fool proof
return unitPlaceHolder
-- | Update statement for sequence table -- | Update statement for sequence table
updateNumber :: (PersistableWidth s, Integral i, ShowConstantTermsSQL i) updateNumber :: (PersistableWidth s, Integral i, ShowConstantTermsSQL i)
=> i -- ^ sequence number to set. expect not SQL injectable. => i -- ^ sequence number to set. expect not SQL injectable.
-> Sequence s i -- ^ sequence table -> Sequence s i -- ^ sequence table
-> Update () -> Update ()
updateNumber i seqt = typedUpdate (seqTable seqt) . updateTarget' $ \ proj -> do updateNumber = updateNumber' defaultConfig
let iv = value i
seqKey seqt <-# iv
wheres $ proj ! seqKey seqt .<=. iv -- fool proof
return unitPlaceHolder