Safe Haskell | None |
---|---|
Language | Haskell2010 |
Generic deriving with unbalanced trees.
Synopsis
- data GenericStrategy
- withDepths :: [CstrDepth] -> GenericStrategy
- rightBalanced :: GenericStrategy
- leftBalanced :: GenericStrategy
- rightComb :: GenericStrategy
- leftComb :: GenericStrategy
- haskellBalanced :: GenericStrategy
- reorderingConstrs :: EntriesReorder -> GenericStrategy -> GenericStrategy
- reorderingFields :: UnnamedEntriesReorder -> EntriesReorder -> GenericStrategy -> GenericStrategy
- reorderingData :: UnnamedEntriesReorder -> EntriesReorder -> GenericStrategy -> GenericStrategy
- alphabetically :: EntriesReorder
- leaveUnnamedFields :: UnnamedEntriesReorder
- forbidUnnamedFields :: UnnamedEntriesReorder
- cstr :: forall n. KnownNat n => [Natural] -> CstrDepth
- fld :: forall n. KnownNat n => Natural
- customGeneric :: String -> GenericStrategy -> Q [Dec]
- fromDepthsStrategy :: (Int -> [Natural]) -> GenericStrategy
- reifyDataType :: Name -> Q (Name, Cxt, Maybe Kind, [TyVarBndr], [Con])
- deriveFullType :: Name -> Maybe Kind -> [TyVarBndr] -> TypeQ
- customGeneric' :: Maybe Type -> Name -> Type -> [Con] -> GenericStrategy -> Q [Dec]
Custom Generic strategies
data GenericStrategy Source #
Type of a strategy to derive Generic
instances.
withDepths :: [CstrDepth] -> GenericStrategy Source #
In this strategy the desired depths of contructors (in the type tree) and fields (in each constructor's tree) are provided manually and simply checked against the number of actual constructors and fields.
rightBalanced :: GenericStrategy Source #
Strategy to make right-balanced instances (both in constructors and fields).
This will try its best to produce a flat tree:
- the balances of all leaves differ no more than by 1;
- leaves at left will have equal or lesser depth than leaves at right.
leftBalanced :: GenericStrategy Source #
Strategy to make left-balanced instances (both in constructors and fields).
This is the same as symmetrically mapped rightBalanced
.
rightComb :: GenericStrategy Source #
Strategy to make fully right-leaning instances (both in constructors and fields).
leftComb :: GenericStrategy Source #
Strategy to make fully left-leaning instances (both in constructors and fields).
haskellBalanced :: GenericStrategy Source #
Strategy to make Haskell's Generics-like instances (both in constructors and fields).
This is similar to rightBalanced
, except for the "flat" part:
- for each node, size of the left subtree is equal or less by one than size of the right subtree.
This strategy matches A1.1.
customGeneric T haskellBalanced
is equivalent to mere
deriving stock Generic T
.
Entries reordering
reorderingConstrs :: EntriesReorder -> GenericStrategy -> GenericStrategy Source #
Modify given strategy to reorder constructors.
The reordering will take place before depths are evaluated and structure of generic representation is formed.
Example: reorderingConstrs alphabetically rightBalanced
.
reorderingFields :: UnnamedEntriesReorder -> EntriesReorder -> GenericStrategy -> GenericStrategy Source #
Modify given strategy to reorder fields.
Same notes as for reorderingConstrs
apply here.
Example: reorderingFields forbidUnnamedFields alphabetically rightBalanced
.
reorderingData :: UnnamedEntriesReorder -> EntriesReorder -> GenericStrategy -> GenericStrategy Source #
Modify given strategy to reorder constructors and fields.
Same notes as for reorderingConstrs
apply here.
Example: reorderingData forbidUnnamedFields alphabetically rightBalanced
.
alphabetically :: EntriesReorder Source #
Sort entries by name alphabetically.
leaveUnnamedFields :: UnnamedEntriesReorder Source #
Leave unnamed fields intact, without any reordering.
forbidUnnamedFields :: UnnamedEntriesReorder Source #
Fail in case records are unnamed and we cannot figure out the necessary reordering.
Depth usage helpers
cstr :: forall n. KnownNat n => [Natural] -> CstrDepth Source #
Helper for making a constructor depth.
Note that this is only intended to be more readable than directly using a
tuple with withDepths
and for the ability to be used in places where
RebindableSyntax
overrides the number literal resolution.
fld :: forall n. KnownNat n => Natural Source #
Helper for making a field depth.
Note that this is only intended to be more readable than directly using a
tuple with withDepths
and for the ability to be used in places where
RebindableSyntax
overrides the number literal resolution.
Instance derivation
customGeneric :: String -> GenericStrategy -> Q [Dec] Source #
Helpers
fromDepthsStrategy :: (Int -> [Natural]) -> GenericStrategy Source #
Helper to make a strategy that created depths for constructor and fields in the same way, just from their number.
The provided function f
must satisfy the following rules:
length (f n) ≡ n
sum $ (x -> 2 ^^ (-x)) $ f n ≡ 1
(unlessn = 0
)
Internals
reifyDataType :: Name -> Q (Name, Cxt, Maybe Kind, [TyVarBndr], [Con]) Source #
Reifies info from a type name (given as a String
).
The lookup happens from the current splice's scope (see lookupTypeName
) and
the only accepted result is a "plain" data type (no GADTs).