barbies-0.1.2.0: Classes for working with types that can change clothes.

Safe HaskellNone
LanguageHaskell2010

Data.Barbie

Contents

Description

A common Haskell idiom is to parameterise a datatype by a type * -> *, 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, ProofB
    )

deriving instance ConstraintsOf Show f Barbie => Show Barbie
deriving instance ConstraintsOf Eq   f Barbie => Eq   Barbie

Sometimes one wants to use Barbie Identity and it may feels lik a second-class record type, where one needs to unpack values in each field. For those cases, we can leverage on closed type-families ang get the best of both worlds:

data Bare

type family Wear f a where
  Wear Bare a = a
  Wear f      a = f a

data SignUpForm f
  = SignUpForm'
      { username  :: Wear f String,
      , password  :: Wear f String
      , mailingOk :: Wear f Boolean
      }
  deriving ( ..., BareB)

type SignUpRaw  = SignUpForm Maybe
type SignUpData = SignUpForm Bare

formData = SignUpForm "jbond" "shaken007" False :: SignUpData

Synopsis

Functor

class FunctorB b 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.

Methods

bmap :: (forall a. f a -> g a) -> b f -> b g Source #

bmap :: CanDeriveGenericInstance b => (forall a. f a -> g a) -> b f -> b g Source #

Instances

FunctorB b => FunctorB (Barbie b) Source # 

Methods

bmap :: (forall a. f a -> g a) -> Barbie b f -> Barbie b g Source #

Traversable

class FunctorB b => TraversableB b where Source #

Barbie-types that can be traversed from left to right. Instances should satisfy the following laws:

 t . btraverse f = btraverse (t . f)  -- naturality
