Merge pull request #51 from diagrams/lens4

Update Wrapped instances for lens-4.0

.gitignore

@@ -9,4 +9,6 @@ cabal-dev
 dist_*
 .hsenv_*
 TAGS
-.diagrams-cache
+.diagrams-cache
+/.cabal-sandbox/
+/cabal.sandbox.config

.travis.yml

@@ -6,13 +6,15 @@ env:
     - HPVER=2013.2.0.0
     - GHCVER=7.4.2
     - GHCVER=7.6.3
-    - GHCVER=head
+    - GHCVER=7.8.1
   global:
     - CABALVER=1.18
 
 matrix:
   allow_failures:
     - env: GHCVER=head
+    - env: GHCVER=7.8.1
+
 
 before_install:
   - git clone http://github.com/diagrams/diagrams-travis travis

diagrams-core.cabal

@@ -44,7 +44,7 @@ Library
                        newtype >= 0.2 && < 0.3,
                        monoid-extras >= 0.3 && < 0.4,
                        dual-tree >= 0.2 && < 0.3,
-                       lens >= 3.8 && < 4
+                       lens >= 4.0 && < 4.1
 
   hs-source-dirs:      src
 

src/Diagrams/Core/Envelope.hs

@@ -43,8 +43,8 @@ module Diagrams.Core.Envelope
        ) where
 
 import           Control.Applicative     ((<$>))
