Lenses and TypeFamilies

Question

I've encountered a problem of using Control.Lens together with
datatypes while using the -XTypeFamilies GHC pragma.

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies    #-}

import Control.Lens (makeLenses)

class SomeClass t where
  data SomeData t :: * -> *

data MyData = MyData Int

instance SomeClass MyData where
  data SomeData MyData a = SomeData {_a :: a, _b :: a}

makeLenses ''SomeData

The error message is: reifyDatatype: Use a value constructor to reify a data family instance.

Is there any way to overcome it, maybe using some functional from Control.Lens?

I guess `lens` package can't implement lenses for associated data families. I found similar issue report for `microlens` library (this library uses the same `makeLenses` function): https://github.com/aelve/microlens/issues/93 So probably no luck here. I suggest you to create issue in `lens` github repository. Or you can create your own `-XTemplateHaskell` macro for generating lenses specifically for your case... — Shersh, Dec 22 '17 at 20:16

leftaroundabout · Answer 1 · 2017-12-22T19:56:53.543

3

The most sensible thing would be to just define those lenses yourself... it's not like it's very difficult:

a, b :: Lens' (SomeData MyData a) a
a = lens _a (\s a' -> s{_a=a'})
b = lens _b (\s b' -> s{_b=b'})

or even

a, b :: Functor f => (a -> f a) -> SomeData MyData a -> f (SomeData MyData a)
a f (SomeData a₀ b₀) = (`SomeData`b₀) <$> f a₀
b f (SomeData a₀ b₀) =   SomeData a₀  <$> f b₀

...which doesn't use anything from the lens library at all, but is fully compatible to all lens combinators.

edited Dec 22 '17 at 19:56

answered Dec 22 '17 at 19:52

leftaroundabout

117,950
5
174
319

Unfortunately, it's not the solution for my case. It is assumed that datatypes may contain much more fields. – errfrom Dec 22 '17 at 19:56
1

If it's so many fields that you can't afford a single line to define a lens for each, then I seriously question that it's a clever idea to define it as a monolithic data structure. If you just find the repetion ugly – ok, but that can be addressed with a simple CPP macro. – leftaroundabout Dec 22 '17 at 20:58
@errfrom This works regardless of how many fields your datatypes have. Unless you're generating these datatypes and *need* to derive the lenses automatically, this just just a matter of a modicum of tedium. – Cubic Dec 22 '17 at 20:58
1

I don't think it's just tedium that is the issue; this is code duplication that can lead to many bugs, and has all the issues that boilerplate has. – Justin L. Mar 23 '18 at 04:04

score 1 · Answer 2 · answered Dec 23 '17 at 12:44

tfMakeLenses generates setters of type t a -> a -> t a for associated datatypes.
There are some places this function can be improved, but it works!

tfMakeLenses :: Name -> DecsQ
tfMakeLenses t = do
  fieldNames <- tfFieldNames t
  let associatedFunNames = associateFunNames fieldNames
  return (map createLens associatedFunNames)
  where createLens :: (Name, Name) -> Dec
        createLens (funName, fieldName) =
          let dtVar  = mkName "dt"
              valVar = mkName "newValue"
              body   = NormalB (LamE [VarP valVar] (RecUpdE (VarE dtVar) [(fieldName, VarE valVar)]))
          in FunD funName [(Clause [VarP dtVar] body [])]

        associateFunNames :: [Name] -> [(Name, Name)]
        associateFunNames [] = []
        associateFunNames (fieldName:xs) = ((mkName . tail . nameBase) fieldName, (mkName . nameBase) fieldName)
                                         : associateFunNames xs

        tfFieldNames t = do
          FamilyI _ ((DataInstD _ _ _ _ ((RecC _ fields):_) _):_) <- reify t
          let fieldNames = flip map fields $ \(name, _, _) -> name
          return fieldNames

Setters, or lenses? Your remark is a bit confusing. Also, your code needs much more explanation to be a proper answer! — dfeuer, Dec 23 '17 at 22:47
@dfeuer It doesn't play a major role here and can be easily adapted for generating lenses instead of pure setters. But yes, you're absolutely right - this answer could be improved. I'm going to do that after a while =) — errfrom, Dec 23 '17 at 23:57

Ahmad B · Answer 3 · 2021-02-08T17:04:51.523

This answer is an adaptation of errfrom's original answer with a bit more details. The function below also creates lenses, rather than just setters.

tfMakeLenses generates lenses of type Lens' s a, or by definition, (a -> f a) -> s -> f s for associated datatypes.

{-# TemplateHaskell #-}
import Control.Lens.TH
import Language.Haskell.TH.Syntax

tfMakeLenses typeFamilyName = do
  fieldNames <- tfFieldNames typeFamilyName
  let associatedFunNames = associateFunNames fieldNames
  return $ map createLens associatedFunNames

  where -- Creates a function of the form:
        -- funName lensFun record = fmap (\newValue -> record {fieldName=newValue}) (lensFun (fieldName record))
        createLens :: (Name, Name) -> Dec
        createLens (funName, fieldName) =
          let lensFun   = mkName "lensFunction"
              recordVar = mkName "record"
              valVar    = mkName "newValue"
              setterFunction = LamE [VarP valVar] $ RecUpdE (VarE recordVar) [(fieldName, VarE valVar)]
              getValue       = AppE (VarE fieldName) (VarE recordVar)
              body           = NormalB (AppE (AppE (VarE 'fmap) setterFunction) (AppE (VarE lensFun) getValue))
          in FunD funName [(Clause [VarP lensFun, VarP recordVar] body [])]

        -- Maps [Module._field1, Module._field2] to [(field1, _field1), (field2, _field2)]
        associateFunNames :: [Name] -> [(Name, Name)]
        associateFunNames = map funNames
                            where funNames fieldName = ((mkName . tail . nameBase) fieldName, (mkName . nameBase) fieldName)

        -- Retrieves fields of last instance declaration of type family "t"
        tfFieldNames t = do
          FamilyI _ ((DataInstD _ _ _ _ ((RecC _ fields):_) _):_) <- reify t
          let fieldNames = flip map fields $ \(name, _, _) -> name
          return fieldNames

Usage: pass type family name to tfMakeLenses. Lenses will be created for the last type family instance before the call.

class SomeClass t where
  data SomeData t :: * -> *

data MyData = MyData Int

instance SomeClass MyData where
  data SomeData MyData a = SomeData {_a :: a, _b :: a

tfMakeLenses ''SomeData

Lenses and TypeFamilies

3 Answers3

Linked