Merge branch 'master' into issue263

diagrams · Oct 2, 2015 · f78989b · f78989b
2 parents 62a6443 + db1f5c9
commit f78989b
Show file tree

Hide file tree

Showing 3 changed files with 20 additions and 1 deletion.
diff --git a/CHANGELOG-PENDING.md b/CHANGELOG-PENDING.md
@@ -3,6 +3,7 @@
 ## [v1.X] (YYYY-MM-DD)
 
 - Add reflectXY and reflectionXY
+- Add _LocLoop and _LocLine prisms
 
 **Dependency/version changes**
 

diff --git a/src/Diagrams/Prelude.hs b/src/Diagrams/Prelude.hs
@@ -1,4 +1,5 @@
 {-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
+{-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Diagrams.Prelude
@@ -78,11 +79,20 @@ module Diagrams.Prelude
 import           Diagrams
 
 import           Control.Applicative
+
+#if MIN_VERSION_lens(4,13,0)
+import           Control.Lens        hiding (argument, at, backwards, beside,
+                                      children, contains, indexed, indices,
+                                      inside, levels, none, outside, singular,
+                                      transform, ( # ), (...), (.>), (<.>))
+#else
 import           Control.Lens        hiding (argument, at, backwards, beside,
                                       children, coerce, contains, indexed,
                                       indices, inside, levels, none, outside,
                                       singular, transform, ( # ), (...), (.>),
                                       (<.>))
+#endif
+
 import           Data.Active
 import           Data.Colour         hiding (AffineSpace (..), atop, over)
 import           Data.Colour.Names   hiding (tan)
@@ -93,4 +103,3 @@ import           Data.Semigroup
 import           Linear.Affine
 import           Linear.Metric
 import           Linear.Vector
-
diff --git a/src/Diagrams/Trail.hs b/src/Diagrams/Trail.hs
@@ -56,6 +56,7 @@ module Diagrams.Trail
 
        , Trail(..)
        , _Line, _Loop
+       , _LocLine, _LocLoop
        , wrapTrail, wrapLine, wrapLoop
        , onTrail, onLine
 
@@ -772,6 +773,14 @@ _Line = _Wrapped' . _Left
 _Loop :: Prism' (Trail v n) (Trail' Loop v n)
 _Loop = _Wrapped' . _Right
 
+-- | Prism onto a 'Located' 'Line'.
+_LocLine :: Prism' (Located (Trail v n)) (Located (Trail' Line v n))
+_LocLine = prism' (mapLoc Trail) $ located (preview _Line)
+
+-- | Prism onto a 'Located' 'Loop'.
+_LocLoop :: Prism' (Located (Trail v n)) (Located (Trail' Loop v n))
+_LocLoop = prism' (mapLoc Trail) $ located (preview _Loop)
+
 instance Rewrapped (Trail v n) (Trail v' n')
 instance Wrapped (Trail v n) where
   type Unwrapped (Trail v n) = Either (Trail' Line v n) (Trail' Loop v n)