Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Can I build something like a lens when my getter and setter return `Either`?

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
like image 927
Jeffrey Benjamin Brown Avatar asked Nov 07 '22 19:11

Jeffrey Benjamin Brown


1 Answers

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

like image 194
Chris Penner Avatar answered Nov 12 '22 22:11

Chris Penner