bzipWithCF

[gergoerdi]

I'd like to write the following function:

type Mask b = b Covered (Const Bool)

mask :: (BareB b, ApplicativeB (b Covered), _ctx) => Mask b -> b Covered f -> b Covered f
mask keep = bzipWith mask1 keep
  where
    mask1 :: (Monoid m) => Const Bool a -> m -> m
    mask1 (Const keep) x = if keep then x else mempty

So here, I think a sensible solution for _ctx would be to require that all fields of f a of b Covered have a Monoid (f a) instance, i.e. that we have AllBF Monoid f (b Covered). But just using bzipWith, or bzipWithC, doesn't propagate this constraint to the per-leaf function.

I think it would make sense to have an AllBF-based version of bzipWithC, something with the following type:

bzipWithCF 
    :: (AllBF c1 f b, AllBF c2 g b, ConstraintsB b, ApplicativeB b) 
    => (forall a. (c1 (f a), c2 (g a)) => f a -> g a -> h a) 
    -> b f -> b g -> b h

What do you think?

[gergoerdi]

I just realized that for this particular instance, one can do this:

type Mask b = b Covered (Const Bool)

mask
    :: (BareB b, ApplicativeB (b Covered), ConstraintsB (b Covered), AllBF Monoid f (b Covered))
    => Mask b -> b Covered f -> b Covered f
mask = bzipWith3 mask1 bmempty
  where
    mask1 :: f a -> Const Bool a -> f a -> f a
    mask1 empty (Const keep) x = if keep then x else empty

So basically we zip with an extra skeleton of evidence. However, I'm not sure how well this would generalize -- bmempty has an easy time because the only evidence we need per leaf is a single mempty : : f a.

[gergoerdi]

One might think we can use bzipWithC with ClassF, but nope: (I have also gotten rid of the BareB noise, which was just because of my specific use case):

mask :: (ApplicativeB b, ConstraintsB b, AllBF Monoid f b) => b (Const Bool) -> b f  -> b f
mask = bzipWithC mask1
  where
    mask1 :: (ClassF Monoid f a) => Const Bool a -> f a -> f a
    mask1 (Const keep) x = if keep then x else mempty

This results in:

    • Overlapping instances for ClassF Monoid f a
        arising from a use of ‘mask1’
      Matching instances:
        instance [safe] forall k1 k2 (c :: k1 -> Constraint)
                               (f :: k2 -> k1) (a :: k2).
                        c (f a) =>
                        ClassF c f a
          -- Defined in ‘barbies-2.0.1.0:Barbies.Internal.Dicts’
      There exists a (perhaps superclass) match:
        from the context: (ApplicativeB b, ConstraintsB b,
                           AllBF Monoid f b)
          bound by the type signature for:
                     mask :: forall k2 (b :: (k2 -> Type) -> Type) (f :: k2 -> Type).
                             (ApplicativeB b, ConstraintsB b, AllBF Monoid f b) =>
                             b (Const Bool) -> b f -> b f
          at CPU.hs:52:1-91
        or from: c0 a
          bound by a type expected by the context:
                     forall (a :: k2). c0 a => Const Bool a -> f a -> f a
          at CPU.hs:53:18-22
      (The choice depends on the instantiation of ‘f, k2, a’
       To pick the first instance above, use IncoherentInstances
       when compiling the other instance declarations)
    • In the first argument of ‘bzipWithC’, namely ‘mask1’
      In the expression: bzipWithC mask1

[gergoerdi]

So basically we zip with an extra skeleton of evidence. However, I'm not sure how well this would generalize -- bmempty has an easy time because the only evidence we need per leaf is a single mempty : : f a.

Actually, turns out this approach does generalize rather nicely! Consider:

bdict :: forall b f c. (ApplicativeB b, ConstraintsB b, AllB (ClassF c f) b) => b (Dict (ClassF c f))
bdict = bpureC @(ClassF c f) Dict

mask :: (ApplicativeB b, ConstraintsB b, AllBF Monoid f b) => b (Const Bool) -> b f  -> b f
mask = bzipWith3 mask1 bdict
  where
    mask1 :: Dict (ClassF Monoid f) a -> Const Bool a -> f a -> f a
    mask1 Dict (Const keep) x = if keep then x else mempty

[gergoerdi]

Never mind, I just had a case of the dumb:

mask :: forall b f. (ApplicativeB b, ConstraintsB b, AllBF Monoid f b) => b (Const Bool) -> b f  -> b f
mask = bzipWithC @(ClassF Monoid f) mask1
  where
    mask1 :: (ClassF Monoid f a) => Const Bool a -> f a -> f a
    mask1 (Const keep) x = if keep then x else mempty