How to apply the same lens on two different records? (or, record field-names as first-class values?)

Question

Consider the following records and their lenses:

data Bar = Bar {barField1 :: Int, barField2 :: String}
makeLensesWith abbreviatedFields ''Bar

data BarError = BarError {barerrField1 :: [String], barerrField2 :: [String]}
makeLensesWith abbreviatedFields ''BarError

Now, both of them have access to the lenses field1 & field2 by virtue of implementing the HasField1 and HasField2 type-classes. However, I am unable to get the following piece of code to compile:

-- Most-general type-signature inferred by the compiler, if I remove the
-- KindSignatures from `record` & `errRecord` below:
--
-- validateLength :: (IsString a) => (Int, Int) -> ALens t t [a] [a] -> t -> t -> t
-- 
validateLength (mn, mx) l (record :: Bar)  (errRecord :: BarErr) =
  let len = length (record ^# l)
  in if ((len<mn) || (len>mx))
  then errRecord & l #%~ (\x -> ("incorrect length"):x)
  else errRecord

-- Usage scenario:
--
-- let x = Bar 10 "hello there"
--     xErr = BarError [] []
-- in validateLength (3, 10) field2 x xErr

Error message:

/Users/saurabhnanda/projects/vl-haskell/src/TryLens.hs:18:20: error:
    • Couldn't match type ‘BarError’ with ‘Bar’
      Expected type: BarError -> BarError
        Actual type: Bar -> BarError
    • In the second argument of ‘(&)’, namely
        ‘l #%~ (\ x -> ("incorrect length") : x)’
      In the expression:
        errRecord & l #%~ (\ x -> ("incorrect length") : x)
      In the expression:
        if ((len < mn) || (len > mx)) then
            errRecord & l #%~ (\ x -> ("incorrect length") : x)
        else
            errRecord

Note: Instead of using ^. and %~ I'm using ^# and #%~ because I'd like to treat the lens (l) as a getter & setter simultaneously.

Edit: A simpler snippet to demonstrate the problem is:

-- intended type signature:
-- funkyLensAccess :: l -> r1 -> r2 -> (t1, t2)
--
-- type signature inferred by the compiler
-- funkyLensAccess :: Getting t s t -> s -> s -> (t, t)
--
funkyLensAccess l rec1 rec2 = (rec1 ^. l, rec2 ^. l)

Answer 1

So essentially your problem has nothing to do with lenses, but with (accessor-) functions that can operate on different types, for each giving a different-typed result.

That immediately means trouble: if the accessed-field type is supposed to depend on the containing-struct type, this is a dependent type. Haskell is not a dependently-typed language. It's the kind of task you can easily do in e.g. Python by calling a field by name (in form of a string) and then operating on the field via duck typing, but Haskell erases such expensive information as record label strings at runtime for very good reasons, and of course the compiler needs to know all the types so they can't be duck-inferred at runtime. In that sense, what you're asking is simply not possible.

Or is it? GHC actually has become pretty good at dependent types. It has been possible for quite some time now to handle non-type-specific labels as type-level string values, called Symbols. And very recently, there has been work on allowing fields of any record to be accessed by name, i.e. much like in Python but all at compile time, with whatever type is contained in the field.

The essential thing is that you need to express the type-level function mapping a record-label and a record-type to a type of contained element. This is expressed by the HasField class.

{-# LANGUAGE DataKinds, KindSignatures, FlexibleInstances, FlexibleContexts, FunctionalDependencies, ScopedTypeVariables, UnicodeSyntax, TypeApplications, AllowAmbiguousTypes #-}

import GHC.Records
import GHC.TypeLits (Symbol)

data Bar = Bar {barField1 :: Int, barField2 :: String}

data BarError = BarError {barerrField1 :: [String], barerrField2 :: [String]}
 deriving (Show)

type LensOn s a = (a, a -> s)  -- poor man's lens focus

instance HasField "Field2" Bar (LensOn Bar String) where
  getField (Bar i s) = (s, \s' -> Bar i s')

instance HasField "Field2" BarError (LensOn BarError [String]) where
  getField (BarError f₁ f₂) = (f₂, \f₂' -> BarError f₁ f₂')

validateLength :: ∀ (f :: Symbol)
                      . ( HasField f Bar (LensOn Bar String)
                        , HasField f BarError (LensOn BarError [String]) )
    => (Int,Int) -> Bar -> BarError -> BarError
validateLength (mn,mx) record errRecord
    = let len = length . fst $ getField @f record
      in if len < mn || len > mx
          then case getField @f errRecord of
                 (oldRec, setRec) -> setRec $ "incorrect length" : oldRec
          else errRecord

main :: IO ()
main = let x = Bar 10 "hello there"
           xErr = BarError [] []
       in print $ validateLength @"Field2" (3,10) x xErr

Tested with GHC-8.3.20170711, probably doesnt' work with significantly older versions.

Answer 2

If you want a value passed as an argument to operate at two different types, you'll need Rank2Types (or the equivalent RankNTypes) extension.

Then, since rank-2 or higher types are never inferred in GHC, you'll need to write the type signature explicitly.

Our first pass might look something like: IsString a => (Int, Int) -> (forall s a. Lens' s a) -> Bar -> BarError -> BarError But, that's way too general for that second argument, so general I tend to doubt a non-bottom value of that type exists. We certainly can't pass field1 or field2 there.

Since we want to pass field1 or field2 we need something that unifies their types: HasField1 s a => Lens' s a and HasField2 s a => Lens' s a. Unfortunately, since HasField1 and HasField2 do not share (or have) any super classes, the only type that unifies these the the type given in the last paragraph.

Note that even if HasField1 and HasField2 shared a super class, we still wouldn't be done. Your implementation also requires that the field in Bar be a Foldable and that the field in BarError be a list of IsString. Expressing those constraints is possible, but not exactly user-friendly.