I would like to define something like a lens, but which can fail when trying to set. See fooLens in the following example.
{-# 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)
fooLens :: Lens (Foo a) (Either String (Foo a)) a a
fooLens f (Foo a) = Right . Foo <$> f a
main = do
let foo = Foo "test"
print foo
print $ view fooLens foo
print $ over fooLens (map toUpper) foo
The output of this is what you would expect
Foo "test"
"test"
Right (Foo "TEST")
I have generalised the definition of Getting here to make this work. The first thing to make clear is that fooLens is not a lens: it doesn't satisfy the lens laws. Instead, it is the composition of a lens and something like a prism.
This seems to work, but the fact that it's not supported by any of the lens libraries I've checked suggests that there may be a better way to go about this problem. Is there a way to refactor fooLens so that it:
Your specific formulation doesn't work very well within the lens ecosystem. The most important thing lens does is provide composition of optics of different types. To demonstrate, let's start with a slightly embellished version of your code:
{-# 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
The output is:
Foo "test"
"test"
Right (Foo "TEST")
Left "Cannot be empty"
I modified fooLens a bit to take full advantage of its type, validating data on update. This helps to illustrate the goal with this formulation.
Then I decided to test out how well this composes, and added the following:
data Bar = Bar (Foo String)
deriving (Show, Eq, Ord)
barLens :: Lens Bar Bar (Foo String) (Foo String)
barLens f (Bar x) = Bar <$> f x
And then adding the following to main:
print $ view (barLens . fooLens) (Bar foo)
It just doesn't compose:
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)
| ^^^^^^^
This alone is enough to prevent using this formulation in lens. It doesn't fit within the goals of the library.
Let's try something different. This isn't exactly what you're looking for, but it's an observation.
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
Output:
[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"]
Obviously that's not a true lens and should probably have a different name, as it doesn't obey the set-view law. It's a bit awkward that it can be written with the same type, but there's precedent for that with things like filtered.
But there's a further complication, as evidenced by the last test - filtering on the result of an update still requires running the update's effects, even when the update is rejected. That's not how skipping an element, with filtered for instance, in a Traversal works. That seems like it's impossible to avoid with the van Laarhoven representation. But maybe that's not so bad. It isn't an issue when setting or viewing - only when doing much less common operations.
In any case, it doesn't report the failure to set, so it's not exactly what you're looking for. But with enough rejiggering, it can be a starting point.
{-# 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
And here's the output from running it:
[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"
This formulation integrates with normal lens stuff. It works, at the expense of requiring a variation on over to get the error reporting. It maintains compatibility with a lot of lens functions, at the cost of a bit of non-lawful behavior in one case. It's not perfect, but it's probably as close as you can get within the constraints of maintaining compatibility with the rest of the lens library.
As for why something along these lines isn't in the library, it's probably because it requires a custom constraint on the f type alias, which is a real hassle for working with combinators like (%%~). The instances I provided for Identity and Const take care of most uses from lens itself, but there's a more people might choose to do with it.
The lens library's open design allows for a huge amount of external customization. This is a possible approach that probably works for a lot of cases. But it works for a lot less than the full breadth of what lens allows, and I think that's why nothing like this is currently present.