How to simplify calling a field on a polymorphic field name into one typeclass

Question

In a previous question I asked how a record field can be made polymorphic when using DuplicateRecordFields. I got an excellent answer for this from @user2407038. He answered the question to my initial spec providing one type class per field, but he mentioned that it could all be simplified into one typeclass.

(Note: this too can be generalized to a single class with an additional parameter corresponding to the field name; this is probably outside the scope of this question).

I'm not sure how to go about doing this generalization. Does anybody have any ideas on how this can accomplished?

Answer 1

Defining such a class is easy enough

-- s has a field named field of type a and setting it to b turns the s into a t
class HasLens field s t a b | field s -> a, field t -> b, field s b -> t, field t a -> s where
  -- Fundeps are pretty common sense, and also appear in the library linked in the comments
  lensOf :: Functor f => (a -> f b) -> s -> f t
  -- Not sure why the library linked above includes f in the class head...

You'll notice that field appears nowhere in lensOf's type, so this class would be unusable as is, because the inferencer can never figure out what it should be. You have these options:

Old:

class HasLens name s t a b | ... where
  lensOf :: Functor f => Proxy name -> (a -> f b) -> s -> f t
  -- Or Proxy#, which has no runtime overhead, or forall proxy. Functor f => proxy name -> ...

The Proxy argument is a dummy; it is never used for anything except telling the compiler about name. Usage is unbearably ugly, though:

lensOf (Proxy :: Proxy "field")
-- or proxy#, or undefined

New:

{-# LANGUAGE AllowAmbiguousTypes, TypeApplications #-}

Now you use explicit type applications to set name at the call site (also make sure that name is first in the class head, or else the order of type arguments will get messed up).

lensOf @"field"

Fuller example:

{-# LANGUAGE AllowAmbiguousTypes
           , DataKinds
           , FlexibleContexts
           , FlexibleInstances
           , FunctionalDependencies
           , NoMonomorphismRestriction
           , PolyKinds
           , ScopedTypeVariables
           , TypeApplications
#-}

import Control.Lens

class HasLens x s t a b | x s -> a, x t -> b, x s b -> t, x t a -> s where
  lensOf :: Functor f => (a -> f b) -> s -> f t

data Tup2 a b = Tup2 { _left2 :: a, _right2 :: b } deriving Show
data Tup3 a b c = Tup3 { _left3 :: a, _middle3 :: b, _right3 :: c } deriving Show

instance HasLens "left" (Tup2 a b) (Tup2 a' b) a a' where
  lensOf = lens _left2 $ \t x -> t { _left2 = x }

instance HasLens "left" (Tup3 a b c) (Tup3 a' b c) a a' where
  lensOf = lens _left3 $ \t x -> t { _left3 = x }

instance HasLens "right" (Tup2 a b) (Tup2 a b') b b' where
  lensOf = lens _right2 $ \t x -> t { _right2 = x }

instance HasLens "right" (Tup3 a b c) (Tup3 a b c') c c' where
  lensOf = lens _right3 $ \t x -> t { _right3 = x }

swap' :: forall xlr xrl l r xll xrr. (HasLens "left" xlr xrr l r, HasLens "right" xlr xll r l, HasLens "left" xll xrl l r, HasLens "right" xrr xrl r l) => xlr -> xrl
swap' x = x & lensOf @"left"  .~ x^#lensOf @"right" @xlr @xll @r @l
            & lensOf @"right" .~ x^#lensOf @"left"  @xlr @xrr @l @r

main = do out $ Tup2 5 6
          out $ Tup3 'l' 'm' 'r'
          out $ Tup2 "l" 'r'
          out $ Tup3 17 [5,10] "a"
  where out = print . swap'