diff options
Diffstat (limited to 'src/Database/Record/ToSql.hs')
| -rw-r--r-- | src/Database/Record/ToSql.hs | 35 |
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) |