How can I use overloaded record fields with lenses?

Question

It's possible to mix classes with lenses to simulate overloaded record fields, up to a point. See, for example, makeFields in Control.Lens.TH. I'm trying to figure out if there's a nice way to reuse the same name as a lens for some types and a traversal for others. Notably, given a sum of products, each product can have lenses, which will degrade to traversals of the sum. The simplest thing I could think of was this**:

First try

class Boo booey where
  type Con booey :: (* -> *) -> Constraint
  boo :: forall f . Con booey f => (Int -> f Int) -> booey -> f booey

This works fine for simple things, like

data Boop = Boop Int Char
instance Boo Boop where
  type Con Boop = Functor
  boo f (Boop i c) = (\i' -> Boop i' c) <$> f i

But it falls on its face as soon as you need anything more complicated, like

instance Boo boopy => Boo (Maybe boopy) where

which should be able to produce a Traversal regardless of the choice of underlying Boo.

Second try

The next thing I tried, which sort of works, is to constrain the Con family. This gets kind of gross. First, change the class:

class LTEApplicative c where
  lteApplicative :: Applicative a :- c a

class LTEApplicative (Con booey) => Boo booey where
  type Con booey :: (* -> *) -> Constraint
  boo :: forall f . Con booey f => (Int -> f Int) -> booey -> f booey

This makes Boo instances carry around explicit evidence that their boo produces a Traversal' booey Int. Some more stuff:

instance LTEApplicative Applicative where
  lteApplicative = Sub Dict

instance LTEApplicative Functor where
  lteApplicative = Sub Dict

-- flub :: Boo booey => Traversal booey booey Int Int
flub :: forall booey f . (Boo booey, Applicative f) => (Int -> f Int) -> booey -> f booey
flub = case lteApplicative of
         Sub (Dict :: Dict (Con booey f)) -> boo

instance Boo boopy => Boo (Maybe boopy) where
  type Con (Maybe boopy) = Applicative
  boo _ Nothing = pure Nothing
  boo f (Just x) = Just <$> hum f x
    where hum :: Traversal' boopy Int
          hum = flub

And the base Boop example works unchanged.

Why this still sucks

We now have boo producing a Lens or Traversal under appropriate circumstances, and we can always use it as a Traversal, but every time we want to do so, we have to first drag in the evidence that it really is one. This is, of course, far too inconvenient for the purpose of implementing overloaded record fields! Is there any nicer way?

** This code compiles with the following (may not be minimal):

{-# LANGUAGE PolyKinds, TypeFamilies,
     TypeOperators, FlexibleContexts,
     ScopedTypeVariables, RankNTypes,
     KindSignatures #-}

import Control.Lens
import Data.Constraint

Answer 1

The following has worked for me before:

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

import Control.Lens

data Boop = Boop Int Char deriving (Show)

class HasBoo f s where
  boo :: LensLike' f s Int

instance Functor f => HasBoo f Boop where
  boo f (Boop a b) = flip Boop b <$> f a

instance (Applicative f, HasBoo f s) => HasBoo f (Maybe s) where
  boo = traverse . boo

It can be also scaled to polymorphic fields, if we make sure to enforce all the relevant functional dependencies (just like here). Leaving an overloaded field completely polymorphic is rarely useful or a good idea; I illustrate that case though because from there one can always monomorphize as necessary (or we can constrain polymorphic fields, for example a name field to IsString).

{-# LANGUAGE
  UndecidableInstances, MultiParamTypeClasses,
  FlexibleInstances, FunctionalDependencies, TemplateHaskell #-}

import Control.Lens

data Foo a b = Foo {_fooFieldA :: a, _fooFieldB :: b} deriving Show

makeLenses ''Foo

class HasFieldA f s t a b | s -> a, t -> b, s b -> t, t a -> s where
  fieldA :: LensLike f s t a b

instance Functor f => HasFieldA f (Foo a b) (Foo a' b) a a' where
  fieldA = fooFieldA

instance (Applicative f, HasFieldA f s t a b) => HasFieldA f (Maybe s) (Maybe t) a b where
  fieldA = traverse . fieldA

One can also go a bit wild and use a single class for all "has" functionality:

{-# LANGUAGE
  UndecidableInstances, MultiParamTypeClasses,
  RankNTypes, TypeFamilies, DataKinds,
  FlexibleInstances, FunctionalDependencies,
  TemplateHaskell #-}

import Control.Lens hiding (has)
import GHC.TypeLits
import Data.Proxy

class Has (sym :: Symbol) f s t a b | s sym -> a, sym t -> b, s b -> t, t a -> s where
  has' :: Proxy sym -> LensLike f s t a b

data Foo a = Foo {_fooFieldA :: a, _fooFieldB :: Int} deriving Show
makeLenses ''Foo

instance Functor f => Has "fieldA" f (Foo a) (Foo a') a a' where
  has' _ = fooFieldA

With GHC 8, one can add

{-# LANGUAGE TypeApplications #-}

and avoid the proxies:

has :: forall (sym :: Symbol) f s t a b. Has sym f s t a b => LensLike f s t a b
has = has' (Proxy :: Proxy sym)

instance (Applicative f, Has "fieldA" f s t a b) => Has "fieldA" f (Maybe s) (Maybe t) a b where
  has' _ = traverse . has @"fieldA"

Examples:

> Just (Foo 0 1) ^? has @"fieldA"
Just 0
> Foo 0 1 & has @"fieldA" +~ 10
Foo {_fooFieldA = 10, _fooFieldB = 1}