btraverse Identity = Identity         -- identity
btraverse (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.

Methods

btraverse :: Applicative t => (forall a. f a -> t (g a)) -> b f -> t (b g) Source #

btraverse :: (Applicative t, CanDeriveGenericInstance b) => (forall a. f a -> t (g a)) -> b f -> t (b g) Source #

Instances

TraversableB b => TraversableB (Barbie b) Source # 

Methods

btraverse :: Applicative t => (forall a. f a -> t (g a)) -> Barbie b f -> t (Barbie b g) Source #

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.

Product

class FunctorB b => ProductB b where Source #

Barbie-types that can form products, subject to the laws:

bmap (Pair a _) . uncurry . bprod = fst
bmap (Pair _ 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 :: f String, o2 :: f Int}        -- has an instance
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, any x :: forall a . f a determines a unique value of b f, witnessed by the buniq method. Formally:

const (buniq x) = bmap (const x)

There is a default implementation of bprod and buniq for Generic types, so instances can derived automatically.

Methods

bprod :: b f -> b g -> b (Product f g) Source #

buniq :: (forall a. f a) -> b f Source #

bprod :: CanDeriveGenericInstance b => b f -> b g -> b (Product f g) Source #

buniq :: CanDeriveGenericInstance' b => (forall a. f a) -> b f Source #

Instances

ProductB b => ProductB (Barbie b) Source # 

Methods

bprod :: Barbie b f -> Barbie b g -> Barbie b (Product * f g) Source #

buniq :: (forall a. f a) -> Barbie b f Source #

(/*/) :: ProductB b => b f -> b g -> b (Prod '[f, g]) infixr 4 Source #

Like bprod, but returns a binary Prod, instead of Product, which composes better.

See /*/ for usage.

(/*) :: 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 a

bmap (uncurryn f) (bf /* bg /*/ bh)

bzip :: ProductB b => b f -> b g -> b (Product f g) Source #

An alias of bprod, since this is like a zip for Barbie-types.

bunzip :: ProductB b => b (Product f 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.

Bare values

type family Wear f a where ... Source #

The Wear type-function allows one to define a Barbie-type as

data B f
  = B { f1 :: Wear f Int
      , f2 :: Wear f Bool
      }

This way, one can use Bare as a phantom that denotes no functor around the typw:

B { f1 :: 5, f2 = True } :: B Bare

Equations

Wear Bare a = a 
Wear (Target f) a = Target (W f) a 
Wear f a = f a 

data Bare a Source #

Bare is the only type such that Wear Bare a ~ a'.

class FunctorB b => BareB b where Source #

Class of Barbie-types defined using Wear and can therefore have Bare versions. Must satisfy:

bcover . bstrip = id
bstrip . bcover = id

bstripFrom :: BareB b => (forall a. f a -> a) -> b f -> b Bare Source #

Generalization of bstrip to arbitrary functors

bcoverWith :: BareB b => (forall a. a -> f a) -> b Bare -> b f Source #

Generalization of bcover to arbitrary functors

Constraints and proofs of instance

class FunctorB b => ConstraintsB b where Source #

Instances of this class provide means to talk about constraints, both at compile-time, using ConstraintsOf and at run-time, in the form of class instance dictionaries, via adjProof.

A manual definition would look like this:

data T f = A (f Int) (f String) | B (f Bool) (f Int)

instance ConstraintsB T where
  type ConstraintsOf c f T
    = (c (f Int), c (f String), c (f Bool))

  adjProof t = case t of
    A x y -> A (Pair (packDict x) (packDict y))
    B z w -> B (Pair (packDict z) (packDict w))

There is a default implementation of ConstraintsOf for Generic types, so in practice one will simply do:

derive instance Generic T
instance ConstraintsB T

Associated Types

type ConstraintsOf (c :: * -> Constraint) (f :: * -> *) b :: Constraint Source #

ConstraintsOf c f b should contain a constraint c (f x) for each f x occurring in b. E.g.:

ConstraintsOf Show f Barbie = (Show (f String), Show (f Int))

Methods

adjProof :: forall c f. ConstraintsOf c f b => b f -> b (Product (DictOf c f) f) Source #

Adjoint a proof-of-instance to a barbie-type.

adjProof :: forall c f. (CanDeriveGenericInstance b, ConstraintsOfMatchesGenericDeriv c f b, ConstraintsOf c f b) => b f -> b (Product (DictOf c f) f) Source #

Adjoint a proof-of-instance to a barbie-type.

Instances

ConstraintsB b => ConstraintsB (Barbie b) Source # 

Associated Types

type ConstraintsOf (c :: * -> Constraint) (f :: * -> *) (Barbie b :: (* -> *) -> *) :: Constraint Source #

Methods

adjProof :: ConstraintsOf c f (Barbie b) => Barbie b f -> Barbie b (Product * (DictOf c f) f) Source #

class (ConstraintsB b, ProductB b) => ProofB b where Source #

Barbie-types with products have a canonical proof of instance.

There is a default bproof implementation for Generic types, so instances can derived automatically.

Instances

ProofB b => ProofB (Barbie b) Source # 

Methods

bproof :: ConstraintsOf c f (Barbie b) => Barbie b (DictOf c f) Source #

Wrapper

newtype Barbie b (f :: * -> *) Source #

A wrapper for Barbie-types, providing useful instances.

Constructors

Barbie 

Fields

Instances

FunctorB b => FunctorB (Barbie b) Source # 

Methods

bmap :: (forall a. f a -> g a) -> Barbie b f -> Barbie b g Source #

TraversableB b => TraversableB (Barbie b) Source # 

Methods

btraverse :: Applicative t => (forall a. f a -> t (g a)) -> Barbie b f -> t (Barbie b g) Source #

ConstraintsB b => ConstraintsB (Barbie b) Source # 

Associated Types

type ConstraintsOf (c :: * -> Constraint) (f :: * -> *) (Barbie b :: (* -> *) -> *) :: Constraint Source #

Methods

adjProof :: ConstraintsOf c f (Barbie b) => Barbie b f -> Barbie b (Product * (DictOf c f) f) Source #

BareB b => BareB (Barbie b) Source # 
ProductB b => ProductB (Barbie b) Source # 

Methods

bprod :: Barbie b f -> Barbie b g -> Barbie b (Product * f g) Source #

buniq :: (forall a. f a) -> Barbie b f Source #

ProofB b => ProofB (Barbie b) Source # 

Methods

bproof :: ConstraintsOf c f (Barbie b) => Barbie b (DictOf c f) Source #

(ProofB b, ConstraintsOf Semigroup f b) => Semigroup (Barbie b f) Source # 

Methods

(<>) :: Barbie b f -> Barbie b f -> Barbie b f #

sconcat :: NonEmpty (Barbie b f) -> Barbie b f #

stimes :: Integral b => b -> Barbie b f -> Barbie b f #

(ProofB b, ConstraintsOf Monoid f b) => Monoid (Barbie b f) Source # 

Methods

mempty :: Barbie b f #

mappend :: Barbie b f -> Barbie b f -> Barbie b f #

mconcat :: [Barbie b f] -> Barbie b f #

type ConstraintsOf c f (Barbie b) Source # 
type ConstraintsOf c f (Barbie b) = ConstraintsOf c f b