| Copyright | 2013-2017 Kei Hibino |
|---|---|
| License | BSD3 |
| Maintainer | ex8k.hibino@gmail.com |
| Stability | experimental |
| Portability | unknown |
| Safe Haskell | Safe-Inferred |
| Language | Haskell2010 |
Database.Record.Persistable
Description
This module defines proposition interfaces for database value type and record type width.
Synopsis
- data PersistableSqlType q
- runPersistableNullValue :: PersistableSqlType q -> q
- unsafePersistableSqlTypeFromNull :: q -> PersistableSqlType q
- type PersistableRecordWidth a = ProductConst (Sum Int) a
- runPersistableRecordWidth :: PersistableRecordWidth a -> Int
- unsafePersistableRecordWidth :: Int -> PersistableRecordWidth a
- unsafeValueWidth :: PersistableRecordWidth a
- (<&>) :: PersistableRecordWidth a -> PersistableRecordWidth b -> PersistableRecordWidth (a, b)
- maybeWidth :: PersistableRecordWidth a -> PersistableRecordWidth (Maybe a)
- class Eq q => PersistableType q where
- sqlNullValue :: PersistableType q => q
- class PersistableWidth a where
- derivedWidth :: PersistableWidth a => (PersistableRecordWidth a, Int)
- class GFieldWidthList f
- data ProductConst a b
- getProductConst :: ProductConst a b -> a
- genericFieldOffsets :: (Generic a, GFieldWidthList (Rep a)) => ProductConst (Array Int Int) a
Specify database value type
data PersistableSqlType q Source #
Proposition to specify type q is database value type, contains null value
runPersistableNullValue :: PersistableSqlType q -> q Source #
Null value of database value type q.
unsafePersistableSqlTypeFromNull Source #
Arguments
| :: q | null value of database value type |
| -> PersistableSqlType q | Result proof object |
Unsafely specify PersistableSqlType axiom from specified database null value which type is q.
Specify record width
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.
runPersistableRecordWidth :: PersistableRecordWidth a -> Int Source #
Get width Int value of record type a.
unsafePersistableRecordWidth Source #
Arguments
| :: Int | Specify width of Haskell type |
| -> PersistableRecordWidth a | Result proof object |
Unsafely specify PersistableRecordWidth axiom from specified width of Haskell type a.
unsafeValueWidth :: PersistableRecordWidth a Source #
Unsafely specify PersistableRecordWidth axiom for Haskell type a which is single column type.
(<&>) :: PersistableRecordWidth a -> PersistableRecordWidth b -> PersistableRecordWidth (a, b) Source #
Derivation rule of PersistableRecordWidth for tuple (,) type.
maybeWidth :: PersistableRecordWidth a -> PersistableRecordWidth (Maybe a) Source #
Derivation rule of PersistableRecordWidth from from Haskell type a into for Haskell type Maybe a.
Implicit derivation rules, database value type and record type width
class Eq q => PersistableType q where Source #
Interface of derivation rule for PersistableSqlType.
Methods
sqlNullValue :: PersistableType q => q Source #
Implicitly derived null value of database value 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
Methods
persistableWidth :: PersistableRecordWidth a Source #
default persistableWidth :: (Generic a, GFieldWidthList (Rep a)) => PersistableRecordWidth a Source #
Instances
derivedWidth :: PersistableWidth a => (PersistableRecordWidth a, Int) Source #
Pass type parameter and inferred width value.
low-level interfaces
class GFieldWidthList f Source #
Generic width value list of record fields.
Minimal complete definition
gFieldWidthList
Instances
| GFieldWidthList (U1 :: Type -> Type) Source # | |
Defined in Database.Record.Persistable Methods gFieldWidthList :: ProductConst (DList Int) (U1 a) | |
| (GFieldWidthList a, GFieldWidthList b) => GFieldWidthList (a :*: b) Source # | |
Defined in Database.Record.Persistable Methods gFieldWidthList :: ProductConst (DList Int) ((a :*: b) a0) | |
| PersistableWidth a => GFieldWidthList (K1 i a :: Type -> Type) Source # | |
Defined in Database.Record.Persistable Methods gFieldWidthList :: ProductConst (DList Int) (K1 i a a0) | |
| GFieldWidthList a => GFieldWidthList (M1 i c a) Source # | |
Defined in Database.Record.Persistable Methods gFieldWidthList :: ProductConst (DList Int) (M1 i c a a0) | |
data ProductConst a b Source #
Restricted in product isomorphism record type b
Instances
| Monoid a => ProductIsoApplicative (ProductConst a) Source # | |
Defined in Database.Record.Persistable Methods pureP :: ProductConstructor a0 => a0 -> ProductConst a a0 # (|*|) :: ProductConst a (a0 -> b) -> ProductConst a a0 -> ProductConst a b # | |
| ProductIsoFunctor (ProductConst a) Source # | |
Defined in Database.Record.Persistable Methods (|$|) :: ProductConstructor (a0 -> b) => (a0 -> b) -> ProductConst a a0 -> ProductConst a b # | |
| Show a => Show (ProductConst a b) Source # | |
Defined in Database.Record.Persistable Methods showsPrec :: Int -> ProductConst a b -> ShowS # show :: ProductConst a b -> String # showList :: [ProductConst a b] -> ShowS # | |
getProductConst :: ProductConst a b -> a Source #
extract constant value of ProductConst.
genericFieldOffsets :: (Generic a, GFieldWidthList (Rep a)) => ProductConst (Array Int Int) a Source #
Generic offset array of record fields.