Merge pull request #159 from diagrams/units

* Updates to use `Measure`
* Get rid of bitrotted `Show` backend

diagrams-lib.cabal

@@ -57,6 +57,7 @@ Library
                        Diagrams.TwoD.Align,
                        Diagrams.TwoD.Arrow,
                        Diagrams.TwoD.Arrowheads,
+                       Diagrams.TwoD.Attributes,
                        Diagrams.TwoD.Combinators,
                        Diagrams.TwoD.Deform,
                        Diagrams.TwoD.Transform,
@@ -88,13 +89,13 @@ Library
                        Diagrams.Animation,
                        Diagrams.Animation.Active,
                        Diagrams.Util,
-                       Diagrams.Backend.Show,
                        Diagrams.Backend.CmdLine
   Build-depends:       base >= 4.2 && < 4.8,
                        containers >= 0.3 && < 0.6,
                        array >= 0.3 && < 0.6,
                        semigroups >= 0.3.4 && < 0.13,
                        monoid-extras >= 0.3 && < 0.4,
+                       dual-tree >= 0.2 && < 0.3,
                        diagrams-core >= 1.1 && < 1.2,
                        active >= 0.1 && < 0.2,
                        vector-space >= 0.7.7 && < 0.9,

src/Diagrams/Attributes.hs

