| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Data.Barbie
Contents
Description
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 :: f String
, age :: f Int
}
b1 :: Barbie Last -- Barbie with a monoid structure
b2 :: Barbie (Const a) -- Container Barbie
b3 :: Barbie Identity -- 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 :: f String
, age :: f Int
}
deriving
( Generic
, FunctorB, TraversableB, ProductB, ConstraintsB, ProductBC
)
deriving instance AllBF Show f Barbie => Show (Barbie f)
deriving instance AllBF 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:
bmapid=idbmapf .bmapg =bmap(f . g)
There is a default bmap implementation for Generic types, so
instances can derived automatically.
Minimal complete definition
Nothing
Methods
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 .btraversef =btraverse(t . f) -- naturalitybtraverseIdentity=Identity-- identitybtraverse(Compose.fmapg . f) =Compose.fmap(btraverseg) .btraversef -- composition
There is a default btraverse implementation for Generic types, so
instances can derived automatically.
Minimal complete definition
Nothing
Methods
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(\(Paira _) -> a) .uncurrybprod=fstbmap(\(Pair_ b) -> b) .uncurrybprod=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 :: f String, o2 :: f Int}
data Bad f = Bad{b1 :: f String, 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(buniqx) =bmap(constx)
There is a default implementation of bprod and buniq for Generic types,
so instances can derived automatically.
Minimal complete definition
Nothing
Methods
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(uncurrynf) (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) 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 # | |
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 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.
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::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 #
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.
Constructors
| Unit |
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 Methods 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 Methods 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 Associated Types 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)