4

In brief

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.

In detail

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?

Example code

{-# 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
Micha Wiedenmann
  • 19,979
  • 21
  • 92
  • 137
Jeffrey Benjamin Brown
  • 3,427
  • 2
  • 28
  • 40
  • 1
    At a glance, it looks like it should be possible to have something like [the `ix` traversal](https://www.stackage.org/haddock/lts-13.8/microlens-0.4.10/Lens-Micro.html#v:ix). You'd lose the error messages, but that might not be such a big cost (as far as I can see, they don't actually bring extra information about the failure). – duplode Mar 15 '19 at 22:28
  • 1
    Related: https://stackoverflow.com/questions/33972337/lens-prism-with-error-handling/ – danidiaz Mar 16 '19 at 00:02
  • @duplode, that was so worth it! Now I'm first using a function to test whether the path is in bounds, and then using ix. I'm going to leave this question open in the hope that someday someone solves the general problem -- since the data in a Left will in some cases be important -- but in my specific case your solution is perfect. – Jeffrey Benjamin Brown Mar 16 '19 at 05:10

1 Answers1

1

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 :)

Chris Penner
  • 1,881
  • 11
  • 15