@@ -41,10 +41,7 @@ module Diagrams.Attributes (
   -- ** Converting colors
   , colorToSRGBA, colorToRGBA
 
-  -- * Lines
-  -- ** Width
-  , LineWidth, getLineWidth, lineWidth, lineWidthA, lw
-
+  -- * Line stuff
   -- ** Cap style
   , LineCap(..), LineCapA, getLineCap, lineCap
 
@@ -54,9 +51,6 @@ module Diagrams.Attributes (
   -- ** Miter limit
   , LineMiterLimit(..), getLineMiterLimit, lineMiterLimit, lineMiterLimitA
 
-  -- ** Dashing
-  , Dashing(..), DashingA, getDashing, dashing
-
   -- * Compilation utilities
   , splitFills
 
@@ -277,43 +271,9 @@ opacity :: HasStyle a => Double -> a -> a
 opacity = applyAttr . Opacity . Product
 
 ------------------------------------------------------------
---  Lines and stuff    -------------------------------------
+--  Line stuff    -------------------------------------
 ------------------------------------------------------------
 
--- | The width of lines.  By default, the line width is measured with
---   respect to the /final/ coordinate system of a rendered diagram,
---   as opposed to the local coordinate systems in effect at the time
---   the line width was set for various subdiagrams.  This is so that
---   it is easy to combine a variety of shapes (some created by
---   scaling) and have them all drawn using a consistent line width.
---   However, sometimes it is desirable for scaling to affect line
---   width; the 'freeze' operation is provided for this purpose.  The
---   line width of frozen diagrams is affected by transformations.
---
---   Line widths specified on child nodes always override line widths
---   specified at parent nodes.
-newtype LineWidth = LineWidth (Last Double)
-  deriving (Typeable, Semigroup)
-instance AttributeClass LineWidth
-
-instance Default LineWidth where
-    def = LineWidth (Last 0.01)
-
-getLineWidth :: LineWidth -> Double
-getLineWidth (LineWidth (Last w)) = w
-
--- | Set the line (stroke) width.
-lineWidth :: HasStyle a => Double -> a -> a
-lineWidth = applyAttr . LineWidth . Last
-
--- | Apply a 'LineWidth' attribute.
-lineWidthA ::  HasStyle a => LineWidth -> a -> a
-lineWidthA = applyAttr
-
--- | A convenient synonym for 'lineWidth'.
-lw :: HasStyle a => Double -> a -> a
-lw = lineWidth
-
 -- | What sort of shape should be placed at the endpoints of lines?
 data LineCap = LineCapButt   -- ^ Lines end precisely at their endpoints.
              | LineCapRound  -- ^ Lines are capped with semicircles
@@ -379,28 +339,6 @@ lineMiterLimit = applyAttr . LineMiterLimit . Last
 -- | Apply a 'LineMiterLimit' attribute.
 lineMiterLimitA :: HasStyle a => LineMiterLimit -> a -> a
 lineMiterLimitA = applyAttr
-
--- | Create lines that are dashing... er, dashed.
-data Dashing = Dashing [Double] Double
-  deriving (Typeable, Eq)
-
-newtype DashingA = DashingA (Last Dashing)
-  deriving (Typeable, Semigroup, Eq)
-instance AttributeClass DashingA
-
-getDashing :: DashingA -> Dashing
-getDashing (DashingA (Last d)) = d
-
--- | Set the line dashing style.
-dashing :: HasStyle a =>
-           [Double]  -- ^ A list specifying alternate lengths of on
-                     --   and off portions of the stroke.  The empty
-                     --   list indicates no dashing.
-        -> Double    -- ^ An offset into the dash pattern at which the
-                     --   stroke should start.
-        -> a -> a
-dashing ds offs = applyAttr (DashingA (Last (Dashing ds offs)))
-
 ------------------------------------------------------------
 
 data FillLoops v = FillLoops

src/Diagrams/Attributes/Compile.hs

@@ -83,7 +83,7 @@ splitAttr code = fst . splitAttr' Nothing
   --   * is some sort of prim not under consideration: don't apply the attribute; return True
   --   * is unsafe: don't apply the attribute; return False
   --   * is safe  :  do   apply the attribute; return True
-  splitAttr' mattr (Node rp@(RPrim _ (Prim prm)) _) =
+  splitAttr' mattr (Node rp@(RPrim (Prim prm)) _) =
       case cast prm :: Maybe (PrimType code) of
         Nothing  -> (Node rp [], True)
         Just p ->

src/Diagrams/Combinators.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE Rank2Types            #-}
@@ -40,23 +40,27 @@ module Diagrams.Combinators
 
 import           Data.Typeable
 
-import           Control.Lens       (Lens', generateSignatures, lensField,
-                                     lensRules, makeLensesWith, (%~), (&), (.~),
-                                     (^.), _Wrapping)
+import           Control.Lens          (Lens', generateSignatures, lensField,
+                                        lensRules, makeLensesWith, (%~), (&),
+                                        (.~), (^.), _Wrapping)
 import           Data.AdditiveGroup
-import           Data.AffineSpace   ((.+^))
+import           Data.AffineSpace      ((.+^))
 import           Data.Default.Class
+import           Data.Monoid.Deletable (toDeletable)
+import           Data.Monoid.MList     (inj)
 #if __GLASGOW_HASKELL__ < 707
 import           Data.Proxy
 #endif
 import           Data.Semigroup
+import qualified Data.Tree.DUAL        as D
 import           Data.VectorSpace
 
 import           Diagrams.Core
+import           Diagrams.Core.Types   (QDiagram (QD))
 import           Diagrams.Located
 import           Diagrams.Path
-import           Diagrams.Segment   (straight)
-import           Diagrams.Trail     (Trail, trailVertices)
+import           Diagrams.Segment      (straight)
+import           Diagrams.Trail        (Trail, trailVertices)
 import           Diagrams.Util
 
 ------------------------------------------------------------
@@ -89,7 +93,7 @@ withTrace = setTrace . getTrace
 -- | @phantom x@ produces a \"phantom\" diagram, which has the same
 --   envelope and trace as @x@ but produces no output.
 phantom :: (Backend b (V a), Typeable (V a), Enveloped a, Traced a, Monoid' m) => a -> QDiagram b (V a) m
-phantom a = mkQD nullPrim (getEnvelope a) (getTrace a) mempty mempty
+phantom a = QD $ D.leafU ((inj . toDeletable . getEnvelope $ a) <> (inj . toDeletable . getTrace $ a))
 
 -- | @pad s@ \"pads\" a diagram, expanding its envelope by a factor of
 --   @s@ (factors between 0 and 1 can be used to shrink the envelope).
@@ -130,7 +134,7 @@ strut :: ( Backend b v, Typeable v
          , Monoid' m
          )
       => v -> QDiagram b v m
-strut v = mkQD nullPrim env mempty mempty mempty
+strut v = QD $ D.leafU (inj . toDeletable $ env)
   where env = translate ((-0.5) *^ v) . getEnvelope $ straight v
   -- note we can't use 'phantom' here because it tries to construct a
   -- trace as well, and segments do not have a trace in general (only

src/Diagrams/Path.hs

@@ -130,8 +130,6 @@ but that doesn't take into account the fact that some
 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 . op Path --view pathTrails
           -- this type signature is necessary to work around an apparent bug in ghc 6.12.1

src/Diagrams/ThreeD/Camera.hs

@@ -86,8 +86,6 @@ instance Transformable (Camera l) where
              (transform t u)
              l
 
-instance IsPrim (Camera l)
-
 instance Renderable (Camera l) NullBackend where
     render _ _ = mempty
 

src/Diagrams/ThreeD/Light.hs

@@ -38,9 +38,6 @@ instance Transformable PointLight where
 instance Transformable ParallelLight where
     transform t (ParallelLight v c) = ParallelLight (transform t v) c
 
-instance IsPrim PointLight
-instance IsPrim ParallelLight
-
 -- | Construct a Diagram with a single PointLight at the origin, which
 -- takes up no space.
 pointLight :: (Backend b R3, Renderable PointLight b)

src/Diagrams/ThreeD/Shapes.hs

@@ -20,19 +20,19 @@ module Diagrams.ThreeD.Shapes
        , Frustum(..) , frustum, cone, cylinder
        ) where
 
-import           Data.Typeable
 import           Control.Applicative
-import           Control.Lens            ((^.), review, _1)
+import           Control.Lens           (review, (^.), _1)
+import           Data.Typeable
 
 import           Data.AffineSpace
 import           Data.Semigroup
 import           Data.VectorSpace
+import           Diagrams.Angle
 import           Diagrams.Coordinates
 import           Diagrams.Core
 import           Diagrams.Solve
 import           Diagrams.ThreeD.Types
 import           Diagrams.ThreeD.Vector
-import           Diagrams.Angle
 
 data Ellipsoid = Ellipsoid T3
   deriving Typeable
@@ -42,8 +42,6 @@ type instance V Ellipsoid = R3
 instance Transformable Ellipsoid where
   transform t1 (Ellipsoid t2) = Ellipsoid (t1 <> t2)
 
-instance IsPrim Ellipsoid
-
 instance Renderable Ellipsoid NullBackend where
   render _ _ = mempty
 
@@ -70,8 +68,6 @@ type instance V Box = R3
 instance Transformable Box where
     transform t1 (Box t2) = Box (t1 <> t2)
 
-instance IsPrim Box
-
 instance Renderable Box NullBackend where
     render _ _ = mempty
 
@@ -108,8 +104,6 @@ type instance V Frustum = R3
 instance Transformable Frustum where
     transform t1 (Frustum r0 r1 t2) = Frustum r0 r1 (t1 <> t2)
 
-instance IsPrim Frustum
-
 instance Renderable Frustum NullBackend where
     render _ _ = mempty
 

src/Diagrams/TwoD.hs

@@ -144,12 +144,6 @@ module Diagrams.TwoD
        , arrowHead
        , arrowTail
        , arrowShaft
-       , headSize
-       , tailSize
-       , sizes
-       , headWidth
-       , tailWidth
-       , widths
        , headGap
        , tailGap
        , gaps, gap
@@ -159,10 +153,15 @@ module Diagrams.TwoD
        , tailStyle
        , shaftColor
        , shaftStyle
+       , HeadSize, headSize, headSizeA, getHeadSize
+       , hs, hsO, hsL, hsN, hsG
+       , TailSize, tailSize, tailSizeA, getTailSize
+       , ts, tsO, tsL, tsN, tsG
 
          -- * Text
        , text, topLeftText, alignedText, baselineText
-       , font, fontSize, italic, oblique, bold
+       , font, italic, oblique, bold, fontSize
+       , fontSizeO, fontSizeL, fontSizeN, fontSizeG
 
          -- * Images
        , Image, image
@@ -233,6 +232,16 @@ module Diagrams.TwoD
          -- ** Adjusting size
        , sized, sizedAs
 
+       -- ** Width
+       , LineWidth, getLineWidth, lineWidth, lineWidthA
+       , lw, lwN, lwO, lwL, lwG
+       , ultraThin, veryThin, thin, medium, thick, veryThick, none
+       , tiny, verySmall, small, normal, large, veryLarge, huge
+
+       -- ** Dashing
+       , Dashing(..), DashingA, getDashing
+       , dashing, dashingO, dashingL, dashingN, dashingG
+
          -- * Visual aids for understanding the internal model
        , showOrigin
        , showOrigin'
@@ -245,13 +254,14 @@ import           Diagrams.TwoD.Align
 import           Diagrams.TwoD.Arc
 import           Diagrams.TwoD.Arrow
 import           Diagrams.TwoD.Arrowheads
+import           Diagrams.TwoD.Attributes
 import           Diagrams.TwoD.Combinators
+import           Diagrams.TwoD.Deform
 import           Diagrams.TwoD.Ellipse
 import           Diagrams.TwoD.Image
 import           Diagrams.TwoD.Model
 import           Diagrams.TwoD.Path
 import           Diagrams.TwoD.Polygons
-import           Diagrams.TwoD.Deform
 import           Diagrams.TwoD.Shapes
 import           Diagrams.TwoD.Size
 import           Diagrams.TwoD.Text