我怎样才能写一个 sum 类型的镜头

Question

我有这样的类型：

data Problem =
   ProblemFoo Foo |
   ProblemBar Bar |
   ProblemBaz Baz

Foo、Bar和Baz的名字都有一个镜头：

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

现在我想制作一个镜头

problemName :: Lens' Problem String

显然我可以使用 lens 构造函数和一对 case 语句来编写此代码，但是有没有更好的方法？

outside 的文档讨论了使用 Prism 作为一种 first-class 模式，这听起来很有启发性，但我看不出如何真正实现它。

（编辑：添加了 Baz 案例，因为我的真正问题与 Either 不同构。）

Answer 1

The function you probably want 是

choosing :: Functor f => LensLike f s t a b -> LensLike f s' t' a b -> LensLike f (Either s s') (Either t t') a b

读作

choosing :: Lens' s   a      -> Lens' s'  a      -> Lens' (Either s s')    a

或者你的情况

choosing :: Lens' Foo String -> Lens' Bar String -> Lens' (Either Foo Bar) String

要将其与 Problem 一起使用，您需要 Problem 实际上与 Either Foo Bar 同构。 Prism' Problem Foo 和 Prism' Problem Bar 的存在是不够的，因为你也可以有

data Problem' = Problem'Foo Foo
              | Spoilsport
              | Problem'Bar Bar

我不认为有任何标准的 TH 实用程序可以使用多个构造函数给出这样的同构，但您可以自己编写，这比自己将镜头写到字符串上要容易一些：

delegateProblem :: Iso' Problem (Either Foo Bar)
delegateProblem = iso p2e e2p
 where p2e (ProblemFoo foo) = Left foo
       p2e (ProblemBar bar) = Right bar
       e2p (Left foo) = ProblemFoo foo
       e2p (Right bar) = ProblemBar bar

然后

problemName :: Lens' Problem String
problemName = delegateProblem . choosing fooName barName

简短版本：

{-# LANGUAGE LambdaCase #-}
problemName = iso (\case ProblemFoo foo -> Left foo
                         ProblemBar bar -> Right bar)
                  (\case Left foo -> ProblemFoo foo
                         Right bar -> ProblemBar bar)
            . choosing fooName barName

Answer 2

当然，这很机械：

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

如果您能想出一种方法来描述为每个分支选择的正确子镜头，那么如何将其扩展到更多的构造函数，甚至如何为它编写一些 TH 应该是显而易见的——也许使用类型类进行分派或类似。

Answer 3

你是对的，你可以用outside来写。首先，一些定义：

{-# 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

以上就是你在问题中描述的内容，只是我也在为Problem制作棱镜。

outside的类型（专门针对函数，简单透镜，简单棱镜，为了清楚起见）是：

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

给定一个棱镜，例如求和类型的案例，outside 为您提供了求和类型函数的镜头，该函数针对处理案例的函数分支。指定函数的所有分支相当于处理所有情况：

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

这相当漂亮，除了由于缺少合理的默认值而需要抛出 error 情况。 The total library 提供了一种改进的替代方案，并在此过程中提供详尽检查，只要您愿意进一步扭曲您的类型：

{-# 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)

我怎样才能写一个 sum 类型的镜头

How can I write a lens for a sum type

haskell

haskell-lens