Convert from newtype to lens

diagrams-lib.cabal

@@ -92,7 +92,6 @@ Library
                        colour >= 2.3.2 && < 2.4,
                        data-default-class < 0.1,
                        pretty >= 1.0.1.2 && < 1.2,
-                       newtype >= 0.2 && < 0.3,
                        fingertree >= 0.1 && < 0.2,
                        intervals >= 0.2.2 && < 0.3,
                        lens >= 3.9 && < 3.10

src/Diagrams/CubicSpline.hs

@@ -34,7 +34,7 @@ import           Diagrams.TrailLike            (TrailLike (..))
 -- for e.g. the Fractional (Double, Double) instance
 import           Data.NumInstances.Tuple       ()
 
-import           Control.Newtype
+import           Data.AffineSpace.Point
 import           Data.VectorSpace
 
 -- | Construct a spline path-like thing of cubic segments from a list of
@@ -53,7 +53,7 @@ import           Data.VectorSpace
 --   For more information, see <http://mathworld.wolfram.com/CubicSpline.html>.
 cubicSpline :: (TrailLike t, Fractional (V t)) => Bool -> [Point (V t)] -> t
 cubicSpline closed [] = trailLike . closeIf closed $ emptyLine `at` origin
-cubicSpline closed ps = flattenBeziers . map f . solveCubicSplineCoefficients closed . map unpack $ ps
+cubicSpline closed ps = flattenBeziers . map f . solveCubicSplineCoefficients closed . map unPoint $ ps
   where
     f [a,b,c,d] = [a, (3*a+b)/3, (3*a+2*b+c)/3, a+b+c+d]
     flattenBeziers bs@((b:_):_)

src/Diagrams/Path.hs

@@ -28,7 +28,7 @@ module Diagrams.Path
 
          -- * Paths
 
-         Path(..)
+         Path, pathTrails
 
          -- * Constructing paths
          -- $construct
@@ -67,7 +67,7 @@ import           Diagrams.TrailLike
 import           Diagrams.Transform
 
 import           Control.Arrow        ((***))
-import           Control.Newtype      hiding (under)
+import           Control.Lens         (Iso, from, iso, mapped, over, view, (%~))
 import           Data.AffineSpace
 import qualified Data.Foldable        as F
 import           Data.List            (partition)
@@ -82,21 +82,20 @@ import           Data.VectorSpace
 --   Hence, unlike trails, paths are not translationally invariant,
 --   and they form a monoid under /superposition/ (placing one path on
 --   top of another) rather than concatenation.
-newtype Path v = Path { pathTrails :: [Located (Trail v)] }
+newtype Path v = Path { _pathTrails :: [Located (Trail v)] }
   deriving (Semigroup, Monoid)
 
+pathTrails :: Iso (Path v) (Path v') [Located (Trail v)] [Located (Trail v')]
+pathTrails = iso _pathTrails Path
+
 deriving instance Show v => Show (Path v)
 deriving instance Eq   v => Eq   (Path v)
 deriving instance Ord  v => Ord  (Path v)
 
 type instance V (Path v) = v
 
-instance Newtype (Path v) [Located (Trail v)] where
-  pack   = Path
-  unpack = pathTrails
-
 instance VectorSpace v => HasOrigin (Path v) where
-  moveOriginTo = over Path . map . moveOriginTo
+  moveOriginTo = over pathTrails . map . moveOriginTo
 
 -- | Paths are trail-like; a trail can be used to construct a
 --   singleton path.
@@ -106,7 +105,7 @@ instance (InnerSpace v, OrderedField (Scalar v)) => TrailLike (Path v) where
 -- See Note [Transforming paths]
 instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v))
     => Transformable (Path v) where
-  transform = over Path . map . transform
+  transform = over pathTrails . map . transform
 
 {- ~~~~ Note [Transforming paths]
 
@@ -121,7 +120,7 @@ of the v's are inside Points and hence ought to be translated.
 instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v)) => IsPrim (Path v)
 
 instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (Path v) where
-  getEnvelope = F.foldMap trailEnvelope . pathTrails
+  getEnvelope = F.foldMap trailEnvelope . view pathTrails
           -- this type signature is necessary to work around an apparent bug in ghc 6.12.1
     where trailEnvelope :: Located (Trail v) -> Envelope v
           trailEnvelope (viewLoc -> (p, t)) = moveOriginTo ((-1) *. p) (getEnvelope t)
@@ -166,11 +165,11 @@ pathFromLocTrail = trailLike
 -- | Extract the vertices of a path, resulting in a separate list of
 --   vertices for each component trail (see 'trailVertices').
 pathVertices :: (InnerSpace v, OrderedField (Scalar v)) => Path v -> [[Point v]]
-pathVertices = map trailVertices . pathTrails
+pathVertices = map trailVertices . view pathTrails
 
 -- | Compute the total offset of each trail comprising a path (see 'trailOffset').
 pathOffsets :: (InnerSpace v, OrderedField (Scalar v)) => Path v -> [v]
