beam-th-0.2.0.0: Template Haskell utilities for beam

Safe HaskellNone
LanguageHaskell2010

Database.Beam.TH.Internal

Contents

Description

Various internal utilities for beam-th. The usual caveats apply.

Synopsis

The MakeTableT monad transformer

Definition

newtype MakeTableT m a Source #

A monad transformer for writing Template Haskell declarations.

The Reader contains both the base name of the table and the VarBangType of the primary key field.

If you can come up with a better name, drop me a line.

Constructors

MakeTableT 

Fields

Instances

MonadTrans MakeTableT Source # 

Methods

lift :: Monad m => m a -> MakeTableT m a #

Monad m => Monad (MakeTableT m) Source # 

Methods

(>>=) :: MakeTableT m a -> (a -> MakeTableT m b) -> MakeTableT m b #

(>>) :: MakeTableT m a -> MakeTableT m b -> MakeTableT m b #

return :: a -> MakeTableT m a #

fail :: String -> MakeTableT m a #

Functor m => Functor (MakeTableT m) Source # 

Methods

fmap :: (a -> b) -> MakeTableT m a -> MakeTableT m b #

(<$) :: a -> MakeTableT m b -> MakeTableT m a #

MonadFail m => MonadFail (MakeTableT m) Source # 

Methods

fail :: String -> MakeTableT m a #

Applicative m => Applicative (MakeTableT m) Source # 

Methods

pure :: a -> MakeTableT m a #

(<*>) :: MakeTableT m (a -> b) -> MakeTableT m a -> MakeTableT m b #

(*>) :: MakeTableT m a -> MakeTableT m b -> MakeTableT m b #

(<*) :: MakeTableT m a -> MakeTableT m b -> MakeTableT m a #

Monad m => MonadWriter [Dec] (MakeTableT m) Source # 

Methods

writer :: (a, [Dec]) -> MakeTableT m a #

tell :: [Dec] -> MakeTableT m () #

listen :: MakeTableT m a -> MakeTableT m (a, [Dec]) #

pass :: MakeTableT m (a, [Dec] -> [Dec]) -> MakeTableT m a #

Monad m => MonadReader (Name, VarBangType) (MakeTableT m) Source # 

Methods

ask :: MakeTableT m (Name, VarBangType) #

local :: ((Name, VarBangType) -> (Name, VarBangType)) -> MakeTableT m a -> MakeTableT m a #

reader :: ((Name, VarBangType) -> a) -> MakeTableT m a #

Derived type synonyms

type MakeTable a = MakeTableT Identity a Source #

Type synonym for MakeTableT in the Identity monad.

Only defined for complying with the monad transformer conventions and not actually used.

type MakeTableT' a = MakeTableT Q a Source #

Type synonym for MakeTableT in the Q monad.

type MakeTableT'' = MakeTableT' () Source #

Type synonym for MakeTableT in the Q monad with the empty tuple as the inner type. This is the most common use case.

Helper functions

runTableT Source #

Arguments

:: Name

The base name of the table, without the trailing "T".

-> VarBangType

The primary key field.

-> MakeTableT' a

The table writing sequence to be executed. The inner type is ignored.

-> DecsQ 

Run the table writing sequence (or, the MakeTableT if you prefer).

tellD :: MonadWriter [Dec] m => Dec -> m () Source #

Write a single Dec

Extracting values from a MakeTableT

vst :: MonadReader (Name, VarBangType) m => m VarBangType Source #

Extract the PrimaryKey VarBangType

Simple and composite names

name :: MonadReader (Name, VarBangType) m => m Name Source #

Get the base name

nameId :: MonadReader (Name, VarBangType) m => m Name Source #

Get the name with an "Id" suffix

nameId' :: MonadReader (Name, VarBangType) m => m Name Source #

Get the name with an "Id'" suffix

nameT :: MonadReader (Name, VarBangType) m => m Name Source #

Get the name with a "T" suffix

Name utilities

rename :: (String -> String) -> Name -> Name Source #

Rename a Name using a function on Strings

Type and Expression Application Sugar

(<~>) :: Type -> Type -> Type infixl 6 Source #

Convenient syntactic sugar for application of types.

>>> ConT nm <~> ConT nm <~> ConT nm
AppT (AppT (ConT nm) (ConT nm)) (ConT nm)

(<+>) :: Exp -> Exp -> Exp infixl 6 Source #

Convenient syntactic sugar for application of expressions.

>>> ConE nm <+> ConE nm <+> ConE nm
AppE (AppE (ConE nm) (ConE nm)) (ConE nm)

(~>) :: Type -> Type -> Type infixl 6 Source #

Convenient syntactic sugar for arrows in types.

>>> StarT ~> StarT
AppT (AppT ArrowT StarT) StarT

Error handling

Constructor types

invalidConstructor :: MonadFail m => m a Source #

Complain about an unknown field in the table.

Table names

assert :: Bool -> String -> Q () Source #

Assert a condition related to the table base name and suggest following the naming convention.

assertMany :: [(Bool, String)] -> Q () Source #

Assert a list of conditions and associated error messages.