packages feed

persistable-record (empty) → 0.0.1.0

raw patch · 10 files changed

+1240/−0 lines, 10 filesdep +arraydep +basedep +containerssetup-changed

Dependencies added: array, base, containers, dlist, names-th, template-haskell, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Kei Hibino++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Kei Hibino nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ persistable-record.cabal view
@@ -0,0 +1,45 @@+name:                persistable-record+version:             0.0.1.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.+homepage:            http://twitter.com/khibino+license:             BSD3+license-file:        LICENSE+author:              Kei Hibino+maintainer:          ex8k.hibino@gmail.com+copyright:           Copyright (c) 2013 Kei Hibino+category:            Database+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:+                        Database.Record.FromSql+                        Database.Record.ToSql+                        Database.Record.Persistable+                        Database.Record.Instances+                        Database.Record.KeyConstraint+                        Database.Record+                        Database.Record.TH++  build-depends:          base <5+                        , template-haskell+                        , array+                        , containers+                        , transformers+                        , dlist+                        , names-th+  hs-source-dirs:       src+  ghc-options:          -Wall++  default-language:     Haskell2010+++source-repository head+  type:       git+  location:   https://github.com/khibino/haskell-relational-record++source-repository head+  type:       mercurial+  location:   https://bitbucket.org/khibino/haskell-relational-record
+ src/Database/Record.hs view
@@ -0,0 +1,79 @@+-- |+-- Module      : Database.Record+-- Copyright   : 2013 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This is integrated module which contains+-- types to represent table constraints and+-- interfaces to bind between SQL database values and Haskell records.+module Database.Record (+  -- * Concepts+  -- $concepts++  -- * Binding between SQL values and Haskell records+  -- $bindSqlAndHaskellRecords++  -- * Constraints used for 'RecordFromSql' inference+  -- $constraintsForInference++  -- * Modules which provide proof objects+  -- ** Table constraint specified by keys+  module Database.Record.KeyConstraint,+  -- ** Convert between Haskell type and list of SQL type+  module Database.Record.Persistable,+  -- ** Convert from list of SQL type+  module Database.Record.FromSql,+  -- ** Convert into list of SQL type+  module Database.Record.ToSql+  ) where++import Database.Record.KeyConstraint+  (ColumnConstraint, HasColumnConstraint(..),+   Primary, PrimaryColumnConstraint,+   Unique, UniqueColumnConstraint, uniqueColumn, derivedUniqueColumnConstraint,+   NotNull, NotNullColumnConstraint, notNullColumn, derivedNotNullColumnConstraint,+   KeyConstraint, HasKeyConstraint(..), PrimaryConstraint, UniqueConstraint,+   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,+   runTakeRecord, takeRecord, runToRecord, toRecord)+import Database.Record.ToSql+  (ToSqlM, RecordToSql, ToSql(..), valueToSql,+   runFromRecord, wrapToSql, putRecord, putEmpty, fromRecord,+   updateValuesByUnique, updateValuesByPrimary)++{- $concepts+On most drivers for SQL database,+we need to write or read untyped SQL value sequence+when accessing databases.++This library maps between list of untyped SQL type+and Haskell record type using type classes.+-}++{- $bindSqlAndHaskellRecords+You will need to implement instances of 'Persistable' class+to bind between SQL database values and Haskell records.+'Persistable' instance is source to derive 'FromSql' and 'ToSql'.++You can use Database.Record.TH module in this package+to generate instances from SQL database record column names and types.+-}++{- $constraintsForInference+You will need to implement instances of+'HasColumnConstraint' 'NotNull' which is a premise+to infer 'RecordFromSql' proof object using 'ToSql' 'q' ('Maybe' a) instance.+This proof object cat convert from SQL type into 'Maybe' typed record+when dealing with outer joined query.+-}++{-# ANN module "HLint: ignore Use import/export shortcut" #-}
+ src/Database/Record/FromSql.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module      : Database.Record.FromSql+-- Copyright   : 2013 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module defines interfaces+-- from list of SQL type into Haskell type.+module Database.Record.FromSql (+  -- * Conversion from list of SQL type into record type+  -- $recordFromSql+  RecordFromSql, runTakeRecord, runToRecord,+  createRecordFromSql,++  (<&>),+  maybeRecord,++  -- * Inference rules of 'RecordFromSql' conversion+  FromSql (recordFromSql),+  takeRecord, toRecord,++  valueFromSql+  ) where++import Database.Record.Persistable+  (PersistableType, PersistableValue, persistableValue, toValue)+import qualified Database.Record.Persistable as Persistable+import Database.Record.KeyConstraint+  (HasColumnConstraint(columnConstraint), ColumnConstraint, NotNull, index)++import Control.Monad (liftM, ap)+import Control.Applicative ((<$>), Applicative(pure, (<*>)))++{- $recordFromSql+Structure of 'RecordFromSql' 'q' 'a' is similar to parser.+While running 'RecordFromSql' behavior is the same as parser+which parse list of SQL type ['q'] stream.++So, 'RecordFromSql' 'q' is 'Monad' and 'Applicative' instance like parser monad.+When, you have data constructor and objects like below.++@+  data MyRecord = MyRecord Foo Bar Baz+@++@+  foo :: 'RecordFromSql' SqlValue Foo+  foo =  ...+  bar :: 'RecordFromSql' SqlValue Bar+  bar =  ...+  baz :: 'RecordFromSql' SqlValue Bar+  baz =  ...+@++You can get composed 'RecordFromSql' like below.++@+  myRecord :: RecordFromSql SqlValue MyRecord+  myRecord =  MyRecord \<$\> foo \<*\> bar \<*\> baz+@+-}++-- | Proof object type to convert from sql value type 'q' list into Haskell type 'a'.+newtype RecordFromSql q a = RecordFromSql ([q] -> (a, [q]))++-- | Run 'RecordFromSql' proof object.+--   Convert from list of SQL type ['q'] into Haskell type 'a' and rest of list ['q'].+runTakeRecord :: RecordFromSql q a -- ^ Proof object which has capability to convert+              -> [q]               -- ^ list of SQL type+              -> (a, [q])          -- ^ Haskell type and rest of list+runTakeRecord (RecordFromSql f) = f++-- | Axiom of 'RecordFromSql' for SQL type 'q' and Haskell type 'a'+createRecordFromSql :: ([q] -> (a, [q])) -- ^ Convert function body+                    -> RecordFromSql q a -- ^ Result proof object+createRecordFromSql =  RecordFromSql++-- | Run 'RecordFromSql' proof object. Convert from list of SQL type ['q'] into  Haskell type 'a'.+runToRecord :: RecordFromSql q a -- ^ Proof object which has capability to convert+            -> [q]               -- ^ list of SQL type+            -> a                 -- ^ Haskell type+runToRecord r = fst . runTakeRecord r++-- | 'Monad' instance like parser 'Monad'.+instance Monad (RecordFromSql q) where+  return a = createRecordFromSql ((,) a)+  ma >>= fmb =+    createRecordFromSql+    (\vals -> let (a, vals') = runTakeRecord ma vals+              in  runTakeRecord (fmb a) vals')++-- | Derived 'Functor' instance from 'Monad' instance+instance Functor (RecordFromSql q) where+  fmap = liftM++-- | Derived 'Applicative' instance from 'Monad' instance+instance Applicative (RecordFromSql q) where+  pure  = return+  (<*>) = ap++-- | Derivation rule of 'RecordFromSql' proof object for Haskell tuple (,) type.+(<&>) :: RecordFromSql q a -> RecordFromSql q b -> RecordFromSql q (a, b)+a <&> b = (,) <$> a <*> b++infixl 4 <&>+++-- | Derivation rule of 'RecordFromSql' proof object for Haskell 'Maybe' type.+maybeRecord :: PersistableType q+            => RecordFromSql q a+            -> ColumnConstraint NotNull a+            -> RecordFromSql q (Maybe a)+maybeRecord rec pkey = createRecordFromSql mayToRec where+  mayToRec vals+    | vals !! index pkey /= Persistable.sqlNullValue = (Just a,  vals')+    | otherwise                         = (Nothing, vals')  where+      (a, vals') = runTakeRecord rec vals+++-- | Inference rule interface for 'RecordFromSql' proof object.+class FromSql q a where+  -- | 'RecordFromSql' proof object.+  recordFromSql :: RecordFromSql q a++-- | Inference rule of 'RecordFromSql' proof object which can convert+--   from list of SQL type ['q'] into Haskell tuple ('a', 'b') type.+instance (FromSql q a, FromSql q b) => FromSql q (a, b)  where+  recordFromSql = recordFromSql <&> recordFromSql++-- | Inference rule of 'RecordFromSql' proof object which can convert+--   from list of SQL type ['q'] into Haskell 'Maybe' type.+instance (HasColumnConstraint NotNull a, FromSql q a, PersistableType q)+         => FromSql q (Maybe a)  where+  recordFromSql = maybeRecord recordFromSql columnConstraint++-- | Inference rule of 'RecordFromSql' proof object which can convert+--   from /empty/ list of SQL type ['q'] into Haskell unit () type.+instance FromSql q () where+  recordFromSql = RecordFromSql (\qs -> ((), qs))++-- | Run inferred 'RecordFromSql' proof object.+--   Convert from list of SQL type ['q'] into haskell type 'a' and rest of list ['q'].+takeRecord :: FromSql q a => [q] -> (a, [q])+takeRecord =  runTakeRecord recordFromSql++-- | Run inferred 'RecordFromSql' proof object.+--   Convert from list of SQL type ['q'] into haskell type 'a'.+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)
+ src/Database/Record/Instances.hs view
@@ -0,0 +1,29 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++-- |+-- Module      : Database.Record.Instances+-- Copyright   : 2013 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- Single column instances for example to load schema of system catalogs.+module Database.Record.Instances () where++import Data.Int (Int16, Int32, Int64)+import Database.Record.TH (deriveNotNullType)++$(fmap concat $ mapM deriveNotNullType+  [ [t| Bool |]+  , [t| Char |]+  , [t| String |]+  , [t| Int |]+  , [t| Int16 |]+  , [t| Int32 |]+  , [t| Int64 |]+  ])
+ src/Database/Record/KeyConstraint.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module      : Database.HDBC.Record.KeyConstraint+-- Copyright   : 2013 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module provides proof object definitions+-- of table constraint specifiey by keys.+module Database.Record.KeyConstraint (+  -- * Constraint specified by keys+  ColumnConstraint, index, unsafeSpecifyColumnConstraint,++  Unique, UniqueColumnConstraint,+  NotNull, NotNullColumnConstraint,++  Primary, PrimaryColumnConstraint,++  KeyConstraint, indexes, unsafeSpecifyKeyConstraint,++  UniqueConstraint, PrimaryConstraint,++  -- * Deriviations+  uniqueColumn, notNullColumn,++  leftColumnConstraint,++  unsafeSpecifyNotNullValue,++  deriveComposite,++  unique,++  -- * Inferences+  HasColumnConstraint (columnConstraint),++  derivedUniqueColumnConstraint,+  derivedNotNullColumnConstraint,++  HasKeyConstraint (keyConstraint),++  derivedCompositePrimary,+  derivedUniqueConstraint+  ) where+++-- | Proof object to specify table constraint+--   for table record type 'r' and constraint 'c'+--   specified by a single column.+newtype ColumnConstraint c r = ColumnConstraint Int++-- | Index of key which specifies table constraint.+index :: ColumnConstraint c r -> Int+index (ColumnConstraint i) = i++-- | Constraint type. Unique key.+data Unique++-- | Constraint type. Not-null key.+data NotNull++-- | Constraint type. Primary key.+data Primary++-- | Specialized unique constraint.+type UniqueColumnConstraint  = ColumnConstraint Unique++-- | Specialized not-null constraint.+type NotNullColumnConstraint = ColumnConstraint NotNull++-- | Specialized primary constraint.+type PrimaryColumnConstraint = ColumnConstraint Primary++-- | Unsafely generate 'ColumnConstraint' proof object using specified key index.+unsafeSpecifyColumnConstraint :: Int               -- ^ Key index which specify this constraint+                           -> ColumnConstraint c r -- ^ Result constraint proof object+unsafeSpecifyColumnConstraint =  ColumnConstraint++-- | Derivation rule for 'UniqueColumnConstraint'. Derive Unique from Primary.+uniqueColumn :: PrimaryColumnConstraint r -> UniqueColumnConstraint r+uniqueColumn =  unsafeSpecifyColumnConstraint . index++-- | Derivation rule for 'NotNullColumnConstraint'. Derive NotNull from Primary.+notNullColumn :: PrimaryColumnConstraint r -> NotNullColumnConstraint r+notNullColumn =  unsafeSpecifyColumnConstraint . index+++-- | Derivation rule of 'ColumnConstraint' 'NotNull' for tuple (,) type.+leftColumnConstraint :: ColumnConstraint NotNull a -> ColumnConstraint NotNull (a, b)+leftColumnConstraint pa = ColumnConstraint (index pa)++-- | Interface of inference rule for 'ColumnConstraint' proof object.+class HasColumnConstraint c a where+  -- | Infer 'ColumnConstraint' proof object.+  columnConstraint :: ColumnConstraint c a++-- | Inference rule of 'ColumnConstraint' 'NotNull' for tuple (,) type.+instance HasColumnConstraint NotNull a => HasColumnConstraint NotNull (a, b) where+  columnConstraint = leftColumnConstraint columnConstraint++-- | Inferred 'UniqueColumnConstraint' proof object.+--   Record type 'r' has unique key which is derived 'r' has primary key.+derivedUniqueColumnConstraint :: HasColumnConstraint Primary r => UniqueColumnConstraint r+derivedUniqueColumnConstraint =  uniqueColumn columnConstraint++-- | Inferred 'NotNullColumnConstraint' proof object.+--   Record type 'r' has not-null key which is derived 'r' has primary key.+derivedNotNullColumnConstraint :: HasColumnConstraint Primary r => NotNullColumnConstraint r+derivedNotNullColumnConstraint =  notNullColumn columnConstraint+++-- | Unsafely generate 'NotNullColumnConstraint' proof object of single column value.+unsafeSpecifyNotNullValue :: NotNullColumnConstraint a+unsafeSpecifyNotNullValue =  unsafeSpecifyColumnConstraint 0+++-- | Proof object to specify table constraint+--   for table record type 'r' and constraint 'c'.+--   Constraint is specified by composite key.+newtype KeyConstraint c r = KeyConstraint [Int]++-- | Index of key which specifies table constraint.+indexes :: KeyConstraint c r -> [Int]+indexes (KeyConstraint is) = is++-- | Unsafely generate 'KeyConstraint' proof object using specified key indexes.+unsafeSpecifyKeyConstraint :: [Int]             -- ^ Key index which specify this constraint+                           -> KeyConstraint c r -- ^ Result constraint proof object+unsafeSpecifyKeyConstraint =  KeyConstraint++-- | Derivation rule for 'KeyConstraint'. Derive from 'ColumnConstraint'.+deriveComposite :: ColumnConstraint c r -> KeyConstraint c r+deriveComposite =  unsafeSpecifyKeyConstraint . (:[]) . index++-- | Specialized unique constraint.+type UniqueConstraint  = KeyConstraint Unique++-- | Specialized primary constraint.+type PrimaryConstraint = KeyConstraint Primary++-- | Derivation rule for 'UniqueConstraint'.+unique :: PrimaryConstraint r -> UniqueConstraint r+unique =  unsafeSpecifyKeyConstraint . indexes++-- | Interface of inference rule for 'KeyConstraint' proof object.+class HasKeyConstraint c a where+  -- | Infer 'ColumnConstraint' proof object.+  keyConstraint :: KeyConstraint c a++-- | Inferred 'KeyConstraint' proof object.+--   Record type 'r' has composite key which is derived 'r' has single column key.+derivedCompositeConstraint :: HasColumnConstraint c r => KeyConstraint c r+derivedCompositeConstraint =  deriveComposite columnConstraint++-- | Inferred 'PrimaryConstraint' proof object.+--   Record type 'r' has composite primary key which is derived 'r' has single column primary key.+derivedCompositePrimary :: HasColumnConstraint Primary r => PrimaryConstraint r+derivedCompositePrimary =  derivedCompositeConstraint++-- | Inferred 'UniqueConstraint' proof object.+--   Record type 'r' has unique key which is derived 'r' has primary key.+derivedUniqueConstraint :: HasKeyConstraint Primary r => UniqueConstraint r+derivedUniqueConstraint =  unique keyConstraint
+ src/Database/Record/Persistable.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module      : Database.Record.Persistable+-- Copyright   : 2013 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module defines interfaces+-- between Haskell type and list of SQL type.+module Database.Record.Persistable (+  -- * Specify SQL type+  PersistableSqlType, runPersistableNullValue, unsafePersistableSqlTypeFromNull,++  -- * Specify record width+  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+++-- | Proof object to specify type 'q' is SQL type+newtype PersistableSqlType q = PersistableSqlType q++-- | Null value of SQL type 'q'.+runPersistableNullValue :: PersistableSqlType q -> q+runPersistableNullValue (PersistableSqlType q) = q++-- | Unsafely generate 'PersistableSqlType' proof object from specified SQL null value which type is 'q'.+unsafePersistableSqlTypeFromNull :: q                    -- ^ SQL null value of SQL type 'q'+                                 -> PersistableSqlType q -- ^ Result proof object+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 =+  PersistableRecordWidth Int++-- | Get width 'Int' value of record type 'a'.+runPersistableRecordWidth :: PersistableRecordWidth a -> Int+runPersistableRecordWidth (PersistableRecordWidth w) = w++-- | Unsafely generate 'PersistableRecordWidth' proof object from specified width of Haskell type 'a'.+unsafePersistableRecordWidth :: Int                      -- ^ Specify width of Haskell type 'a'+                             -> PersistableRecordWidth a -- ^ Result proof object+unsafePersistableRecordWidth =  PersistableRecordWidth++-- | Unsafely generate 'PersistableRecordWidth' proof object for Haskell type 'a' which is single column type.+unsafeValueWidth :: PersistableRecordWidth a+unsafeValueWidth =  unsafePersistableRecordWidth 1++-- | Derivation rule of 'PersistableRecordWidth' for tuple (,) type.+(<&>) :: PersistableRecordWidth a -> PersistableRecordWidth b -> PersistableRecordWidth (a, b)+a <&> b = PersistableRecordWidth $ runPersistableRecordWidth a + runPersistableRecordWidth b++-- | Derivation rule of 'PersistableRecordWidth' from from Haskell type 'a' into for Haskell type 'Maybe' 'a'.+maybeWidth :: PersistableRecordWidth a -> PersistableRecordWidth (Maybe a)+maybeWidth =  PersistableRecordWidth . runPersistableRecordWidth++-- | Axiom of 'PersistableRecordWidth' for Haskell unit () type.+voidWidth :: PersistableRecordWidth ()+voidWidth =  unsafePersistableRecordWidth 0+++-- | Interface of inference rule for 'PersistableSqlType' proof object+class Eq q => PersistableType q where+  persistableType :: PersistableSqlType q++-- | Inferred Null value of SQL type.+sqlNullValue :: PersistableType q => q+sqlNullValue =  runPersistableNullValue persistableType+++-- | Interface of inference rule for 'PersistableRecordWidth' proof object+class PersistableWidth a where+  persistableWidth :: PersistableRecordWidth a++-- | Inference rule of 'PersistableRecordWidth' proof object for tuple ('a', 'b') type.+instance (PersistableWidth a, PersistableWidth b) => PersistableWidth (a, b) where+  persistableWidth = persistableWidth <&> persistableWidth++-- | Inference rule of 'PersistableRecordWidth' proof object for 'Maybe' type.+instance PersistableWidth a => PersistableWidth (Maybe a) where+  persistableWidth = maybeWidth persistableWidth++-- | Inference rule of 'PersistableRecordWidth' for Haskell unit () type. Derive from axiom.+instance PersistableWidth () where+  persistableWidth = voidWidth++-- | Pass type parameter and inferred width value.+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
+ src/Database/Record/TH.hs view
@@ -0,0 +1,402 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module      : Database.Record.TH+-- Copyright   : 2013 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module defines templates for Haskell record type and+-- type class instances to map between list of untyped SQL type and Haskell record type.+module Database.Record.TH (+  -- * Generate all templates about record+  defineRecord,+  defineRecordDefault,++  -- * Deriving class symbols+  derivingEq, derivingShow, derivingRead, derivingData, derivingTypable,++  -- * Table constraint specified by key+  defineHasColumnConstraintInstance,+  defineHasPrimaryConstraintInstanceDerived,+  defineHasNotNullKeyInstance,+  defineHasPrimaryKeyInstance,+  defineHasPrimaryKeyInstanceDefault,+  defineHasNotNullKeyInstanceDefault,++  -- * Record type+  defineRecordType, defineRecordTypeDefault,++  -- * Function declarations depending on SQL type+  makeRecordPersistableWithSqlType,+  makeRecordPersistableWithSqlTypeDefault,++  -- * Function declarations against defined record types+  makeRecordPersistableWithSqlTypeFromDefined,+  makeRecordPersistableWithSqlTypeDefaultFromDefined,+  defineColumnOffsets,++  recordWidthTemplate,++  defineRecordParser,+  defineRecordPrinter,++  definePersistableInstance,++  -- * Reify+  reifyRecordType,++  -- * Templates about record type name+  recordTypeNameDefault, recordTypeDefault,++  columnOffsetsVarNameDefault,++  persistableFunctionNamesDefault,++  -- * Not nullable single column type+  deriveNotNullType+  ) where+++import Control.Applicative (pure, (<*>))+import Data.List (foldl')+import Data.Array (Array, listArray, (!))+import Language.Haskell.TH.Name.CamelCase+  (ConName(conName), VarName(varName),+   conCamelcaseName, varCamelcaseName, varNameWithPrefix,+   toTypeCon, toDataCon, toVarExp)+import Language.Haskell.TH.Lib.Extra (integralE, simpleValD)+import Language.Haskell.TH+  (Q, newName, nameBase, reify, Info(TyConI), Name,+   TypeQ, conT, Con (NormalC, RecC),+   Dec(DataD), dataD, sigD, valD,+   ExpQ, Exp(ConE), conE, varE, lamE, listE, sigE,+   varP, conP, normalB, recC,+   cxt, varStrictType, strictType, isStrict)++import Database.Record+  (HasColumnConstraint(columnConstraint), Primary, NotNull,+   HasKeyConstraint(keyConstraint), derivedCompositePrimary,+   PersistableRecordWidth, PersistableWidth(persistableWidth),+   FromSql(recordFromSql), RecordFromSql,+   ToSql(recordToSql), RecordToSql, wrapToSql, putRecord, putEmpty)++import Database.Record.KeyConstraint+  (unsafeSpecifyColumnConstraint, unsafeSpecifyNotNullValue, unsafeSpecifyKeyConstraint)+import Database.Record.Persistable (unsafePersistableRecordWidth, runPersistableRecordWidth)+import qualified Database.Record.Persistable as Persistable+++-- | Generate default name of record type constructor from SQL table name 'String'+recordTypeNameDefault :: String  -- ^ Table name in SQL+                      -> ConName -- ^ Result name+recordTypeNameDefault =  conCamelcaseName++-- | Record type constructor template from SQL table name 'String'.+--   Type name is generated by 'recordTypeNameDefault'.+recordTypeDefault :: String -- ^ Table name in SQL+                  -> TypeQ  -- ^ Result type template+recordTypeDefault =  toTypeCon . recordTypeNameDefault++-- | Variable expression of record column offset array.+columnOffsetsVarNameDefault :: Name    -- ^ Table type name+                            -> VarName -- ^ Result expression variable name+columnOffsetsVarNameDefault =  (`varNameWithPrefix` "columnOffsets") . nameBase++-- | Template of 'HasColumnConstraint' instance.+defineHasColumnConstraintInstance :: TypeQ   -- ^ Type which represent constraint type+                                  -> TypeQ   -- ^ Type constructor of record+                                  -> Int     -- ^ Key index which specifies this constraint+                                  -> Q [Dec] -- ^ Result declaration template+defineHasColumnConstraintInstance constraint typeCon index =+  [d| instance HasColumnConstraint $constraint $typeCon where+        columnConstraint = unsafeSpecifyColumnConstraint $(integralE index) |]++-- | Template of 'HasKeyConstraint' instance.+defineHasPrimaryConstraintInstanceDerived ::TypeQ    -- ^ Type constructor of record+                                          -> Q [Dec] -- ^ Result declaration template+defineHasPrimaryConstraintInstanceDerived typeCon =+  [d| instance HasKeyConstraint Primary $typeCon where+        keyConstraint = derivedCompositePrimary |]++-- | Template of 'HasColumnConstraint' 'Primary' instance.+defineHasPrimaryKeyInstance :: TypeQ   -- ^ Type constructor of record+                            -> [Int]   -- ^ Key index which specifies this constraint+                            -> Q [Dec] -- ^ Declaration of primary key constraint instance+defineHasPrimaryKeyInstance typeCon = d  where+  d []   = return []+  d [ix] = do+    col  <- defineHasColumnConstraintInstance [t| Primary |] typeCon ix+    comp <- defineHasPrimaryConstraintInstanceDerived typeCon+    return $ col ++ comp+  d ixs  =+    [d| instance HasKeyConstraint Primary $typeCon where+          keyConstraint = unsafeSpecifyKeyConstraint+                          $(listE [integralE ix | ix <- ixs ])+      |]++-- | Template of 'HasColumnConstraint' 'NotNull' instance.+defineHasNotNullKeyInstance :: TypeQ   -- ^ Type constructor of record+                            -> Int     -- ^ Key index which specifies this constraint+                            -> Q [Dec] -- ^ Declaration of not null key constraint instance+defineHasNotNullKeyInstance =+  defineHasColumnConstraintInstance [t| NotNull |]++-- | Template of 'HasColumnConstraint' 'Primary' instance+--   from SQL table name 'String' and key index.+defineHasPrimaryKeyInstanceDefault :: String  -- ^ Table name+                                   -> [Int]   -- ^ Key index which specifies this constraint+                                   -> Q [Dec] -- ^ Declaration of primary key constraint instance+defineHasPrimaryKeyInstanceDefault =+  defineHasPrimaryKeyInstance . recordTypeDefault++-- | Template of 'HasColumnConstraint' 'NotNull' instance+--   from SQL table name 'String' and key index.+defineHasNotNullKeyInstanceDefault :: String  -- ^ Table name+                                   -> Int     -- ^ Key index which specifies this constraint+                                   -> Q [Dec] -- ^ Declaration of not null key constraint instance+defineHasNotNullKeyInstanceDefault =+  defineHasNotNullKeyInstance . recordTypeDefault++-- | Name to specify deriving 'Eq'+derivingEq :: ConName+derivingEq   = conCamelcaseName "Eq"++-- | Name to specify deriving 'Show'+derivingShow :: ConName+derivingShow = conCamelcaseName "Show"++-- | Name to specify deriving 'Read'+derivingRead :: ConName+derivingRead = conCamelcaseName "Read"++-- | Name to specify deriving 'Data'+derivingData :: ConName+derivingData = conCamelcaseName "Data"++-- | Name to specify deriving 'Typable'+derivingTypable :: ConName+derivingTypable = conCamelcaseName "Typable"++-- | Record type width expression template.+recordWidthTemplate :: TypeQ -- ^ Record type constructor.+                    -> ExpQ  -- ^ Expression to get record width.+recordWidthTemplate ty =+  [| runPersistableRecordWidth+     $(sigE [| persistableWidth |] [t| PersistableRecordWidth $(ty) |])+   |]++-- | Column offset array and 'PersistableWidth' instance declaration.+defineColumnOffsets :: ConName -- ^ Record type constructor.+                    -> [TypeQ] -- ^ Types of record columns.+                    -> Q [Dec] -- ^ Declaration of 'PersistableWidth' instance.+defineColumnOffsets typeName' tys = do+  let ofsVar = columnOffsetsVarNameDefault $ conName typeName'+      widthIxE = integralE $ length tys+  ar <- simpleValD (varName ofsVar) [t| Array Int Int |]+        [| listArray (0 :: Int, $widthIxE) $+           scanl (+) (0 :: Int) $(listE $ map recordWidthTemplate tys) |]+  pw <- [d| instance PersistableWidth $(toTypeCon typeName') where+              persistableWidth = unsafePersistableRecordWidth $ $(toVarExp ofsVar) ! $widthIxE+          |]+  return $ ar ++ pw++-- | Record type declaration template.+defineRecordType :: ConName            -- ^ Name of the data type of table record type.+                 -> [(VarName, TypeQ)] -- ^ List of columns in the table. Must be legal, properly cased record columns.+                 -> [ConName]          -- ^ Deriving type class names.+                 -> Q [Dec]            -- ^ The data type record declaration.+defineRecordType typeName' columns derives = do+  let typeName = conName typeName'+      fld (n, tq) = varStrictType (varName n) (strictType isStrict tq)+  rec  <- dataD (cxt []) typeName [] [recC typeName (map fld columns)] (map conName derives)+  offs <- defineColumnOffsets typeName' [ty | (_, ty) <- columns]+  return $ rec : offs++-- | Generate column name from 'String'.+columnDefault :: String -> TypeQ -> (VarName, TypeQ)+columnDefault n t = (varCamelcaseName n, t)++-- | Record type declaration template from SQL table name 'String'+--   and column name 'String' - type pairs, derivings.+defineRecordTypeDefault :: String -> [(String, TypeQ)] -> [ConName] -> Q [Dec]+defineRecordTypeDefault table columns =+  defineRecordType+  (recordTypeNameDefault table)+  [ columnDefault n t | (n, t) <- columns ]+++-- | Record parser template.+defineRecordParser :: TypeQ         -- ^ SQL value type.+                   -> VarName       -- ^ Name of record parser.+                   -> (TypeQ, ExpQ) -- ^ Record type constructor and data constructor.+                   -> Int           -- ^ Count of record columns.+                   -> Q [Dec]       -- ^ Declaration of record construct function from SQL values.+defineRecordParser sqlValType name' (tyCon, dataCon) width = do+  let name = varName name'+  sig <- sigD name [t| RecordFromSql $sqlValType $tyCon |]+  var <- valD (varP name)+         (normalB+          (foldl' (\a x -> [| $a <*> $x |]) [| pure $dataCon |]+           $ replicate width [| recordFromSql |])+         )+         []+  return [sig, var]++dataConInfo :: Exp -> Q Name+dataConInfo =  d  where+  d (ConE n) = return n+  d e        = fail $ "Not record data constructor: " ++ show e++-- | Record printer template.+defineRecordPrinter :: TypeQ         -- ^ SQL value type.+                    -> VarName       -- ^ Name of record printer.+                    -> (TypeQ, ExpQ) -- ^ Record type constructor and data constructor.+                    -> Int           -- ^ Count of record columns.+                    -> Q [Dec]       -- ^ Declaration of record construct function from SQL values.+defineRecordPrinter sqlValType name' (tyCon, dataCon) width = do+  let name = varName name'+  sig <- sigD name [t| RecordToSql $sqlValType $tyCon |]+  names <- mapM (newName . ('f':) . show) [1 .. width]+  dcn <- dataCon >>= dataConInfo+  var <- valD (varP name)+         (normalB [| wrapToSql+                     $(lamE+                       [ conP dcn [ varP n | n <- names ] ]+                       (foldr (\a x -> [| $a >> $x |]) [| putEmpty () |]+                        [ [| putRecord $(varE n) |] | n <- names ])) |])+         []+  return [sig, var]++-- | Record parser and printer instance templates for converting+--   between list of SQL type and Haskell record type.+definePersistableInstance :: TypeQ   -- ^ SQL value type.+                           -> TypeQ   -- ^ Record type constructor.+                           -> VarName -- ^ Record parser name.+                           -> VarName -- ^ Record printer name.+                           -> Int     -- ^ Count of record columns.+                           -> Q [Dec] -- ^ Instance declarations for 'Persistable'.+definePersistableInstance sqlType typeCon parserName printerName _width = do+  [d| instance FromSql $sqlType $typeCon where+        recordFromSql = $(toVarExp parserName)++      instance ToSql $sqlType $typeCon where+        recordToSql = $(toVarExp printerName)+    |]++-- | All templates depending on SQL value type.+makeRecordPersistableWithSqlType :: TypeQ              -- ^ SQL value type.+                                 -> (VarName, VarName) -- ^ Constructor function name and decompose function name.+                                 -> (TypeQ, ExpQ)      -- ^ Record type constructor and data constructor.+                                 -> Int                -- ^ Count of record columns.+                                 -> Q [Dec]            -- ^ Result declarations.+makeRecordPersistableWithSqlType+  sqlValueType+  (cF, dF) conPair@(tyCon, _)+  width = do+  fromSQL  <- defineRecordParser sqlValueType cF conPair width+  toSQL    <- defineRecordPrinter sqlValueType dF conPair width+  instSQL  <- definePersistableInstance sqlValueType tyCon cF dF width+  return $ fromSQL ++ toSQL ++ instSQL++-- | Default name of record construction function from SQL table name.+fromSqlNameDefault :: String -> VarName+fromSqlNameDefault =  (`varNameWithPrefix` "fromSqlOf")++-- | Default name of record decomposition function from SQL table name.+toSqlNameDefault :: String -> VarName+toSqlNameDefault =  (`varNameWithPrefix` "toSqlOf")++-- | All templates depending on SQL value type with default names.+makeRecordPersistableWithSqlTypeDefault :: TypeQ   -- ^ SQL value type+                                        -> String  -- ^ Table name of database+                                        -> Int     -- ^ Count of record columns+                                        -> Q [Dec] -- ^ Result declarations+makeRecordPersistableWithSqlTypeDefault sqlValueType table width = do+  makeRecordPersistableWithSqlType+    sqlValueType+    (persistableFunctionNamesDefault . conName . conCamelcaseName $ table)+    (recordTypeDefault table, toDataCon . recordTypeNameDefault $ table)+    width++recordInfo' :: Info -> Maybe ((TypeQ, ExpQ), (Maybe [Name], [TypeQ]))+recordInfo' =  d  where+  d (TyConI (DataD _cxt tcn _bs [r] _ds)) = case r of+    NormalC dcn ts     -> Just ((conT tcn, conE dcn), (Nothing, [return t | (_, t) <- ts]))+    RecC    dcn vts    -> Just ((conT tcn, conE dcn), (Just ns, ts))+      where (ns, ts) = unzip [(n, return t) | (n, _, t) <- vts]+    _                  -> Nothing+  d _                  =  Nothing++-- | Low-level reify interface for record type name.+reifyRecordType :: Name -> Q ((TypeQ, ExpQ), (Maybe [Name], [TypeQ]))+reifyRecordType recTypeName = do+  tyConInfo   <- reify recTypeName+  maybe+    (fail $ "Defined record type constructor not found: " ++ show recTypeName)+    return+    (recordInfo' tyConInfo)++-- | Generate persistable function symbol names using default rule.+persistableFunctionNamesDefault :: Name -> (VarName, VarName)+persistableFunctionNamesDefault recTypeName = (fromSqlNameDefault bn, toSqlNameDefault bn)  where+  bn = nameBase recTypeName++-- | All templates depending on SQL value type. Defined record type information is used.+makeRecordPersistableWithSqlTypeFromDefined :: TypeQ              -- ^ SQL value type+                                            -> (VarName, VarName) -- ^ Constructor function name and decompose function name+                                            -> Name               -- ^ Record type constructor name+                                            -> Q [Dec]            -- ^ Result declarations+makeRecordPersistableWithSqlTypeFromDefined sqlValueType fnames recTypeName = do+  (conPair, (_, cts)) <- reifyRecordType recTypeName+  makeRecordPersistableWithSqlType sqlValueType fnames conPair $ length cts++-- | All templates depending on SQL value type with default names. Defined record type information is used.+makeRecordPersistableWithSqlTypeDefaultFromDefined :: TypeQ   -- ^ SQL value type+                                                   -> Name    -- ^ Record type constructor name+                                                   -> Q [Dec] -- ^ Result declarations+makeRecordPersistableWithSqlTypeDefaultFromDefined sqlValueType recTypeName =+  makeRecordPersistableWithSqlTypeFromDefined sqlValueType (persistableFunctionNamesDefault recTypeName) recTypeName++-- | All templates for record type.+defineRecord :: TypeQ              -- ^ SQL value type+             -> (VarName, VarName) -- ^ Constructor function name and decompose function name+             -> ConName            -- ^ Record type name+             -> [(VarName, TypeQ)] -- ^ Column schema+             -> [ConName]          -- ^ Record derivings+             -> Q [Dec]            -- ^ Result declarations+defineRecord+  sqlValueType+  fnames tyC+  columns drvs = do++  typ     <- defineRecordType tyC columns drvs+  withSql <- makeRecordPersistableWithSqlType sqlValueType fnames (toTypeCon tyC, toDataCon tyC) $ length columns+  return $ typ ++ withSql++-- | All templates for record type with default names.+defineRecordDefault :: TypeQ             -- ^ SQL value type+                    -> String            -- ^ Table name+                    -> [(String, TypeQ)] -- ^ Column names and types+                    -> [ConName]         -- ^ Record derivings+                    -> Q [Dec]           -- ^ Result declarations+defineRecordDefault sqlValueType table columns derives = do+  typ     <- defineRecordTypeDefault table columns derives+  withSql <- makeRecordPersistableWithSqlTypeDefault sqlValueType table $ length columns+  return $ typ ++ withSql+++-- | Templates for single column value type.+deriveNotNullType :: TypeQ -> Q [Dec]+deriveNotNullType typeCon =+  [d| instance PersistableWidth $typeCon where+        persistableWidth = Persistable.unsafeValueWidth++      instance HasColumnConstraint NotNull $typeCon where+        columnConstraint = unsafeSpecifyNotNullValue+    |]
+ src/Database/Record/ToSql.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Module      : Database.Record.ToSql+-- Copyright   : 2013 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module defines interfaces+-- from Haskell type into list of SQL type.+module Database.Record.ToSql (+  -- * Conversion from record type into list of SQL type+  ToSqlM, RecordToSql, runFromRecord,+  createRecordToSql,++  (<&>),++  -- * Inference rules of 'RecordToSql' conversion+  ToSql (recordToSql),+  putRecord, putEmpty, fromRecord, wrapToSql,++  valueToSql,++  -- * Make parameter list for updating with key+  updateValuesByUnique',+  updateValuesByUnique,+  updateValuesByPrimary,++  untypedUpdateValuesIndex,+  unsafeUpdateValuesWithIndexes+  ) where++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)+import Database.Record.KeyConstraint+  (Primary, Unique, KeyConstraint, HasKeyConstraint(keyConstraint), unique, indexes)+++-- | Context type to convert SQL type list.+type ToSqlM q a = Writer (DList q) a++runToSqlM :: ToSqlM q a -> [q]+runToSqlM =  DList.toList . execWriter++-- | Proof object type to convert from Haskell type 'a' into list of SQL type ['q'].+newtype RecordToSql q a = RecordToSql (a -> ToSqlM q ())++runRecordToSql :: RecordToSql q a -> a -> ToSqlM q ()+runRecordToSql (RecordToSql f) = f++-- | Finalize 'RecordToSql' record printer.+wrapToSql :: (a -> ToSqlM q ()) -> RecordToSql q a+wrapToSql =  RecordToSql++-- | Run 'RecordToSql' proof object. Convert from Haskell type 'a' into list of SQL type ['q'].+runFromRecord :: RecordToSql q a -- ^ Proof object which has capability to convert+              -> a               -- ^ Haskell type+              -> [q]             -- ^ list of SQL type+runFromRecord r = runToSqlM . runRecordToSql r++-- | Axiom of 'RecordToSql' for SQL type 'q' and Haksell type 'a'.+createRecordToSql :: (a -> [q])      -- ^ Convert function body+                  -> RecordToSql q a -- ^ Result proof object+createRecordToSql f =  wrapToSql $ tell . DList.fromList . f++-- | Derivation rule of 'RecordToSql' proof object for Haskell tuple (,) type.+(<&>) :: RecordToSql q a -> RecordToSql q b -> RecordToSql q (a, b)+ra <&> rb = RecordToSql $ \(a, b) -> do+  runRecordToSql ra a+  runRecordToSql rb b++-- | Derivation rule of 'RecordToSql' proof object for Haskell 'Maybe' type.+maybeRecord :: PersistableSqlType q -> PersistableRecordWidth a -> RecordToSql q a -> RecordToSql q (Maybe a)+maybeRecord qt w ra =  wrapToSql d  where+  d (Just r) = runRecordToSql ra r+  d Nothing  = tell $ DList.replicate (runPersistableRecordWidth w) (runPersistableNullValue qt)++infixl 4 <&>+++-- | Inference rule interface for 'RecordToSql' proof object.+class ToSql q a where+  -- | Infer 'RecordToSql' proof object.+  recordToSql :: RecordToSql q a++-- | Inference rule of 'RecordToSql' proof object which can convert+--   from Haskell tuple ('a', 'b') type into list of SQL type ['q'].+instance (ToSql q a, ToSql q b) => ToSql q (a, b) where+  recordToSql = recordToSql <&> recordToSql++-- | Inference rule of 'RecordToSql' proof object which can convert+--   from Haskell 'Maybe' type into list of SQL type ['q'].+instance (PersistableType q, PersistableWidth a, ToSql q a) => ToSql q (Maybe a)  where+  recordToSql = maybeRecord persistableType persistableWidth recordToSql++-- | Inference rule of 'RecordToSql' proof object which can convert+--   from Haskell unit () type into /empty/ list of SQL type ['q'].+instance ToSql q () where+  recordToSql = wrapToSql $ \() -> tell DList.empty++-- | Run inferred 'RecordToSql' proof object.+--   Context to convert haskell record type 'a' into SQL type 'q' list.+putRecord :: ToSql q a => a -> ToSqlM q ()+putRecord =  runRecordToSql recordToSql++-- | Run 'RecordToSql' empty printer.+putEmpty :: () -> ToSqlM q ()+putEmpty =  putRecord++-- | Run inferred 'RecordToSql' proof object.+--   Convert from haskell type 'a' into list of SQL type ['q'].+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++-- | Make untyped indexes to update column from key indexes and record width.+--   Expected by update form like+--+-- /UPDATE <table> SET c0 = ?, c1 = ?, ..., cn = ? WHERE key0 = ? AND key1 = ? AND key2 = ? ... /+untypedUpdateValuesIndex :: [Int] -- ^ Key indexes+                         -> Int   -- ^ Record width+                         -> [Int] -- ^ Indexes to update other than key+untypedUpdateValuesIndex key width = otherThanKey  where+    maxIx = width - 1+    otherThanKey = toList $ fromList [0 .. maxIx] \\ fromList key++-- | Unsafely specify key indexes to convert from Haskell type `ra`+--   into SQL value `q` list expected by update form like+--+-- /UPDATE <table> SET c0 = ?, c1 = ?, ..., cn = ? WHERE key0 = ? AND key1 = ? AND key2 = ? ... /+--+--   using 'RecordToSql' proof object.+unsafeUpdateValuesWithIndexes :: RecordToSql q ra+                              -> [Int]+                              -> ra+                              -> [q]+unsafeUpdateValuesWithIndexes pr key a =+  [ valsA ! i | i <- otherThanKey ++ key ]  where+    vals = runFromRecord pr a+    width = length vals+    valsA = listArray (0, width - 1) vals+    otherThanKey = untypedUpdateValuesIndex key width++-- | Convert from Haskell type `ra` into SQL value `q` list expected by update form like+--+-- /UPDATE <table> SET c0 = ?, c1 = ?, ..., cn = ? WHERE key0 = ? AND key1 = ? AND key2 = ? ... /+--+--   using 'RecordToSql' proof object.+updateValuesByUnique' :: RecordToSql q ra+                      -> KeyConstraint Unique ra -- ^ Unique key table constraint proof object.+                      -> ra+                      -> [q]+updateValuesByUnique' pr uk = unsafeUpdateValuesWithIndexes pr (indexes uk)++-- | Convert like 'updateValuesByUnique'' using inferred 'RecordToSql' proof object.+updateValuesByUnique :: ToSql q ra+                     => KeyConstraint Unique ra -- ^ Unique key table constraint proof object.+                     -> ra+                     -> [q]+updateValuesByUnique = updateValuesByUnique' recordToSql++-- | Convert like 'updateValuesByUnique'' using inferred 'RecordToSql' and 'ColumnConstraint' proof objects.+updateValuesByPrimary :: (HasKeyConstraint Primary ra, ToSql q ra)+                      => ra -> [q]+updateValuesByPrimary =  updateValuesByUnique (unique keyConstraint)