-pathOffsets = map (trailOffset . unLoc) . pathTrails
+pathOffsets = map (trailOffset . unLoc) . view pathTrails
 
 -- | Compute the /centroid/ of a path (/i.e./ the average location of
 --   its vertices).
@@ -179,18 +178,18 @@ pathCentroid = centroid . concat . pathVertices
 
 -- | Convert a path into a list of lists of 'FixedSegment's.
 fixPath :: (InnerSpace v, OrderedField (Scalar v)) => Path v -> [[FixedSegment v]]
-fixPath = map fixTrail . unpack
+fixPath = map fixTrail . view pathTrails
 
 -- | \"Explode\" a path by exploding every component trail (see
 --   'explodeTrail').
 explodePath :: (VectorSpace (V t), TrailLike t) => Path (V t) -> [[t]]
-explodePath = map explodeTrail . pathTrails
+explodePath = map explodeTrail . view pathTrails
 
 -- | Partition a path into two paths based on a predicate on trails:
 --   the first containing all the trails for which the predicate returns
 --   @True@, and the second containing the remaining trails.
 partitionPath :: (Located (Trail v) -> Bool) -> Path v -> (Path v, Path v)
-partitionPath p = (pack *** pack) . partition p . unpack
+partitionPath p = (view (from pathTrails) *** view (from pathTrails)) . partition p . view pathTrails
 
 ------------------------------------------------------------
 --  Modifying paths  ---------------------------------------
@@ -204,4 +203,4 @@ scalePath d p = (scale d `under` translation (origin .-. pathCentroid p)) p
 
 -- | Reverse all the component trails of a path.
 reversePath :: (InnerSpace v, OrderedField (Scalar v)) => Path v -> Path v
-reversePath = (over Path . map) reverseLocTrail
+reversePath = pathTrails . mapped %~ reverseLocTrail

src/Diagrams/Points.hs

@@ -24,12 +24,11 @@ module Diagrams.Points
 
 import           Diagrams.Core.Points
 
-import           Control.Newtype
-
-import           Control.Arrow        ((&&&))
+import           Control.Arrow          ((&&&))
 
+import           Data.AffineSpace.Point
 import           Data.VectorSpace
 
 -- | The centroid of a set of /n/ points is their sum divided by /n/.
 centroid :: (VectorSpace v, Fractional (Scalar v)) => [Point v] -> Point v
-centroid = pack . uncurry (^/) . (sumV &&& (fromIntegral . length)) . map unpack
+centroid = P . uncurry (^/) . (sumV &&& (fromIntegral . length)) . map unPoint

src/Diagrams/ThreeD/Types.hs

