Какова подходящая абстракция для объектива, который может потерпеть неудачу в качестве сеттера?

Ваша конкретная формула не очень хорошо работает в экосистеме линз. Самое главное, что делает объектив, это обеспечивает композицию оптики разных типов. Чтобы продемонстрировать, давайте начнем со слегка приукрашенной версии вашего кода:

{-# LANGUAGE RankNTypes #-}

import Data.Char (toUpper)
import Data.Functor.Const (Const(..))
import Data.Functor.Identity (Identity(..))

type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
type Getting r s t a = (a -> Const r a) -> s -> Const r t

view :: Getting a s t a -> s -> a
view l = getConst . l Const

over :: Lens s t a b -> (a -> b) -> s -> t
over l f = runIdentity . l (Identity . f)

data Foo a = Foo a
    deriving (Show, Eq, Ord)

fooLens :: Lens (Foo [a]) (Either String (Foo [a])) [a] [a]
fooLens f (Foo a) = update <$> f a
  where
    update x | null x = Left "Cannot be empty"
             | otherwise = Right (Foo x)

main = do
    let foo = Foo "test"
    print foo
    print $ view fooLens foo
    print $ over fooLens (map toUpper) foo
    print $ over fooLens (const "") foo

Результат:

Foo "test"
"test"
Right (Foo "TEST")
Left "Cannot be empty"

Я немного изменил fooLens, чтобы в полной мере использовать его тип, проверяя данные при обновлении. Это помогает проиллюстрировать цель этой формулировкой.

Затем я решил проверить, насколько хорошо это сочиняет, и добавил следующее:

data Bar = Bar (Foo String)
    deriving (Show, Eq, Ord)

barLens :: Lens Bar Bar (Foo String) (Foo String)
barLens f (Bar x) = Bar <$> f x

А затем добавьте следующее к main:

    print $ view (barLens . fooLens) (Bar foo)

Просто не складывается:

error:
    • Couldn't match type ‘Either String (Foo [Char])’
                     with ‘Foo String’
      Expected type: ([Char] -> Const [Char] [Char])
                     -> Foo String -> Const [Char] (Foo String)
        Actual type: ([Char] -> Const [Char] [Char])
                     -> Foo [Char] -> Const [Char] (Either String (Foo [Char]))
    • In the second argument of ‘(.)’, namely ‘fooLens’
      In the first argument of ‘view’, namely ‘(barLens . fooLens)’
      In the second argument of ‘($)’, namely
        ‘view (barLens . fooLens) (Bar foo)’
   |
37 |     print $ view (barLens . fooLens) (Bar foo)
   |                             ^^^^^^^

Одного этого достаточно, чтобы предотвратить использование этого состава в линзах. Это не соответствует целям библиотеки.

Давайте попробуем что-нибудь другое. Это не совсем то, что вы ищете, но это наблюдение.

import Control.Lens

data Foo a = Foo a
    deriving (Show, Eq, Ord)

fooLens :: Lens (Foo [a]) (Foo [a]) [a] [a]
fooLens f (Foo a) = update <$> f a
  where
    update x | null x = Foo a
             | otherwise = Foo x

main :: IO ()
main = do
    let foos = map Foo $ words "go fly a kite"
    print foos
    print $ toListOf (traverse . fooLens) foos
    print $ over (traverse . fooLens) tail foos
    print =<< (traverse . fooLens) (\x -> tail x <$ print x) foos

Выход:

[Foo "go",Foo "fly",Foo "a",Foo "kite"]
["go","fly","a","kite"]
[Foo "o",Foo "ly",Foo "a",Foo "ite"]
"go"
"fly"
"a"
"kite"
[Foo "o",Foo "ly",Foo "a",Foo "ite"]

Очевидно, что это не настоящая линза, и, вероятно, у нее должно быть другое имя, так как она не подчиняется закону заданного вида. Немного неудобно, что его можно записать одним и тем же типом, но есть прецедент для таких вещей, как filtered.

Но есть еще одна сложность, о чем свидетельствует последний тест — фильтрация результатов обновления по-прежнему требует запуска эффектов обновления, даже если обновление отклонено. Это не то, как работает пропуск элемента, например, с filtered в Traversal. Кажется, что этого невозможно избежать с представлением ван Лаарховена. Но, возможно, это не так уж и плохо. Это не проблема при настройке или просмотре — только при выполнении гораздо менее распространенных операций.

В любом случае, он не сообщает об ошибке установки, так что это не совсем то, что вы ищете. Но при достаточном количестве повторений это может стать отправной точкой.

{-# LANGUAGE
        MultiParamTypeClasses,
        FlexibleInstances,
        TypeFamilies,
        UndecidableInstances,
        FlexibleContexts #-}

import Data.Functor.Identity
import Control.Applicative
import Control.Monad

import Control.Lens



class Functor f => Reportable f e where
    report :: a -> f (Either e a) -> f a

instance Reportable (Const r) e where
    report _ (Const x) = Const x

instance Reportable Identity e where
    report a (Identity i) = Identity $ either (const a) id i

instance (e ~ a) => Reportable (Either a) e where
    report _ = join

overWithReport
    :: ((a -> Either e b) -> s -> Either e t)
    -> (a -> b)
    -> s
    -> Either e t
overWithReport l f s = l (pure . f) s



data Foo a = Foo a
    deriving (Show, Eq, Ord)

fooLens
    :: (Reportable f String)
    => ([a] -> f [a])
    -> Foo [a]
    -> f (Foo [a])
fooLens f (Foo a) = report (Foo a) $ update <$> f a
  where
    update x | null x = Left "Cannot be empty"
             | otherwise = Right $ Foo x



main :: IO ()
main = do
    let foos = [Foo [1], Foo [2, 3]]
    print foos

    putStrLn "\n  Use as a normal lens:"
    print $ toListOf (traverse . fooLens . traverse) foos
    print $ over (traverse . fooLens . traverse) (+ 10) foos
    print $ over (traverse . fooLens) tail foos

    putStrLn "\n  Special use:"
    print $ overWithReport (traverse . fooLens . traverse) (+ 10) foos
    print $ overWithReport (traverse . fooLens) (0 :) foos
    print $ overWithReport (traverse . fooLens) tail foos

И вот результат его запуска:

[Foo [1],Foo [2,3]]

  Use as a normal lens:
[1,2,3]
[Foo [11],Foo [12,13]]
[Foo [1],Foo [3]]

  Special use:
Right [Foo [11],Foo [12,13]]
Right [Foo [0,1],Foo [0,2,3]]
Left "Cannot be empty"

Эта формула интегрируется с обычным материалом для линз. Это работает за счет необходимости изменения over для получения отчета об ошибке. Он поддерживает совместимость со многими функциями объектива за счет некоторого неправомерного поведения в одном случае. Это не идеально, но, вероятно, максимально приближено к ограничениям совместимости с остальной библиотекой объективов.

Что касается того, почему что-то в этом роде отсутствует в библиотеке, возможно, это связано с тем, что для этого требуется пользовательское ограничение на псевдоним типа f, что является настоящей проблемой для работы с комбинаторами, такими как (%%~). Экземпляры, которые я предоставил для Identity и Const, позаботятся о большинстве применений самого объектива, но есть и другие люди, которые могут использовать его.

Открытый дизайн библиотеки объективов позволяет выполнять огромное количество внешних настроек. Это возможный подход, который, вероятно, работает во многих случаях. Но это работает намного меньше, чем позволяет объектив, и я думаю, поэтому ничего подобного в настоящее время нет.

Я думаю, это потому, что для профункторной оптики существует негласный закон типового уровня. Оптический тип s t a b должен удовлетворять закону типового уровня: a ~ b подразумевает s ~ t.

В результате Getting не является обобщенным, поскольку его тип имеет a ~ b, что подразумевает s ~ t. Точно так же fooLens не является известной оптикой, потому что она нарушает этот закон, так что она вроде как не запускается.

Как я уже сказал, я никогда не видел, чтобы этот закон на уровне типов был явным, но я думаю, что он подразумевается.