5

This article by Chris Penner talks about "Witherable Optics"; Optics that can be used to filter items out from a structure.

The article uses the following "Van Laarhoven" representation for these optics:

type Wither s t a b = forall f. Alternative f => (a -> f b) -> s -> f t

Most (if not all) Van Laarhoven optics have an equivalent profunctor representation. For example Lens:

type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t 

Is equivalent to:

type Lens s t a b = forall p. Strong p => p a b -> p s t

Does Wither also have a Profuctor representation? And if so, what is it?

Joe
  • 1,479
  • 13
  • 22
  • 1
    Interesting question! My first thought was that it would just be `Choice` plus something else, that is, I think you want to filter by a `Prism`, but with some additional restrictions. For example, I don’t think you can return any elements that fail the predicate you’re filtering by, or else it’s not a valid `Traversal`. There might also be some relationship to indexed optics like [`At`](https://hackage.haskell.org/package/lens-4.19.2/docs/Control-Lens-At.html), too—I can see a filter as sort of “partitioning” a structure into two halves, those that pass the predicate and those that don’t. – Jon Purdy Nov 01 '20 at 20:47
  • 1
    Maybe [`Conjoined`](https://hackage.haskell.org/package/lens-4.19.2/docs/Control-Lens-Combinators.html#t:Conjoined) and [`indices`](https://hackage.haskell.org/package/lens-4.19.2/docs/Control-Lens-Combinators.html#v:indices) are relevant? – Jon Purdy Nov 01 '20 at 21:15

1 Answers1

2

Chris here; here's my swing at the profunctor optics representation:

Here's the profunctor class:

import Data.Profunctor
import Data.Profunctor.Traversing
import Control.Applicative

class (Traversing p) => Withering p where
  cull :: (forall f. Alternative f => (a -> f b) -> (s -> f t)) -> p a b -> p s t

instance Alternative f => Withering (Star f) where
  cull f (Star amb) = Star (f amb)

instance Monoid m => Withering (Forget m) where
  cull f (Forget h) = Forget (getAnnihilation . f (AltConst . Just . h))
    where
      getAnnihilation (AltConst Nothing) = mempty
      getAnnihilation (AltConst (Just m)) = m

newtype AltConst a b = AltConst (Maybe a)
  deriving stock (Eq, Ord, Show, Functor)

instance Monoid a => Applicative (AltConst a) where
  pure _ = (AltConst (Just mempty))
  (AltConst Nothing) <*> _ = (AltConst Nothing)
  _ <*> (AltConst Nothing) = (AltConst Nothing)
  (AltConst (Just a)) <*> (AltConst (Just b)) = AltConst (Just (a <> b))

instance (Semigroup a) => Semigroup (AltConst a x) where
  (AltConst Nothing) <> _ = (AltConst Nothing)
  _ <> (AltConst Nothing) = (AltConst Nothing)
  (AltConst (Just a)) <> (AltConst (Just b)) = AltConst (Just (a <> b))

instance (Monoid a) => Monoid (AltConst a x) where
  mempty = (AltConst (Just mempty))

instance Monoid m => Alternative (AltConst m) where
  empty = (AltConst Nothing)
  (AltConst Nothing) <|> a = a
  a <|> (AltConst Nothing) = a
  (AltConst (Just a)) <|> (AltConst (Just b)) = (AltConst (Just (a <> b)))

If you're interested in some of the optics that arise, I've implemented a few of those here:

It's definitely possible there are other interpretations or perhaps some simpler representation, but at the moment this seems to do the trick. If anyone else has other ideas I'd love to see them!

Happy to chat about it more if you have any other questions!

Chris Penner
  • 1,881
  • 11
  • 15
  • Having a typeclass method "lift" the Van Laarhoven representation onto the profunctor representation is a pretty nifty trick! – Joe Nov 01 '20 at 23:10
  • 1
    Indeed! It makes the comparison pretty easy, take a look at [wander](https://hackage.haskell.org/package/profunctors-5.6/docs/Data-Profunctor-Traversing.html#v:wander) from Traversing; note that they have an "equivalent" implementation in terms of `traverse'`. We could do the same with `wither'` IF we wanted to take on a Witherable or Compactable dependency, but `cull` works fine on its own, you can always implement `wither'` using `cull` later on. – Chris Penner Nov 01 '20 at 23:14