haskellhaskell-lens

How can I write a lens for a sum type


I have a type like this:

data Problem =
   ProblemFoo Foo |
   ProblemBar Bar |
   ProblemBaz Baz

Foo, Bar and Baz all have a lens for their names:

fooName :: Lens' Foo String
barName :: Lens' Bar String
bazName :: Lens' Baz String

Now I'd like to create a lens

problemName :: Lens' Problem String

Clearly I can write this using the lens construction function and a pair of case statements, but is there a better way?

The documentation for outside talks about using a Prism as a kind of first-class pattern, which sounds suggestive, but I can't see how to actually make it happen.

(Edit: added Baz case because my real problem isn't isomorphic with Either.)


Solution

  • You are right in that you can write it with outside. (Well, at least as far as using "a kind of first-class pattern" for something akin to your purposes goes. As rightly pointed out in the comments, outside per se won't give you a Lens' Problem String. For approaches more in line with that, see the answers by leftaroundabout and Daniel Wagner.)

    To begin with, some definitions:

    {-# LANGUAGE TemplateHaskell #-}
    
    import Control.Lens
    
    newtype Foo = Foo { _fooName :: String }
        deriving (Eq, Ord, Show)
    makeLenses ''Foo
    
    newtype Bar = Bar { _barName :: String }
        deriving (Eq, Ord, Show)
    makeLenses ''Bar
    
    newtype Baz = Baz { _bazName :: String }
        deriving (Eq, Ord, Show)
    makeLenses ''Baz
    
    data Problem =
        ProblemFoo Foo |
        ProblemBar Bar |
        ProblemBaz Baz
        deriving (Eq, Ord, Show)
    makePrisms ''Problem
    

    The above is just what you described in your question, except that I'm also making prisms for Problem.

    The type of outside (specialised to functions, simple lenses, and simple prisms, for the sake of clarity) is:

    outside :: Prism' s a -> Lens' (s -> r) (a -> r)
    

    Given a prism for e.g. a case of a sum type, outside gives you a lens on functions from the sum type which targets the branch of the function that handles the case. Specifying all branches of the function amounts to handling all cases:

    problemName :: Problem -> String
    problemName = error "Unhandled case in problemName"
        & outside _ProblemFoo .~ view fooName
        & outside _ProblemBar .~ view barName
        & outside _ProblemBaz .~ view bazName
    

    That is rather pretty, except for the need to throw in the error case due to the lack of a sensible default. The total library offers an alternative that improves on that and provides exhaustiveness checking along the way, as long as you are willing to contort your types a bit further:

    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE DeriveGeneric #-}
    
    import Control.Lens
    import GHC.Generics (Generic)
    import Lens.Family.Total    
    
    -- etc.
    
    -- This is needed for total's exhaustiveness check.
    data Problem_ a b c =
        ProblemFoo a |
        ProblemBar b |
        ProblemBaz c
        deriving (Generic, Eq, Ord, Show)
    makePrisms ''Problem_
    
    instance (Empty a, Empty b, Empty c) => Empty (Problem_ a b c)
    
    type Problem = Problem_ Foo Bar Baz
    
    problemName :: Problem -> String
    problemName = _case
        & on _ProblemFoo (view fooName)
        & on _ProblemBar (view barName)
        & on _ProblemBaz (view bazName)