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
.)
Sure, it's very mechanical:
problemName :: Lens' Problem String
problemName f = \case
ProblemFoo foo -> ProblemFoo <$> fooName f foo
ProblemBar bar -> ProblemBar <$> barName f bar
ProblemBaz baz -> ProblemBaz <$> bazName f baz
It should be obvious how to extend this to further constructors, or even how to write a bit of TH for it provided you can think of a way to describe the right sub-lens to pick for each branch -- perhaps using a typeclass for dispatch or similar.
You are right in that you can write it with outside
. 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)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With