persistable-record-0.6.0.5: Binding between SQL database values and haskell records.

Copyright2013 Kei Hibino
LicenseBSD3
Maintainerex8k.hibino@gmail.com
Stabilityexperimental
Portabilityunknown
Safe HaskellNone
LanguageHaskell2010

Database.Record

Contents

Description

This is integrated module which contains types to represent table constraints and interfaces to bind between SQL database values and Haskell records.

Synopsis

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.

Binding between SQL values and Haskell records

You will need to implement instances of FromSql and ToSql class to bind between SQL database values and Haskell records.

You can use Database.Record.TH module in this package to generate instances from SQL database record column names and types.

Constraints used for RecordFromSql inference

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.

Modules which provide proof objects

Table constraint specified by keys

class HasKeyConstraint c a where Source #

Interface of inference rule for KeyConstraint proof object.

Methods

keyConstraint :: KeyConstraint c a Source #

Infer ColumnConstraint proof object.

type PrimaryConstraint = KeyConstraint Primary Source #

Specialized primary constraint.

type UniqueConstraint = KeyConstraint Unique Source #

Specialized unique constraint.

data KeyConstraint c r Source #

Proof object to specify table constraint for table record type r and constraint c. Constraint is specified by composite key.

class HasColumnConstraint c a where Source #

Interface of inference rule for ColumnConstraint proof object.

Methods

columnConstraint :: ColumnConstraint c a Source #

Infer ColumnConstraint proof object.

Instances
HasColumnConstraint NotNull Bool Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull Char Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull Int Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull Int8 Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull Int16 Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull Int32 Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull Int64 Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull String Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull a => HasColumnConstraint NotNull (a, b) Source #

Inference rule of ColumnConstraint NotNull for tuple (,) type.

Instance details

Defined in Database.Record.KeyConstraint

type PrimaryColumnConstraint = ColumnConstraint Primary Source #

Specialized primary constraint.

type NotNullColumnConstraint = ColumnConstraint NotNull Source #

Specialized not-null constraint.

type UniqueColumnConstraint = ColumnConstraint Unique Source #

Specialized unique constraint.

data Primary Source #

Constraint type. Primary key.

data NotNull Source #

Constraint type. Not-null key.

Instances
HasColumnConstraint NotNull Bool Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull Char Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull Int Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull Int8 Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull Int16 Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull Int32 Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull Int64 Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull String Source # 
Instance details

Defined in Database.Record.Instances

HasColumnConstraint NotNull a => HasColumnConstraint NotNull (a, b) Source #

Inference rule of ColumnConstraint NotNull for tuple (,) type.

Instance details

Defined in Database.Record.KeyConstraint

data Unique Source #

Constraint type. Unique key.

data ColumnConstraint c r Source #

Proof object to specify table constraint for table record type r and constraint c specified by a single column.

uniqueColumn :: PrimaryColumnConstraint r -> UniqueColumnConstraint r Source #

Derivation rule for UniqueColumnConstraint. Derive Unique from Primary.

notNullColumn :: PrimaryColumnConstraint r -> NotNullColumnConstraint r Source #

Derivation rule for NotNullColumnConstraint. Derive NotNull from Primary.

derivedUniqueColumnConstraint :: HasColumnConstraint Primary r => UniqueColumnConstraint r Source #

Inferred UniqueColumnConstraint proof object. Record type r has unique key which is derived r has primary key.

derivedNotNullColumnConstraint :: HasColumnConstraint Primary r => NotNullColumnConstraint r Source #

Inferred NotNullColumnConstraint proof object. Record type r has not-null key which is derived r has primary key.

derivedCompositePrimary :: HasColumnConstraint Primary r => PrimaryConstraint r Source #

Inferred PrimaryConstraint proof object. Record type r has composite primary key which is derived r has single column primary key.

derivedUniqueConstraint :: HasKeyConstraint Primary r => UniqueConstraint r Source #

Inferred UniqueConstraint proof object. Record type r has unique key which is derived r has primary key.

Convert between Haskell type and list of SQL type

class PersistableWidth a where Source #

PersistableWidth a is implicit rule to derive PersistableRecordWidth a width proposition for type a.

