Safe Haskell | None |
---|---|
Language | Haskell2010 |
Functors from indexed-types to types.
Synopsis
-
class
FunctorB
(b :: (k ->
Type
) ->
Type
)
where
- bmap :: ( forall a. f a -> g a) -> b f -> b g
-
class
FunctorB
b =>
TraversableB
(b :: (k ->
Type
) ->
Type
)
where
- btraverse :: Applicative e => ( forall a. f a -> e (g a)) -> b f -> e (b g)
- btraverse_ :: ( TraversableB b, Applicative e) => ( forall a. f a -> e c) -> b f -> e ()
- bfoldMap :: ( TraversableB b, Monoid m) => ( forall a. f a -> m) -> b f -> m
- bsequence :: ( Applicative e, TraversableB b) => b ( Compose e f) -> e (b f)
- bsequence' :: ( Applicative e, TraversableB b) => b e -> e (b Identity )
-
class
FunctorB
b =>
DistributiveB
(b :: (k ->
Type
) ->
Type
)
where
- bdistribute :: Functor f => f (b g) -> b ( Compose f g)
- bdistribute' :: ( DistributiveB b, Functor f) => f (b Identity ) -> b f
- bcotraverse :: ( DistributiveB b, Functor f) => ( forall a. f (g a) -> f a) -> f (b g) -> b f
- bdecompose :: DistributiveB b => (a -> b Identity ) -> b ((->) a)
- brecompose :: FunctorB b => b ((->) a) -> a -> b Identity
- class FunctorB b => ApplicativeB (b :: (k -> Type ) -> Type ) where
- bzip :: ApplicativeB b => b f -> b g -> b (f `Product` g)
- bunzip :: ApplicativeB b => b (f `Product` g) -> (b f, b g)
- bzipWith :: ApplicativeB b => ( forall a. f a -> g a -> h a) -> b f -> b g -> b h
- bzipWith3 :: ApplicativeB b => ( forall a. f a -> g a -> h a -> i a) -> b f -> b g -> b h -> b i
- bzipWith4 :: ApplicativeB b => ( forall a. f a -> g a -> h a -> i a -> j a) -> b f -> b g -> b h -> b i -> b j
-
class
FunctorB
b =>
ConstraintsB
(b :: (k ->
Type
) ->
Type
)
where
- type AllB (c :: k -> Constraint ) b :: Constraint
- baddDicts :: forall c f. AllB c b => b f -> b ( Dict c `Product` f)
- type AllBF c f b = AllB ( ClassF c f) b
- bdicts :: forall c b. ( ConstraintsB b, ApplicativeB b, AllB c b) => b ( Dict c)
- bmapC :: forall c b f g. ( AllB c b, ConstraintsB b) => ( forall a. c a => f a -> g a) -> b f -> b g
- bfoldMapC :: forall c b m f. ( TraversableB b, ConstraintsB b, AllB c b, Monoid m) => ( forall a. c a => f a -> m) -> b f -> m
- btraverseC :: forall c b f g e. ( TraversableB b, ConstraintsB b, AllB c b, Applicative e) => ( forall a. c a => f a -> e (g a)) -> b f -> e (b g)
- bpureC :: forall c f b. ( AllB c b, ConstraintsB b, ApplicativeB b) => ( forall a. c a => f a) -> b f
- bzipWithC :: forall c b f g h. ( AllB c b, ConstraintsB b, ApplicativeB b) => ( forall a. c a => f a -> g a -> h a) -> b f -> b g -> b h
- bzipWith3C :: forall c b f g h i. ( AllB c b, ConstraintsB b, ApplicativeB b) => ( forall a. c a => f a -> g a -> h a -> i a) -> b f -> b g -> b h -> b i
- bzipWith4C :: forall c b f g h i j. ( AllB c b, ConstraintsB b, ApplicativeB b) => ( forall a. c a => f a -> g a -> h a -> i a -> j a) -> b f -> b g -> b h -> b i -> b j
- bmempty :: forall f b. ( AllBF Monoid f b, ConstraintsB b, ApplicativeB b) => b f
- newtype Rec (p :: Type ) a x = Rec { }
Functor
class FunctorB (b :: (k -> Type ) -> Type ) where Source #
Barbie-types that can be mapped over. Instances of
FunctorB
should
satisfy the following laws:
bmap
id
=id
bmap
f .bmap
g =bmap
(f . g)
There is a default
bmap
implementation for
Generic
types, so
instances can derived automatically.
Nothing
bmap :: ( forall a. f a -> g a) -> b f -> b g Source #
default bmap :: forall f g. CanDeriveFunctorB b f g => ( forall a. f a -> g a) -> b f -> b g Source #
Instances
FunctorB ( Proxy :: (k -> Type ) -> Type ) Source # | |
FunctorB ( Void :: (k -> Type ) -> Type ) Source # | |
FunctorB ( Unit :: (k -> Type ) -> Type ) Source # | |
FunctorB ( Constant x :: (k -> Type ) -> Type ) Source # | |
FunctorB ( Const x :: (k -> Type ) -> Type ) Source # | |
FunctorB b => FunctorB ( Barbie b :: (k -> Type ) -> Type ) Source # | |
( FunctorB a, FunctorB b) => FunctorB ( Sum a b :: (k -> Type ) -> Type ) Source # | |
( FunctorB a, FunctorB b) => FunctorB ( Product a b :: (k -> Type ) -> Type ) Source # | |
( Functor f, FunctorB b) => FunctorB ( Compose f b :: (k -> Type ) -> Type ) Source # | |
FunctorT b => FunctorB ( Flip b f :: (k1 -> Type ) -> Type ) Source # | |
Traversable
class FunctorB b => TraversableB (b :: (k -> Type ) -> Type ) where Source #
Barbie-types that can be traversed from left to right. Instances should satisfy the following laws:
t .btraverse
f =btraverse
(t . f) -- naturalitybtraverse
Identity
=Identity
-- identitybtraverse
(Compose
.fmap
g . f) =Compose
.fmap
(btraverse
g) .btraverse
f -- composition
There is a default
btraverse
implementation for
Generic
types, so
instances can derived automatically.
Nothing
btraverse :: Applicative e => ( forall a. f a -> e (g a)) -> b f -> e (b g) Source #
default btraverse :: ( Applicative e, CanDeriveTraversableB b f g) => ( forall a. f a -> e (g a)) -> b f -> e (b g) Source #
Instances
Utility functions
btraverse_ :: ( TraversableB b, Applicative e) => ( forall a. f a -> e c) -> b f -> e () Source #
Map each element to an action, evaluate these actions from left to right, and ignore the results.
bfoldMap :: ( TraversableB b, Monoid m) => ( forall a. f a -> m) -> b f -> m Source #
Map each element to a monoid, and combine the results.
bsequence :: ( Applicative e, TraversableB b) => b ( Compose e f) -> e (b f) Source #
Evaluate each action in the structure from left to right, and collect the results.
bsequence' :: ( Applicative e, TraversableB b) => b e -> e (b Identity ) Source #
Distributive
class FunctorB b => DistributiveB (b :: (k -> Type ) -> Type ) where Source #
A
FunctorB
where the effects can be distributed to the fields:
bdistribute
turns an effectful way of building a Barbie-type
into a pure Barbie-type with effectful ways of computing the
values of its fields.
This class is the categorical dual of
TraversableB
,
with
bdistribute
the dual of
bsequence
and
bcotraverse
the dual of
btraverse
. As such,
instances need to satisfy these laws:
bdistribute
. h =bmap
(Compose
. h .getCompose
) .bdistribute
-- naturalitybdistribute
.Identity
=bmap
(Compose
.Identity
) -- identitybdistribute
.Compose
=bmap
(Compose
.Compose
.fmap
getCompose
.getCompose
) .bdistribute
.fmap
bdistribute
-- composition
By specializing
f
to
((->) a)
and
g
to
Identity
, we can define a function that
decomposes a function on distributive barbies into a collection of simpler functions:
bdecompose
::DistributiveB
b => (a -> bIdentity
) -> b ((->) a)bdecompose
=bmap
(fmap
runIdentity
.getCompose
) .bdistribute
Lawful instances of the class can then be characterized as those that satisfy:
brecompose
.bdecompose
=id
bdecompose
.brecompose
=id
This means intuitively that instances need to have a fixed shape (i.e. no sum-types can be involved). Typically, this means record types, as long as they don't contain fields where the functor argument is not applied.
There is a default implementation of
bdistribute
based on
Generic
. Intuitively, it works on product types where the shape
of a pure value is uniquely defined and every field is covered by
the argument
f
.
Nothing
bdistribute :: Functor f => f (b g) -> b ( Compose f g) Source #
default bdistribute :: forall f g. CanDeriveDistributiveB b f g => Functor f => f (b g) -> b ( Compose f g) Source #
Instances
DistributiveB ( Proxy :: (k -> Type ) -> Type ) Source # | |
Defined in Barbies.Internal.DistributiveB |
|
DistributiveB ( Unit :: (k -> Type ) -> Type ) Source # | |
Defined in Barbies.Internal.Trivial |
|
( DistributiveB a, DistributiveB b) => DistributiveB ( Product a b :: (k -> Type ) -> Type ) Source # | |
Defined in Barbies.Internal.DistributiveB |
|
DistributiveT b => DistributiveB ( Flip b f :: ( Type -> Type ) -> Type ) Source # | |
Defined in Barbies.Bi |
|
( Distributive h, DistributiveB b) => DistributiveB ( Compose h b :: (k -> Type ) -> Type ) Source # | |
Defined in Barbies.Internal.DistributiveB |
bdistribute' :: ( DistributiveB b, Functor f) => f (b Identity ) -> b f Source #
A version of
bdistribute
with
g
specialized to
Identity
.
bcotraverse :: ( DistributiveB b, Functor f) => ( forall a. f (g a) -> f a) -> f (b g) -> b f Source #
Dual of
btraverse
bdecompose :: DistributiveB b => (a -> b Identity ) -> b ((->) a) Source #
Decompose a function returning a distributive barbie, into a collection of simpler functions.
brecompose :: FunctorB b => b ((->) a) -> a -> b Identity Source #
Recompose a decomposed function.
Applicative
class FunctorB b => ApplicativeB (b :: (k -> Type ) -> Type ) where Source #
A
FunctorB
with application, providing operations to:
It should satisfy the following laws:
-
Naturality of
bprod
bmap
((Pair
a b) ->Pair
(f a) (g b)) (u `bprod
` v) =bmap
f u `bprod
`bmap
g v
- Left and right identity
bmap
((Pair
_ b) -> b) (bpure
e `bprod
` v) = vbmap
((Pair
a _) -> a) (u `bprod
`bpure
e) = u
- Associativity
bmap
((Pair
a (Pair
b c)) ->Pair
(Pair
a b) c) (u `bprod
` (v `bprod
` w)) = (u `bprod
` v) `bprod
` w
It is to
FunctorB
in the same way as
Applicative
relates to
Functor
. For a presentation of
Applicative
as
a monoidal functor, see Section 7 of
Applicative Programming with Effects
.
There is a default implementation of
bprod
and
bpure
based on
Generic
.
Intuitively, it works on types where the value of
bpure
is uniquely defined.
This corresponds rougly to record types (in the presence of sums, there would
be several candidates for
bpure
), where every field is either a
Monoid
or
covered by the argument
f
.
Nothing
bpure :: ( forall a. f a) -> b f Source #
default bpure :: CanDeriveApplicativeB b f f => ( forall a. f a) -> b f Source #
bprod :: b f -> b g -> b (f `Product` g) Source #
default bprod :: CanDeriveApplicativeB b f g => b f -> b g -> b (f `Product` g) Source #
Instances
( ProductB b, FunctorB b) => ApplicativeB (b :: (k -> Type ) -> Type ) Source # | |
ApplicativeB ( Proxy :: (k -> Type ) -> Type ) Source # | |
ApplicativeB ( Unit :: (k -> Type ) -> Type ) Source # | |
Monoid a => ApplicativeB ( Constant a :: (k -> Type ) -> Type ) Source # | |
Monoid a => ApplicativeB ( Const a :: (k -> Type ) -> Type ) Source # | |
ApplicativeB b => ApplicativeB ( Barbie b :: (k -> Type ) -> Type ) Source # | |
( ApplicativeB a, ApplicativeB b) => ApplicativeB ( Product a b :: (k -> Type ) -> Type ) Source # | |
ApplicativeT b => ApplicativeB ( Flip b f :: (k1 -> Type ) -> Type ) Source # | |
Utility functions
bzip :: ApplicativeB b => b f -> b g -> b (f `Product` g) Source #
bzipWith :: ApplicativeB b => ( forall a. f a -> g a -> h a) -> b f -> b g -> b h Source #
An equivalent of
zipWith
.
bzipWith3 :: ApplicativeB b => ( forall a. f a -> g a -> h a -> i a) -> b f -> b g -> b h -> b i Source #
An equivalent of
zipWith3
.
bzipWith4 :: ApplicativeB b => ( forall a. f a -> g a -> h a -> i a -> j a) -> b f -> b g -> b h -> b i -> b j Source #
An equivalent of
zipWith4
.
Constraints and instance dictionaries
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
.
The
ConstraintsB
class let us overcome this problem.
class FunctorB b => ConstraintsB (b :: (k -> Type ) -> Type ) 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, when we given a
T f
, if we need to use the
Show
instance of
their fields, we can use:
baddDicts
:: AllB Show b => b f -> b (Dict
Show
`Product
` f)
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 #
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 # | |
Utility functions
bdicts :: forall c b. ( ConstraintsB b, ApplicativeB b, AllB c b) => b ( Dict c) Source #
Similar to
baddDicts
but can produce the instance dictionaries
"out of the blue".
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)
bfoldMapC :: forall c b m f. ( TraversableB b, ConstraintsB b, AllB c b, Monoid m) => ( forall a. c a => f a -> m) -> b f -> m Source #
btraverseC :: forall c b f g e. ( TraversableB b, ConstraintsB b, AllB c b, Applicative e) => ( forall a. c a => f a -> e (g a)) -> b f -> e (b g) Source #
Like
btraverse
but with a constraint on the elements of
b
.
bpureC :: forall c f b. ( AllB c b, ConstraintsB b, ApplicativeB b) => ( forall a. c a => f a) -> b f Source #
Like
bpure
but a constraint is allowed to be required on
each element of
b
.
bzipWithC :: forall c b f g h. ( AllB c b, ConstraintsB b, ApplicativeB b) => ( forall a. c a => f a -> g a -> h a) -> b f -> b g -> b h Source #
Like
bzipWith
but with a constraint on the elements of
b
.
bzipWith3C :: forall c b f g h i. ( AllB c b, ConstraintsB b, ApplicativeB b) => ( forall a. c a => f a -> g a -> h a -> i a) -> b f -> b g -> b h -> b i Source #
Like
bzipWith3
but with a constraint on the elements of
b
.
bzipWith4C :: forall c b f g h i j. ( AllB c b, ConstraintsB b, ApplicativeB b) => ( forall a. c a => f a -> g a -> h a -> i a -> j a) -> b f -> b g -> b h -> b i -> b j Source #
Like
bzipWith4
but with a constraint on the elements of
b
.
bmempty :: forall f b. ( AllBF Monoid f b, ConstraintsB b, ApplicativeB b) => b f Source #
Builds a
b f
, by applying
mempty
on every field of
b
.
Support for generic derivations
newtype Rec (p :: Type ) a x Source #
Instances
GTraversable (n :: k1) (f :: k2 -> Type ) (g :: k2 -> Type ) ( Rec a a :: k3 -> Type ) ( Rec a a :: k3 -> Type ) Source # | |
Defined in Barbies.Generics.Traversable |
|
GConstraints n (c :: k1 -> Constraint ) (f :: k2) ( Rec a' a :: Type -> Type ) ( Rec b' b :: k3 -> Type ) ( Rec b' b :: k3 -> Type ) Source # | |
Monoid x => GApplicative (n :: k1) (f :: k2 -> Type ) (g :: k2 -> Type ) ( Rec x x :: k3 -> Type ) ( Rec x x :: k3 -> Type ) ( Rec x x :: k3 -> Type ) Source # | |
Defined in Barbies.Generics.Applicative |
|
GFunctor n (f :: k1 -> Type ) (g :: k1 -> Type ) ( Rec x x :: k2 -> Type ) ( Rec x x :: k2 -> Type ) Source # | |
repbi ~ repbb => GBare n ( Rec repbi repbi :: k -> Type ) ( Rec repbb repbb :: k -> Type ) Source # | |
type GAll n (c :: k -> Constraint ) ( Rec l r :: Type -> Type ) Source # | |
Defined in Barbies.Generics.Constraints |