Safe Haskell | None |
---|---|
Language | Haskell2010 |
Generate generics-sop
boilerplate instances using Template Haskell.
Synopsis
- deriveGeneric :: Name -> Q [Dec]
- deriveGenericOnly :: Name -> Q [Dec]
- deriveGenericSubst :: Name -> (Name -> Q Type) -> Q [Dec]
- deriveGenericOnlySubst :: Name -> (Name -> Q Type) -> Q [Dec]
- deriveGenericFunctions :: Name -> String -> String -> String -> Q [Dec]
- deriveMetadataValue :: Name -> String -> String -> Q [Dec]
- deriveMetadataType :: Name -> String -> Q [Dec]
Documentation
deriveGeneric :: Name -> Q [Dec] Source #
Generate generics-sop
boilerplate for the given datatype.
This function takes the name of a datatype and generates:
- a
Code
instance - a
Generic
instance - a
HasDatatypeInfo
instance
Note that the generated code will require the TypeFamilies
and
DataKinds
extensions to be enabled for the module.
Example: If you have the datatype
data Tree = Leaf Int | Node Tree Tree
and say
deriveGeneric ''Tree
then you get code that is equivalent to:
instance Generic Tree where type Code Tree = '[ '[Int], '[Tree, Tree] ] from (Leaf x) = SOP ( Z (I x :* Nil)) from (Node l r) = SOP (S (Z (I l :* I r :* Nil))) to (SOP (Z (I x :* Nil))) = Leaf x to (SOP (S (Z (I l :* I r :* Nil)))) = Node l r to (SOP (S (S x))) = x `seq` error "inaccessible" instance HasDatatypeInfo Tree where type DatatypeInfoOf Tree = T.ADT "Main" "Tree" '[ T.Constructor "Leaf", T.Constructor "Node" ] datatypeInfo _ = T.demoteDatatypeInfo (Proxy :: Proxy (DatatypeInfoOf Tree))
Limitations: Generation does not work for GADTs, for datatypes that involve existential quantification, for datatypes with unboxed fields.
deriveGenericOnly :: Name -> Q [Dec] Source #
Like deriveGeneric
, but omit the HasDatatypeInfo
instance.
deriveGenericSubst :: Name -> (Name -> Q Type) -> Q [Dec] Source #
Variant of deriveGeneric
that allows to restrict the type parameters.
Experimental function, exposed primarily for benchmarking.
deriveGenericOnlySubst :: Name -> (Name -> Q Type) -> Q [Dec] Source #
Variant of deriveGenericOnly
that allows to restrict the type parameters.
Experimental function, exposed primarily for benchmarking.
deriveGenericFunctions :: Name -> String -> String -> String -> Q [Dec] Source #
Like deriveGenericOnly
, but don't derive class instance, only functions.
Example: If you say
deriveGenericFunctions ''Tree "TreeCode" "fromTree" "toTree"
then you get code that is equivalent to:
type TreeCode = '[ '[Int], '[Tree, Tree] ] fromTree :: Tree -> SOP I TreeCode fromTree (Leaf x) = SOP ( Z (I x :* Nil)) fromTree (Node l r) = SOP (S (Z (I l :* I r :* Nil))) toTree :: SOP I TreeCode -> Tree toTree (SOP (Z (I x :* Nil))) = Leaf x toTree (SOP (S (Z (I l :* I r :* Nil)))) = Node l r toTree (SOP (S (S x))) = x `seq` error "inaccessible"
Since: 0.2
deriveMetadataValue :: Name -> String -> String -> Q [Dec] Source #
Deprecated: Use deriveMetadataType
and demoteDatatypeInfo
instead.
Derive DatatypeInfo
value for the type.
Example: If you say
deriveMetadataValue ''Tree "TreeCode" "treeDatatypeInfo"
then you get code that is equivalent to:
treeDatatypeInfo :: DatatypeInfo TreeCode treeDatatypeInfo = ADT "Main" "Tree" (Constructor "Leaf" :* Constructor "Node" :* Nil)
Note: CodeType needs to be derived with deriveGenericFunctions
.
Since: 0.2
deriveMetadataType :: Name -> String -> Q [Dec] Source #
Derive DatatypeInfo
type for the type.
Example: If you say
deriveMetadataType ''Tree "TreeDatatypeInfo"
then you get code that is equivalent to:
type TreeDatatypeInfo = T.ADT "Main" "Tree" [ T.Constructor "Leaf", T.Constructor "Node" ]
Since: 0.3.0.0