Как я могу написать объектив для типа суммы - PullRequest
Новая
       26

Как я могу написать объектив для типа суммы

0 голосов
/ 16 октября 2018

У меня есть такой тип: 

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 в качестве некоего первоклассного шаблона, что звучит многообещающе, но я не понимаю, как на самом деле это сделать.

(Изменить: добавлено Baz case, потому что моя настоящая проблема не изоморфна с Either.)

Ответы [ 3 ]

0 голосов
/ 16 октября 2018

Конечно, это очень механично: 

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 для него, если вы можете придумать способ описатьправильный сублинз для каждой ветви - возможно, с использованием класса типов для отправки или аналогичного.

0 голосов
/ 16 октября 2018

Вы правы в том, что можете написать это с помощью 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.

Тип *Для ясности 1008 * (специально для функций, простых линз и простых призм): 

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

При наличии призмы, например, для случая типа суммы, outside дает вам линзуна функции из типа sum, которая нацелена на ветвь функции, которая обрабатывает регистр.Указание всех ветвей функции равнозначно обработке всех случаев: 

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

Это довольно красиво, за исключением необходимости бросать в случае error из-за отсутствия разумного значения по умолчанию. Библиотека total предлагает альтернативу, которая улучшит это и обеспечит полную проверку на всем пути, если вы захотите немного исказить типы: 

{-# 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)
0 голосов
/ 16 октября 2018

Функция, которую вы, вероятно, хотите : 

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
...