groundhog-0.3.0.1: Type-safe datatype-database mapping library.

Safe HaskellNone

Database.Groundhog

Contents

Description

This module exports the most commonly used functions and datatypes.

The example below shows the most of the main features. See more examples in the examples directory.

{-# LANGUAGE GADTs, TypeFamilies, TemplateHaskell, QuasiQuotes, FlexibleInstances #-}
import Control.Monad.IO.Class (liftIO)
import Database.Groundhog.TH
import Database.Groundhog.Sqlite

data Customer a = Customer {customerName :: String, remark :: a} deriving Show
data Product = Product {productName :: String, quantity :: Int, customer :: Customer String} deriving Show

mkPersist (defaultCodegenConfig {migrationFunction = Just "migrateAll"}) [groundhog|
 - entity: Customer
   constructors:
     - name: Customer
       uniques:
         - name: NameConstraint
           fields: [customerName]
 - entity: Product
 |]

main = withSqliteConn ":memory:" $ runDbConn $ do
  -- Customer is also migrated because Product references it.
  -- It is possible to migrate schema for given type, e.g. migrate (undefined :: Customer String), or run migrateAll
  runMigration defaultMigrationLogger migrateAll
  let john = Customer "John Doe" "Phone: 01234567"
  johnKey <- insert john
  -- John is inserted only once because of the name constraint
  insert $ Product "Apples" 5 john
  insert $ Product "Melon" 2 john
  -- Groundhog prevents SQL injections. Quotes and other special symbols are safe.
  insert $ Product "Melon" 6 (Customer "Jack Smith" "Don't let him pay by check")
  -- Bonus melon for all large melon orders. The values used in expressions should have known type, so literal 5 is annotated.
  update [QuantityField =. toArith QuantityField + 1] (ProductNameField ==. "Melon" &&. QuantityField >. (5 :: Int))
  productsForJohn <- select $ CustomerField ==. johnKey
  liftIO $ putStrLn $ "Products for John: " ++ show productsForJohn
  -- Check bonus
  melon <- select $ (ProductNameField ==. "Melon") `orderBy` [Desc QuantityField]
  liftIO $ putStrLn $ "Melon orders: " ++ show melon

Synopsis

Main definitions

class (Monad m, DbDescriptor (PhantomDb m)) => PersistBackend m whereSource

Associated Types

type PhantomDb m Source

A token which defines the DB type. For example, different monads working with Sqlite, return may Sqlite type.

Methods

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

Insert a new record to a database and return its autogenerated key or ()

insert_ :: PersistEntity v => v -> m ()Source

Insert a new record to a database. For some backends it may be faster than insert.

insertBy :: (PersistEntity v, IsUniqueKey (Key v (Unique u))) => u (UniqueMarker v) -> v -> m (Either (AutoKey v) (AutoKey v))Source

Try to insert a record and return Right newkey. If there is a constraint violation for the given constraint, Left oldkey is returned , where oldkey is an identifier of the record with the matching values.

insertByAll :: PersistEntity v => v -> m (Either (AutoKey v) (AutoKey v))Source

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

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

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

select :: (PersistEntity v, Constructor c, HasSelectOptions opts (PhantomDb m) (RestrictionHolder v c)) => opts -> m [v]Source

Return a list of the records satisfying the condition. Example: select $ (FirstField ==. "abc" &&. SecondField >. "def") `orderBy` [Asc ThirdField] `limitBy` 100

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

Return a list of all records. Order is undefined. It is useful for datatypes with multiple constructors.

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

Fetch an entity from a database

getBy :: (PersistEntity v, IsUniqueKey (Key v (Unique u))) => Key v (Unique u) -> m (Maybe v)Source

Fetch an entity from a database by its unique key

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

Update the records satisfying the condition. Example: update [FirstField =. "abc"] $ FirstField ==. "def"

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

Remove the records satisfying the condition

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

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

count :: (PersistEntity v, Constructor c) => Cond (PhantomDb m) (RestrictionHolder 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

project :: (PersistEntity v, Constructor c, Projection p (PhantomDb m) (RestrictionHolder v c) a', HasSelectOptions opts (PhantomDb m) (RestrictionHolder v c)) => p -> opts -> m [a']Source

Fetch projection of some fields. Example: project (SecondField, ThirdField) $ (FirstField ==. "abc" &&. SecondField >. "def") `orderBy` [Asc ThirdField] `offsetBy` 100

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

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

data Unique u Source

A holder for Unique constraints

Instances

(PersistEntity v, IsUniqueKey (Key v (Unique u)), ~ * r (RestrictionHolder v (UniqueConstr (Key v (Unique u))))) => Projection (u (UniqueMarker v)) db r (Key v (Unique u)) 

data BackendSpecific Source

Key marked with this type can have value for any backend

extractUnique :: (IsUniqueKey uKey, uKey ~ Key v u) => v -> uKeySource

Creates value of unique key using the data extracted from the passed value

data Cond db r Source

Represents condition for a query.

Constructors

And (Cond db r) (Cond db r) 
Or (Cond db r) (Cond db r) 
Not (Cond db r) 
Compare ExprRelation (UntypedExpr db r) (UntypedExpr db r) 
CondRaw (QueryRaw db r) 

Instances

HasSelectOptions (Cond db r) db r 

data Order db r Source

Defines sort order of a result-set

Constructors

forall a f . FieldLike f db r a => Asc f 
forall a f . FieldLike f db r a => Desc f 

data AutoKeyField v c whereSource

It can be used in expressions like a regular field. Note that the constructor should be specified for the condition. For example, delete (AutoKeyField asTypeOf (undefined :: f v SomeConstructor) ==. k) or delete (AutoKeyField ==. k ||. SomeField ==. "DUPLICATE")

Constructors

AutoKeyField :: (PersistEntity v, Constructor c) => AutoKeyField v c 

(~>) :: (PersistEntity v, Constructor c, FieldLike f db (RestrictionHolder v c) a, Embedded a) => f -> Selector a a' -> SubField v c a'Source

Accesses fields of the embedded datatypes. For example, SomeField ==. ("abc", "def") ||. SomeField ~> Tuple2_0Selector ==. "def"

orderBy :: (HasSelectOptions a db r, HasOrder a ~ HFalse) => a -> [Order db r] -> SelectOptions db r (HasLimit a) (HasOffset a) HTrueSource

Expressions

(=.) :: (FieldLike f db r a', Expression db r b, Unifiable f b) => f -> b -> Update db rSource

Update field

(&&.) :: Cond db r -> Cond db r -> Cond db rSource

Boolean "and" operator.

(||.) :: Cond db r -> Cond db r -> Cond db rSource

Boolean "or" operator.

(==.) :: (Expression db r a, Expression db r b, Unifiable a b) => a -> b -> Cond db rSource

(/=.) :: (Expression db r a, Expression db r b, Unifiable a b) => a -> b -> Cond db rSource

(<.) :: (Expression db r a, Expression db r b, Unifiable a b) => a -> b -> Cond db rSource

(<=.) :: (Expression db r a, Expression db r b, Unifiable a b) => a -> b -> Cond db rSource

(>.) :: (Expression db r a, Expression db r b, Unifiable a b) => a -> b -> Cond db rSource

(>=.) :: (Expression db r a, Expression db r b, Unifiable a b) => a -> b -> Cond db rSource

Migration

createMigration :: PersistBackend m => Migration m -> m NamedMigrationsSource

Produce the migrations but not execute them. Fails when an unsafe migration occurs.

executeMigration :: (PersistBackend m, MonadIO m) => (String -> IO ()) -> NamedMigrations -> m ()Source

Execute the migrations and log them.

executeMigrationUnsafe :: (PersistBackend m, MonadIO m) => (String -> IO ()) -> NamedMigrations -> m ()Source

Execute migrations and log them. Executes the unsafe migrations without warnings

runMigration :: (PersistBackend m, MonadIO m) => (String -> IO ()) -> Migration m -> m ()Source

Run migrations and log them. Fails when an unsafe migration occurs.

runMigrationUnsafe :: (PersistBackend m, MonadIO m) => (String -> IO ()) -> Migration m -> m ()Source

Run migrations and log them. Executes the unsafe migrations without warnings

printMigration :: MonadIO m => NamedMigrations -> m ()Source

Pretty print the migrations

defaultMigrationLogger :: String -> IO ()Source

Prints the queries to stdout