From a5cfe998ae9912641801335ddf48f6aca77c57c9 Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Sat, 2 Nov 2013 16:32:47 -0400 Subject: [PATCH] add located lens for access into Located things --- src/Diagrams/Located.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/Diagrams/Located.hs b/src/Diagrams/Located.hs index d106714a..6410c0e1 100644 --- a/src/Diagrams/Located.hs +++ b/src/Diagrams/Located.hs @@ -19,11 +19,13 @@ module Diagrams.Located ( Located - , at, viewLoc, unLoc, loc, mapLoc + , at, viewLoc, unLoc, loc, mapLoc, located ) where +import Control.Lens (Lens) import Data.AffineSpace +import Data.Functor ((<$>)) import Data.VectorSpace import Diagrams.Core @@ -83,6 +85,10 @@ viewLoc (Loc p a) = (p,a) mapLoc :: (V a ~ V b) => (a -> b) -> Located a -> Located b mapLoc f (Loc p a) = Loc p (f a) +-- | A lens giving access to the object within a 'Located' wrapper. +located :: (V a ~ V a') => Lens (Located a) (Located a') a a' +located f (Loc p a) = Loc p <$> f a + deriving instance (Eq (V a), Eq a ) => Eq (Located a) deriving instance (Ord (V a), Ord a ) => Ord (Located a) deriving instance (Show (V a), Show a) => Show (Located a)