summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKeiHibino <>2016-02-13 00:46:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-02-13 00:46:00 (GMT)
commitc0b98f2bcfb52a2f53383756a6bda784c8773328 (patch)
treeb5132111ef061389ebcf4faeefbdd7b5ba3efead
parent279ea0b9bd04fbf522d368bb8a61e348d1a57873 (diff)
version 0.4.0.00.4.0.0
-rw-r--r--persistable-record.cabal2
-rw-r--r--src/Database/Record.hs5
-rw-r--r--src/Database/Record/FromSql.hs11
-rw-r--r--src/Database/Record/Persistable.hs39
-rw-r--r--src/Database/Record/TH.hs1
-rw-r--r--src/Database/Record/ToSql.hs12
6 files changed, 14 insertions, 56 deletions
diff --git a/persistable-record.cabal b/persistable-record.cabal
index c002045..16c0474 100644
--- a/persistable-record.cabal
+++ b/persistable-record.cabal
@@ -1,5 +1,5 @@
name: persistable-record
-version: 0.3.0.0
+version: 0.4.0.0
synopsis: Binding between SQL database values and haskell records.
description: This package contiains types to represent table constraints and
interfaces to bind between SQL database values and Haskell records.
diff --git a/src/Database/Record.hs b/src/Database/Record.hs
index 36f3934..99ca60c 100644
--- a/src/Database/Record.hs
+++ b/src/Database/Record.hs
@@ -40,13 +40,12 @@ import Database.Record.KeyConstraint
deriveComposite, unique, derivedCompositePrimary, derivedUniqueConstraint)
import Database.Record.Persistable
(PersistableSqlType, PersistableType(..), sqlNullValue,
- PersistableSqlValue, PersistableValue(..), fromSql, toSql,
PersistableRecordWidth, PersistableWidth(..), derivedWidth)
import Database.Record.FromSql
- (RecordFromSql, FromSql(..), valueFromSql,
+ (RecordFromSql, FromSql(..), valueRecordFromSql,
runTakeRecord, takeRecord, runToRecord, toRecord)
import Database.Record.ToSql
- (ToSqlM, RecordToSql, ToSql(..), valueToSql,
+ (ToSqlM, RecordToSql, ToSql(..), valueRecordToSql,
runFromRecord, wrapToSql, putRecord, putEmpty, fromRecord,
updateValuesByUnique, updateValuesByPrimary)
diff --git a/src/Database/Record/FromSql.hs b/src/Database/Record/FromSql.hs
index 31bc835..4882ed6 100644
--- a/src/Database/Record/FromSql.hs
+++ b/src/Database/Record/FromSql.hs
@@ -26,11 +26,10 @@ module Database.Record.FromSql (
FromSql (recordFromSql),
takeRecord, toRecord,
- valueFromSql
+ valueRecordFromSql,
) where
-import Database.Record.Persistable
- (PersistableType, PersistableValue, persistableValue, toValue)
+import Database.Record.Persistable (PersistableType)
import qualified Database.Record.Persistable as Persistable
import Database.Record.KeyConstraint
(HasColumnConstraint(columnConstraint), ColumnConstraint, NotNull, index)
@@ -155,6 +154,6 @@ takeRecord = runTakeRecord recordFromSql
toRecord :: FromSql q a => [q] -> a
toRecord = runToRecord recordFromSql
--- | Derived 'RecordFromSql' from persistable value.
-valueFromSql :: PersistableValue q a => RecordFromSql q a
-valueFromSql = RecordFromSql $ \qs -> (toValue persistableValue $ head qs, tail qs)
+-- | Derivation rule of 'RecordFromSql' proof object for value convert function.
+valueRecordFromSql :: (q -> a) -> RecordFromSql q a
+valueRecordFromSql d = createRecordFromSql $ \qs -> (d $ head qs, tail qs)
diff --git a/src/Database/Record/Persistable.hs b/src/Database/Record/Persistable.hs
index 2f1e9ef..40aaf46 100644
--- a/src/Database/Record/Persistable.hs
+++ b/src/Database/Record/Persistable.hs
@@ -20,14 +20,9 @@ module Database.Record.Persistable (
PersistableRecordWidth, runPersistableRecordWidth,
unsafePersistableRecordWidth, unsafeValueWidth, (<&>), maybeWidth,
- -- * Bidirectional conversion between single column type and SQL type
- PersistableSqlValue, persistableSqlValue,
- toValue, fromValue,
-
-- * Inference rules for proof objects
PersistableType(..), sqlNullValue,
- PersistableValue (..), fromSql, toSql,
PersistableWidth (..), derivedWidth
) where
@@ -45,26 +40,6 @@ unsafePersistableSqlTypeFromNull :: q -- ^ SQL null value of
unsafePersistableSqlTypeFromNull = PersistableSqlType
--- | Proof object to specify value type 'a' is convertible with SQL type 'q'
-data PersistableSqlValue q a = PersistableSqlValue (q -> a) (a -> q)
-
--- | Run 'PersistableSqlValue' proof object. Convert from SQL type 'q' into Haskell type 'a'.
-toValue :: PersistableSqlValue q a -- ^ Proof object which has capability to convert
- -> q -- ^ SQL type
- -> a -- ^ Haskell type
-toValue (PersistableSqlValue f _) = f
-
--- | Run 'PersistableSqlValue' proof object. Convert from Haskell type 'a' into SQL type 'q'.
-fromValue :: PersistableSqlValue q a -- ^ Proof object which has capability to convert
- -> a -- ^ Haskell type
- -> q -- ^ SQL type
-fromValue (PersistableSqlValue _ g) = g
-
--- | Axiom of 'PersistableSqlValue' for SQL type 'q' and Haskell type 'a'.
-persistableSqlValue :: PersistableSqlType q -> (q -> a) -> (a -> q) -> PersistableSqlValue q a
-persistableSqlValue = const PersistableSqlValue
-
-
-- | Proof object to specify width of Haskell type 'a'
-- when converting to SQL type list.
newtype PersistableRecordWidth a =
@@ -125,17 +100,3 @@ instance PersistableWidth () where
derivedWidth :: PersistableWidth a => (PersistableRecordWidth a, Int)
derivedWidth = (pw, runPersistableRecordWidth pw) where
pw = persistableWidth
-
-
--- | Interface of inference rule for 'PersistableSqlValue' proof object
-class PersistableType q => PersistableValue q a where
- -- | Infer 'PersistableSqlValue' proof object.
- persistableValue :: PersistableSqlValue q a
-
--- | Run inferred 'PersistableSqlValue' proof object. Convert from SQL type 'q' into Haskell type 'a'.
-fromSql :: PersistableValue q a => q -> a
-fromSql = toValue persistableValue
-
--- | Run inferred 'PersistableSqlValue' proof object. Convert from Haskell type 'a' into SQL type 'q'.
-toSql :: PersistableValue q a => a -> q
-toSql = fromValue persistableValue
diff --git a/src/Database/Record/TH.hs b/src/Database/Record/TH.hs
index baaa98d..aefc1e8 100644
--- a/src/Database/Record/TH.hs
+++ b/src/Database/Record/TH.hs
@@ -231,6 +231,7 @@ defineRecordType typeName' columns derives = do
columnDefault :: String -> TypeQ -> (VarName, TypeQ)
columnDefault n t = (varCamelcaseName n, t)
+-- | Record type declaration template with configured names.
defineRecordTypeWithConfig :: NameConfig -> String -> String -> [(String, TypeQ)] -> [Name] -> Q [Dec]
defineRecordTypeWithConfig config schema table columns =
defineRecordType
diff --git a/src/Database/Record/ToSql.hs b/src/Database/Record/ToSql.hs
index 2124bb5..eee5850 100644
--- a/src/Database/Record/ToSql.hs
+++ b/src/Database/Record/ToSql.hs
@@ -24,7 +24,7 @@ module Database.Record.ToSql (
ToSql (recordToSql),
putRecord, putEmpty, fromRecord, wrapToSql,
- valueToSql,
+ valueRecordToSql,
-- * Make parameter list for updating with key
updateValuesByUnique',
@@ -37,15 +37,13 @@ module Database.Record.ToSql (
import Data.Array (listArray, (!))
import Data.Set (toList, fromList, (\\))
-import Control.Applicative (pure)
import Control.Monad.Trans.Writer (Writer, execWriter, tell)
import Data.DList (DList)
import qualified Data.DList as DList
import Database.Record.Persistable
(PersistableSqlType, runPersistableNullValue, PersistableType (persistableType),
- PersistableRecordWidth, runPersistableRecordWidth, PersistableWidth(persistableWidth),
- PersistableValue, persistableValue, fromValue)
+ PersistableRecordWidth, runPersistableRecordWidth, PersistableWidth(persistableWidth))
import Database.Record.KeyConstraint
(Primary, Unique, KeyConstraint, HasKeyConstraint(keyConstraint), unique, indexes)
@@ -126,9 +124,9 @@ putEmpty = putRecord
fromRecord :: ToSql q a => a -> [q]
fromRecord = runToSqlM . putRecord
--- | Derived 'RecordToSql' from persistable value.
-valueToSql :: PersistableValue q a => RecordToSql q a
-valueToSql = RecordToSql $ tell . pure . fromValue persistableValue
+-- | Derivation rule of 'RecordToSql' proof object for value convert function.
+valueRecordToSql :: (a -> q) -> RecordToSql q a
+valueRecordToSql = createRecordToSql . ((:[]) .)
-- | Make untyped indexes to update column from key indexes and record width.
-- Expected by update form like