diff --git a/src/Diagrams/Core.hs b/src/Diagrams/Core.hs
index 16bd029..c9a22b1 100644
--- a/src/Diagrams/Core.hs
+++ b/src/Diagrams/Core.hs
@@ -1,7 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Diagrams.Core
--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)
+-- Copyright   :  (c) 2011-2015 diagrams-core team (see LICENSE)
 -- License     :  BSD-style (see LICENSE)
 -- Maintainer  :  diagrams-discuss@googlegroups.com
 --
@@ -22,7 +22,7 @@
 -- The diagrams library relies heavily on custom types and classes. Many
 -- of the relevant definitions are in the "Diagrams.Core.Types" module.
 -- Indeed the definition of the diagram type @QDiagram@ is contained in:
--- 'Diagrams.Core.Types.QDiagram'. 
+-- 'Diagrams.Core.Types.QDiagram'.
 --
 -- The best place to start when learning
 -- about diagrams\' types is the user manual:
@@ -32,11 +32,11 @@
 --
 -- * "Diagrams.Core.Types"
 --
---     * @Annotation@, 
+--     * @Annotation@,
 --     * @UpAnnots b v m@, @DownAnnots v@,
 --     * @QDiaLeaf b v m@, @Measure v@,
 --     * @Subdiagram b v m@,  @SubMap b v m@,
---     * @Prim b v@, @Backend b v@, 
+--     * @Prim b v@, @Backend b v@,
 --     * @DNode b v a@, @DTree b v a@,
 --     * @RNode b v a@, @RTree b v a@,
 --     * @NullBackend@, @Renderable t b@,
@@ -149,10 +149,11 @@ module Diagrams.Core
          -- * Attributes and styles
 
        , AttributeClass
-       , Attribute, mkAttr, mkTAttr, unwrapAttr
+       , Attribute (..)
 
        , Style, HasStyle(..)
-       , getAttr, combineAttr
+       , getAttr
+       , atAttr, atMAttr, atTAttr
        , applyAttr, applyMAttr, applyTAttr
 
          -- * Envelopes
diff --git a/src/Diagrams/Core/Compile.hs b/src/Diagrams/Core/Compile.hs
index 59ce02c..ee4c203 100644
--- a/src/Diagrams/Core/Compile.hs
+++ b/src/Diagrams/Core/Compile.hs
@@ -7,7 +7,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Diagrams.Core.Compile
--- Copyright   :  (c) 2013 diagrams-core team (see LICENSE)
+-- Copyright   :  (c) 2013-2015 diagrams-core team (see LICENSE)
 -- License     :  BSD-style (see LICENSE)
 -- Maintainer  :  diagrams-discuss@googlegroups.com
 --
@@ -63,7 +63,8 @@ uncurry3 :: (a -> b -> c -> r) -> (a, b, c) -> r
 uncurry3 f (x, y, z) = f x y z
 
 -- | Convert a @QDiagram@ into a raw tree.
-toDTree :: (HasLinearMap v, Floating n, Typeable n) => n -> n -> QDiagram b v n m -> Maybe (DTree b v n Annotation)
+toDTree :: (HasLinearMap v, Floating n, Typeable n)
+        => n -> n -> QDiagram b v n m -> Maybe (DTree b v n Annotation)
 toDTree g n (QD qd)
   = foldDUAL
 
diff --git a/src/Diagrams/Core/Query.hs b/src/Diagrams/Core/Query.hs
index e89b123..4d0885c 100644
--- a/src/Diagrams/Core/Query.hs
+++ b/src/Diagrams/Core/Query.hs
@@ -5,7 +5,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Diagrams.Core.Query
--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)
+-- Copyright   :  (c) 2011-2015 diagrams-core team (see LICENSE)
 -- License     :  BSD-style (see LICENSE)
 -- Maintainer  :  diagrams-discuss@googlegroups.com
 --
