generic-persistence-0.2.0.0: Database persistence using generics
Safe HaskellSafe-Inferred
LanguageGHC2021

Database.GP

Synopsis

Documentation

retrieveById :: forall a id. (Entity a, Convertible id SqlValue) => id -> GP (Maybe a) Source #

A function that retrieves an entity from a database. The function takes entity id as parameter. If an entity with the given id exists in the database, it is returned as a Just value. If no such entity exists, Nothing is returned. An error is thrown if there are more than one entity with the given id.

retrieveAll :: forall a. Entity a => GP [a] Source #

This function retrieves all entities of type a from a database. The function takes an HDBC connection as parameter. The type a is determined by the context of the function call.

retrieveAllWhere :: forall a. Entity a => String -> SqlValue -> GP [a] Source #

persist :: Entity a => a -> GP () Source #

A function that persists an entity to a database. The function takes an HDBC connection and an entity as parameters. The entity is either inserted or updated, depending on whether it already exists in the database. The required SQL statements are generated dynamically using Haskell generics and reflection

insert :: Entity a => a -> GP () Source #

A function that explicitely inserts an entity into a database.

update :: Entity a => a -> GP () Source #

A function that explicitely updates an entity in a database.

delete :: Entity a => a -> GP () Source #

setupTableFor :: forall a. Entity a => GP a Source #

set up a table for a given entity type. The table is dropped and recreated.

idValue :: forall a. Entity a => a -> SqlValue Source #

A function that returns the primary key value of an entity as a SqlValue.

class Data a => Entity a where Source #

Minimal complete definition

Nothing

Methods

fromRow :: [SqlValue] -> GP a Source #

Converts a database row to a value of type a.

default fromRow :: [SqlValue] -> GP a Source #

toRow :: a -> GP [SqlValue] Source #

Converts a value of type a to a database row.

default toRow :: a -> GP [SqlValue] Source #

idField :: a -> String Source #

Returns the name of the primary key field for a type a.

default idField :: a -> String Source #

fieldsToColumns :: a -> [(String, String)] Source #

Returns a list of tuples that map field names to column names for a type a.

default fieldsToColumns :: a -> [(String, String)] Source #

tableName :: a -> String Source #

Returns the name of the table for a type a.

default tableName :: a -> String Source #

columnNameFor :: Entity a => a -> String -> String Source #

A convenience function: returns the name of the column for a field of a type a.

fieldTypeFor :: Entity a => a -> String -> TypeRep Source #

A convenience function: returns the TypeRep of a field of a type a.

toString :: Entity a => a -> String Source #

Returns a string representation of a value of type a.

evidence :: forall a. Entity a => a Source #

A convenience function: returns an evidence instance of type a. This is useful for type inference where no instance is available.

evidenceFrom :: forall a. Entity a => TypeInfo a -> a Source #

type ResolutionCache = [(EntityId, Dynamic)] Source #

The resolution cache maps an EntityId to a Dynamic value (representing an Entity). It is used to resolve circular references during loading and storing of Entities.

type EntityId = (TypeRep, SqlValue) Source #

The EntityId is a tuple of the TypeRep and the primary key value of an Entity. It is used as a key in the resolution cache.

entityId :: Entity a => a -> EntityId Source #

Computes the EntityId of an entity. The EntityId of an entity is a (typeRep, idValue) tuple.

getElseRetrieve :: forall a. Entity a => EntityId -> GP (Maybe a) Source #

Lookup an entity in the cache, or retrieve it from the database. The Entity is identified by its EntityId, which is a (typeRep, idValue) tuple.

data TypeInfo a Source #

A data type holding meta-data about a type. The Phantom type parameter a ensures type safety for reflective functions that use this type to create type instances (See module RecordtypeReflection).

Instances

Instances details
Show (TypeInfo a) Source # 
Instance details

Defined in Database.GP.TypeInfo

Methods

showsPrec :: Int -> TypeInfo a -> ShowS #

show :: TypeInfo a -> String #

showList :: [TypeInfo a] -> ShowS #

typeInfoFromContext :: forall a. Data a => TypeInfo a Source #

This function creates a TypeInfo object from the context of a function call. The Phantom Type parameter a is used to convince the compiler that the `TypeInfo a` object really describes type a. See also https://stackoverflow.com/questions/75171829/how-to-obtain-a-data-data-constr-etc-from-a-type-representation

typeInfo :: Data a => a -> TypeInfo a Source #

this function is a smart constructor for TypeInfo objects. It takes a value of type a and returns a `TypeInfo a` object. If the type has no named fields, an error is thrown. If the type has more than one constructor, an error is thrown.

data Ctx Source #

type Ctx defines the context in which the persistence operations are executed. It contains a connection to the database and a resolution cache for circular lookups.

Constructors

Ctx 

Fields

type GP = RIO Ctx Source #

runGP :: (MonadIO m, IConnection conn) => conn -> RIO Ctx a -> m a Source #

liftIO :: MonadIO m => IO a -> m a #

Lift a computation from the IO monad. This allows us to run IO computations in any monadic stack, so long as it supports these kinds of operations (i.e. IO is the base monad for the stack).

Example

Expand
import Control.Monad.Trans.State -- from the "transformers" library

printState :: Show s => StateT s IO ()
printState = do
  state <- get
  liftIO $ print state

Had we omitted liftIO, we would have ended up with this error:

• Couldn't match type ‘IO’ with ‘StateT s IO’
 Expected type: StateT s IO ()
   Actual type: IO ()

The important part here is the mismatch between StateT s IO () and IO ().

Luckily, we know of a function that takes an IO a and returns an (m a): liftIO, enabling us to run the program and see the expected results:

> evalStateT printState "hello"
"hello"

> evalStateT printState 3
3

local #

Arguments

:: MonadReader r m 
=> (r -> r)

The function to modify the environment.

-> m a

Reader to run in the modified environment.

-> m a 

Executes a computation in a modified environment.

ask :: MonadReader r m => m r #

Retrieves the monad environment.