Safe Haskell | None |
---|---|
Language | Haskell2010 |
Deprecated: Use Data.Functor.Barbie or Barbies instead
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 ApplicativeB b => ProductB (b :: (k -> Type) -> Type) where
- type CanDeriveProductB b f g = (GenericN (b f), GenericN (b g), GenericN (b (f `Product` g)), GProductB f g (RepN (b f)) (RepN (b g)) (RepN (b (f `Product` g))))
- 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
- 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 e. (TraversableB b, ConstraintsB b, AllB c b, Applicative e) => (forall a. c a => f a -> e (g a)) -> b f -> e (b g)
- class (ConstraintsB b, ProductB b) => ProductBC (b :: (k -> Type) -> Type) where
- type CanDeriveProductBC c b = (GenericN (b (Dict c)), AllB c b ~ GAll 0 c (GAllRepB b), GProductBC c (GAllRepB b) (RepN (b (Dict c))))
- 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, ConstraintsB b, ApplicativeB 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 {}
- class GProductB (f :: k -> Type) (g :: k -> Type) repbf repbg repbfg where
- class GProductBC c repbx repbd where
- (/*/) :: ProductB b => b f -> b g -> b (Prod '[f, g])
- (/*) :: ProductB b => b f -> b (Prod fs) -> b (Prod (f ': fs))
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 #
Product
class ApplicativeB b => ProductB (b :: (k -> Type) -> Type) where Source #
Deprecated: Use ApplicativeB
Nothing
bprod :: b f -> b g -> b (f `Product` g) Source #
default bprod :: CanDeriveProductB b f g => b f -> b g -> b (f `Product` g) Source #
buniq :: (forall a. f a) -> b f Source #
Deprecated: Use bpure
default buniq :: CanDeriveProductB b f f => (forall a. f a) -> b f Source #
type CanDeriveProductB b f g = (GenericN (b f), GenericN (b g), GenericN (b (f `Product` g)), GProductB f g (RepN (b f)) (RepN (b g)) (RepN (b (f `Product` g)))) 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
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
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 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
.
Products and constaints
class (ConstraintsB b, ProductB b) => ProductBC (b :: (k -> Type) -> Type) where Source #
Nothing
Instances
ProductBC (Proxy :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Internal.ProductC | |
ProductBC (Unit :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Internal.ProductC | |
ProductBC b => ProductBC (Barbie b :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Internal.ProductC | |
(ProductBC a, ProductBC b) => ProductBC (Product a b :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Internal.ProductC |
type CanDeriveProductBC c b = (GenericN (b (Dict c)), AllB c b ~ GAll 0 c (GAllRepB b), GProductBC c (GAllRepB b) (RepN (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 #
Deprecated: Use bpureC instead
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
.
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 Barbies.Internal.Wrappers | |
ApplicativeB b => ApplicativeB (Barbie b :: (k -> Type) -> Type) Source # | |
ConstraintsB b => ConstraintsB (Barbie b :: (k -> Type) -> Type) Source # | |
ProductB b => ProductB (Barbie b :: (k -> Type) -> Type) Source # | |
ProductBC b => ProductBC (Barbie b :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Internal.ProductC | |
(ConstraintsB b, ApplicativeB b, AllBF Semigroup f b) => Semigroup (Barbie b f) Source # | |
(ConstraintsB b, ApplicativeB 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 Barbies.Internal.Wrappers |
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 Barbies.Internal.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 Barbies.Internal.Trivial | |
DistributiveB (Unit :: (k -> Type) -> Type) Source # | |
Defined in Barbies.Internal.Trivial | |
ApplicativeB (Unit :: (k -> Type) -> Type) Source # | |
ConstraintsB (Unit :: (k -> Type) -> Type) Source # | |
ProductB (Unit :: (k -> Type) -> Type) Source # | |
ProductBC (Unit :: (k -> Type) -> Type) Source # | |
Defined in Data.Barbie.Internal.ProductC | |
Eq (Unit f) Source # | |
(Typeable f, Typeable k) => Data (Unit f) Source # | |
Defined in Barbies.Internal.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 :: forall r r'. (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
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 |
class GProductB (f :: k -> Type) (g :: k -> Type) repbf repbg repbfg where Source #
gbprod :: Proxy f -> Proxy g -> repbf x -> repbg x -> repbfg x Source #
gbuniq :: (f ~ g, repbf ~ repbg) => Proxy f -> Proxy repbf -> Proxy repbfg -> (forall a. f a) -> repbf x Source #
Instances
GProductB (f :: k1 -> Type) (g :: k1 -> Type) (U1 :: k2 -> Type) (U1 :: k2 -> Type) (U1 :: k2 -> Type) Source # | |
(GProductB f g lf lg lfg, GProductB f g rf rg rfg) => GProductB (f :: k1 -> Type) (g :: k1 -> Type) (lf :*: rf :: k2 -> Type) (lg :*: rg :: k2 -> Type) (lfg :*: rfg :: k2 -> Type) Source # | |
Defined in Data.Barbie.Internal.Product | |
GProductB f g repf repg repfg => GProductB (f :: k1 -> Type) (g :: k1 -> Type) (M1 i c repf :: k2 -> Type) (M1 i c repg :: k2 -> Type) (M1 i c repfg :: k2 -> Type) Source # | |
Defined in Data.Barbie.Internal.Product |
class GProductBC c repbx repbd where Source #
Instances
GProductBC (c :: k1 -> Constraint) (U1 :: Type -> Type) (U1 :: k2 -> Type) Source # | |
(GProductBC c lx ld, GProductBC c rx rd) => GProductBC (c :: k1 -> Constraint) (lx :*: rx) (ld :*: rd :: k2 -> Type) Source # | |
GProductBC c repbx repbd => GProductBC (c :: k1 -> Constraint) (M1 i k3 repbx) (M1 i k3 repbd :: k2 -> Type) Source # | |
Deprecations
(/*) :: 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)