groundhog-0.0.1.1: Type-safe ADT-database mapping library.

Database.Groundhog.Core

Contents

Description

This module defines the functions and datatypes used throughout the framework. Most of them are for internal use

Synopsis

Main types

class PersistField v => PersistEntity v whereSource

Only instances of this class can be persisted in a database

Associated Types

data Fields v :: * -> * -> *Source

This type is used for typesafe manipulation of separate fields of datatype v. Each constructor in Fields corresponds to its field in a datatype v. It is parametrised by constructor phantom type and field value type.

Methods

entityDef :: v -> EntityDefSource

Returns a complete description of the type

toPersistValues :: PersistBackend m => v -> m [PersistValue]Source

Marshalls value to a list of PersistValue ready for insert to a database

fromPersistValues :: PersistBackend m => [PersistValue] -> m vSource

Constructs the value from the list of PersistValue

getConstraints :: v -> (Int, [(String, [(String, PersistValue)])])Source

Returns constructor number and a list of constraint names and corresponding field names with their values

showField :: Fields v c a -> StringSource

eqField :: Fields v c a -> Fields v c a -> BoolSource

class PersistField a whereSource

Methods

persistName :: a -> StringSource

Return name of the type. If it is polymorhic, the names of parameter types are separated with "$" symbol

toPersistValue :: PersistBackend m => a -> m PersistValueSource

Convert a value into something which can be stored in a database column. Note that for complex datatypes it may insert them to return identifier

fromPersistValue :: PersistBackend m => PersistValue -> m aSource

Constructs a value from a PersistValue. For complex datatypes it may query the database

dbType :: a -> DbTypeSource

Description of value type

data PersistEntity v => Key v Source

A unique identifier of a value stored in a database

Constructors

Key Int64 

Constructing expressions

The expressions are used in conditions and right part of Update statement. Despite the wordy types of the comparison functions, they are simple to use. Type of the compared polymorphic values like numbers or Nothing must be supplied manually. Example:

 StringField ==. "abc" &&. NumberField >. (0 :: Int) ||. MaybeField ==. (Nothing :: Maybe String) ||. MaybeField ==. Just "def"

data Cond v c Source

Represents condition for a query.

Constructors

And (Cond v c) (Cond v c) 
Or (Cond v c) (Cond v c) 
Not (Cond v c) 
forall a . (HasOrder a, PersistField a) => Lesser (Expr v c a) (Expr v c a) 
forall a . (HasOrder a, PersistField a) => Greater (Expr v c a) (Expr v c a) 
forall a . PersistField a => Equals (Expr v c a) (Expr v c a) 
forall a . PersistField a => NotEquals (Expr v c a) (Expr v c a) 
KeyIs (Key v)

Lookup will be performed only in table for the specified constructor c. To fetch value by key without constructor limitation use get

data Update v c Source

Constructors

forall a . Update (Fields v c a) (Expr v c a) 

(=.) :: (Expression a, TypesCastV v (FuncV a) v, TypesCastC c (FuncC a) c) => Fields v c (FuncA a) -> a -> Update v cSource

Update field

(&&.) :: (TypesCastV v1 v2 v3, TypesCastC c1 c2 c3) => Cond v1 c1 -> Cond v2 c2 -> Cond v3 c3Source

Boolean "and" operator.

(||.) :: (TypesCastV v1 v2 v3, TypesCastC c1 c2 c3) => Cond v1 c1 -> Cond v2 c2 -> Cond v3 c3Source

Boolean "or" operator.

(==.) :: (TypeCast a b v c, FuncA a ~ FuncA b, PersistField (FuncA a)) => a -> b -> Cond v cSource

(/=.) :: (TypeCast a b v c, FuncA a ~ FuncA b, PersistField (FuncA a)) => a -> b -> Cond v cSource

(<.) :: (TypeCast a b v c, FuncA a ~ FuncA b, PersistField (FuncA a), HasOrder (FuncA a)) => a -> b -> Cond v cSource

(<=.) :: (TypeCast a b v c, FuncA a ~ FuncA b, PersistField (FuncA a), HasOrder (FuncA a)) => a -> b -> Cond v cSource

(>.) :: (TypeCast a b v c, FuncA a ~ FuncA b, PersistField (FuncA a), HasOrder (FuncA a)) => a -> b -> Cond v cSource

(>=.) :: (TypeCast a b v c, FuncA a ~ FuncA b, PersistField (FuncA a), HasOrder (FuncA a)) => a -> b -> Cond v cSource

wrapPrim :: Primitive a => a -> Expr Any Any aSource

By default during converting values of certain types to Expr, the types can be changed. For example, Key a is transformed into a. It is convenient because the fields usually contain reference to a certain datatype, not its Key. But sometimes when automatic transformation gets in the way function wrapPrim will help. Use it when a field in a datatype has type (Key a) or Maybe (Key a). Example:

data Example = Example {entity1 :: Maybe Smth, entity2 :: Key Smth}
Entity1Field ==. Just k &&. Entity2Field ==. wrapPrim k

toArith :: Fields v c a -> Arith v c aSource

Convert field to an arithmetic value

class HasOrder a Source

The same goals as for Numeric. Certain types like String which have order in Haskell may not have it in DB

class Numeric a Source

Constraint for use in arithmetic expressions. Num is not used to explicitly include only types supported by the library . TODO: consider replacement with Num

class NeverNull a Source

Types which when converted to PersistValue are never NULL. Consider the type Maybe (Maybe a). Now Nothing is stored as NULL, so we cannot distinguish between Just Nothing and Nothing which is a problem. The purpose of this class is to ban the inner Maybe's. Maybe this class can be removed when support for inner Maybe's appears.

