Safe Haskell | None |
---|---|
Language | Haskell2010 |
Support for operating on Barbie-types with constrained functions.
Consider the following function:
showIt ::Show
a =>Maybe
a ->Const
String
a showIt =Const
.show
We would then like to be able to do:
bmap
showIt
::FunctorB
b => bMaybe
-> b (Const
String
)
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
) instanceConstraintsB
T where typeAllB
c T = (cInt
, cString
, cBool
)baddDicts
t = case t of A x y -> A (Pair
Dict
x) (Pair
Dict
y) B z w -> B (Pair
Dict
z) (Pair
Dict
w)
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 (Dict
Show
Product
b)
There is a default implementation of ConstraintsB
for
Generic
types, so in practice one will simply do:
derive instanceGeneric
(T f) instanceConstraintsB
T
Nothing
type AllB (c :: k -> Constraint) b :: Constraint Source #
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
::AllB
c 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 .AllB
c b => b (Dict
c)bdicts
=buniqC
(Dict
@c)
There is a default implementation for Generic
types, so
instances can derived automatically.
Nothing
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 Show
able 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)