@@ -15,9 +15,8 @@
 -----------------------------------------------------------------------------
 
 module Diagrams.Core.Query
-       ( Query (Query)
-       , runQuery
-       ) where
+  ( Query (..)
+  ) where
 
 import           Control.Applicative
 import           Control.Lens            (Rewrapped, Wrapped (..), iso)
@@ -44,7 +43,7 @@ newtype Query v n m = Query { runQuery :: Point v n -> m }
   deriving (Functor, Applicative, Semigroup, Monoid)
 
 instance Wrapped (Query v n m) where
-  type Unwrapped (Query v n m) = (Point v n -> m)
+  type Unwrapped (Query v n m) = Point v n -> m
   _Wrapped' = iso runQuery Query
 
 instance Rewrapped (Query v a m) (Query v' a' m')
diff --git a/src/Diagrams/Core/Style.hs b/src/Diagrams/Core/Style.hs
index 42109a7..ae72012 100644
--- a/src/Diagrams/Core/Style.hs
+++ b/src/Diagrams/Core/Style.hs
@@ -1,10 +1,13 @@
+{-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE Rank2Types            #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE ViewPatterns          #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -19,41 +22,61 @@
 -----------------------------------------------------------------------------
 
 module Diagrams.Core.Style
-       ( -- * Attributes
-         -- $attr
+  ( -- * Attributes
+    -- $attr
+
+    AttributeClass
+  , Attribute(..)
+
+    -- ** Attributes prisms
+  , _Attribute
+  , _MAttribute
+  , _TAttribute
+
+    -- ** Attributes utilities
+  , unwrapAttribute
+  , unmeasureAttribute
+  , attributeType
+
+    -- * Styles
+    -- $style
 
-         AttributeClass
-       , Attribute(..), _Attribute, _MAttribute, _TAttribute
-       , mkAttr, mkMAttr, mkTAttr, unwrapAttr
-       , applyAttr, applyMAttr, applyTAttr
+  , Style(..)
 
-         -- * Styles
-         -- $style
+    -- ** Making styles
+  , attributeToStyle
 
-       , Style(..)
-       , attrToStyle, tAttrToStyle, mAttrToStyle
-       , getAttr, setAttr, addAttr, combineAttr
+    -- ** Extracting attibutes from styles
+  , getAttr
+  , unmeasureAttrs
 
-       , unmeasureAttr, unmeasureAttrs
+    -- ** Attibute lenses
+  , atAttr
+  , atMAttr
+  , atTAttr
 
-       , HasStyle(..)
+    -- ** Applying styles
+  , applyAttr
+  , applyMAttr
+  , applyTAttr
 
-       ) where
+  , HasStyle(..)
 
-import           Control.Arrow ((***))
-import           Control.Lens (At(..), Each(..), Index, Ixed(..),
-                               IxValue, Prism', Rewrapped,
-                               Traversable, Wrapped(..), _Wrapped, iso, prism')
-import qualified Data.HashMap.Strict as HM
-import qualified Data.Map as M
-import           Data.Monoid.Action
+  ) where
+
+import           Control.Applicative
+import           Control.Arrow           ((***))
+import           Control.Lens            hiding (transform)
+import qualified Data.HashMap.Strict     as HM
+import qualified Data.Map                as M
+import           Data.Monoid.Action      as A
 import           Data.Semigroup
-import qualified Data.Set as S
+import qualified Data.Set                as S
 import           Data.Typeable
 
+import           Diagrams.Core.Measure
 import           Diagrams.Core.Transform
 import           Diagrams.Core.V
-import           Diagrams.Core.Measure
 
 import           Linear.Vector
 
@@ -95,70 +118,77 @@ data Attribute (v :: * -> *) n :: * where
 type instance V (Attribute v n) = v
 type instance N (Attribute v n) = n
 
+-- | Attributes form a semigroup, where the semigroup operation simply
+--   returns the right-hand attribute when the types do not match, and
+--   otherwise uses the semigroup operation specific to the (matching)
+--   types.
+instance Typeable n => Semigroup (Attribute v n) where
+  (Attribute a1)  <> (preview _Attribute  -> Just a2) = Attribute  (a1 <> a2)
+  (MAttribute a1) <> (preview _MAttribute -> Just a2) = MAttribute (a1 <> a2)
+  (TAttribute a1) <> (preview _TAttribute -> Just a2) = TAttribute (a1 <> a2)
+  _               <> a2                               = a2
+
+-- | 'TAttribute's are transformed directly, 'MAttribute's have their
+--   local scale multiplied by the average scale of the transform.
+--   Plain 'Attribute's are unaffected.
+instance (Additive v, Traversable v, Floating n) => Transformable (Attribute v n) where
+  transform _ (Attribute a)  = Attribute a
+  transform t (MAttribute a) = MAttribute $ scaleLocal (avgScale t) a
+  transform t (TAttribute a) = TAttribute (transform t a)
+
+-- | Unwrap an unknown 'Attribute' type, performing a dynamic (but
+--   safe) check on the type of the result. If the required type
+--   matches the type of the attribute, the attribute value is
+--   returned wrapped in @Just@; if the types do not match, @Nothing@
+--   is returned.
+--
+--   Measured attributes cannot be extrated from this function until
+--   they have been unmeasured with 'unmeasureAttribute'. If you want a
+--   measured attibute use the '_MAttribute' prism.
+unwrapAttribute :: AttributeClass a => Attribute v n -> Maybe a
+unwrapAttribute (Attribute a)  = cast a
+unwrapAttribute (MAttribute _) = Nothing
+unwrapAttribute (TAttribute a) = cast a
+{-# INLINE unwrapAttribute #-}
+
 -- | Prism onto an 'Attribute'.
 _Attribute :: AttributeClass a => Prism' (Attribute v n) a
 _Attribute = prism' Attribute $ \case Attribute a -> cast a; _ -> Nothing
+{-# INLINE _Attribute #-}
 
 -- | Prism onto an 'MAttribute'.
 _MAttribute :: (AttributeClass a, Typeable n) => Prism' (Attribute v n) (Measured n a)
 _MAttribute = prism' MAttribute $ \case MAttribute a -> cast a; _ -> Nothing
+{-# INLINE _MAttribute #-}
 
 -- | Prism onto a 'TAttribute'.
-_TAttribute :: (AttributeClass a, Transformable a, V a ~ v, N a ~ n)
+_TAttribute :: (V a ~ v, N a ~ n, AttributeClass a, Transformable a)
             => Prism' (Attribute v n) a
 _TAttribute = prism' TAttribute $ \case TAttribute a -> cast a; _ -> Nothing
+{-# INLINE _TAttribute #-}
+
+-- | Turn an 'MAttribute' into an 'Attribute' using the given 'global'
+--   and 'normalized' scale.
+unmeasureAttribute :: (Num n, Typeable n)
+                   => n -> n -> Attribute v n -> Attribute v n
+unmeasureAttribute g n (MAttribute m) = Attribute (fromMeasured g n m)
+unmeasureAttribute _ _ a              = a
+
+-- | Type of an attribute that is stored with a style. Measured
+--   attributes return the type as if it where unmeasured.
+attributeType :: Attribute v n -> TypeRep
+attributeType (Attribute a)  = typeOf a
+attributeType (MAttribute a) = mType a
+attributeType (TAttribute a) = typeOf a
 
--- | Wrap up an attribute.
-mkAttr :: AttributeClass a => a -> Attribute v n
-mkAttr = Attribute
-
--- | Wrap up a measured attribute.
-mkMAttr :: AttributeClass a => Measured n a -> Attribute v n
-mkMAttr = MAttribute
-
--- | Wrap up a transformable attribute.
-mkTAttr :: (AttributeClass a, Transformable a) => a -> Attribute (V a) (N a)
-mkTAttr = TAttribute
-
--- | Unwrap an unknown 'Attribute' type, performing a dynamic (but
---   safe) check on the type of the result.  If the required type
---   matches the type of the attribute, the attribute value is
---   returned wrapped in @Just@; if the types do not match, @Nothing@
---   is returned.
-unwrapAttr :: AttributeClass a => Attribute v n -> Maybe a
-unwrapAttr (Attribute a)   = cast a
-unwrapAttr (MAttribute _)  = Nothing -- can't unwarp measured attributes
-unwrapAttr (TAttribute a)  = cast a
--- Measured is intentionally not an instance on 'AttributeClass' to avoid any
--- mix ups.
-
--- | Same as 'unwrapAttr' but for an 'MAttribute'.
-unwrapMAttr :: (AttributeClass a, Typeable n) => Attribute v n -> Maybe (Measured n a)
-unwrapMAttr (MAttribute m) = cast m
-unwrapMAttr _              = Nothing
-
--- | Attributes form a semigroup, where the semigroup operation simply
---   returns the right-hand attribute when the types do not match, and
---   otherwise uses the semigroup operation specific to the (matching)
---   types.
-instance Typeable n => Semigroup (Attribute v n) where
-  (Attribute a1) <> a2 =
-    case unwrapAttr a2 of
-      Just a2' -> Attribute (a1 <> a2')
-      Nothing  -> a2
-  (MAttribute (Measured a1)) <> a2 =
-    case unwrapMAttr a2 of
-      Just (Measured a2') -> MAttribute $ Measured (a1 <> a2')
-      Nothing             -> a2
-  (TAttribute a1) <> a2 =
-    case unwrapAttr a2 of
-      Just a2' -> TAttribute (a1 <> a2')
-      Nothing  -> a2
+-- Note that we use type 'a' not 'Measured n a' so we don't have to rebuild
+-- when unmeasuring the attributes.
+mType :: forall n a. Typeable a => Measured n a -> TypeRep
+mType _ = typeOf (undefined :: a)
 
-instance (Additive v, Traversable v, Floating n) => Transformable (Attribute v n) where
-  transform _ (Attribute a)  = Attribute a
-  transform t (MAttribute a) = MAttribute $ scaleLocal (avgScale t) a
-  transform t (TAttribute a) = TAttribute (transform t a)
+-- naming convention: "Attribute" deals with the 'AttibuteType'
+-- directly and "Attr" is for other things (like styles). Users should
+-- rarely (if at all) deal with the 'Attibute' type directly.
 
 ------------------------------------------------------------
 --  Styles  ------------------------------------------------
@@ -174,6 +204,8 @@ instance (Additive v, Traversable v, Floating n) => Transformable (Attribute v n
 --   at most one attribute of any given type.
 newtype Style v n = Style (HM.HashMap TypeRep (Attribute v n))
 
+-- instances -----------------------------------------------------------
+
 type instance V (Style v n) = v
 type instance N (Style v n) = n
 
@@ -183,6 +215,10 @@ instance Wrapped (Style v n) where
   _Wrapped' = iso (\(Style m) -> m) Style
   {-# INLINE _Wrapped' #-}
 
+instance Each (Style v n) (Style v' n') (Attribute v n) (Attribute v' n') where
+  each = _Wrapped . each
+  {-# INLINE each #-}
+
 type instance Index (Style v n)   = TypeRep
 type instance IxValue (Style v n) = Attribute v n
 
@@ -194,87 +230,83 @@ instance At (Style v n) where
   at k = _Wrapped' . at k
   {-# INLINE at #-}
 
-instance Each (Style v n) (Style v' n') (Attribute v n) (Attribute v' n') where
-  each = _Wrapped . each
-  {-# INLINE each #-}
+-- | Combine a style by combining the attributes; if the two styles have
+--   attributes of the same type they are combined according to their
+--   semigroup structure.
+instance Typeable n => Semigroup (Style v n) where
+  Style s1 <> Style s2 = Style $ HM.unionWith (<>) s1 s2
+
+-- | The empty style contains no attributes.
+instance Typeable n => Monoid (Style v n) where
+  mempty  = Style HM.empty
+  mappend = (<>)
+
+instance (Additive v, Traversable v, Floating n) => Transformable (Style v n) where
+  transform t = over each (transform t)
+
+-- | Styles have no action on other monoids.
+instance A.Action (Style v n) m
 
--- | Map the attributes of a style, with the possibility of changing the space
---   / number type.
-attrMap :: (Attribute v n -> Attribute u n') -> Style v n -> Style u n'
-attrMap f (Style s) = Style $ HM.map f s
+-- making styles -------------------------------------------------------
+
+-- | Turn an attribute into a style. An easier way to make a style is to
+--   use the monoid instance and apply library functions for applying
+--   that attribute:
+--
+-- @
+-- myStyle = mempty # fc blue :: Style V2 Double
+-- @
+attributeToStyle :: Attribute v n -> Style v n
+attributeToStyle a = Style $ HM.singleton (attributeType a) a
 
--- | Helper function for operating on styles.
-inStyle :: (HM.HashMap TypeRep (Attribute v n) -> HM.HashMap TypeRep (Attribute v n))
-        -> Style v n -> Style v n
-inStyle f (Style s) = Style (f s)
+-- extracting attributes -----------------------------------------------
 
 -- | Extract an attribute from a style of a particular type.  If the
 --   style contains an attribute of the requested type, it will be
 --   returned wrapped in @Just@; otherwise, @Nothing@ is returned.
+--
+--   Trying to extract a measured attibute will fail. It either has to
+--   be unmeasured with 'unmeasureAttrs' or use the 'atMAttr' lens.
 getAttr :: forall a v n. AttributeClass a => Style v n -> Maybe a
-getAttr (Style s) = HM.lookup ty s >>= unwrapAttr
+getAttr (Style s) = HM.lookup ty s >>= unwrapAttribute
   where ty = typeOf (undefined :: a)
-  -- the unwrapAttr should never fail, since we maintain the invariant
-  -- that attributes of type T are always stored with the key "T".
-
--- | Create a style from a single attribute.
-attrToStyle :: AttributeClass a => a -> Style v n
-attrToStyle a = Style (HM.singleton (typeOf a) (mkAttr a))
-
--- | Create a style from a single attribute.
-mAttrToStyle :: forall v n a. (AttributeClass a, Typeable n) => Measured n a -> Style v n
-mAttrToStyle a = Style (HM.singleton (typeOf (undefined :: a)) (mkMAttr a))
--- Note that we use type 'a' not 'Measured n a' so we don't have to rebuild
--- when un-measuring the attributes.
-
--- | Create a style from a single transformable attribute.
-tAttrToStyle :: (AttributeClass a, Transformable a) => a -> Style (V a) (N a)
-tAttrToStyle a = Style (HM.singleton (typeOf a) (mkTAttr a))
-
--- | Add a new attribute to a style, or replace the old attribute of
---   the same type if one exists.
-setAttr :: AttributeClass a => a -> Style v n -> Style v n
-setAttr a = inStyle $ HM.insert (typeOf a) (mkAttr a)
-
--- | Attempt to add a new attribute to a style, but if an attribute of
---   the same type already exists, do not replace it.
-addAttr :: (AttributeClass a, Typeable n) => a -> Style v n -> Style v n
-addAttr a s = attrToStyle a <> s
-
--- | Add a new attribute to a style that does not already contain an
---   attribute of this type, or combine it on the left with an existing
---   attribute.
-combineAttr :: forall a v n. (AttributeClass a, Typeable n) => a -> Style v n -> Style v n
-combineAttr a = inStyle $ HM.insertWith (<>) (typeOf a) (mkAttr a)
+  -- unwrapAttribute can fail if someone tries to unwrap a measured
+  -- attribute before it gets "unmeasured"
 
 -- | Replace all 'MAttribute's with 'Attribute's using the 'global' and
 --   'normalized' scales.
 unmeasureAttrs :: (Num n, Typeable n) => n -> n -> Style v n -> Style v n
-unmeasureAttrs g n = attrMap (unmeasureAttr g n)
--- Note that measured attributes are stored with their type, not their measured
--- type, so there's no need to rebuild the whole map to rename them
+unmeasureAttrs g n = over each (unmeasureAttribute g n)
 
--- | Turn a 'MAttribute' into a 'Attribute'.
-unmeasureAttr :: (Num n, Typeable n) => n -> n -> Attribute v n -> Attribute v n
-unmeasureAttr g n (MAttribute m) = Attribute (fromMeasured g n m)
-unmeasureAttr _ _ a              = a
+-- style lenses --------------------------------------------------------
 
-instance Typeable n => Semigroup (Style v n) where
-  Style s1 <> Style s2 = Style $ HM.unionWith (<>) s1 s2
+mkAttrLens :: forall v n a. Typeable a
+           => Prism' (Attribute v n) a
+           -> Lens' (Style v n) (Maybe a)
+mkAttrLens p f sty =
+  f (sty ^? ix ty . p) <&> \mAtt -> sty & at ty .~ (review p <$> mAtt)
+  where ty = typeOf (undefined :: a)
+{-# INLINE mkAttrLens #-}
 
--- | The empty style contains no attributes; composition of styles is
---   a union of attributes; if the two styles have attributes of the
---   same type they are combined according to their semigroup
---   structure.
-instance Typeable n => Monoid (Style v n) where
-  mempty = Style HM.empty
-  mappend = (<>)
+-- | Lens onto a plain attribute of a style.
+atAttr :: AttributeClass a
+       => Lens' (Style v n) (Maybe a)
+atAttr = mkAttrLens _Attribute
+{-# INLINE atAttr #-}
 
-instance (Additive v, Traversable v, Floating n) => Transformable (Style v n) where
-  transform t = attrMap (transform t)
+-- | Lens onto a measured attribute of a style.
+atMAttr :: (AttributeClass a, Typeable n)
+        => Lens' (Style v n) (Maybe (Measured n a))
+atMAttr = mkAttrLens _MAttribute
+{-# INLINE atMAttr #-}
 
--- | Styles have no action on other monoids.
-instance Action (Style v n) m
+-- | Lens onto a transformable attribute of a style.
+atTAttr :: (V a ~ v, N a ~ n, AttributeClass a, Transformable a)
+        => Lens' (Style v n) (Maybe a)
+atTAttr = mkAttrLens _TAttribute
+{-# INLINE atTAttr #-}
+
+-- applying styles -----------------------------------------------------
 
 -- | Type class for things which have a style.
 class HasStyle a where
@@ -304,19 +336,24 @@ instance HasStyle b => HasStyle (Measured n b) where
   applyStyle = fmap . applyStyle
 
 -- | Apply an attribute to an instance of 'HasStyle' (such as a
---   diagram or a style).  If the object already has an attribute of
+--   diagram or a style). If the object already has an attribute of
 --   the same type, the new attribute is combined on the left with the
 --   existing attribute, according to their semigroup structure.
 applyAttr :: (AttributeClass a, HasStyle d) => a -> d -> d
-applyAttr = applyStyle . attrToStyle
+applyAttr = applyStyle . attributeToStyle . Attribute
 
-applyMAttr :: (N d ~ n, AttributeClass a, HasStyle d, Typeable n) => Measured n a -> d -> d
-applyMAttr = applyStyle . mAttrToStyle
+-- | Apply a measured attribute to an instance of 'HasStyle' (such as a
+--   diagram or a style). If the object already has an attribute of
+--   the same type, the new attribute is combined on the left with the
+--   existing attribute, according to their semigroup structure.
+applyMAttr :: (AttributeClass a, N d ~ n, HasStyle d, Typeable n) => Measured n a -> d -> d
+applyMAttr = applyStyle . attributeToStyle . MAttribute
 
 -- | Apply a transformable attribute to an instance of 'HasStyle'
---   (such as a diagram or a style).  If the object already has an
+--   (such as a diagram or a style). If the object already has an
 --   attribute of the same type, the new attribute is combined on the
 --   left with the existing attribute, according to their semigroup
 --   structure.
 applyTAttr :: (AttributeClass a, Transformable a, V a ~ V d, N a ~ N d, HasStyle d) => a -> d -> d
-applyTAttr = applyStyle . tAttrToStyle
+applyTAttr = applyStyle . attributeToStyle . TAttribute
+
diff --git a/src/Diagrams/Core/Transform.hs b/src/Diagrams/Core/Transform.hs
index 12a5ac9..9cb5360 100644
--- a/src/Diagrams/Core/Transform.hs
+++ b/src/Diagrams/Core/Transform.hs
@@ -309,16 +309,11 @@ Proofs for the specified properties:
 --   help shorten some of the ridiculously long constraint sets.
 class (HasBasis v, Traversable v) => HasLinearMap v
 instance (HasBasis v, Traversable v) => HasLinearMap v
--- Most (if not all) of the functions in linear that use Applicative could be
--- defined in terms of Additive. Ideally we'd only use Additive but for now
--- just stick both in a class.
 
 -- | An 'Additive' vector space whose representation is made up of basis elements.
 class (Additive v, Representable v, Rep v ~ E v) => HasBasis v
 instance (Additive v, Representable v, Rep v ~ E v) => HasBasis v
 
-
-
 -- | Type class for things @t@ which can be transformed.
 class Transformable t where
 
diff --git a/src/Diagrams/Core/Types.hs b/src/Diagrams/Core/Types.hs
index e624fc0..2c818fa 100644
--- a/src/Diagrams/Core/Types.hs
+++ b/src/Diagrams/Core/Types.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE TupleSections              #-}
+{-# LANGUAGE LambdaCase              #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeOperators              #-}
 {-# LANGUAGE UndecidableInstances       #-}
@@ -101,14 +102,20 @@ module Diagrams.Core.Types
          -- $prim
 
        , Prim(..)
+       , _Prim
 
          -- * Backends
 
        , Backend(..)
-       , DNode(..)
        , DTree
-       , RNode(..)
+       , DNode(..)
+
        , RTree
+       , RNode(..)
+       , _RStyle
+       , _RAnnot
+       , _RPrim
+       , _REmpty
 
          -- ** Null backend
 
@@ -125,7 +132,7 @@ module Diagrams.Core.Types
 
 import           Control.Arrow             (first, second, (***))
 import           Control.Lens              (Lens', Rewrapped, Wrapped (..), iso, lens, over, view,
-                                            (^.), _Wrapped, _Wrapping)
+                                            (^.), _Wrapped, _Wrapping, Prism', prism')
 import           Control.Monad             (mplus)
 import           Data.Typeable
 import           Data.List                 (isSuffixOf)
@@ -361,9 +368,9 @@ setTrace :: forall b v n m. ( OrderedField n, Metric v
                             , Semigroup m)
          => Trace v n -> QDiagram b v n m -> QDiagram b v n m
 setTrace t = over _Wrapped' ( D.applyUpre (inj . toDeletable $ t)
-                         . D.applyUpre (inj (deleteL :: Deletable (Trace v n)))
-                         . D.applyUpost (inj (deleteR :: Deletable (Trace v n)))
-                       )
+                            . D.applyUpre (inj (deleteL :: Deletable (Trace v n)))
+                            . D.applyUpost (inj (deleteR :: Deletable (Trace v n)))
+                            )
 
 -- | Lens onto the 'SubMap' of a 'QDiagram' (/i.e./ an association from
 --   names to subdiagrams).
@@ -768,6 +775,9 @@ lookupSub a (SubMap m)
 data Prim b v n where
   Prim :: (Transformable p, Typeable p, Renderable p b) => p -> Prim b (V p) (N p)
 
+_Prim :: (Transformable p, Typeable p, Renderable p b) => Prism' (Prim b (V p) (N p)) p
+_Prim = prism' Prim (\(Prim p) -> cast p)
+
 type instance V (Prim b v n) = v
 type instance N (Prim b v n) = n
 
@@ -785,6 +795,13 @@ instance Renderable (Prim b v n) b where
 -- Backends  -----------------------------------------------
 ------------------------------------------------------------
 
+-- | A 'DTree' is a raw tree representation of a 'QDiagram', with all
+--   the @u@-annotations removed.  It is used as an intermediate type
+--   by diagrams-core; backends should not need to make use of it.
+--   Instead, backends can make use of 'RTree', which 'DTree' gets
+--   compiled and optimized to.
+type DTree b v n a = Tree (DNode b v n a)
+
 data DNode b v n a = DStyle (Style v n)
                    | DTransform (Transformation v n)
                    | DAnnot a
@@ -798,18 +815,6 @@ data DNode b v n a = DStyle (Style v n)
                    | DPrim (Prim b v n)
                    | DEmpty
 
--- | A 'DTree' is a raw tree representation of a 'QDiagram', with all
---   the @u@-annotations removed.  It is used as an intermediate type
---   by diagrams-core; backends should not need to make use of it.
---   Instead, backends can make use of 'RTree', which 'DTree' gets
---   compiled and optimized to.
-type DTree b v n a = Tree (DNode b v n a)
-
-data RNode b v n a = RStyle (Style v n) -- ^ A style node.
-                   | RAnnot a
-                   | RPrim (Prim b v n) -- ^ A primitive.
-                   | REmpty
-
 -- | An 'RTree' is a compiled and optimized representation of a
 --   'QDiagram', which can be used by backends.  They have the
 --   following invariant which backends may rely upon:
@@ -817,6 +822,27 @@ data RNode b v n a = RStyle (Style v n) -- ^ A style node.
 --   * @RPrim@ nodes never have any children.
 type RTree b v n a = Tree (RNode b v n a)
 
+data RNode b v n a = RStyle (Style v n) -- ^ A style node.
+                   | RAnnot a
+                   | RPrim (Prim b v n) -- ^ A primitive.
+                   | REmpty
+
+-- | Prism onto a style of an 'RNode'.
+_RStyle :: Prism' (RNode b v n a) (Style v n)
+_RStyle = prism' RStyle $ \case RStyle s -> Just s; _ -> Nothing
+
+-- | Prism onto an annotation of an 'RNode'.
+_RAnnot :: Prism' (RNode b v n a) a
+_RAnnot = prism' RAnnot $ \case RAnnot a -> Just a; _ -> Nothing
+
+-- | Prism onto a 'Prim' of an 'RNode'.
+_RPrim :: Prism' (RNode b v n a) (Prim b v n)
+_RPrim = prism' RPrim $ \case RPrim p -> Just p; _ -> Nothing
+
+-- | Prism onto an empty 'RNode'.
+_REmpty :: Prism' (RNode b v n a) ()
+_REmpty = prism' (const REmpty) $ \case REmpty -> Just (); _ -> Nothing
+
 -- | Abstract diagrams are rendered to particular formats by
 --   /backends/.  Each backend/vector space combination must be an
 --   instance of the 'Backend' class.