postgresql-orm-0.3.2: An ORM (Object Relational Mapping) and migrations DSL for PostgreSQL.

Safe HaskellSafe
LanguageHaskell2010

Data.GetField

Contents

Description

Functions to extract a field of a particular type from a Generic data structure, when the data structure contains exactly one field of the given type. Only works for types with exactly one constructor (not variant types).

An example of usage:

data MyType = MyType { myString :: String             -- position 0
                     , myInt :: Int                   -- position 1
                     , myBool :: Bool                 -- position 2
                     , myMaybeChar :: Maybe Char      -- position 3
                     , myMaybeString :: Maybe String  -- position 4
                     } deriving (Show, Generic)

myType :: MyType
myType = MyType "my type" 21 True Nothing (Just "maybe string")
>>> getFieldVal ExtractId myType :: String
"my type"
>>> getFieldVal ExtractId myType :: Int
21
>>> getFieldVal ExtractMaybe myType :: Maybe Char
Nothing
>>> getFieldVal ExtractMaybe myType :: Maybe Int
Just 21
>>> getFieldVal ExtractMaybe myType :: Maybe String  -- ambiguous
<interactive>:5:1: Couldn't match type `THasMany' with `THasOne'
>>> getFieldPos' ExtractId (undefined :: MyType) (undefined :: Bool)
2
>>> getFieldPos' ExtractMaybe (undefined :: MyType) (undefined :: Maybe Bool)
2
>>> getFieldPos' ExtractMaybe myType ()  -- No field has type ()
<interactive>:8:1: Couldn't match type `THasNone' with `THasOne'

Synopsis

Documentation

class (Generic a, GGetField f (Rep a) r THasOne) => GetField f a r where Source

Methods

getFieldVal :: f r -> a -> r Source

Extract the single field matching Extractor f r from a Generic data structure a with exactly one constructor.

getFieldPos :: f r -> a -> Int Source

Extract the 0-based position of the single field matching Extractor f r within Generic data structure a. Non-strict in both arguments.

Instances

(Generic a, GGetField f (Rep a) r THasOne) => GetField f a r 

data ExtractId r Source

An extractor that matches an exact field type.

Constructors

ExtractId 

data ExtractMaybe r Source

An extractor that matches either type r or type Maybe r, and, in the former case, wraps Just around the value so as always to return type Maybe r.

Constructors

ExtractMaybe 

getFieldPos' :: (Generic a, GGetField f (Rep a) r THasOne) => f () -> a -> r -> Int Source

A variant of getFieldPos in which the type of the field is supplied as a non-strict argument. This may be easier than typecasting the extractor argument. For example, to extract the Int from a structure with a single Int field:

      getFieldPos' ExtractId myStruct (undefined :: Int)

Internals

newtype THasOne a Source

Exactly one matching field has been found.

Constructors

THasOne 

Fields

fromTHasOne :: a
 

data THasNone a Source

Zero matching fields have been found.

Constructors

THasNone 

Instances

newtype THasMany a Source

More than one matching field has been found.

Constructors

THasMany 

Fields

fromTHasMany :: [a]
 

Instances

Show a => Show (THasMany a) 

class Extractor f a r g | f a r -> g where Source

Class of types used as tag arguments to gGetFieldVal and gGetFieldPos. f should be a new unit type of kind * -> *, used to designate the type of extraction you want. Then instances should be defined to transform each type a you want to extract to some type r, with g set to THasOne.

For example, ExtractMaybe is a type to convert types a and Maybe a both to type Maybe a (i.e., type argument r is Maybe a).

data ExtractMaybe a = ExtractMaybe
instance Extractor ExtractMaybe a (Maybe a) THasOne where
  extract _ = THasOne . Just
instance Extractor ExtractMaybe (Maybe a) (Maybe a) THasOne where
  extract _ = THasOne

Note that there is already a default general instance returning THasNone. Hence, you do not need to define one. Otherwise, you would have to define an overlapping instance such as:

instance Extractor ExtractMaybe a b THasZero where  -- Incorrect
  extract _ = THasNone

(Except the above wouldn't quite work anyway given the rules for overlapping instances.) So just assume that any instance you don't explicitly define for your Extractor will automatically fall back to THasNone.

Minimal complete definition

extract

Methods

extract :: f r -> a -> g r Source

extractCount :: f r -> a -> (Int, [Int]) Source

class GGetField f rep r g | f rep r -> g where Source

Generlized extraction of a field from a Generic data structure. Argument rep should generally be the type Rep t for some data type t whose fields you want to extract. r is the result type you want back from the extraction. f should be defined such that there is an instance of Extractor f a r THasOne for each type a you want to convert to r and extract.

Methods

gGetFieldVal :: f r -> rep p -> g r Source

Returns zero, one, or multiple values of type f wrapped in THasOne, THasNone, or THasMany respectively.

gGetFieldPos :: f r -> rep p -> (Int, [Int]) Source

Returns (total, positions) where total is the total number of fields (matching or not) in the structure and positions is a list of zero-based field numbers of the fields matching target type f r.

Instances

(GGetField f a1 r g1, GGetField f a2 r g2, GCombine g1 g2 g) => GGetField f ((:*:) a1 a2) r g 
Extractor f c r g => GGetField f (K1 i c) r g 
GGetField f a r g => GGetField f (M1 i c a) r g