overloaded-records-0.4.2.0: Overloaded Records based on current GHC proposal.

Copyright(c) 2016, Peter Trško
LicenseBSD3
Maintainerpeter.trsko@gmail.com
Stabilityexperimental
PortabilityCPP, DataKinds, DeriveDataTypeable, DeriveGeneric, FlexibleContexts (GHC <8), FlexibleInstances, LambdaCase, MagicHash (GHC <8), MultiParamTypeClasses, NoImplicitPrelude, RecordWildCards, TemplateHaskell, TupleSections, TypeFamilies, TypeSynonymInstances
Safe HaskellNone
LanguageHaskell2010

Data.OverloadedRecords.TH.Internal

Contents

Description

Derive magic instances for OverloadedRecordFields.

Synopsis

Derive OverloadedRecordFields instances

overloadedRecord Source #

Arguments

:: DeriveOverloadedRecordsParams

Parameters for customization of deriving process. Use def to get default behaviour.

-> Name

Name of the type for which magic instances should be derived.

-> DecsQ 

Derive magic OverloadedRecordFields instances for specified type. Fails if different record fields within the same type would map to the same overloaded label.

overloadedRecords Source #

Arguments

:: DeriveOverloadedRecordsParams

Parameters for customization of deriving process. Use def to get default behaviour.

-> [Name]

Names of the types for which magic instances should be derived.

-> DecsQ 

Derive magic OverloadedRecordFields instances for specified types.

overloadedRecordFor Source #

Arguments

:: Name

Name of the type for which magic instances should be derived.

-> (DeriveOverloadedRecordsParams -> DeriveOverloadedRecordsParams)

Function that modifies parameters for customization of deriving process.

-> DecsQ 

Derive magic OverloadedRecordFields instances for specified type.

Similar to overloadedRecords, but instead of DeriveOverloadedRecordsParams value it takes function which can modify its default value.

data Coordinates2D a
    { coordinateX :: a
    , coordinateY :: a
    }

overloadedRecordsFor ''Coordinates2D
    $ #fieldDerivation .~ \_ _ _ -> \case
        Nothing -> Nothing
        Just field -> lookup field
           [ ("coordinateX", GetterOnlyField "x" Nothing)
           , ("coordinateY", GetterOnlyField "y" Nothing)
           ]

overloadedRecordsFor Source #

Arguments

:: [Name]

Names of the types for which magic instances should be derived.

-> (DeriveOverloadedRecordsParams -> DeriveOverloadedRecordsParams)

Function that modifies parameters for customization of deriving process.

-> DecsQ 

Derive magic OverloadedRecordFields instances for specified types.

Customize Derivation Process

data DeriveOverloadedRecordsParams Source #

Parameters for customization of deriving process. Use def to get default behaviour.

Constructors

DeriveOverloadedRecordsParams 

Fields

Instances

Generic DeriveOverloadedRecordsParams Source # 
Default DeriveOverloadedRecordsParams Source #
def = DeriveOverloadedRecordsParams
    { strictFields = False
    , fieldDerivation = defaultFieldDerivation
    }
HasField "fieldDerivation" DeriveOverloadedRecordsParams FieldDerivation Source # 
ModifyField "fieldDerivation" DeriveOverloadedRecordsParams DeriveOverloadedRecordsParams FieldDerivation FieldDerivation Source # 
type Rep DeriveOverloadedRecordsParams Source # 
type Rep DeriveOverloadedRecordsParams = D1 (MetaData "DeriveOverloadedRecordsParams" "Data.OverloadedRecords.TH.Internal" "overloaded-records-0.4.2.0-KMonJjWpg7Q2vzJ7zuavEs" False) (C1 (MetaCons "DeriveOverloadedRecordsParams" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "_strictFields") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool)) (S1 (MetaSel (Just Symbol "_fieldDerivation") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 FieldDerivation))))
type FieldType "fieldDerivation" DeriveOverloadedRecordsParams Source # 
type UpdateType "fieldDerivation" DeriveOverloadedRecordsParams FieldDerivation Source # 

type FieldDerivation Source #

Arguments

 = String

Name of the type, of which this field is part of.

-> String

Name of the constructor, of which this field is part of.

-> Word

Field position as an argument of the constructor it is part of. Indexing starts from zero.

-> Maybe String

Name of the field (record) accessor; Nothing means that there is no record accessor defined for it.

-> Maybe OverloadedField

Describes how overloaded record field should be generated for this specific constructor field. Nothing means that no overloaded record field should be derived. See also OverloadedField for details.

Type signature of a function that can customize the derivation of each individual overloaded record field.

If field has an selector then the function will get its name or Nothing otherwise. Function has to return Nothing in case when generating overloaded record field instances is not desired.

