Safe Haskell | None |
---|---|
Language | Haskell2010 |
A common Haskell idiom is to parameterise a datatype by a type k -> *
,
typically a functor or a GADT. These are like outfits of a Barbie,
that turn her into a different doll. E.g.
data Barbie f = Barbie { name :: fString
, age :: fInt
} b1 :: BarbieLast
-- Barbie with a monoid structure b2 :: Barbie (Const
a) --Container
Barbie b3 :: BarbieIdentity
-- Barbie's new clothes
This module define the classes to work with these types and easily
transform them. They all come with default instances based on
Generic
, so using them is as easy as:
data Barbie f = Barbie { name :: fString
, age :: fInt
} deriving (Generic
,FunctorB
,TraversableB
,ProductB
,ConstraintsB
,ProductBC
) deriving instanceAllBF
Show
f Barbie =>Show
(Barbie f) deriving instanceAllBF
Eq
f Barbie =>Eq
(Barbie f)
Sometimes one wants to use Barbie
and it may feel like a second-class record type, where one needs to
unpack values in each field. Data.Barbie.Bare offers a way to have
bare versions of a barbie-type.Identity
Notice that all classes in this package are poly-kinded. Intuitively, a barbie is a type parameterised by a functor, and because a barbies is a type of functor, a type parameterised by a barbie is a (higher-kinded) barbie too:
data Catalog b = Catalog (bIdentity
) (bMaybe
) deriving (Generic
,FunctorB
,TraversableB
,ProductB
,ConstraintsB
,ProductBC
)
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 t => (forall a. f a -> t (g a)) -> b f -> t (b g)
- btraverse_ :: (TraversableB b, Applicative t) => (forall a. f a -> t c) -> b f -> t ()
- bfoldMap :: (TraversableB b, Monoid m) => (forall a. f a -> m) -> b f -> m
- bsequence :: (Applicative f, TraversableB b) => b (Compose f g) -> f (b g)
- bsequence' :: (Applicative f, TraversableB b) => b f -> f (b Identity)
- class FunctorB b => ProductB (b :: (k -> Type) -> Type) where
- bzip :: ProductB b => b f -> b g -> b (f `Product` g)
- bunzip :: ProductB b => b (f `Product` g) -> (b f, b g)
- bzipWith :: ProductB b => (forall a. f a -> g a -> h a) -> b f -> b g -> b h
- bzipWith3 :: ProductB b => (forall a. f a -> g a -> h a -> i a) -> b f -> b g -> b h -> b i
- bzipWith4 :: ProductB b => (forall a. f a -> g a -> h a -> i a -> j a) -> b f -> b g -> b h -> b i -> b j
- (/*/) :: ProductB b => b f -> b g -> b (Prod '[f, g])
- (/*) :: ProductB b => b f -> b (Prod fs) -> b (Prod (f ': fs))
- 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)
- type AllBF c f b = AllB (ClassF c f) b
- 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)
- class (ConstraintsB b, ProductB b) => ProductBC (b :: (k -> Type) -> Type) where
- buniqC :: forall c f b. (AllB c b, ProductBC b) => (forall a. c a => f a) -> b f
- bmempty :: forall f b. (AllBF Monoid f b, ProductBC b) => b f
- newtype Barbie (b :: (k -> Type) -> Type) f = Barbie {
- getBarbie :: b f
- data Void (f :: k -> Type)
- data Unit (f :: k -> Type) = Unit
- newtype Rec (p :: Type) a x = Rec {}
- 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
- bproof :: forall b c. (ProductBC b, AllB c b) => b (Dict c)
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 #
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 (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 # | |
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 t => (forall a. f a -> t (g a)) -> b f -> t (b g) Source #
btraverse :: (Applicative t, CanDeriveTraversableB b f g) => (forall a. f a -> t (g a)) -> b f -> t (b g) Source #
Instances
TraversableB (Proxy :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Internal.Traversable | |
TraversableB (Void :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Trivial | |
TraversableB (Unit :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Trivial | |
TraversableB (Const a :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Internal.Traversable | |
TraversableB b => TraversableB (Barbie b :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Internal.Instances | |
(TraversableB a, TraversableB b) => TraversableB (Sum a b :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Internal.Traversable | |
(TraversableB a, TraversableB b) => TraversableB (Product a b :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Internal.Traversable | |
(Traversable f, TraversableB b) => TraversableB (Compose f b :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Internal.Traversable |
Utility functions
btraverse_ :: (TraversableB b, Applicative t) => (forall a. f a -> t c) -> b f -> t () 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 f, TraversableB b) => b (Compose f g) -> f (b g) Source #
Evaluate each action in the structure from left to right, and collect the results.
bsequence' :: (Applicative f, TraversableB b) => b f -> f (b Identity) Source #
Product
class FunctorB b => ProductB (b :: (k -> Type) -> Type) where Source #
Barbie-types that can form products, subject to the laws:
bmap
(\(Pair
a _) -> a) .uncurry
bprod
=fst
bmap
(\(Pair
_ b) -> b) .uncurry
bprod
=snd
Notice that because of the laws, having an internal product structure is not enough to have a lawful instance. E.g.
data Ok f = Ok {o1 :: fString
, o2 :: fInt
} data Bad f = Bad{b1 :: fString
, hiddenFromArg:Int
} -- no lawful instance
Intuitively, the laws for this class require that b
hides no structure
from its argument f
. Because of this, if we are given any:
x :: forall a . f a
then this determines a unique value of type b f
, witnessed by the buniq
method.
For example:
buniq
x = Ok {o1 = x, o2 = x}
Formally, buniq
should satisfy:
const
(buniq
x) =bmap
(const
x)
There is a default implementation of bprod
and buniq
for Generic
types,
so instances can derived automatically.
Nothing
bprod :: b f -> b g -> b (f `Product` g) Source #
buniq :: (forall a. f a) -> b f Source #
bprod :: CanDeriveProductB b f g => b f -> b g -> b (f `Product` g) Source #
buniq :: CanDeriveProductB b f f => (forall a. f a) -> b f Source #
Utility functions
bunzip :: ProductB b => b (f `Product` g) -> (b f, b g) Source #
An equivalent of unzip
for Barbie-types.
bzipWith :: ProductB b => (forall a. f a -> g a -> h a) -> b f -> b g -> b h Source #
An equivalent of zipWith
for Barbie-types.
bzipWith3 :: ProductB b => (forall a. f a -> g a -> h a -> i a) -> b f -> b g -> b h -> b i Source #
An equivalent of zipWith3
for Barbie-types.
bzipWith4 :: ProductB 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
for Barbie-types.
Applicative-like interface
(/*) :: ProductB b => b f -> b (Prod fs) -> b (Prod (f ': fs)) infixr 4 Source #
Similar to /*/
but one of the sides is already a
.Prod
fs
Note that /*
, /*/
and uncurryn
are meant to be used together:
/*
and /*/
combine b f1, b f2...b fn
into a single product that
can then be consumed by using uncurryn
on an n-ary function. E.g.
f :: f a -> g a -> h a -> i abmap
(uncurryn
f) (bf/*
bg/*/
bh)
Constraints and instance 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 # | |
Utility functions
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
.
Products and constaints
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 #
Utility functions
buniqC :: forall c f b. (AllB c b, ProductBC b) => (forall a. c a => f a) -> b f Source #
Like buniq
but a constraint is allowed to be required on
each element of b
.
bmempty :: forall f b. (AllBF Monoid f b, ProductBC b) => b f Source #
Builds a b f
, by applying mempty
on every field of b
.
Wrapper
newtype Barbie (b :: (k -> Type) -> Type) f Source #
A wrapper for Barbie-types, providing useful instances.
Instances
FunctorB b => FunctorB (Barbie b :: (k -> Type) -> Type) Source # | |
TraversableB b => TraversableB (Barbie b :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Internal.Instances | |
ProductB b => ProductB (Barbie b :: (k -> Type) -> Type) Source # | |
ConstraintsB b => ConstraintsB (Barbie b :: (k -> Type) -> Type) Source # | |
ProductBC b => ProductBC (Barbie b :: (k -> Type) -> Type) Source # | |
(ProductBC b, AllBF Semigroup f b) => Semigroup (Barbie b f) Source # | |
(ProductBC b, AllBF Semigroup f b, AllBF Monoid f b) => Monoid (Barbie b f) Source # | |
type AllB (c :: k -> Constraint) (Barbie b :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Internal.Instances |
Trivial Barbies
data Void (f :: k -> Type) Source #
Uninhabited barbie type.
Instances
FunctorB (Void :: (k -> Type) -> Type) Source # | |
TraversableB (Void :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Trivial | |
ConstraintsB (Void :: (k -> Type) -> Type) Source # | |
Eq (Void f) Source # | |
Ord (Void f) Source # | |
Show (Void f) Source # | |
Generic (Void f) Source # | |
Semigroup (Void f) Source # | |
type AllB (c :: k -> Constraint) (Void :: (k -> Type) -> Type) Source # | |
type Rep (Void f) Source # | |
data Unit (f :: k -> Type) Source #
A barbie type without structure.
Instances
FunctorB (Unit :: (k -> Type) -> Type) Source # | |
TraversableB (Unit :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Trivial | |
ProductB (Unit :: (k -> Type) -> Type) Source # | |
ConstraintsB (Unit :: (k -> Type) -> Type) Source # | |
ProductBC (Unit :: (k -> Type) -> Type) Source # | |
Eq (Unit f) Source # | |
(Typeable f, Typeable k) => Data (Unit f) Source # | |
Defined in Data.Barbie.Trivial gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Unit f -> c (Unit f) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Unit f) # toConstr :: Unit f -> Constr # dataTypeOf :: Unit f -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Unit f)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Unit f)) # gmapT :: (forall b. Data b => b -> b) -> Unit f -> Unit f # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Unit f -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Unit f -> r # gmapQ :: (forall d. Data d => d -> u) -> Unit f -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Unit f -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Unit f -> m (Unit f) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Unit f -> m (Unit f) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Unit f -> m (Unit f) # | |
Ord (Unit f) Source # | |
Read (Unit f) Source # | |
Show (Unit f) Source # | |
Generic (Unit f) Source # | |
Semigroup (Unit f) Source # | |
Monoid (Unit f) Source # | |
type AllB (c :: k -> Constraint) (Unit :: (k -> Type) -> Type) Source # | |
type Rep (Unit f) Source # | |
Generic derivations
newtype Rec (p :: Type) a x Source #
Instances
GConstraintsB (c :: k3 -> Constraint) (f :: k2 -> Type) (Rec a a :: Type -> Type) (Rec a a :: k1 -> Type) (Rec a a :: k1 -> Type) Source # | |
Defined in Data.Barbie.Internal.Constraints | |
GFunctorB (f :: k2 -> Type) (g :: k2 -> Type) (Rec x x :: k1 -> Type) (Rec x x :: k1 -> Type) Source # | |
GTraversableB (f :: k2 -> Type) (g :: k2 -> Type) (Rec a a :: k1 -> Type) (Rec a a :: k1 -> Type) Source # | |
Defined in Data.Barbie.Internal.Traversable gbtraverse :: Applicative t => (forall (a0 :: k). f a0 -> t (g a0)) -> Rec a a x -> t (Rec a a x) Source # | |
GAllBC (Rec a a :: Type -> Type) Source # | |
Defined in Data.Barbie.Internal.Constraints type GAllB c (Rec a a) :: Constraint Source # | |
repbi ~ repbb => GBareB (Rec repbi repbi :: Type -> Type) (Rec repbb repbb :: Type -> Type) Source # | |
type GAllB (c :: k -> Constraint) (Rec a a :: Type -> Type) Source # | |
Defined in Data.Barbie.Internal.Constraints |
Deprecations
type ConstraintsOf c f b = AllBF c f b Source #
Deprecated: Renamed to AllBF (now based on AllB)