-import           Control.Lens (Wrapped(..), iso, view, over, mapped, unwrapped
-                              , unwrapped')
+import           Control.Lens (Wrapped(..), Rewrapped, iso, over, mapped
+                              , _Wrapping', op)
 import qualified Data.Map                as M
 import           Data.Maybe              (fromMaybe)
 import           Data.Semigroup
@@ -97,18 +97,17 @@ import           Diagrams.Core.V
 --   <http://byorgey.wordpress.com/2009/10/28/collecting-attributes/#comment-2030>.  See also Brent Yorgey, /Monoids: Theme and Variations/, published in the 2012 Haskell Symposium: <http://www.cis.upenn.edu/~byorgey/pub/monoid-pearl.pdf>; video: <http://www.youtube.com/watch?v=X-8NCkD2vOw>.
 newtype Envelope v = Envelope (Option (v -> Max (Scalar v)))
 
-instance (Scalar v ~ s, Scalar v' ~ s', s ~ s')
-                                        => Wrapped
-                                        (Option (v -> Max s))
-                                        (Option (v' -> Max s'))
-                                        (Envelope v) (Envelope v')
-         where wrapped = iso Envelope (\(Envelope e) -> e)
+instance Wrapped (Envelope v) where
+    type Unwrapped (Envelope v) = Option (v -> Max (Scalar v))
+    _Wrapped' = iso (\(Envelope e) -> e) Envelope
+
+instance Rewrapped (Envelope v) (Envelope v')
 
 appEnvelope :: Envelope v -> Maybe (v -> Scalar v)
 appEnvelope (Envelope (Option e)) = (getMax .) <$> e
 
 onEnvelope :: ((v -> Scalar v) -> (v -> Scalar v)) -> Envelope v -> Envelope v
-onEnvelope t = over (unwrapped . mapped) ((Max .) . t . (getMax .))
+onEnvelope t = over (_Wrapping' Envelope . mapped) ((Max .) . t . (getMax .))
 
 mkEnvelope :: (v -> Scalar v) -> Envelope v
 mkEnvelope = Envelope . Option . Just . (Max .)
@@ -189,7 +188,7 @@ instance (OrderedField (Scalar v), InnerSpace v) => Enveloped (Point v) where
   getEnvelope p = moveTo p . mkEnvelope $ const zeroV
 
 instance Enveloped t => Enveloped (TransInv t) where
-  getEnvelope = getEnvelope . view unwrapped'
+  getEnvelope = getEnvelope . op TransInv
 
 instance (Enveloped a, Enveloped b, V a ~ V b) => Enveloped (a,b) where
   getEnvelope (x,y) = getEnvelope x <> getEnvelope y

src/Diagrams/Core/Names.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE OverlappingInstances       #-}
 {-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeSynonymInstances       #-}
 -----------------------------------------------------------------------------
 -- |
@@ -31,7 +32,7 @@ module Diagrams.Core.Names
 
        ) where
 
-import           Control.Lens            (over, unwrapped, Wrapped(..), iso)
+import           Control.Lens            (over, Wrapped(..), Rewrapped, iso, _Unwrapping')
 import           Data.List               (intercalate)
 import qualified Data.Map                as M
 import           Data.Semigroup
@@ -92,8 +93,11 @@ instance Show AName where
 newtype Name = Name [AName]
   deriving (Eq, Ord, Semigroup, Monoid, Typeable)
 
-instance Wrapped [AName] [AName] Name Name
-  where wrapped = iso Name (\(Name ans) -> ans)
+instance Wrapped Name where
+    type Unwrapped Name = [AName]
+    _Wrapped' = iso (\(Name ans) -> ans) Name
+
+instance Rewrapped Name Name
 
 instance Show Name where
   show (Name ns) = intercalate " .> " $ map show ns
@@ -118,7 +122,7 @@ instance Qualifiable Name where
   (|>) = (.>)
 
 instance Qualifiable a => Qualifiable (TransInv a) where
-  (|>) n = over unwrapped (n |>)
+  (|>) n = over (_Unwrapping' TransInv) (n |>)
 
 instance (Qualifiable a, Qualifiable b) => Qualifiable (a,b) where
   n |> (a,b) = (n |> a, n |> b)

src/Diagrams/Core/Query.hs

@@ -21,7 +21,7 @@ module Diagrams.Core.Query
        ) where
 
 import Control.Applicative
-import Control.Lens (Wrapped(..), iso)
+import Control.Lens (Wrapped(..), Rewrapped, iso)
 import Data.Semigroup
 
 import Data.AffineSpace
@@ -45,8 +45,11 @@ import Diagrams.Core.V
 newtype Query v m = Query { runQuery :: Point v -> m }
   deriving (Functor, Applicative, Semigroup, Monoid)
 
-instance Wrapped (Point v -> m) (Point v' -> m') (Query v m) (Query v' m')
-    where wrapped = iso Query runQuery
+instance Wrapped (Query v m) where
+    type Unwrapped (Query v m) = (Point v -> m)
+    _Wrapped' = iso runQuery Query
+
+instance Rewrapped (Query v m) (Query v' m')
 
 type instance V (Query v m) = v
 

src/Diagrams/Core/Style.hs

@@ -44,7 +44,7 @@ module Diagrams.Core.Style
        ) where
 
 import           Control.Arrow ((***))
-import           Control.Lens (Wrapped(..), iso)
+import           Control.Lens (Wrapped(..), Rewrapped, iso)
 import qualified Data.Map as M
 import           Data.Semigroup
 import qualified Data.Set as S
@@ -140,12 +140,11 @@ newtype Style v = Style (M.Map String (Attribute v))
   -- The String keys are serialized TypeRep values, corresponding to
   -- the type of the stored attribute.
 
-instance Wrapped
-         (M.Map String (Attribute v))
-         (M.Map String (Attribute v'))
-         (Style v)
-         (Style v')
-     where wrapped = iso Style (\(Style m) -> m)
+instance Wrapped (Style v) where
+    type Unwrapped (Style v) = M.Map String (Attribute v)
+    _Wrapped' = iso (\(Style m) -> m) Style
+
+instance Rewrapped (Style v) (Style v')
 
 type instance V (Style v) = v
 

src/Diagrams/Core/Trace.hs

@@ -141,12 +141,11 @@ instance Ord a => Monoid (SortedList a) where
 
 newtype Trace v = Trace { appTrace :: Point v -> v -> SortedList (Scalar v) }
 
-instance (Scalar v ~ s, Scalar v' ~ s', s ~ s') =>
-         Wrapped
-         (Point v -> v -> SortedList s)
-         (Point v' -> v' -> SortedList s')
-         (Trace v) (Trace v')
-         where wrapped = iso Trace appTrace
+instance Wrapped (Trace v) where
+    type Unwrapped (Trace v) = Point v -> v -> SortedList (Scalar v)
+    _Wrapped' = iso appTrace Trace
+
+instance Rewrapped (Trace v) (Trace v')
 
 mkTrace :: (Point v -> v -> SortedList (Scalar v)) -> Trace v
 mkTrace = Trace
@@ -163,7 +162,7 @@ deriving instance (Ord (Scalar v)) => Monoid (Trace v)
 type instance V (Trace v) = v
 
 instance (VectorSpace v) => HasOrigin (Trace v) where
-  moveOriginTo (P u) = unwrapping Trace %~ \f p -> f (p .+^ u)
+  moveOriginTo (P u) = (_Wrapping' Trace) %~ \f p -> f (p .+^ u)
 
 instance Show (Trace v) where
   show _ = "<trace>"
@@ -173,7 +172,7 @@ instance Show (Trace v) where
 ------------------------------------------------------------
 
 instance HasLinearMap v => Transformable (Trace v) where
-  transform t = unwrapped %~ \f p v -> f (papply (inv t) p) (apply (inv t) v)
+  transform t = _Wrapped' %~ \f p v -> f (papply (inv t) p) (apply (inv t) v)
 
 ------------------------------------------------------------
 --  Traced class  ------------------------------------------

src/Diagrams/Core/Transform.hs

@@ -6,6 +6,7 @@
            , MultiParamTypeClasses
            , GeneralizedNewtypeDeriving
            , TemplateHaskell
+           , TypeFamilies
            , TypeSynonymInstances
            , ScopedTypeVariables
   #-}
@@ -60,7 +61,7 @@ module Diagrams.Core.Transform
 
        ) where
 
-import           Control.Lens                 (Wrapped(..), iso)
+import           Control.Lens                 (Wrapped(..), Rewrapped, iso)
 import qualified Data.Map as M
 import           Data.Semigroup
 import qualified Data.Set as S
@@ -275,8 +276,11 @@ instance Transformable Rational where
 newtype TransInv t = TransInv t
   deriving (Eq, Ord, Show, Semigroup, Monoid)
 
-instance Wrapped t t' (TransInv t) (TransInv t')
-         where wrapped = iso TransInv (\(TransInv t) -> t)
+instance Wrapped (TransInv t) where
+    type Unwrapped (TransInv t) = t
+    _Wrapped' = iso (\(TransInv t) -> t) TransInv
+
+instance Rewrapped (TransInv t) (TransInv t')
 
 type instance V (TransInv t) = V t