data Arith v c a Source

Arithmetic expressions which can include fields and literals

Constructors

Plus (Arith v c a) (Arith v c a) 
Minus (Arith v c a) (Arith v c a) 
Mult (Arith v c a) (Arith v c a) 
Abs (Arith v c a) 
ArithField (Fields v c a) 
Lit Int64 

Instances

Eq (Fields v c a) => Eq (Arith v c a) 
(Eq (Fields v c a), Show (Fields v c a), Numeric a) => Num (Arith v c a) 
Show (Fields v c a) => Show (Arith v c a) 
PersistEntity v => Expression (Arith v c a) 

data Expr v c a whereSource

Used to uniformly represent fields, literals and arithmetic expressions. A value should be convertec to Expr for usage in expressions

Constructors

ExprPrim :: Primitive a => a -> Expr v c a 
ExprField :: PersistEntity v => Fields v c a -> Expr v c a 
ExprArith :: PersistEntity v => Arith v c a -> Expr v c a 
ExprPlain :: Primitive a => a -> Expr v c (FuncA a) 

Instances

Expression (Expr v c a) 

data Order v c Source

Defines sort order of a result-set

Constructors

forall a . HasOrder a => Asc (Fields v c a) 
forall a . HasOrder a => Desc (Fields v c a) 

Type description

data DbType Source

A DB data type. Naming attempts to reflect the underlying Haskell datatypes, eg DbString instead of DbVarchar. Different databases may have different translations for these types.

Instances

data NamedType Source

It is used to store type DbType and persist name of a value

data EntityDef Source

Describes an ADT.

Constructors

EntityDef 

Fields

entityName :: String

Emtity name

typeParams :: [NamedType]

Named types of the instantiated polymorphic type parameters

constructors :: [ConstructorDef]

List of entity constructors definitions

data ConstructorDef Source

Describes an entity constructor

Constructors

ConstructorDef 

Fields

constrNum :: Int

Number of the constructor in the ADT

constrName :: String

Constructor name

constrParams :: [(String, NamedType)]

Parameter names with their named type

constrConstrs :: [Constraint]

Uniqueness constraints on the constructor fiels

class Constructor a whereSource

Phantom constructors are made instances of this class. This class should be used only by Template Haskell codegen

type Constraint = (String, [String])Source

Constraint name and list of the field names that form a unique combination. Only fields of Primitive types can be used in a constraint

Migration

type SingleMigration = Either [String] [(Bool, String)]Source

Either error messages or migration queries with safety flags

type NamedMigrations = Map String SingleMigrationSource

Datatype names and corresponding migrations

Database

class Monad m => PersistBackend m whereSource

Methods

insert :: PersistEntity v => v -> m (Key v)Source

Insert a new record to a database and return its Key

insertBy :: PersistEntity v => v -> m (Either (Key v) (Key v))Source

Try to insert a record and return Right newkey. If there is a constraint violation, Left oldkey is returned , where oldkey is an identifier of the record with the same constraint values. Note that if several constraints are violated, a key of an arbitrary matching record is returned.

replace :: PersistEntity v => Key v -> v -> m ()Source

Replace a record with the given key. Result is undefined if the record does not exist.

selectEnumSource

Arguments

:: (PersistEntity v, Constructor c) 
=> Cond v c 
-> [Order v c] 
-> Int

limit

-> Int

offset

-> Enumerator (Key v, v) m a 

Return a list of all records

selectAllEnum :: PersistEntity v => Enumerator (Key v, v) m aSource

Get all records. Order is undefined

selectSource

Arguments

:: (PersistEntity v, Constructor c) 
=> Cond v c 
-> [Order v c] 
-> Int

limit

-> Int

offset

-> m [(Key v, v)] 

Return a list of the records satisfying the condition

selectAll :: PersistEntity v => m [(Key v, v)]Source

Return a list of all records. Order is undefined

get :: PersistEntity v => Key v -> m (Maybe v)Source

Fetch an entity from a database

update :: (PersistEntity v, Constructor c) => [Update v c] -> Cond v c -> m ()Source

Update the records satisfying the condition

delete :: (PersistEntity v, Constructor c) => Cond v c -> m ()Source

Remove the records satisfying the condition

deleteByKey :: PersistEntity v => Key v -> m ()Source

Remove the record with given key. No-op if the record does not exist

count :: (PersistEntity v, Constructor c) => Cond v c -> m IntSource

Count total number of records satisfying the condition

countAll :: PersistEntity v => v -> m IntSource

Count total number of records with all constructors

migrate :: PersistEntity v => v -> Migration mSource

Check database schema and create migrations for the entity and the entities it contains

executeRawSource

Arguments

:: Bool

keep in cache

-> String

query

-> [PersistValue]

positional parameters

-> m () 

Execute raw query

queryRawSource

Arguments

:: Bool

keep in cache

-> String

query

-> [PersistValue]

positional parameters

-> (RowPopper m -> m a)

results processing function

-> m a 

Execute raw query with results

insertTuple :: NamedType -> [PersistValue] -> m Int64Source

getTuple :: NamedType -> Int64 -> m [PersistValue]Source

insertList :: PersistField a => [a] -> m Int64Source

getList :: PersistField a => Int64 -> m [a]Source

newtype Monad m => DbPersist conn m a Source

Constructors

DbPersist 

Fields

unDbPersist :: ReaderT conn m a
 

Instances

runDbPersist :: Monad m => DbPersist conn m a -> conn -> m aSource