Generic programming (https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#generic-programming) with default signature is available for PersistableWidth class, so you can make instance like below:

  {-# LANGUAGE DeriveGeneric #-}
  import GHC.Generics (Generic)
  --
  data Foo = Foo { ... } deriving Generic
  instance PersistableWidth Foo

Minimal complete definition

Nothing

Instances
PersistableWidth Bool Source # 
Instance details

Defined in Database.Record.Instances

PersistableWidth Char Source # 
Instance details

Defined in Database.Record.Instances

PersistableWidth Int Source # 
Instance details

Defined in Database.Record.Instances

PersistableWidth Int8 Source # 
Instance details

Defined in Database.Record.Instances

PersistableWidth Int16 Source # 
Instance details

Defined in Database.Record.Instances

PersistableWidth Int32 Source # 
Instance details

Defined in Database.Record.Instances

PersistableWidth Int64 Source # 
Instance details

Defined in Database.Record.Instances

PersistableWidth () Source #

Inference rule of PersistableRecordWidth for Haskell unit () type. Derive from axiom.

Instance details

Defined in Database.Record.Persistable

PersistableWidth String Source # 
Instance details

Defined in Database.Record.Instances

PersistableWidth a => PersistableWidth (Maybe a) Source #

Inference rule of PersistableRecordWidth proof object for Maybe type.

Instance details

Defined in Database.Record.Persistable

(PersistableWidth a, PersistableWidth b) => PersistableWidth (a, b) Source # 
Instance details

Defined in Database.Record.TupleInstances

(PersistableWidth a, PersistableWidth b, PersistableWidth c) => PersistableWidth (a, b, c) Source # 
Instance details

Defined in Database.Record.TupleInstances

(PersistableWidth a, PersistableWidth b, PersistableWidth c, PersistableWidth d) => PersistableWidth (a, b, c, d) Source # 
Instance details

Defined in Database.Record.TupleInstances

(PersistableWidth a, PersistableWidth b, PersistableWidth c, PersistableWidth d, PersistableWidth e) => PersistableWidth (a, b, c, d, e) Source # 
Instance details

Defined in Database.Record.TupleInstances

(PersistableWidth a, PersistableWidth b, PersistableWidth c, PersistableWidth d, PersistableWidth e, PersistableWidth f) => PersistableWidth (a, b, c, d, e, f) Source # 
Instance details

Defined in Database.Record.TupleInstances

Methods

persistableWidth :: PersistableRecordWidth (a, b, c, d, e, f) Source #

(PersistableWidth a, PersistableWidth b, PersistableWidth c, PersistableWidth d, PersistableWidth e, PersistableWidth f, PersistableWidth g) => PersistableWidth (a, b, c, d, e, f, g) Source # 
Instance details

Defined in Database.Record.TupleInstances

Methods

persistableWidth :: PersistableRecordWidth (a, b, c, d, e, f, g) Source #

class Eq q => PersistableType q where Source #

Interface of derivation rule for PersistableSqlType.

type PersistableRecordWidth a = ProductConst (Sum Int) a Source #

Proposition to specify width of Haskell type a. The width is length of database value list which is converted from Haskell type a.

data PersistableSqlType q Source #

Proposition to specify type q is database value type, contains null value

sqlNullValue :: PersistableType q => q Source #

Implicitly derived null value of database value type.

derivedWidth :: PersistableWidth a => (PersistableRecordWidth a, Int) Source #

Pass type parameter and inferred width value.

Convert from list of SQL type

class FromSql q a where Source #

FromSql q a is implicit rule to derive RecordFromSql q a record parser function against type a.

Generic programming (https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#generic-programming) with default signature is available for FromSql class, so you can make instance like below:

  {-# LANGUAGE DeriveGeneric #-}
  import GHC.Generics (Generic)
  import Database.HDBC (SqlValue)
  --
  data Foo = Foo { ... } deriving Generic
  instance FromSql SqlValue Foo

Minimal complete definition

Nothing

Methods

recordFromSql :: RecordFromSql q a Source #

RecordFromSql q a record parser function.

recordFromSql :: (Generic a, GFromSql q (Rep a)) => RecordFromSql q a Source #

RecordFromSql q a record parser function.

Instances
FromSql q () Source #

Implicit derivation rule of RecordFromSql parser function object which can convert from empty list of database value type [q] into Haskell unit () type.

Instance details

Defined in Database.Record.FromSql

(HasColumnConstraint NotNull a, FromSql q a, PersistableType q) => FromSql q (Maybe a) Source #

Implicit derivation rule of RecordFromSql parser function object which can convert from list of database value type [q] into Haskell Maybe type.

Instance details

Defined in Database.Record.FromSql

(FromSql q a, FromSql q b) => FromSql q (a, b) Source # 
Instance details

Defined in Database.Record.TupleInstances

Methods

recordFromSql :: RecordFromSql q (a, b) Source #

(FromSql q a, FromSql q b, FromSql q c) => FromSql q (a, b, c) Source # 
Instance details

Defined in Database.Record.TupleInstances

Methods

recordFromSql :: RecordFromSql q (a, b, c) Source #

(FromSql q a, FromSql q b, FromSql q c, FromSql q d) => FromSql q (a, b, c, d) Source # 
Instance details

Defined in Database.Record.TupleInstances

Methods

recordFromSql :: RecordFromSql q (a, b, c, d) Source #

(FromSql q a, FromSql q b, FromSql q c, FromSql q d, FromSql q e) => FromSql q (a, b, c, d, e) Source # 
Instance details

Defined in Database.Record.TupleInstances

Methods

recordFromSql :: RecordFromSql q (a, b, c, d, e) Source #

(FromSql q a, FromSql q b, FromSql q c, FromSql q d, FromSql q e, FromSql q f) => FromSql q (a, b, c, d, e, f) Source # 
Instance details

Defined in Database.Record.TupleInstances

Methods

recordFromSql :: RecordFromSql q (a, b, c, d, e, f) Source #

(FromSql q a, FromSql q b, FromSql q c, FromSql q d, FromSql q e, FromSql q f, FromSql q g) => FromSql q (a, b, c, d, e, f, g) Source # 
Instance details

Defined in Database.Record.TupleInstances

Methods

recordFromSql :: RecordFromSql q (a, b, c, d, e, f, g) Source #

data RecordFromSql q a Source #

RecordFromSql q a is data-type wrapping function to convert from list of database value type (to receive from database) [q] into Haskell type a

This structure is similar to parser. While running RecordFromSql behavior is the same as non-fail-able parser which parse list of database value 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 Baz
  baz =  ...

You can get composed RecordFromSql like below.

  myRecord :: RecordFromSql SqlValue MyRecord
  myRecord =  MyRecord <$> foo <*> bar <*> baz
Instances
Monad (RecordFromSql q) Source #

Monad instance like parser Monad.

Instance details

Defined in Database.Record.FromSql

Methods

(>>=) :: RecordFromSql q a -> (a -> RecordFromSql q b) -> RecordFromSql q b #

(>>) :: RecordFromSql q a -> RecordFromSql q b -> RecordFromSql q b #

return :: a -> RecordFromSql q a #

fail :: String -> RecordFromSql q a #

Functor (RecordFromSql q) Source #

Derived Functor instance from Monad instance

Instance details

Defined in Database.Record.FromSql

Methods

fmap :: (a -> b) -> RecordFromSql q a -> RecordFromSql q b #

(<$) :: a -> RecordFromSql q b -> RecordFromSql q a #

Applicative (RecordFromSql q) Source #

Derived Applicative instance from Monad instance

Instance details

Defined in Database.Record.FromSql

Methods

pure :: a -> RecordFromSql q a #

(<*>) :: RecordFromSql q (a -> b) -> RecordFromSql q a -> RecordFromSql q b #

liftA2 :: (a -> b -> c) -> RecordFromSql q a -> RecordFromSql q b -> RecordFromSql q c #

(*>) :: RecordFromSql q a -> RecordFromSql q b -> RecordFromSql q b #

(<*) :: RecordFromSql q a -> RecordFromSql q b -> RecordFromSql q a #

takeRecord :: FromSql q a => [q] -> (a, [q]) Source #

Run implicit RecordFromSql parser function object. Convert from list of database value type [q] into haskell type a and rest of list [q].

toRecord :: FromSql q a => [q] -> a Source #

Run implicit RecordFromSql parser function object. Convert from list of database value type [q] into haskell type a.

valueRecordFromSql :: (q -> a) -> RecordFromSql q a Source #

Derivation rule of RecordFromSql parser function object for value convert function.

Convert into list of SQL type

class PersistableWidth a => ToSql q a where Source #

ToSql q a is implicit rule to derive RecordToSql q a record printer function for type a.

Generic programming (https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#generic-programming) with default signature is available for ToSql class, so you can make instance like below:

  {-# LANGUAGE DeriveGeneric #-}
  import GHC.Generics (Generic)
  import Database.HDBC (SqlValue)
  --
  data Foo = Foo { ... } deriving Generic
  instance ToSql SqlValue Foo

To make instances of ToSql manually, ToSql q a and RecordToSql 'q a are composable with monadic context. When, you have data constructor and objects like below.

  data MyRecord = MyRecord Foo Bar Baz
  instance ToSql SqlValue Foo where
    ...
  instance ToSql SqlValue Bar where
    ...
  instance ToSql SqlValue Baz where
    ...

You can get composed ToSql implicit rule like below.

  instance ToSql SqlValue MyRecord where
    recordToSql =
    recordToSql = wrapToSql $ \ (MyRecord x y z) -> do
      putRecord x
      putRecord y
      putRecord z

Minimal complete definition

Nothing

Methods

recordToSql :: RecordToSql q a Source #

Derived RecordToSql printer function object.

recordToSql :: (Generic a, GToSql q (Rep a)) => RecordToSql q a Source #

Derived RecordToSql printer function object.

Instances
ToSql q () Source #

Implicit derivation rule of RecordToSql printer function object which can convert from Haskell unit () type into empty list of database value type [q].

Instance details

Defined in Database.Record.ToSql

(PersistableType q, ToSql q a) => ToSql q (Maybe a) Source #

Implicit derivation rule of RecordToSql printer function object which can convert from Haskell Maybe type into list of database value type [q].

Instance details

Defined in Database.Record.ToSql

(ToSql q a, ToSql q b) => ToSql q (a, b) Source # 
Instance details

Defined in Database.Record.TupleInstances

Methods

recordToSql :: RecordToSql q (a, b) Source #

(ToSql q a, ToSql q b, ToSql q c) => ToSql q (a, b, c) Source # 
Instance details

Defined in Database.Record.TupleInstances

Methods

recordToSql :: RecordToSql q (a, b, c) Source #

(ToSql q a, ToSql q b, ToSql q c, ToSql q d) => ToSql q (a, b, c, d) Source # 
Instance details

Defined in Database.Record.TupleInstances

Methods

recordToSql :: RecordToSql q (a, b, c, d) Source #

(ToSql q a, ToSql q b, ToSql q c, ToSql q d, ToSql q e) => ToSql q (a, b, c, d, e) Source # 
Instance details

Defined in Database.Record.TupleInstances

Methods

recordToSql :: RecordToSql q (a, b, c, d, e) Source #

(ToSql q a, ToSql q b, ToSql q c, ToSql q d, ToSql q e, ToSql q f) => ToSql q (a, b, c, d, e, f) Source # 
Instance details

Defined in Database.Record.TupleInstances

Methods

recordToSql :: RecordToSql q (a, b, c, d, e, f) Source #

(ToSql q a, ToSql q b, ToSql q c, ToSql q d, ToSql q e, ToSql q f, ToSql q g) => ToSql q (a, b, c, d, e, f, g) Source # 
Instance details

Defined in Database.Record.TupleInstances

Methods

recordToSql :: RecordToSql q (a, b, c, d, e, f, g) Source #

data RecordToSql q a Source #

RecordToSql q a is data-type wrapping function to convert from Haskell type a into list of database value type (to send to database) [q].

This structure is similar to printer. While running RecordToSql behavior is the same as list printer. which appends list of database value type [q] stream.

type ToSqlM q a = Writer (DList q) a Source #

Context type to convert into database value list.

putRecord :: ToSql q a => a -> ToSqlM q () Source #

Run implicit RecordToSql printer function object. Context to convert haskell record type a into lib of database value type [q].

putEmpty :: () -> ToSqlM q () Source #

Run RecordToSql empty printer.

fromRecord :: ToSql q a => a -> [q] Source #

Run implicit RecordToSql printer function object. Convert from haskell type a into list of database value type [q].

valueRecordToSql :: (a -> q) -> RecordToSql q a Source #

Derivation rule of RecordToSql printer function object for value convert function.

updateValuesByUnique Source #

Arguments

:: ToSql q ra 
=> KeyConstraint Unique ra

Unique key table constraint printer function object.

-> ra 
-> [q] 

Convert from Haskell type ra into database value q list expected by update form like

  UPDATE table SET c0 = ?, c1 = ?, c2 = ? ... WHERE key0 = ? AND key1 = ? AND key2 = ? ...

using printer function object infered by ToSql ra q.

updateValuesByPrimary :: (HasKeyConstraint Primary ra, ToSql q ra) => ra -> [q] Source #

Convert like updateValuesByUnique' using implicit RecordToSql and ColumnConstraint.