@@ -1,10 +1,10 @@
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE TypeOperators              #-}
+{-# LANGUAGE TypeSynonymInstances       #-}
+{-# LANGUAGE ViewPatterns               #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -39,17 +39,17 @@ module Diagrams.ThreeD.Types
        , asSpherical
        ) where
 
-import Control.Applicative
+import           Control.Applicative
+import           Control.Lens           (Iso', iso, over)
 
-import Diagrams.Coordinates
-import Diagrams.TwoD.Types
-import Diagrams.Core
+import           Diagrams.Coordinates
+import           Diagrams.Core
+import           Diagrams.TwoD.Types
 
-import Control.Newtype
-
-import Data.Basis
-import Data.VectorSpace
-import Data.Cross
+import           Data.AffineSpace.Point
+import           Data.Basis
+import           Data.Cross
+import           Data.VectorSpace
 
 ------------------------------------------------------------
 -- 3D Euclidean space
@@ -58,23 +58,22 @@ import Data.Cross
 newtype R3 = R3 { unR3 :: (Double, Double, Double) }
   deriving (AdditiveGroup, Eq, Ord, Show, Read)
 
-instance Newtype R3 (Double, Double, Double) where
-  pack   = R3
-  unpack = unR3
+r3Iso :: Iso' R3 (Double, Double, Double)
+r3Iso = iso unR3 R3
 
 -- | Construct a 3D vector from a triple of components.
 r3 :: (Double, Double, Double) -> R3
-r3 = pack
+r3 = R3
 
 -- | Convert a 3D vector back into a triple of components.
 unr3 :: R3 -> (Double, Double, Double)
-unr3 = unpack
+unr3 = unR3
 
 type instance V R3 = R3
 
 instance VectorSpace R3 where
   type Scalar R3 = Double
-  (*^) = over R3 . (*^)
+  (*^) = over r3Iso . (*^)
 
 instance HasBasis R3 where
   type Basis R3 = Either () (Either () ()) -- = Basis (Double, Double, Double)
@@ -98,11 +97,11 @@ type P3 = Point R3
 
 -- | Construct a 3D point from a triple of coordinates.
 p3 :: (Double, Double, Double) -> P3
-p3 = pack . pack
+p3 = P . R3
 
 -- | Convert a 2D point back into a triple of coordinates.
 unp3 :: P3 -> (Double, Double, Double)
-unp3 = unpack . unpack
+unp3 = unR3 . unPoint
 
 -- | Transformations in R^3.
 type T3 = Transformation R3

src/Diagrams/TwoD/Offset.hs

@@ -31,6 +31,7 @@ module Diagrams.TwoD.Offset
     ) where
 
 import Control.Applicative
+import Control.Lens (view)
 
 import Data.AffineSpace
 import Data.Monoid
@@ -232,9 +233,9 @@ offsetTrail = offsetTrail' def
 
 -- | Offset a 'Path' by applying 'offsetTrail'' to each trail in the path.
 offsetPath' :: OffsetOpts -> Double -> Path R2 -> Path R2
-offsetPath' opts r = mconcat 
-                   . map (bindLoc (trailLike . offsetTrail' opts r) . (`at` origin)) 
-                   . pathTrails 
+offsetPath' opts r = mconcat
+                   . map (bindLoc (trailLike . offsetTrail' opts r) . (`at` origin))
+                   . view pathTrails
 
 -- | Offset a 'Path' with the default options and given radius.  See 'offsetPath''.
 offsetPath :: Double -> Path R2 -> Path R2
@@ -349,9 +350,9 @@ expandTrail = expandTrail' def
 
 -- | Expand a 'Path' using 'expandTrail'' on each trail in the path.
 expandPath' :: ExpandOpts -> Double -> Path R2 -> Path R2
-expandPath' opts r = mconcat 
-                   . map (bindLoc (expandTrail' opts r) . (`at` origin)) 
-                   . pathTrails
+expandPath' opts r = mconcat
+                   . map (bindLoc (expandTrail' opts r) . (`at` origin))
+                   . view pathTrails
 
 -- | Expand a 'Path' with the given radius and default options.  See 'expandPath''.
 expandPath :: Double -> Path R2 -> Path R2

src/Diagrams/TwoD/Path.hs

@@ -43,6 +43,7 @@ module Diagrams.TwoD.Path
        ) where
 
 import           Control.Applicative   (liftA2)
+import           Control.Lens          (view, (^.))
 import qualified Data.Foldable         as F
 import           Data.Semigroup
 import           Data.Typeable
@@ -80,7 +81,7 @@ instance Traced (Trail R2) where
     . lineSegments
 
 instance Traced (Path R2) where
-  getTrace = F.foldMap getTrace . pathTrails
+  getTrace = F.foldMap getTrace . view pathTrails
 
 ------------------------------------------------------------
 --  Constructing path-based diagrams  ----------------------
@@ -112,9 +113,9 @@ instance Renderable (Path R2) b => TrailLike (QDiagram b R2 Any) where
 --   ... }@ syntax may be used.
 stroke' :: (Renderable (Path R2) b, IsName a) => StrokeOpts a -> Path R2 -> Diagram b R2
 stroke' opts path
-  | null (pathTrails pLines) =           mkP pLoops
-  | null (pathTrails pLoops) = mkP pLines
-  | otherwise            = mkP pLines <> mkP pLoops
+  | null (pLines ^. pathTrails) =           mkP pLoops
+  | null (pLoops ^. pathTrails) = mkP pLines
+  | otherwise                   = mkP pLines <> mkP pLoops
   where
     (pLines,pLoops) = partitionPath (isLine . unLoc) path
     mkP p
@@ -282,7 +283,7 @@ isInsideEvenOdd p = odd . crossings p
 -- | Compute the sum of /signed/ crossings of a path as we travel in the
 --   positive x direction from a given point.
 crossings :: P2 -> Path R2 -> Int
-crossings p = F.sum . map (trailCrossings p) . pathTrails
+crossings p = F.sum . map (trailCrossings p) . view pathTrails
 
 -- | Compute the sum of signed crossings of a trail starting from the
 --   given point in the positive x direction.

src/Diagrams/TwoD/Shapes.hs

@@ -59,6 +59,7 @@ import           Diagrams.TwoD.Types
 
 import           Diagrams.Util
 
+import           Control.Lens            (view)
 import           Data.Default.Class
 import           Data.Semigroup
 
@@ -105,7 +106,7 @@ square d = rect d d
 --
 --   <<diagrams/src_Diagrams_TwoD_Shapes_rectEx.svg#diagram=rectEx&width=150>>
 rect :: (TrailLike t, Transformable t, V t ~ R2) => Double -> Double -> t
-rect w h = trailLike . head . pathTrails $ unitSquare # scaleX w # scaleY h
+rect w h = trailLike . head . view pathTrails $ unitSquare # scaleX w # scaleY h
 
 -- > rectEx = rect 1 0.7 # pad 1.1