|
| Data.Generics.PlateTypeable |
|
|
|
|
| Description |
This module supplies a method for writing Biplate instances more easily.
To take an example:
data Expr = Var Int | Neg Expr | Add Expr Expr
instance Typeable Expr where ...
instance (Typeable a, Uniplate a) => PlateAll Expr a where
plateAll (Var x ) = plate Var |- x
plateAll (Neg x ) = plate Neg |+ x
plateAll (Add x y) = plate Add |+ x |+ y
instance Uniplate Expr where
uniplate = uniplateAll
|
|
| Synopsis |
|
|
|
| Documentation |
|
| module Data.Generics.Biplate |
|
| module Data.Typeable |
|
| The Class
|
|
| class PlateAll from to where |
This class represents going from the container type to the target.
This class should only be constructed with plate, |+ and |-
| | | Methods | | plateAll :: from -> Type from to |
| | Instances | | PlateAll Bool to | | PlateAll Char to | | PlateAll Double to | | PlateAll Float to | | PlateAll Int to | | PlateAll Integer to | | PlateAll () to | | (PlateAll a to, Typeable a, PlateAll b to, Typeable b, Typeable to, Uniplate to) => PlateAll (a, b) to | | (PlateAll a to, Typeable a, PlateAll b to, Typeable b, PlateAll c to, Typeable c, Typeable to, Uniplate to) => PlateAll (a, b, c) to | | (PlateAll a to, Typeable a, PlateAll b to, Typeable b, PlateAll c to, Typeable c, PlateAll d to, Typeable d, Typeable to, Uniplate to) => PlateAll (a, b, c, d) to | | (PlateAll a to, Typeable a, PlateAll b to, Typeable b, PlateAll c to, Typeable c, PlateAll d to, Typeable d, PlateAll e to, Typeable e, Typeable to, Uniplate to) => PlateAll (a, b, c, d, e) to | | (PlateAll from to, Typeable from, Typeable to, Uniplate to) => PlateAll (Maybe from) to | | (PlateAll from to, Typeable from, Typeable to, Uniplate to) => PlateAll [from] to | | (PlateAll a to, Typeable a, PlateAll b to, Typeable b, Typeable to, Uniplate to) => PlateAll (Either a b) to |
|
|
|
| uniplateAll :: PlateAll a b => a -> ([b], [b] -> a) |
| This function is used to write a Uniplate instance from a PlateAll one
|
|
| The Combinators
|
|
| plate :: from -> Type from to |
The main combinator used to start the chain.
The following rule can be used for optimisation:
plate Ctor |- x == plate (Ctor x)
|
|
| (|+) :: (Typeable item, Typeable to, PlateAll item to) => Type (item -> from) to -> item -> Type from to |
| the field to the right may contain the target.
|
|
| (|-) :: Type (item -> from) to -> item -> Type from to |
| The field to the right does not contain the target.
This can be used as either an optimisation, or more commonly for excluding
primitives such as Int.
|
|
| Produced by Haddock version 0.8 |