summaryrefslogtreecommitdiff
path: root/src/Database/Record/ToSql.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Database/Record/ToSql.hs')
-rw-r--r--src/Database/Record/ToSql.hs35
1 files changed, 14 insertions, 21 deletions
diff --git a/src/Database/Record/ToSql.hs b/src/Database/Record/ToSql.hs
index 4de7e31..ebfdb1f 100644
--- a/src/Database/Record/ToSql.hs
+++ b/src/Database/Record/ToSql.hs
@@ -17,24 +17,23 @@
-- from Haskell type into list of database value type.
module Database.Record.ToSql (
-- * Conversion from record type into list of database value type
- ToSqlM, RecordToSql, runFromRecord,
+ ToSqlM, execToSqlM, RecordToSql, runFromRecord, wrapToSql,
createRecordToSql,
(<&>),
-- * Derivation rules of 'RecordToSql' conversion
ToSql (recordToSql),
- putRecord, putEmpty, fromRecord, wrapToSql,
+ putRecord, putEmpty, fromRecord,
valueRecordToSql,
-- * Make parameter list for updating with key
updateValuesByUnique,
updateValuesByPrimary,
- updateValuesByUnique',
untypedUpdateValuesIndex,
- unsafeUpdateValuesWithIndexes
+ unsafeUpdateValuesWithIndexes,
) where
import GHC.Generics (Generic, Rep, U1 (..), K1 (..), M1 (..), (:*:)(..), from)
@@ -54,8 +53,9 @@ import Database.Record.KeyConstraint
-- | Context type to convert into database value list.
type ToSqlM q a = Writer (DList q) a
-runToSqlM :: ToSqlM q a -> [q]
-runToSqlM = DList.toList . execWriter
+-- | extract appended print result of record.
+execToSqlM :: ToSqlM q a -> [q]
+execToSqlM = DList.toList . execWriter
{- |
'RecordToSql' 'q' 'a' is data-type wrapping function
@@ -78,7 +78,7 @@ wrapToSql = RecordToSql
runFromRecord :: RecordToSql q a -- ^ printer function object which has capability to convert
-> a -- ^ Haskell type
-> [q] -- ^ list of database value
-runFromRecord r = runToSqlM . runRecordToSql r
+runFromRecord r = execToSqlM . runRecordToSql r
-- | Axiom of 'RecordToSql' for database value type 'q' and Haksell type 'a'.
createRecordToSql :: (a -> [q]) -- ^ Convert function body
@@ -197,7 +197,7 @@ putEmpty = putRecord
-- | Run implicit 'RecordToSql' printer function object.
-- Convert from haskell type 'a' into list of database value type ['q'].
fromRecord :: ToSql q a => a -> [q]
-fromRecord = runToSqlM . putRecord
+fromRecord = execToSqlM . putRecord
-- | Derivation rule of 'RecordToSql' printer function object for value convert function.
valueRecordToSql :: (a -> q) -> RecordToSql q a
@@ -224,13 +224,13 @@ untypedUpdateValuesIndex key width = otherThanKey where
-- @
--
-- using 'RecordToSql' printer function object.
-unsafeUpdateValuesWithIndexes :: RecordToSql q ra
- -> [Int]
+unsafeUpdateValuesWithIndexes :: ToSql q ra
+ => [Int]
-> ra
-> [q]
-unsafeUpdateValuesWithIndexes pr key a =
+unsafeUpdateValuesWithIndexes key a =
[ valsA ! i | i <- otherThanKey ++ key ] where
- vals = runFromRecord pr a
+ vals = execToSqlM $ putRecord a
width = length vals
valsA = listArray (0, width - 1) vals
otherThanKey = untypedUpdateValuesIndex key width
@@ -241,19 +241,12 @@ unsafeUpdateValuesWithIndexes pr key a =
-- UPDATE /table/ SET /c0/ = ?, /c1/ = ?, /c2/ = ? ... WHERE /key0/ = ? AND /key1/ = ? AND /key2/ = ? ...
-- @
--
--- using 'RecordToSql' printer function object.
-updateValuesByUnique' :: RecordToSql q ra
- -> KeyConstraint Unique ra -- ^ Unique key table constraint printer function object.
- -> ra
- -> [q]
-updateValuesByUnique' pr uk = unsafeUpdateValuesWithIndexes pr (indexes uk)
-
--- | Convert like 'updateValuesByUnique'' using implicit 'RecordToSql' printer function object.
+-- using printer function object infered by ToSql ra q.
updateValuesByUnique :: ToSql q ra
=> KeyConstraint Unique ra -- ^ Unique key table constraint printer function object.
-> ra
-> [q]
-updateValuesByUnique = updateValuesByUnique' recordToSql
+updateValuesByUnique uk = unsafeUpdateValuesWithIndexes (indexes uk)
-- | Convert like 'updateValuesByUnique'' using implicit 'RecordToSql' and 'ColumnConstraint'.
updateValuesByPrimary :: (HasKeyConstraint Primary ra, ToSql q ra)