| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Data.Barbie.Constraints
Description
Support for operating on Barbie-types with constrained functions.
Consider the following function:
showIt ::Showa =>Maybea ->ConstStringa showIt =Const.show
We would then like to be able to do:
bmapshowIt::FunctorBb => bMaybe-> b (ConstString)
This however doesn't work because of the ( constraint in the
the type of Show a)showIt.
This module adds support to overcome this problem.
Synopsis
- data Dict c a where
- requiringDict :: (c a => r) -> Dict c a -> r
- class FunctorB b => ConstraintsB (b :: (k -> *) -> *) where
- type AllB (c :: k -> Constraint) b :: Constraint
- baddDicts :: forall c f. AllB c b => b f -> b (Dict c `Product` f)
- class (ConstraintsB b, ProductB b) => ProductBC (b :: (k -> Type) -> Type) where
- bmapC :: forall c b f g. (AllB c b, ConstraintsB b) => (forall a. c a => f a -> g a) -> b f -> b g
- btraverseC :: forall c b f g h. (TraversableB b, ConstraintsB b, AllB c b, Applicative g) => (forall a. c a => f a -> g (h a)) -> b f -> g (b h)
- type AllBF c f b = AllB (ClassF c f) b
- class c (f a) => ClassF c f a
- class c (f a) (g a) => ClassFG c f g a
- type ConstraintsOf c f b = AllBF c f b
- adjProof :: forall b c f. (ConstraintsB b, AllB c b) => b f -> b (Dict c `Product` f)
- type ProofB b = ProductBC b
Instance dictionaries
is evidence that there exists an instance of Dict c ac a.
It is essentially equivalent to Dict (c a) from the
constraints package,
but because of its kind, it allows us to define things like .Dict Show
requiringDict :: (c a => r) -> Dict c a -> r Source #
Turn a constrained-function into an unconstrained one that uses the packed instance dictionary instead.
Retrieving dictionaries
class FunctorB b => ConstraintsB (b :: (k -> *) -> *) where Source #
Instances of this class provide means to talk about constraints,
both at compile-time, using AllB, and at run-time, in the form
of Dict, via baddDicts.
A manual definition would look like this:
data T f = A (fInt) (fString) | B (fBool) (fInt) instanceConstraintsBT where typeAllBc T = (cInt, cString, cBool)baddDictst = case t of A x y -> A (PairDictx) (PairDicty) B z w -> B (PairDictz) (PairDictw)
Now if we given a T f, we need to use the Show instance of
their fields, we can use:
baddDicts:: AllB Show b => b f -> b (DictShowProductb)
There is a default implementation of ConstraintsB for
Generic types, so in practice one will simply do:
derive instanceGeneric(T f) instanceConstraintsBT
Minimal complete definition
Nothing
Associated Types
type AllB (c :: k -> Constraint) b :: Constraint Source #
Methods
baddDicts :: forall c f. AllB c b => b f -> b (Dict c `Product` f) Source #
baddDicts :: forall c f. (CanDeriveConstraintsB c b f, AllB c b) => b f -> b (Dict c `Product` f) Source #
Instances
| ConstraintsB (Proxy :: (k -> Type) -> Type) Source # | |
| ConstraintsB (Void :: (k -> Type) -> Type) Source # | |
| ConstraintsB (Unit :: (k -> Type) -> Type) Source # | |
| ConstraintsB (Const a :: (k -> Type) -> Type) Source # | |
| ConstraintsB b => ConstraintsB (Barbie b :: (k -> Type) -> Type) Source # | |
| (ConstraintsB a, ConstraintsB b) => ConstraintsB (Sum a b :: (k -> Type) -> Type) Source # | |
| (ConstraintsB a, ConstraintsB b) => ConstraintsB (Product a b :: (k -> Type) -> Type) Source # | |
| (Functor f, ConstraintsB b) => ConstraintsB (Compose f b :: (k -> Type) -> Type) Source # | |
class (ConstraintsB b, ProductB b) => ProductBC (b :: (k -> Type) -> Type) where Source #
Every type b that is an instance of both ProductB and
ConstraintsB can be made an instance of ProductBC
as well.
Intuitively, in addition to buniq from ProductB, one
can define buniqC that takes into account constraints:
buniq:: (forall a . f a) -> b fbuniqC::AllBc b => (forall a . c a => f a) -> b f
For technical reasons, buniqC is not currently provided
as a method of this class and is instead defined in terms
bdicts, which is similar to baddDicts but can produce the
instance dictionaries out-of-the-blue. bdicts could also be
defined in terms of buniqC, so they are essentially equivalent.
bdicts:: forall c b .AllBc b => b (Dictc)bdicts=buniqC(Dict@c)
There is a default implementation for Generic types, so
instances can derived automatically.
Minimal complete definition
Nothing
Methods
bdicts :: AllB c b => b (Dict c) Source #
bdicts :: (CanDeriveProductBC c b, AllB c b) => b (Dict c) Source #
bmapC :: forall c b f g. (AllB c b, ConstraintsB b) => (forall a. c a => f a -> g a) -> b f -> b g Source #
Like bmap but a constraint is allowed to be required on
each element of b
E.g. If all fields of b are Showable then you
could store each shown value in it's slot using Const:
showFields :: (AllB Show b, ConstraintsB b) => b Identity -> b (Const String)
showFields = bmapC @Show showField
where
showField :: forall a. Show a => Identity a -> Const String a
showField (Identity a) = Const (show a)btraverseC :: forall c b f g h. (TraversableB b, ConstraintsB b, AllB c b, Applicative g) => (forall a. c a => f a -> g (h a)) -> b f -> g (b h) Source #
Like btraverse but with a constraint on the elements of b.
class c (f a) => ClassF c f a Source #
ClassF has one universal instance that makes
equivalent to ClassF c f ac (f a). However, we have
'ClassF c f :: k -> Constraint
This is useful since it allows to define constraint-constructors like
ClassF Monoid Maybe
Instances
| c (f a) => ClassF (c :: k2 -> Constraint) (f :: k1 -> k2) (a :: k1) Source # | |
Defined in Data.Barbie.Internal.Dicts | |
class c (f a) (g a) => ClassFG c f g a Source #
Like ClassF but for binary relations.
Instances
| c (f a) (g a) => ClassFG (c :: k2 -> k3 -> Constraint) (f :: k1 -> k2) (g :: k1 -> k3) (a :: k1) Source # | |
Defined in Data.Barbie.Internal.Dicts | |
Deprecated
type ConstraintsOf c f b = AllBF c f b Source #
Deprecated: Renamed to AllBF (now based on AllB)