| Safe Haskell | Safe-Inferred |
|---|---|
| Language | GHC2021 |
Strongweak.Generic.Strengthen
Description
strengthen over generic representations.
Strengthen failures are annotated with precise information describing where the failure occurred: datatype name, constructor name, field index (and name if present). To achieve this, we split the generic derivation into 3 classes, each handling/"unwrapping" a different layer of the generic representation: datatype (D), constructor (C) and selector (S).
Synopsis
- strengthenGeneric :: (Generic w, Generic s, GStrengthenD (Rep w) (Rep s)) => w -> Result s
- class GStrengthenD w s where
- gstrengthenD :: w p -> Result (s p)
- class GStrengthenC wcd scd w s where
- gstrengthenC :: w p -> Result (s p)
- class GStrengthenS wcd scd wcc scc (si :: Natural) w s where
- gstrengthenS :: w p -> Result (s p)
- (.>) :: (a -> b) -> (b -> c) -> a -> c
- selName'' :: forall s. Selector s => Maybe String
- conName' :: forall c. Constructor c => String
- datatypeName' :: forall d. Datatype d => String
- selName' :: forall s. Selector s => String
- type family ProdArity (f :: Type -> Type) :: Natural where ...
- natVal'' :: forall n. KnownNat n => Natural
Documentation
strengthenGeneric :: (Generic w, Generic s, GStrengthenD (Rep w) (Rep s)) => w -> Result s Source #
Strengthen a value generically.
The weak and strong types must be compatible. See Generic for
the definition of compatibility in this context.
class GStrengthenD w s where Source #
Generic strengthening at the datatype level.
Methods
gstrengthenD :: w p -> Result (s p) Source #
Instances
| GStrengthenC wcd scd w s => GStrengthenD (D1 wcd w :: k -> Type) (D1 scd s :: k -> Type) Source # | Enter a datatype, stripping its metadata wrapper. |
Defined in Strongweak.Generic.Strengthen | |
class GStrengthenC wcd scd w s where Source #
Generic strengthening at the constructor sum level.
Methods
gstrengthenC :: w p -> Result (s p) Source #
Instances
| GStrengthenC (wcd :: k1) (scd :: k2) (V1 :: k3 -> Type) (V1 :: k3 -> Type) Source # | Nothing to do for empty datatypes. |
Defined in Strongweak.Generic.Strengthen | |
| (GStrengthenC wcd scd wl sl, GStrengthenC wcd scd wr sr) => GStrengthenC (wcd :: k1) (scd :: k2) (wl :+: wr :: k3 -> Type) (sl :+: sr :: k3 -> Type) Source # | Strengthen sum types by casing and strengthening left or right. |
Defined in Strongweak.Generic.Strengthen | |
| GStrengthenS wcd scd wcc scc 0 w s => GStrengthenC (wcd :: k1) (scd :: k2) (C1 wcc w :: k3 -> Type) (C1 scc s :: k3 -> Type) Source # | Enter a constructor, stripping its metadata wrapper. |
Defined in Strongweak.Generic.Strengthen | |
class GStrengthenS wcd scd wcc scc (si :: Natural) w s where Source #
Generic strengthening at the constructor level.
Methods
gstrengthenS :: w p -> Result (s p) Source #
Instances
| GStrengthenS (wcd :: k1) (scd :: k2) (wcc :: k3) (scc :: k4) si (U1 :: k5 -> Type) (U1 :: k5 -> Type) Source # | Nothing to do for empty constructors. |
Defined in Strongweak.Generic.Strengthen | |
| (GStrengthenS wcd scd wcc scc si wl sl, GStrengthenS wcd scd wcc scc (si + ProdArity wl) wr sr) => GStrengthenS (wcd :: k1) (scd :: k2) (wcc :: k3) (scc :: k4) si (wl :*: wr :: Type -> Type) (sl :*: sr :: Type -> Type) Source # | Strengthen product types by strengthening left and right. |
Defined in Strongweak.Generic.Strengthen | |
| GStrengthenS (wcd :: k1) (scd :: k2) (wcc :: k3) (scc :: k4) si (S1 wcs (Rec0 a) :: k5 -> Type) (S1 scs (Rec0 a) :: k5 -> Type) Source # | Special case: if source and target types are equal, copy the value through. |
Defined in Strongweak.Generic.Strengthen | |
| (Weak s ~ w, Strengthen s, Datatype wcd, Datatype scd, Constructor wcc, Constructor scc, Selector wcs, Selector scs, KnownNat si) => GStrengthenS (wcd :: k1) (scd :: k2) (wcc :: k3) (scc :: k4) si (S1 wcs (Rec0 w) :: k5 -> Type) (S1 scs (Rec0 s) :: k5 -> Type) Source # | Strengthen a field using the existing |
Defined in Strongweak.Generic.Strengthen | |
selName'' :: forall s. Selector s => Maybe String Source #
Get the record name for a selector if present.
On the type level, a 'Maybe Symbol' is stored for record names. But the
reification is done using fromMaybe "". So we have to inspect the resulting
string to determine whether the field uses record syntax or not. (Silly.)
conName' :: forall c. Constructor c => String Source #
datatypeName' :: forall d. Datatype d => String Source #
datatypeName without the value (only used as a proxy). Lets us push our
undefineds into one place.