My getter and setter could both fail, with messages describing how. Therefore they return Either String
, which means I can't make lenses out of them in the normal way.
Consider these types:
import qualified Data.Vector as V
data Tree a = Tree { label :: a
, children :: V.Vector (Tree a) }
type Path = [Int]
Not every Path
into a Tree
leads to a Tree
, so a getter has to have a signature like getSubtree :: Path -> Tree a -> Either String (Tree a)
. A setter needs a similar signature (see modSubtree
below).
If the getter and setter returned values of type Tree a
, I would use them to create a lens, via something like the lens
function in Lens.Micro. I can't do that, though, if they return Either
. Therefore I can't compose them with other lenses, so I have to do lots of wrapping and unwrapping.
What would be a better way?
{-# LANGUAGE ScopedTypeVariables #-}
module I_wish_I_could_lens_this_Either where
import qualified Data.Vector as V
data Tree a = Tree { label :: a
, children :: V.Vector (Tree a) }
deriving (Show, Eq, Ord)
type Path = [Int]
-- | This is too complicated.
modSubtree :: forall a. Show a =>
Path -> (Tree a -> Tree a) -> Tree a -> Either String (Tree a)
modSubtree [] f t = Right $ f t
modSubtree (link:path) f t = do
if not $ inBounds (children t) link
then Left $ show link ++ "is out of bounds in " ++ show t
else Right ()
let (cs :: V.Vector (Tree a)) = children t
(c :: Tree a) = cs V.! link
c' <- modSubtree path f c
cs' <- let left = Left "imossible -- link inBounds already checked"
in maybe left Right $ modifyVectorAt link (const c') cs
Right $ t {children = cs'}
getSubtree :: Show a => Path -> Tree a -> Either String (Tree a)
getSubtree [] t = Right t
getSubtree (link:path) t =
if not $ inBounds (children t) link
then Left $ show link ++ "is out of bounds in " ++ show t
else getSubtree path $ children t V.! link
-- | check that an index into a vector is inbounds
inBounds :: V.Vector a -> Int -> Bool
inBounds v i = i >= 0 &&
i <= V.length v - 1
-- | Change the value at an index in a vector.
-- (Data.Vector.Mutable offers a better way.)
modifyVectorAt :: Int -> (a -> a) -> V.Vector a -> Maybe (V.Vector a)
modifyVectorAt i f v
| not $ inBounds v i = Nothing
| otherwise = Just ( before
V.++ V.singleton (f $ v V.! i)
V.++ after )
where before = V.take i v
after = V.reverse $ V.take remaining $ V.reverse v
where remaining = (V.length v - 1) - i
You can indeed do this with lenses! Or more specifically; Traversals :)
First some setup:
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}
module TreeTraversal where
import qualified Data.Vector as V
import Control.Lens hiding (children)
data Tree a = Tree { _label :: a
, _children :: V.Vector (Tree a) }
deriving (Show, Eq, Ord, Functor)
makeLenses ''Tree
type Path = [Int]
From this point on there are two ways to proceed; If you only need to know whether or not the entire traversal succeeded (e.g. any link in the path was inaccessible) then you can use failover
; which takes a traversal and a function, and will try to run the function on the traversal, but which will return the result in an Alternative
context; we can choose this context to be 'maybe' so we can detect the failure with pattern matching and return the appropriate Left
or Right
. I'm not aware of an easy way to traverse a list of indices, so I wrote a quick helper to recurse the list of links and turn them into a traversal using composition.
modSubtreeWithGenericError
:: forall a. Show a
=> Path -> (Tree a -> Tree a) -> Tree a -> Either String (Tree a)
modSubtreeWithGenericError links f =
maybe (Left "out of bounds") Right . failover (pathOf links) f
where
pathOf :: [Int] -> Traversal' (Tree a) (Tree a)
pathOf [] = id
pathOf (p : ps) = children . ix p . pathOf ps
That should do the trick if you only care failure in general, but it would be nice to know WHERE it failed right? We can do this by writing a custom traversal which KNOWS it's operating inside Either String
; Most traversals must work over ANY applicative, but in our case we KNOW we want our result to be in Either; so we can take advantage of that:
modSubtreeWithExpressiveError
:: forall a. Show a
=> [Int] -> (Tree a -> Tree a) -> Tree a -> Either String (Tree a)
modSubtreeWithExpressiveError links f = pathOf links %%~ (pure . f)
where
pathOf :: [Int] -> LensLike' (Either String) (Tree a) (Tree a)
pathOf [] = id
pathOf (x : xs) = childOrFail x . pathOf xs
childOrFail :: Show a => Int -> LensLike' (Either String) (Tree a) (Tree a)
childOrFail link f t =
if t & has (children . ix link)
then t & children . ix link %%~ f
else buildError link t
childOrFail
is the interesting bit; The LensLike
bit is really just an alias for (Tree a -> Either String (Tree a)) -> Tree a -> Either String (Tree a)
which is just traverse
specialized to Either String
; we can't just use traverse
directly though because we only want to traverse a single subtree, and our function runs on Tree a
and not just a
. I wrote the traversal out manually, first checking if the target exists using has
then either failing with a Left
with a nice error, or running the f
(which represents the rest of the traversal) over the appropriate child using %%~
. The %%~
combinator is also a little scary; ironically its definition is literally (%%~) = id
; Normally we would use %~
here instead; but it expects a specific Applicative which doesn't match the Either String
one we've specified. %%~
happily runs our custom traversal, although we still need to add an extra pure
onto our function to get it into the Either context.
This is pretty advanced lens stuff, but at the end of the day it's all just normal traversals (most of lens is).
I've got a guide on writing your own traversals here which might help https://lens-by-example.chrispenner.ca/articles/traversals/writing-traversals
Good luck! Hope that helps :)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With