Safe Haskell | None |
---|---|
Language | Haskell2010 |
Control.Variadic.Generic.Internal
Synopsis
- ghoist :: (Generic (r f), Generic (r g), GHoist (Rep (r f)) (Rep (r g)) f g '["close"]) => (forall x. f x -> g x) -> r f -> r g
- ghoist0 :: (Generic (r f), Generic (r g), GHoist (Rep (r f)) (Rep (r g)) f g '[]) => (forall x. f x -> g x) -> r f -> r g
- ghoist' :: (Generic (r f), Generic (r g), GHoist (Rep (r f)) (Rep (r g)) f g ignored) => proxy ignored -> (forall x. f x -> g x) -> r f -> r g
- class GHoist (i :: * -> *) (o :: * -> *) (f :: * -> *) (g :: * -> *) (ignored :: [Symbol]) where
- gghoist :: proxy ignored -> (forall x. f x -> g x) -> i p -> o p
- type VerifyIgnored e a es = VerifyIgnoredGo e a es es
- type family VerifyIgnoredGo e a es orig :: Constraint where ...
- type VerifyNotIgnored e a es = VerifyNotIgnoredGo e a es es
- type family VerifyNotIgnoredGo e a es orig :: Constraint where ...
Documentation
ghoist :: (Generic (r f), Generic (r g), GHoist (Rep (r f)) (Rep (r g)) f g '["close"]) => (forall x. f x -> g x) -> r f -> r g Source #
Runs hoist
on the return values each field of r
with the given natural transformation function, ignoring
the close
field, if it exists.
ghoist0 :: (Generic (r f), Generic (r g), GHoist (Rep (r f)) (Rep (r g)) f g '[]) => (forall x. f x -> g x) -> r f -> r g Source #
Runs hoist
on the return values each field of r
with the given natural transformation function; no fields
are ignored.
ghoist' :: (Generic (r f), Generic (r g), GHoist (Rep (r f)) (Rep (r g)) f g ignored) => proxy ignored -> (forall x. f x -> g x) -> r f -> r g Source #
Runs hoist
on the return values each field of r
with the given natural transformation function.
A supplied of ignored
fields is provided to signal which
fields should not be transformed.
class GHoist (i :: * -> *) (o :: * -> *) (f :: * -> *) (g :: * -> *) (ignored :: [Symbol]) where Source #
Instances
(Monad f, IsVariadic vf args (f a), IsVariadic vg args (g a)) => GHoist (K1 R vf :: Type -> Type) (K1 R vg :: Type -> Type) f g ignored Source # | |
(GHoist i1 o1 f g ignored, GHoist i2 o2 f g ignored) => GHoist (i1 :*: i2) (o1 :*: o2) f g ignored Source # | |
GHoist i o f g ignored => GHoist (M1 D c i) (M1 D c o) f g ignored Source # | |
GHoist i o f g ignored => GHoist (M1 C c i) (M1 C c o) f g ignored Source # | |
(GHoist (K1 R i :: Type -> Type) (K1 R o :: Type -> Type) f g ignored, VerifyNotIgnored n i ignored) => GHoist (M1 S ('MetaSel ('Just n) su ss ds) (K1 R i :: Type -> Type)) (M1 S ('MetaSel ('Just n) su ss ds) (K1 R o :: Type -> Type)) f g ignored Source # | |
VerifyIgnored n a ignored => GHoist (M1 S ('MetaSel ('Just n) su ss ds) (K1 R a :: Type -> Type)) (M1 S ('MetaSel ('Just n) su ss ds) (K1 R a :: Type -> Type)) f g ignored Source # | |
type VerifyIgnored e a es = VerifyIgnoredGo e a es es Source #
type family VerifyIgnoredGo e a es orig :: Constraint where ... Source #
Equations
VerifyIgnoredGo x a (x ': xs) orig = () | |
VerifyIgnoredGo y a (x ': xs) orig = VerifyIgnoredGo y a xs orig | |
VerifyIgnoredGo x a '[] orig = TypeError (('Text "Field:" :$$: ((('Text " " :<>: 'Text x) :<>: 'Text " :: ") :<>: 'ShowType a)) :$$: (('Text "cannot be ghoist-ed with the supplied " :<>: 'Text "function and was not in the ignored fields list: ") :<>: 'ShowType orig)) |
type VerifyNotIgnored e a es = VerifyNotIgnoredGo e a es es Source #
type family VerifyNotIgnoredGo e a es orig :: Constraint where ... Source #
Equations
VerifyNotIgnoredGo x a (x ': xs) orig = TypeError (('Text "Field:" :$$: ((('Text " " :<>: 'Text x) :<>: 'Text " :: ") :<>: 'ShowType a)) :$$: (('Text "must be ghoist-ed but was present in the ignored " :<>: 'Text "fields list: ") :<>: 'ShowType orig)) | |
VerifyNotIgnoredGo y a (x ': xs) orig = VerifyNotIgnoredGo y a xs orig | |
VerifyNotIgnoredGo x a '[] orig = () |