data OverloadedField Source #

Describes what should be the name of overloaded record field, and can also provide custom implementation of getter and setter.

Constructors

GetterOnlyField String (Maybe ExpQ)

Derive only getter instances. If second argument is Just, then it contains custom definition of getter function.

GetterAndSetterField String (Maybe (ExpQ, ExpQ))

Derive only getter instances. If second argument is Just, then it contains custom definitions of getter and setter functions, respectively.

Instances

Generic OverloadedField Source # 
HasField "fieldDerivation" DeriveOverloadedRecordsParams FieldDerivation Source # 
ModifyField "fieldDerivation" DeriveOverloadedRecordsParams DeriveOverloadedRecordsParams FieldDerivation FieldDerivation Source # 
type Rep OverloadedField Source # 
type UpdateType "fieldDerivation" DeriveOverloadedRecordsParams FieldDerivation Source # 

defaultMakeFieldName Source #

Arguments

:: String

Name of the type, of which this field is part of.

-> String

Name of the constructor, of which this field is part of.

-> Word

Field position as an argument of the constructor it is part of. Indexing starts from zero.

-> Maybe String

Name of the field (record) accessor; Nothing means that there is no record accessor defined for it.

-> Maybe String

Overloaded record field name to be used for this specific constructor field; Nothing means that there shouldn't be a label associated with it.

Suppose we have a weird type definition as this:

data SomeType a b c = SomeConstructor
    { _fieldX :: a
    , someTypeFieldY :: b
    , someConstructorFieldZ :: c
    , anythingElse :: (a, b, c)
    }

Then for each of those fields, defaultMakeFieldName will produce expected OverloadedLabel name:

  • _fieldX --> fieldX
  • someTypeFieldY --> fieldY
  • someConstructorFieldZ --> fieldZ
  • anythingElse is ignored

Low-level Deriving Mechanism

field Source #

Arguments

:: String

Overloaded label name.

-> TypeQ

Record type.

-> TypeQ

Field type.

-> TypeQ

Record type after update.

-> TypeQ

Setter will set field to a value of this type.

-> ExpQ

Getter function.

-> ExpQ

Setter function.

-> DecsQ 

Derive instances for overloaded record field, both getter and setter.

simpleField Source #

Arguments

:: String

Overloaded label name.

-> TypeQ

Record type.

-> TypeQ

Field type.

-> ExpQ

Getter function.

-> ExpQ

Setter function.

-> DecsQ 

Derive instances for overloaded record field, both getter and setter. Same as field, but record type is the same before and after update and so is the field type.

fieldGetter Source #

Arguments

:: String

Overloaded label name.

-> TypeQ

Record type.

-> TypeQ

Field type

-> ExpQ

Getter function.

-> DecsQ 

Derive instances for overloaded record field getter.

fieldSetter Source #

Arguments

:: String

Overloaded label name.

-> TypeQ

Record type.

-> TypeQ

Field type.

-> TypeQ

Record type after update.

-> TypeQ

Setter will set field to a value of this type.

-> ExpQ

Setter function.

-> DecsQ 

Derive instances for overloaded record field setter.

simpleFieldSetter Source #

Arguments

:: String

Overloaded label name.

-> TypeQ

Record type.

-> TypeQ

Field type.

-> ExpQ

Setter function.

-> DecsQ 

Derive instances for overloaded record field setter. Same as fieldSetter, but record type is the same before and after update and so is the field type.

Internal Definitions

data DeriveFieldParams Source #

Parameters for deriveForField function.

Constructors

DeriveFieldParams 

Fields

deriveForConstructor Source #

Arguments

:: DeriveOverloadedRecordsParams

Parameters for customization of deriving process. Use def to get default behaviour.

-> [(String, String)]

Pairs of instances already generated along with the field names they were made from.

-> Name 
-> [TyVarBndr] 
-> Con 
-> (DecsQ, [(String, String)]) 

Derive magic instances for all fields of a specific data constructor of a specific type.

deriveForField Source #

Arguments

:: DeriveOverloadedRecordsParams

Parameters for customization of deriving process. Use def to get default behaviour.

-> [(String, String)]

Pairs of instances already generated along with the field names they were made from.

-> DeriveFieldParams

All the necessary information for derivation procedure.

-> (DecsQ, Maybe (String, String)) 

Derive magic instances for a specific field of a specific type.

Helper Functions

newNames :: Word -> String -> Q [Name] Source #

Construct list of new names usin newName.

varEs :: [Name] -> [ExpQ] Source #

varPs :: [Name] -> [PatQ] Source #

wildPs :: Word -> [Pat] Source #

Construct list of wildcard patterns (WildP).