代码之家 › 专栏 › 技术社区 › Paul Johnson

我怎样才能写一个和型镜头

lens haskell

7

Paul Johnson · 技术社区 · 7 年前

我有这样一种类型:

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 谈到使用棱镜作为一种一流的模式,这听起来很有启发性,但我看不出如何真正做到这一点。

因为我真正的问题不是和 Either .)

3 回复 | 直到 5 年前

1

8

duplode 7 年前

你是对的,你可以用它来写 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 :: Prism' s a -> Lens' (s -> r) (a -> r)

给定一个棱镜,例如一个和类型的情况, 外部

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)

2

7

leftaroundabout 7 年前

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 ,你需要知道 问题 实际上与 Either Foo Bar . 两者的存在 Prism' Problem Foo Prism' Problem Bar 这还不够,因为你也可以

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

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

3

6

Daniel Wagner 7 年前

当然,这很机械:

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