diagrams-core 0.5.0.1 → 0.6

raw patch · 32 files changed

+2637/−3012 lines, 32 filesdep +dual-treedep +monoid-extrasdep ~MemoTriedep ~basedep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: dual-tree, monoid-extras

Dependency ranges changed: MemoTrie, base, containers, vector-space

API changes (from Hackage documentation)

Files

• CHANGES +0/−78
• CHANGES.markdown +184/−0
• README +0/−9
• README.markdown +6/−0
• diagrams-core.cabal +45/−26
• src/Diagrams/Core.hs +165/−0
• src/Diagrams/Core/Envelope.hs +260/−0
• src/Diagrams/Core/HasOrigin.hs +94/−0
• src/Diagrams/Core/Juxtapose.hs +68/−0
• src/Diagrams/Core/Names.hs +111/−0
• src/Diagrams/Core/Points.hs +28/−0
• src/Diagrams/Core/Query.hs +50/−0
• src/Diagrams/Core/Style.hs +239/−0
• src/Diagrams/Core/Trace.hs +172/−0
• src/Diagrams/Core/Transform.hs +278/−0
• src/Diagrams/Core/Types.hs +885/−0
• src/Diagrams/Core/V.hs +52/−0
• src/Graphics/Rendering/Diagrams.hs +0/−153
• src/Graphics/Rendering/Diagrams/Core.hs +0/−632
• src/Graphics/Rendering/Diagrams/Envelope.hs +0/−254
• src/Graphics/Rendering/Diagrams/HasOrigin.hs +0/−94
• src/Graphics/Rendering/Diagrams/Juxtapose.hs +0/−63
• src/Graphics/Rendering/Diagrams/MList.hs +0/−180
• src/Graphics/Rendering/Diagrams/Monoids.hs +0/−467
• src/Graphics/Rendering/Diagrams/Names.hs +0/−231
• src/Graphics/Rendering/Diagrams/Points.hs +0/−28
• src/Graphics/Rendering/Diagrams/Query.hs +0/−50
• src/Graphics/Rendering/Diagrams/Style.hs +0/−239
• src/Graphics/Rendering/Diagrams/Transform.hs +0/−278
• src/Graphics/Rendering/Diagrams/UDTree.hs +0/−161
• src/Graphics/Rendering/Diagrams/Util.hs +0/−27
• src/Graphics/Rendering/Diagrams/V.hs +0/−42

@@ -1,78 +0,0 @@-* 0.5.0.1: 11 May 2012--  - Update MemoTrie upper bound to allow MemoTrie-0.5--* 0.5: 9 March 2012--  * New features:--    - New 'Juxtaposable' class--    - New NullBackend and D types, for conveniently giving a-      monomorphic type to diagrams when we don't care which one it is.--    - #27: Change type of adjustDia to return a new options record-      (with an explicitly filled-in size)--  * New instances:-    - Enveloped, HasOrigin, Juxtaposable, HasStyle, and Transformable-      instances for Sets and tuples-    - V Double = Double-    - Juxtaposable and Boundable instances for Map--  * API changes--    - AnnDiagram -> QDiagram--    - #61: terminology change from "bounds" to "envelope"-      + boundary -> envelopeP-      + "bounding region" -> "envelope"-      + Bounds -> Envelope-      + Boundable -> Enveloped-      + getBounds -> getEnvelope-      + etc.--    - Split out definition of Point into separate package-      (vector-space-points)--    - The Point constructor P is no longer exported from-      Graphics.Rendering.Diagrams.  See the Diagrams.TwoD.Types module-      from diagrams-lib for new tools for working with abstract 2D-      points.  If you really need the P constructor, import-      Graphics.Rendering.Diagrams.Points.--    - Name-related functions now return "located bounding functions"-      instead of pairs of points and bounds, to allow for future-      expansion.--  * Dependency/version changes:-    - vector-space 0.8 is now required.-    - Bump base upper bound to allow 4.5; now tested with GHC 7.4.1.--  * Bug fixes:-    - Bug fix related to empty envelopes--0.4: 23 October 2011-  * improved documentation-  * a few new instances (Newtype Point, Boundable Point)-  * new functions (value, clearValue, resetValue) for working with-    alternate query monoids0.1: 17 May 2011-  * initial preview release--0.3: 18 June 2011-  * big overhaul of name maps:-    - allow arbitrary types as atomic names-    - carry along bounding functions as well as names in NameMaps-    - additional functions for querying information associated with names-  * fix for issue #34 (fix behavior of setBounds)-  * Transformable and HasOrigin instances for Transformations--0.2: 3 June 2011-  * bounding regions can now be overridden-  * new namePoint function for more flexibly assigning names to arbitrary points-  * add HasStyle, Boundable, and HasOrigin instances for lists-  * add a "trivial backend"-  * transformable attributes--0.1.1: 18 May 2011-  * link to new website

@@ -0,0 +1,184 @@+0.6: 11 December 2012+---------------------++* **New features**++    - Proper support for subdiagrams: previous versions of+      diagrams-core had a mechanism for associating names with a pair+      of a location and an envelope.  Now, names are associated with+      actual subdiagrams (including their location and envelope, along+      with all the other information stored by a diagram).++        See+        [`Diagrams.Core.Types`](https://github.com/diagrams/diagrams-core/blob/27b275f45cad514caefcd3035e4e261f1b4adf6f/src/Diagrams/Core/Types.hs#L493).+	  +    - Traces: in addition to an envelope, each diagram now stores a+      "trace", which is like an embedded raytracer: given any ray+      (represented by a base point and a vector), the trace computes+      the closest point of intersection with the diagram along the+      ray.  This is useful for determining points on the boundary of a+      diagram, *e.g.* when drawing arrows between diagrams.++        See [`Diagrams.Core.Trace`](https://github.com/diagrams/diagrams-core/blob/2f8727fdfa60cdf46456a23f358c8a771b2cd90d/src/Diagrams/Core/Trace.hs).++* **API changes**++    - The modules have all been renamed to be more consistent with the+      module naming scheme in the rest of the diagrams universe.  In+      particular:++        `Graphics.Rendering.Diagrams`       -->  `Diagrams.Core`  +        `Grahpics.Rendering.Diagrams.Core`  -->  `Diagrams.Core.Types`  +        `Graphics.Rendering.Diagrams.*`     -->  `Diagrams.Core.*`++    - `Graphics.Rendering.Diagrams.UDTree` has been split out into a+      separate+      [`dual-tree`](http://hackage.haskell.org/package/dual%2Dtree)+      package (which has also been substantially rewritten).++    - `Graphics.Rendering.Diagrams.{Monoids,MList}` have been split+      out into a separate [`monoid-extras`](http://hackage.haskell.org/package/monoid%2Dextras) package.++    - The `names` function now returns a list of names and their+      associated locations, instead of the associated subdiagrams.  In+      particular the output is suitable to be rendered to a `String`+      using `show`.++    - The new `subMap` function fills a similar role that `names` used+      to play, returning the entire mapping from names to subdiagrams.++    - New functions `envelope[VP]May`++        `envelopeV` and `envelopeP` return the zero vector and origin,+        respectively, when called on an empty envelope.  However,+        sometimes it's useful to actually know whether the envelope was+        empty or not (the zero vector and the origin are legitimate+        outputs from non-empty envelopes).  The new functions have their+        return type wrapped in `Maybe` for this purpose.++    - New functions `envelopeS` and `envelopeSMay`++        Like `envelope[VP](May)`, but returning a scalar multiple of+		the input vector.++    - The `Graphics.Rendering.Diagrams.Util` module has been removed,+      along with the `withLength` function.  Calls to `withLength` can+      be replaced using++        `withLength s v = s *^ normalized v`++    - Add needed constraints `(InnerSpace v, OrderedField (Scalar v),+      Monoid' m)` to the type of the `renderDias` method in the+      `MultiBackend` class.++    - Generalized `Transformable` instances for pairs and tuples++		Previously, the components of the tuples were required to have+		the same type; but everything still works as long as they all+		share the same vector space.  This is actually useful in+		practice: say, if we wanted to pair a diagram with a path and+		then apply the same transformation to both.++* **Improvements**++    - More efficient implementation of `diameter`++* **Dependency/version changes**++    - Tested with GHC 7.6.1+    - allow `base-4.6`+    - allow `containers-0.5.*`+    - allow `MemoTrie-0.6.1`++* **Bug fixes**++    - juxtaposeDefault now correctly handles empty envelopes (#37)++        `juxtaposeDefault` is now the identity on the second object if+        either one has an empty envelope.  In particular this means that+        `mempty` is now an identity element for `beside` and friends.++0.5.0.1: 11 May 2012+--------------------++* Update `MemoTrie` upper bound to allow `MemoTrie-0.5`++0.5: 9 March 2012+-----------------++* New features:+    - New `Juxtaposable` class+    - New `NullBackend` and `D` types, for conveniently giving a+      monomorphic type to diagrams when we don't care which one it is.+    - [\#27](http://code.google.com/p/diagrams/issues/detail?id=27): Change type of `adjustDia` to return a new options record+      (with an explicitly filled-in size)++* New instances:+    - `Enveloped`, `HasOrigin`, `Juxtaposable`, `HasStyle`, and `Transformable`+      instances for `Set`s and tuples+    - `V Double = Double`+    - `Juxtaposable` and `Boundable` instances for `Map`++* API changes+    - `AnnDiagram` renamed to `QDiagram`+    - [\#61](http://code.google.com/p/diagrams/issues/detail?id=61): terminology change from "bounds" to "envelope"+        + `boundary` -> `envelopeP`+        + "bounding region" -> "envelope"+        + `Bounds` -> `Envelope`+        + `Boundable` -> `Enveloped`+        + `getBounds` -> `getEnvelope`+        + *etc.*+    - Split out definition of `Point` into separate package+      ([`vector-space-points`](http://hackage.haskell.org/package/vector%2Dspace%2Dpoints))+    - The `Point` constructor `P` is no longer exported from+      `Graphics.Rendering.Diagrams`.  See the `Diagrams.TwoD.Types` module+      from `diagrams-lib` for new tools for working with abstract 2D+      points.  If you really need the `P` constructor, import+      `Graphics.Rendering.Diagrams.Points`.+    - Name-related functions now return "located bounding functions"+      instead of pairs of points and bounds, to allow for future+      expansion.++* Dependency/version changes:+    - `vector-space` 0.8 is now required.+    - Bump base upper bound to allow 4.5; now tested with GHC 7.4.1.++* Bug fixes:+    - Bug fix related to empty envelopes++0.4: 23 October 2011+--------------------++* improved documentation+* a few new instances (Newtype Point, Boundable Point)+* new functions (value, clearValue, resetValue) for working with+  alternate query monoids++0.3: 18 June 2011+-----------------++* big overhaul of name maps:+    - allow arbitrary types as atomic names+    - carry along bounding functions as well as names in NameMaps+    - additional functions for querying information associated with names+* fix for issue #34 (fix behavior of setBounds)+* Transformable and HasOrigin instances for Transformations++0.2: 3 June 2011+----------------++* bounding regions can now be overridden+* new namePoint function for more flexibly assigning names to arbitrary points+* add HasStyle, Boundable, and HasOrigin instances for lists+* add a "trivial backend"+* transformable attributes++0.1.1: 18 May 2011+------------------++* link to new website++0.1: 17 May 2011+----------------++* initial preview release

@@ -1,9 +0,0 @@-The core modules underlying diagrams, a Haskell embedded-domain-specific language for compositional, declarative drawing.  See--  http://projects.haskell.org/diagrams/--for more information about the project, including installation-instructions, tutorials, a user manual, a gallery of example images,-and links to the mailing list, IRC channel, developer wiki and bug-tracker.

@@ -0,0 +1,6 @@+[![Build Status](https://secure.travis-ci.org/diagrams/diagrams-core.png)](http://travis-ci.org/diagrams/diagrams-core)++The core modules defining the basic data structures and algorithms for+[diagrams](http://projects.haskell.org/diagrams), a Haskell embedded+domain-specific language for compositional, declarative drawing.+

@@ -1,5 +1,5 @@ Name:                diagrams-core-Version:             0.5.0.1+Version:             0.6 Synopsis:            Core libraries for diagrams EDSL Description:         The core modules underlying diagrams,                      an embedded domain-specific language@@ -9,38 +9,57 @@ License-file:        LICENSE Author:              Brent Yorgey Maintainer:          diagrams-discuss@googlegroups.com+Bug-reports:         https://github.com/diagrams/diagrams-core/issues Category:            Graphics Build-type:          Simple-Cabal-version:       >=1.6-Extra-source-files:  CHANGES, README-Tested-with:         GHC == 6.12.3, GHC == 7.0.4, GHC == 7.2.1, GHC == 7.4.1+Cabal-version:       >=1.10+Extra-source-files:  CHANGES.markdown, README.markdown+Tested-with:         GHC == 7.0.4, GHC == 7.2.1, GHC == 7.4.2, GHC == 7.6.1 Source-repository head-  type:     darcs-  location: http://patch-tag.com/r/byorgey/diagrams-core+  type:     git+  location: git://github.com/diagrams/diagrams-core.git  Library-  Exposed-modules:     Graphics.Rendering.Diagrams,-                       Graphics.Rendering.Diagrams.Monoids,-                       Graphics.Rendering.Diagrams.MList,-                       Graphics.Rendering.Diagrams.UDTree,-                       Graphics.Rendering.Diagrams.V,-                       Graphics.Rendering.Diagrams.Query,-                       Graphics.Rendering.Diagrams.Transform,-                       Graphics.Rendering.Diagrams.Envelope,-                       Graphics.Rendering.Diagrams.HasOrigin,-                       Graphics.Rendering.Diagrams.Juxtapose,-                       Graphics.Rendering.Diagrams.Points,-                       Graphics.Rendering.Diagrams.Names,-                       Graphics.Rendering.Diagrams.Style,-                       Graphics.Rendering.Diagrams.Util,-                       Graphics.Rendering.Diagrams.Core+  Exposed-modules:     Diagrams.Core,+                       Diagrams.Core.Envelope,+                       Diagrams.Core.HasOrigin,+                       Diagrams.Core.Juxtapose,+                       Diagrams.Core.Names,+                       Diagrams.Core.Points,+                       Diagrams.Core.Style,+                       Diagrams.Core.Trace,+                       Diagrams.Core.Transform,+                       Diagrams.Core.Types,+                       Diagrams.Core.V,+                       Diagrams.Core.Query -  Build-depends:       base >= 4.2 && < 4.6,-                       containers >= 0.3 && < 0.5,+  Build-depends:       base >= 4.2 && < 4.7,+                       containers >= 0.3 && < 0.6,                        semigroups >= 0.3.4 && < 0.9,-                       vector-space >= 0.8 && < 0.9,+                       vector-space >= 0.8.4 && < 0.9,                        vector-space-points >= 0.1 && < 0.2,-                       MemoTrie >= 0.4.7 && < 0.6,-                       newtype >= 0.2 && < 0.3+                       MemoTrie >= 0.4.7 && < 0.7,+                       newtype >= 0.2 && < 0.3,+                       monoid-extras >= 0.2 && < 0.3,+                       dual-tree >= 0.1 && < 0.2    hs-source-dirs:      src++  Other-extensions:    DeriveDataTypeable+                       EmptyDataDecls+                       ExistentialQuantification+                       FlexibleContexts+                       FlexibleInstances+                       GADTs+                       GeneralizedNewtypeDeriving+                       MultiParamTypeClasses+                       OverlappingInstances+                       ScopedTypeVariables+                       StandaloneDeriving+                       TupleSections+                       TypeFamilies+                       TypeOperators+                       TypeSynonymInstances+                       UndecidableInstances++  Default-language:    Haskell2010

@@ -0,0 +1,165 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Core+-- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- The core library of primitives forming the basis of an embedded+-- domain-specific language for describing and rendering diagrams.+-- Normal users of the diagrams library should almost never need to+-- import anything from this package directly; instead, import modules+-- (especially "Diagrams.Prelude") from the diagrams-lib package,+-- which re-exports most things of value to users.+--+-- For most library code needing access to core internals, it should+-- be sufficient to import this module, which simply re-exports useful+-- functionality from other modules in the core library.  Library+-- writers needing finer-grained access or functionality may+-- occasionally find it useful to directly import one of the+-- constituent core modules.+--+-----------------------------------------------------------------------------++module Diagrams.Core+       ( -- * Associated vector spaces++         V++         -- * Points++       , Point, origin, (*.)++         -- * Transformations++         -- ** Invertible linear transformations+       , (:-:), (<->), linv, lapp++         -- ** General transformations+       , Transformation+       , inv, transp, transl+       , apply+       , papply+       , fromLinear++         -- ** Some specific transformations+       , translation, translate, moveTo, place+       , scaling, scale++         -- ** The Transformable class++       , Transformable(..)++         -- ** Translational invariance++       , TransInv(..)++         -- * Names++       , AName+       , Name, IsName(..)+       , Qualifiable(..), (.>)++         -- ** Subdiagram maps++       , SubMap(..)+       , fromNames+       , rememberAs++       , lookupSub++         -- * Attributes and styles++       , AttributeClass+       , Attribute, mkAttr, mkTAttr, unwrapAttr++       , Style, HasStyle(..)+       , getAttr, combineAttr+       , applyAttr, applyTAttr++         -- * Envelopes++       , Envelope+       , inEnvelope, appEnvelope, onEnvelope, mkEnvelope+       , Enveloped(..)+       , envelopeVMay, envelopeV, envelopePMay, envelopeP+       , diameter, radius++         -- * Traces++       , Trace(..)+       , inTrace, mkTrace+       , Traced(..)+       , traceV, traceP+       , maxTraceV, maxTraceP++         -- * Things with local origins++       , HasOrigin(..), moveOriginBy++         -- * Juxtaposable things++       , Juxtaposable(..), juxtaposeDefault++         -- * Queries++       , Query(..)++         -- * Primtives++       , Prim(..), nullPrim++         -- * Diagrams++       , QDiagram, mkQD, Diagram+       , prims+       , envelope, trace, subMap, names, query, sample+       , value, resetValue, clearValue++       , named, nameSub, namePoint+       , withName+       , withNameAll+       , withNames++       , freeze, setEnvelope, setTrace++       , atop++         -- ** Subdiagrams++       , Subdiagram(..), mkSubdiagram+       , getSub, rawSub+       , location+       , subPoint++         -- * Backends++       , Backend(..)+       , MultiBackend(..)+       , Renderable(..)++         -- ** The null backend++       , NullBackend, D++         -- * Convenience classes++       , HasLinearMap+       , OrderedField+       , Monoid'++       ) where++import Diagrams.Core.Types+import Diagrams.Core.Envelope+import Diagrams.Core.HasOrigin+import Diagrams.Core.Juxtapose+import Diagrams.Core.Names+import Diagrams.Core.Points+import Diagrams.Core.Query+import Diagrams.Core.Style+import Diagrams.Core.Trace+import Diagrams.Core.Transform+import Diagrams.Core.V++import Data.Monoid.WithSemigroup (Monoid')

@@ -0,0 +1,260 @@+{-# LANGUAGE TypeFamilies+           , FlexibleInstances+           , FlexibleContexts+           , UndecidableInstances+           , GeneralizedNewtypeDeriving+           , StandaloneDeriving+           , MultiParamTypeClasses+  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Diagrams.Envelope+-- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- "Graphics.Rendering.Diagrams" defines the core library of primitives+-- forming the basis of an embedded domain-specific language for+-- describing and rendering diagrams.+--+-- The @Envelope@ module defines a data type and type class for+-- \"envelopes\", aka functional bounding regions.+--+-----------------------------------------------------------------------------++module Diagrams.Core.Envelope+       ( -- * Envelopes+         Envelope(..)++       , inEnvelope+       , appEnvelope+       , onEnvelope+       , mkEnvelope+       , pointEnvelope++       , Enveloped(..)++         -- * Utility functions+       , diameter+       , radius+       , envelopeVMay, envelopeV, envelopePMay, envelopeP, envelopeSMay, envelopeS++         -- * Miscellaneous+       , OrderedField+       ) where++import           Control.Applicative ((<$>))+import qualified Data.Map as M+import           Data.Maybe (fromMaybe)+import           Data.Semigroup+import qualified Data.Set as S++import           Data.AffineSpace ((.+^), (.-^))+import           Data.VectorSpace++import           Diagrams.Core.HasOrigin+import           Diagrams.Core.Points+import           Diagrams.Core.Transform+import           Diagrams.Core.V++------------------------------------------------------------+--  Envelopes  ---------------------------------------------+------------------------------------------------------------++-- | Every diagram comes equipped with an /envelope/.  What is an envelope?+--+--   Consider first the idea of a /bounding box/. A bounding box+--   expresses the distance to a bounding plane in every direction+--   parallel to an axis.  That is, a bounding box can be thought of+--   as the intersection of a collection of half-planes, two+--   perpendicular to each axis.+--+--   More generally, the intersection of half-planes in /every/+--   direction would give a tight \"bounding region\", or convex hull.+--   However, representing such a thing intensionally would be+--   impossible; hence bounding boxes are often used as an+--   approximation.+--+--   An envelope is an /extensional/ representation of such a+--   \"bounding region\".  Instead of storing some sort of direct+--   representation, we store a /function/ which takes a direction as+--   input and gives a distance to a bounding half-plane as output.+--   The important point is that envelopes can be composed, and+--   transformed by any affine transformation.+--+--   Formally, given a vector @v@, the envelope computes a scalar @s@ such+--   that+--+--     * for every point @u@ inside the diagram,+--       if the projection of @(u - origin)@ onto @v@ is @s' *^ v@, then @s' <= s@.+--+--     * @s@ is the smallest such scalar.+--+--   There is also a special \"empty envelope\".+--+--   The idea for envelopes came from+--   Sebastian Setzer; see+--   <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 { unEnvelope :: Option (v -> Max (Scalar v)) }++inEnvelope :: (Option (v -> Max (Scalar v)) -> Option (v -> Max (Scalar v)))+           -> Envelope v -> Envelope v+inEnvelope f = Envelope . f . unEnvelope++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 = (inEnvelope . fmap) ((Max .) . t . (getMax .))++mkEnvelope :: (v -> Scalar v) -> Envelope v+mkEnvelope = Envelope . Option . Just . (Max .)++-- | Create an envelope for the given point.+pointEnvelope :: (Fractional (Scalar v), InnerSpace v)+              => Point v -> Envelope v+pointEnvelope p = moveTo p (mkEnvelope (const zeroV))++-- | Envelopes form a semigroup with pointwise maximum as composition.+--   Hence, if @e1@ is the envelope for diagram @d1@, and+--   @e2@ is the envelope for @d2@, then @e1 \`mappend\` e2@+--   is the envelope for @d1 \`atop\` d2@.+deriving instance Ord (Scalar v) => Semigroup (Envelope v)++-- | The special empty envelope is the identity for the+--   'Monoid' instance.+deriving instance Ord (Scalar v) => Monoid (Envelope v)++++--   XXX add some diagrams here to illustrate!  Note that Haddock supports+--   inline images, using a \<\<url\>\> syntax.++type instance V (Envelope v) = v++-- | The local origin of an envelope is the point with respect to+--   which bounding queries are made, /i.e./ the point from which the+--   input vectors are taken to originate.+instance (InnerSpace v, Fractional (Scalar v))+         => HasOrigin (Envelope v) where+  moveOriginTo (P u) = onEnvelope $ \f v -> f v ^-^ ((u ^/ (v <.> v)) <.> v)++instance Show (Envelope v) where+  show _ = "<envelope>"++------------------------------------------------------------+--  Transforming envelopes  --------------------------------+------------------------------------------------------------++-- XXX can we get away with removing this Floating constraint? It's the+--   call to normalized here which is the culprit.+instance ( HasLinearMap v, InnerSpace v, Floating (Scalar v))+    => Transformable (Envelope v) where+  transform t =   -- XXX add lots of comments explaining this!+    moveOriginTo (P . negateV . transl $ t) .+    (onEnvelope $ \f v ->+      let v' = normalized $ lapp (transp t) v+          vi = apply (inv t) v+      in  f v' / (v' <.> vi)+    )++------------------------------------------------------------+--  Enveloped class+------------------------------------------------------------++-- | When dealing with envelopes we often want scalars to be an+--   ordered field (i.e. support all four arithmetic operations and be+--   totally ordered) so we introduce this class as a convenient+--   shorthand.+class (Fractional s, Floating s, Ord s, AdditiveGroup s) => OrderedField s+instance (Fractional s, Floating s, Ord s, AdditiveGroup s) => OrderedField s++-- | @Enveloped@ abstracts over things which have an envelope.+class (InnerSpace (V a), OrderedField (Scalar (V a))) => Enveloped a where++  -- | Compute the envelope of an object.  For types with an intrinsic+  --   notion of \"local origin\", the envelope will be based there.+  --   Other types (e.g. 'Trail') may have some other default+  --   reference point at which the envelope will be based; their+  --   instances should document what it is.+  getEnvelope :: a -> Envelope (V a)++instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (Envelope v) where+  getEnvelope = id++instance (OrderedField (Scalar v), InnerSpace v) => Enveloped (Point v) where+  getEnvelope p = moveTo p . mkEnvelope $ const zeroV++instance (Enveloped a, Enveloped b, V a ~ V b) => Enveloped (a,b) where+  getEnvelope (x,y) = getEnvelope x <> getEnvelope y++instance (Enveloped b) => Enveloped [b] where+  getEnvelope = mconcat . map getEnvelope++instance (Enveloped b) => Enveloped (M.Map k b) where+  getEnvelope = mconcat . map getEnvelope . M.elems++instance (Enveloped b) => Enveloped (S.Set b) where+  getEnvelope = mconcat . map getEnvelope . S.elems++------------------------------------------------------------+--  Computing with envelopes+------------------------------------------------------------++-- | Compute the vector from the local origin to a separating+--   hyperplane in the given direction, or @Nothing@ for the empty+--   envelope.+envelopeVMay :: Enveloped a => V a -> a -> Maybe (V a)+envelopeVMay v = fmap ((*^ v) . ($ v)) . appEnvelope . getEnvelope++-- | Compute the vector from the local origin to a separating+--   hyperplane in the given direction.  Returns the zero vector for+--   the empty envelope.+envelopeV :: Enveloped a => V a -> a -> V a+envelopeV v = fromMaybe zeroV . envelopeVMay v++-- | Compute the point on a separating hyperplane in the given+--   direction, or @Nothing@ for the empty envelope.+envelopePMay :: Enveloped a => V a -> a -> Maybe (Point (V a))+envelopePMay v = fmap P . envelopeVMay v++-- | Compute the point on a separating hyperplane in the given+--   direction.  Returns the origin for the empty envelope.+envelopeP :: Enveloped a => V a -> a -> Point (V a)+envelopeP v = P . envelopeV v++-- | Equivalent to the magnitude of 'envelopeVMay':+--+--   @ envelopeSMay v x == fmap magnitude (envelopeVMay v x) @+--+--   (other than differences in rounding error)+--+--   Note that the 'envelopeVMay' / 'envelopePMay' functions above should be+--   preferred, as this requires a call to magnitude.  However, it is more+--   efficient than calling magnitude on the results of those functions.+envelopeSMay :: Enveloped a => V a -> a -> Maybe (Scalar (V a))+envelopeSMay v = fmap ((* magnitude v) . ($ v)) . appEnvelope . getEnvelope++-- | Equivalent to the magnitude of 'envelopeV':+--+--   @ envelopeS v x == magnitude (envelopeV v x) @+--+--   (other than differences in rounding error)+--+--   Note that the 'envelopeV' / 'envelopeP' functions above should be+--   preferred, as this requires a call to magnitude. However, it is more+--   efficient than calling magnitude on the results of those functions.+envelopeS :: (Enveloped a, Num (Scalar (V a))) => V a -> a -> Scalar (V a)+envelopeS v = fromMaybe 0 . envelopeSMay v++-- | Compute the diameter of a enveloped object along a particular+--   vector.  Returns zero for the empty envelope.+diameter :: Enveloped a => V a -> a -> Scalar (V a)+diameter v a = case appEnvelope $ getEnvelope a of+  (Just env) -> (env v - env (negateV v)) * magnitude v+  Nothing -> 0++-- | Compute the \"radius\" (1\/2 the diameter) of an enveloped object+--   along a particular vector.+radius :: Enveloped a => V a -> a -> Scalar (V a)+radius v = (0.5*) . diameter v

@@ -0,0 +1,94 @@+{-# LANGUAGE FlexibleInstances+           , FlexibleContexts+           , TypeFamilies+           , UndecidableInstances+  #-}++-- The UndecidableInstances flag is needed under 6.12.3 for the+-- HasOrigin (a,b) instance.++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Core.HasOrigin+-- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Types which have an intrinsic notion of a \"local origin\",+-- /i.e./ things which are /not/ invariant under translation.+--+-----------------------------------------------------------------------------++module Diagrams.Core.HasOrigin+       ( HasOrigin(..), moveOriginBy, moveTo, place+       ) where++import qualified Data.Map as M+import qualified Data.Set as S++import           Data.AffineSpace ((.-^), (.-.))+import           Data.VectorSpace++import           Diagrams.Core.Points+import           Diagrams.Core.V++-- | Class of types which have an intrinsic notion of a \"local+--   origin\", i.e. things which are not invariant under translation,+--   and which allow the origin to be moved.+--+--   One might wonder why not just use 'Transformable' instead of+--   having a separate class for 'HasOrigin'; indeed, for types which+--   are instances of both we should have the identity+--+--   > moveOriginTo (origin .^+ v) === translate (negateV v)+--+--   The reason is that some things (e.g. vectors, 'Trail's) are+--   transformable but are translationally invariant, i.e. have no+--   origin.+class VectorSpace (V t) => HasOrigin t where++  -- | Move the local origin to another point.+  --+  --   Note that this function is in some sense dual to 'translate'+  --   (for types which are also 'Transformable'); moving the origin+  --   itself while leaving the object \"fixed\" is dual to fixing the+  --   origin and translating the diagram.+  moveOriginTo :: Point (V t) -> t -> t++-- | Move the local origin by a relative vector.+moveOriginBy :: HasOrigin t => V t -> t -> t+moveOriginBy = moveOriginTo . P++-- | Translate the object by the translation that sends the origin to+--   the given point. Note that this is dual to 'moveOriginTo', i.e. we+--   should have+--+--   > moveTo (origin .^+ v) === moveOriginTo (origin .^- v)+--+--   For types which are also 'Transformable', this is essentially the+--   same as 'translate', i.e.+--+--   > moveTo (origin .^+ v) === translate v+moveTo :: HasOrigin t => Point (V t) -> t -> t+moveTo = moveOriginBy . (origin .-.)++-- | A flipped variant of 'moveTo', provided for convenience.  Useful+--   when writing a function which takes a point as an argument, such+--   as when using 'withName' and friends.+place :: HasOrigin t => t -> Point (V t) -> t+place = flip moveTo++instance VectorSpace v => HasOrigin (Point v) where+  moveOriginTo (P u) p = p .-^ u++instance (HasOrigin a, HasOrigin b, V a ~ V b) => HasOrigin (a,b) where+  moveOriginTo p (x,y) = (moveOriginTo p x, moveOriginTo p y)++instance HasOrigin a => HasOrigin [a] where+  moveOriginTo = map . moveOriginTo++instance (HasOrigin a, Ord a) => HasOrigin (S.Set a) where+  moveOriginTo = S.map . moveOriginTo++instance HasOrigin a => HasOrigin (M.Map k a) where+  moveOriginTo = M.map . moveOriginTo

@@ -0,0 +1,68 @@+{-# LANGUAGE FlexibleContexts+           , UndecidableInstances+           , TypeFamilies+  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Core.Juxtapose+-- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Things which can be placed \"next to\" other things, for some+-- appropriate notion of \"next to\".+--+-----------------------------------------------------------------------------++module Diagrams.Core.Juxtapose+       ( Juxtaposable(..), juxtaposeDefault+       ) where++import           Data.Functor ((<$>))+import qualified Data.Map as M+import qualified Data.Set as S++import           Data.VectorSpace++import           Diagrams.Core.Envelope+import           Diagrams.Core.HasOrigin+import           Diagrams.Core.V++-- | Class of things which can be placed \"next to\" other things, for some+--   appropriate notion of \"next to\".+class Juxtaposable a where++  -- | @juxtapose v a1 a2@ positions @a2@ next to @a1@ in the+  --   direction of @v@.  In particular, place @a2@ so that @v@ points+  --   from the local origin of @a1@ towards the old local origin of+  --   @a2@; @a1@'s local origin becomes @a2@'s new local origin.  The+  --   result is just a translated version of @a2@.  (In particular,+  --   this operation does not /combine/ @a1@ and @a2@ in any way.)+  juxtapose :: V a -> a -> a -> a++-- | Default implementation of 'juxtapose' for things which are+--   instances of 'Enveloped' and 'HasOrigin'.  If either envelope is+--   empty, the second object is returned unchanged.+juxtaposeDefault :: (Enveloped a, HasOrigin a) => V a -> a -> a -> a+juxtaposeDefault v a1 a2 =+  case (mv1, mv2) of+    (Just v1, Just v2) -> moveOriginBy (v1 ^+^ v2) a2+    _                  -> a2+  where mv1 = negateV <$> envelopeVMay v a1+        mv2 = envelopeVMay (negateV v) a2++instance (InnerSpace v, OrderedField (Scalar v)) => Juxtaposable (Envelope v) where+  juxtapose = juxtaposeDefault++instance (Enveloped a, HasOrigin a, Enveloped b, HasOrigin b, V a ~ V b)+         => Juxtaposable (a,b) where+  juxtapose = juxtaposeDefault++instance (Enveloped b, HasOrigin b) => Juxtaposable [b] where+  juxtapose = juxtaposeDefault++instance (Enveloped b, HasOrigin b) => Juxtaposable (M.Map k b) where+  juxtapose = juxtaposeDefault++instance (Enveloped b, HasOrigin b, Ord b) => Juxtaposable (S.Set b) where+  juxtapose = juxtaposeDefault

@@ -0,0 +1,111 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverlappingInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Core.Names+-- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- This module defines a type of names which can be used for referring+-- to locations within diagrams, and related types.+--+-----------------------------------------------------------------------------++module Diagrams.Core.Names+       (-- * Names+        -- ** Atomic names+         AName(..)++        -- ** Names+       , Name(..), IsName(..), (.>)++        -- ** Qualifiable+       , Qualifiable(..)++       ) where++import Data.List      ( intercalate )+import Data.Semigroup+import Data.Typeable++------------------------------------------------------------+--  Names  -------------------------------------------------+------------------------------------------------------------++-- | Class for those types which can be used as names.  They must+--   support 'Typeable' (to facilitate extracting them from+--   existential wrappers), 'Ord' (for comparison and efficient+--   storage) and 'Show'.+class (Typeable a, Ord a, Show a) => IsName a where+  toName :: a -> Name+  toName = Name . (:[]) . AName++instance IsName ()+instance IsName Bool+instance IsName Char+instance IsName Int+instance IsName Float+instance IsName Double+instance IsName Integer+instance IsName String+instance IsName a => IsName [a]+instance (IsName a, IsName b) => IsName (a,b)+instance (IsName a, IsName b, IsName c) => IsName (a,b,c)++-- | Atomic names.  @AName@ is just an existential wrapper around+--   things which are 'Typeable', 'Ord' and 'Show'.+data AName where+  AName :: (Typeable a, Ord a, Show a) => a -> AName+  deriving (Typeable)++instance IsName AName where+  toName = Name . (:[])++instance Eq AName where+  (AName a1) == (AName a2) =+    case cast a2 of+      Nothing  -> False+      Just a2' -> a1 == a2'++instance Ord AName where+  (AName a1) `compare` (AName a2) =+    case cast a2 of+      Nothing  -> show (typeOf a1) `compare` show (typeOf a2)+      Just a2' -> a1 `compare` a2'++instance Show AName where+  show (AName a) = show a++-- | A (qualified) name is a (possibly empty) sequence of atomic names.+newtype Name = Name [AName]+  deriving (Eq, Ord, Semigroup, Monoid, Typeable)++instance Show Name where+  show (Name ns) = intercalate " .> " $ map show ns++instance IsName Name where+  toName = id++-- | Convenient operator for writing qualified names with atomic+--   components of different types.  Instead of writing @toName a1 \<\>+--   toName a2 \<\> toName a3@ you can just write @a1 .> a2 .> a3@.+(.>) :: (IsName a1, IsName a2) => a1 -> a2 -> Name+a1 .> a2 = toName a1 <> toName a2++-- | Instances of 'Qualifiable' are things which can be qualified by+--   prefixing them with a name.+class Qualifiable q where+  -- | Qualify with the given name.+  (|>) :: IsName a => a -> q -> q++-- | Of course, names can be qualified using @(.>)@.+instance Qualifiable Name where+  (|>) = (.>)++infixr 5 |>+infixr 5 .>

@@ -0,0 +1,28 @@+{-# LANGUAGE TypeFamilies+  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Core.Points+-- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- A type for /points/ (as distinct from vectors).+--+-----------------------------------------------------------------------------++module Diagrams.Core.Points+       ( -- * Points++         Point(..), origin, (*.)++       ) where++-- We just import from Data.AffineSpace.Point (defined in the+-- vector-space-points package) and re-export.  We also define an+-- instance of V for Point here.+import Data.AffineSpace.Point++import Diagrams.Core.V++type instance V (Point v) = v

@@ -0,0 +1,50 @@+{-# LANGUAGE TypeFamilies+           , GeneralizedNewtypeDeriving+  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Core.Query+-- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- The @Query@ module defines a type for \"queries\" on diagrams, which+-- are functions from points in a vector space to some monoid.+--+-----------------------------------------------------------------------------++module Diagrams.Core.Query+       ( Query(..)+       ) where++import Control.Applicative+import Data.Semigroup++import Data.AffineSpace+import Data.VectorSpace++import Diagrams.Core.HasOrigin+import Diagrams.Core.Points+import Diagrams.Core.Transform+import Diagrams.Core.V++------------------------------------------------------------+--  Queries  -----------------------------------------------+------------------------------------------------------------++-- | A query is a function that maps points in a vector space to+--   values in some monoid. Queries naturally form a monoid, with+--   two queries being combined pointwise.+--+--   The idea for annotating diagrams with monoidal queries came from+--   the graphics-drawingcombinators package, <http://hackage.haskell.org/package/graphics-drawingcombinators>.+newtype Query v m = Query { runQuery :: Point v -> m }+  deriving (Functor, Applicative, Semigroup, Monoid)++type instance V (Query v m) = v++instance VectorSpace v => HasOrigin (Query v m) where+  moveOriginTo (P u) (Query f) = Query $ \p -> f (p .+^ u)++instance HasLinearMap v => Transformable (Query v m) where+  transform t (Query f) = Query $ f . papply (inv t)

@@ -0,0 +1,239 @@+{-# LANGUAGE ScopedTypeVariables+           , GADTs+           , KindSignatures+           , FlexibleInstances+           , MultiParamTypeClasses+           , TypeFamilies+           , UndecidableInstances+  #-}++-- The UndecidableInstances flag is needed under 6.12.3 for the+-- HasStyle (a,b) instance.++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Core.Style+-- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- A definition of /styles/ for diagrams as extensible, heterogeneous+-- collections of attributes.+--+-----------------------------------------------------------------------------++module Diagrams.Core.Style+       ( -- * Attributes+         -- $attr++         AttributeClass+       , Attribute(..)+       , mkAttr, mkTAttr, unwrapAttr+       , applyAttr, applyTAttr++         -- * Styles+         -- $style++       , Style(..)+       , attrToStyle, tAttrToStyle+       , getAttr, setAttr, addAttr, combineAttr++       , HasStyle(..)++       ) where++import           Control.Arrow ((***))+import qualified Data.Map as M+import           Data.Semigroup+import qualified Data.Set as S+import           Data.Typeable++import Data.Monoid.Action++import           Diagrams.Core.Transform+import           Diagrams.Core.V++------------------------------------------------------------+--  Attributes  --------------------------------------------+------------------------------------------------------------++-- $attr+-- An /attribute/ is anything that determines some aspect of a+-- diagram's rendering.  The standard diagrams library defines several+-- standard attributes (line color, line width, fill color, etc.) but+-- additional attributes may easily be created.  Additionally, a given+-- backend need not handle (or even know about) attributes used in+-- diagrams it renders.+--+-- The attribute code is inspired by xmonad's @Message@ type, which+-- was in turn based on ideas in:+--+-- Simon Marlow.+-- /An Extensible Dynamically-Typed Hierarchy of Exceptions/.+-- Proceedings of the 2006 ACM SIGPLAN workshop on+-- Haskell. <http://research.microsoft.com/apps/pubs/default.aspx?id=67968>.++-- | Every attribute must be an instance of @AttributeClass@, which+--   simply guarantees 'Typeable' and 'Semigroup' constraints.  The+--   'Semigroup' instance for an attribute determines how it will combine+--   with other attributes of the same type.+class (Typeable a, Semigroup a) => AttributeClass a where++-- | An existential wrapper type to hold attributes.  Some attributes+--   are affected by transformations and some are not.+data Attribute v :: * where+  Attribute  :: AttributeClass a => a -> Attribute v+  TAttribute :: (AttributeClass a, Transformable a, V a ~ v) => a -> Attribute v++type instance V (Attribute v) = v++-- | Wrap up an attribute.+mkAttr :: AttributeClass a => a -> Attribute v+mkAttr = Attribute++-- | Wrap up a transformable attribute.+mkTAttr :: (AttributeClass a, Transformable a, V a ~ v) => a -> Attribute v+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 -> Maybe a+unwrapAttr (Attribute a)  = cast a+unwrapAttr (TAttribute a) = cast a++-- | 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 Semigroup (Attribute v) where+  (Attribute a1) <> a2 =+    case unwrapAttr a2 of+      Nothing  -> a2+      Just a2' -> Attribute (a1 <> a2')+  (TAttribute a1) <> a2 =+    case unwrapAttr a2 of+      Nothing  -> a2+      Just a2' -> TAttribute (a1 <> a2')++instance HasLinearMap v => Transformable (Attribute v) where+  transform _ (Attribute  a) = Attribute a+  transform t (TAttribute a) = TAttribute (transform t a)++------------------------------------------------------------+--  Styles  ------------------------------------------------+------------------------------------------------------------++-- $style+-- A 'Style' is a heterogeneous collection of attributes, containing+-- at most one attribute of any given type.  This is also based on+-- ideas stolen from xmonad, specifically xmonad's implementation of+-- user-extensible state.++-- | A @Style@ is a heterogeneous collection of attributes, containing+--   at most one attribute of any given type.+newtype Style v = Style (M.Map String (Attribute v))+  -- The String keys are serialized TypeRep values, corresponding to+  -- the type of the stored attribute.++type instance V (Style v) = v++-- | Helper function for operating on styles.+inStyle :: (M.Map String (Attribute v) -> M.Map String (Attribute v))+        -> Style v -> Style v+inStyle f (Style s) = Style (f s)++-- | 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.+getAttr :: forall a v. AttributeClass a => Style v -> Maybe a+getAttr (Style s) = M.lookup ty s >>= unwrapAttr+  where ty = show . 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 :: forall a v. AttributeClass a => a -> Style v+attrToStyle a = Style (M.singleton (show . typeOf $ (undefined :: a)) (mkAttr a))++-- | Create a style from a single transformable attribute.+tAttrToStyle :: forall a v. (AttributeClass a, Transformable a, V a ~ v) => a -> Style v+tAttrToStyle a = Style (M.singleton (show . typeOf $ (undefined :: a)) (mkTAttr a))++-- | Add a new attribute to a style, or replace the old attribute of+--   the same type if one exists.+setAttr :: forall a v. AttributeClass a => a -> Style v -> Style v+setAttr a = inStyle $ M.insert (show . typeOf $ (undefined :: 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 => a -> Style v -> Style v+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 :: AttributeClass a => a -> Style v -> Style v+combineAttr a s =+  case getAttr s of+    Nothing -> setAttr a s+    Just a' -> setAttr (a <> a') s++instance Semigroup (Style v) where+  Style s1 <> Style s2 = Style $ M.unionWith (<>) s1 s2++-- | 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 Monoid (Style v) where+  mempty = Style M.empty+  mappend = (<>)+++instance HasLinearMap v => Transformable (Style v) where+  transform t = inStyle $ M.map (transform t)++-- | Styles have no action on other monoids.+instance Action (Style v) m++-- | Type class for things which have a style.+class HasStyle a where+  -- | /Apply/ a style by combining it (on the left) with the+  --   existing style.+  applyStyle :: Style (V a) -> a -> a++instance HasStyle (Style v) where+  applyStyle = mappend++instance (HasStyle a, HasStyle b, V a ~ V b) => HasStyle (a,b) where+  applyStyle s = applyStyle s *** applyStyle s++instance HasStyle a => HasStyle [a] where+  applyStyle = fmap . applyStyle++instance HasStyle b => HasStyle (a -> b) where+  applyStyle = fmap . applyStyle++instance HasStyle a => HasStyle (M.Map k a) where+  applyStyle = fmap . applyStyle++instance (HasStyle a, Ord a) => HasStyle (S.Set a) where+  applyStyle = S.map . applyStyle++-- | Apply an 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.+applyAttr :: (AttributeClass a, HasStyle d) => a -> d -> d+applyAttr = applyStyle . attrToStyle++-- | Apply a transformable 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.+applyTAttr :: (AttributeClass a, Transformable a, V a ~ V d, HasStyle d) => a -> d -> d+applyTAttr = applyStyle . tAttrToStyle

@@ -0,0 +1,172 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE StandaloneDeriving #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Core.Trace+-- Copyright   :  (c) 2012 diagrams-core team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- "Diagrams" defines the core library of primitives+-- forming the basis of an embedded domain-specific language for+-- describing and rendering diagrams.+--+-- The @Trace@ module defines a data type and type class for+-- \"traces\", aka functional boundaries, essentially corresponding to+-- embedding a raytracer with each diagram.+--+-----------------------------------------------------------------------------++module Diagrams.Core.Trace+       ( -- * Traces+         Trace(..)++       , inTrace+       , mkTrace++         -- * Traced class++       , Traced(..)++         -- * Computing with traces++       , traceV, traceP+       , maxTraceV, maxTraceP++       ) where++import           Control.Applicative+import qualified Data.Map as M+import           Data.Semigroup+import qualified Data.Set as S++import           Data.AffineSpace+import           Data.Monoid.PosInf+import           Data.VectorSpace++import           Diagrams.Core.HasOrigin+import           Diagrams.Core.Points+import           Diagrams.Core.Transform+import           Diagrams.Core.V++------------------------------------------------------------+--  Trace  -------------------------------------------------+------------------------------------------------------------++-- | Every diagram comes equipped with a *trace*.  Intuitively, the+--   trace for a diagram is like a raytracer: given a line+--   (represented as a base point + direction), the trace computes the+--   distance from the base point along the line to the first+--   intersection with the diagram.  The distance can be negative if+--   the intersection is in the opposite direction from the base+--   point, or infinite if the ray never intersects the diagram.+--   Note: to obtain the distance to the *furthest* intersection+--   instead of the *closest*, just negate the direction vector and+--   then negate the result.+--+--   Note that the output should actually be interpreted not as an+--   absolute distance, but as a multiplier relative to the input+--   vector.  That is, if the input vector is @v@ and the returned+--   scalar is @s@, the distance from the base point to the+--   intersection is given by @s *^ magnitude v@.++newtype Trace v = Trace { appTrace :: Point v -> v -> PosInf (Scalar v) }++inTrace :: ((Point v -> v -> PosInf (Scalar v)) -> (Point v -> v -> PosInf (Scalar v)))+        -> Trace v -> Trace v+inTrace f = Trace . f . appTrace++mkTrace :: (Point v -> v -> PosInf (Scalar v)) -> Trace v+mkTrace = Trace++-- | Traces form a semigroup with pointwise minimum as composition.+--   Hence, if @t1@ is the trace for diagram @d1@, and+--   @e2@ is the trace for @d2@, then @e1 \`mappend\` e2@+--   is the trace for @d1 \`atop\` d2@.+deriving instance Ord (Scalar v) => Semigroup (Trace v)++-- | The identity for the 'Monoid' instance is the constantly infinite+--   trace.+deriving instance Ord (Scalar v) => Monoid (Trace v)++type instance V (Trace v) = v++instance (VectorSpace v) => HasOrigin (Trace v) where+  moveOriginTo (P u) = inTrace $ \f p -> f (p .+^ u)++instance Show (Trace v) where+  show _ = "<trace>"++------------------------------------------------------------+--  Transforming traces  -----------------------------------+------------------------------------------------------------++instance HasLinearMap v => Transformable (Trace v) where+  transform t = inTrace $ \f p v -> f (papply (inv t) p) (apply (inv t) v)++------------------------------------------------------------+--  Traced class  ------------------------------------------+------------------------------------------------------------++-- | @Traced@ abstracts over things which have a trace.+class (Ord (Scalar (V a)), VectorSpace (V a)) => Traced a where++  -- | Compute the trace of an object.+  getTrace :: a -> Trace (V a)++instance (Ord (Scalar v), VectorSpace v) => Traced (Trace v) where+  getTrace = id++-- | The trace of a single point is the empty trace, /i.e./ the one+--   which returns positive infinity for every query.  Arguably it+--   should return a finite distance for vectors aimed directly at the+--   given point and infinity for everything else, but due to+--   floating-point inaccuracy this is problematic.  Note that the+--   envelope for a single point is *not* the empty envelope (see+--   "Diagrams.Core.Envelope").+instance (Ord (Scalar v), VectorSpace v) => Traced (Point v) where+  getTrace p = mempty++instance (Traced a, Traced b, V a ~ V b) => Traced (a,b) where+  getTrace (x,y) = getTrace x <> getTrace y++instance (Traced b) => Traced [b] where+  getTrace = mconcat . map getTrace++instance (Traced b) => Traced (M.Map k b) where+  getTrace = mconcat . map getTrace . M.elems++instance (Traced b) => Traced (S.Set b) where+  getTrace = mconcat . map getTrace . S.elems++------------------------------------------------------------+--  Computing with traces  ---------------------------------+------------------------------------------------------------++-- | Compute the vector from the given point to the boundary of the+--   given object in the given direction, or @Nothing@ if there is no+--   intersection.+traceV :: Traced a => Point (V a) -> V a -> a -> Maybe (V a)+traceV p v a = case appTrace (getTrace a) p v of+                 Finite s -> Just (s *^ v)+                 PosInfty -> Nothing++-- | Given a base point and direction, compute the closest point on+--   the boundary of the given object, or @Nothing@ if there is no+--   intersection in the given direction.+traceP :: Traced a => Point (V a) -> V a -> a -> Maybe (Point (V a))+traceP p v a = (p .+^) <$> traceV p v a++-- | Like 'traceV', but computes a vector to the *furthest* point on+--   the boundary instead of the closest.+maxTraceV :: Traced a => Point (V a) -> V a -> a -> Maybe (V a)+maxTraceV p = traceV p . negateV++-- | Like 'traceP', but computes the *furthest* point on the boundary+--   instead of the closest.+maxTraceP :: Traced a => Point (V a) -> V a -> a -> Maybe (Point (V a))+maxTraceP p v a = (p .+^) <$> maxTraceV p v a

@@ -0,0 +1,278 @@+{-# LANGUAGE TypeOperators+           , FlexibleContexts+           , FlexibleInstances+           , UndecidableInstances+           , TypeFamilies+           , MultiParamTypeClasses+           , GeneralizedNewtypeDeriving+           , TypeSynonymInstances+  #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Core.Transform+-- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- "Diagrams" defines the core library of primitives+-- forming the basis of an embedded domain-specific language for+-- describing and rendering diagrams.+--+-- The @Transform@ module defines generic transformations+-- parameterized by any vector space.+--+-----------------------------------------------------------------------------++module Diagrams.Core.Transform+       (+         -- * Transformations++         -- ** Invertible linear transformations+         (:-:)(..), (<->), linv, lapp++         -- ** General transformations+       , Transformation(..)+       , inv, transp, transl+       , apply+       , papply+       , fromLinear++         -- * The Transformable class++       , HasLinearMap+       , Transformable(..)++         -- * Translational invariance++       , TransInv(..)++         -- * Vector space independent transformations+         -- | Most transformations are specific to a particular vector+         --   space, but a few can be defined generically over any+         --   vector space.++       , translation, translate+       , scaling, scale++       ) where++import qualified Data.Map as M+import           Data.Semigroup+import qualified Data.Set as S++import           Data.AdditiveGroup+import           Data.AffineSpace ((.-.))+import           Data.Basis+import           Data.LinearMap+import           Data.MemoTrie+import           Data.Monoid.Action+import           Data.Monoid.Deletable+import           Data.VectorSpace++import           Diagrams.Core.HasOrigin+import           Diagrams.Core.Points+import           Diagrams.Core.V++------------------------------------------------------------+--  Transformations  ---------------------------------------+------------------------------------------------------------++-------------------------------------------------------+--  Invertible linear transformations  ----------------+-------------------------------------------------------++-- | @(v1 :-: v2)@ is a linear map paired with its inverse.+data (:-:) u v = (u :-* v) :-: (v :-* u)+infixr 7 :-:++-- | Create an invertible linear map from two functions which are+--   assumed to be linear inverses.+(<->) :: (HasLinearMap u, HasLinearMap v) => (u -> v) -> (v -> u) -> (u :-: v)+f <-> g = linear f :-: linear g++instance HasLinearMap v => Semigroup (v :-: v) where+  (f :-: f') <> (g :-: g') = f *.* g :-: g' *.* f'++-- | Invertible linear maps from a vector space to itself form a+--   monoid under composition.+instance HasLinearMap v => Monoid (v :-: v) where+  mempty = idL :-: idL+  mappend = (<>)++-- | Invert a linear map.+linv :: (u :-: v) -> (v :-: u)+linv (f :-: g) = g :-: f++-- | Apply a linear map to a vector.+lapp :: (VectorSpace v, Scalar u ~ Scalar v, HasLinearMap u) => (u :-: v) -> u -> v+lapp (f :-: _) = lapply f++--------------------------------------------------+--  Affine transformations  ----------------------+--------------------------------------------------++-- | General (affine) transformations, represented by an invertible+--   linear map, its /transpose/, and a vector representing a+--   translation component.+--+--   By the /transpose/ of a linear map we mean simply the linear map+--   corresponding to the transpose of the map's matrix+--   representation.  For example, any scale is its own transpose,+--   since scales are represented by matrices with zeros everywhere+--   except the diagonal.  The transpose of a rotation is the same as+--   its inverse.+--+--   The reason we need to keep track of transposes is because it+--   turns out that when transforming a shape according to some linear+--   map L, the shape's /normal vectors/ transform according to L's+--   inverse transpose.  This is exactly what we need when+--   transforming bounding functions, which are defined in terms of+--   /perpendicular/ (i.e. normal) hyperplanes.++data Transformation v = Transformation (v :-: v) (v :-: v) v++type instance V (Transformation v) = v++-- | Invert a transformation.+inv :: HasLinearMap v => Transformation v -> Transformation v+inv (Transformation t t' v) = Transformation (linv t) (linv t')+                                             (negateV (lapp (linv t) v))++-- | Get the transpose of a transformation (ignoring the translation+--   component).+transp :: Transformation v -> (v :-: v)+transp (Transformation _ t' _) = t'++-- | Get the translational component of a transformation.+transl :: Transformation v -> v+transl (Transformation _ _ v) = v++-- | Transformations are closed under composition; @t1 <> t2@ is the+--   transformation which performs first @t2@, then @t1@.+instance HasLinearMap v => Semigroup (Transformation v) where+  Transformation t1 t1' v1 <> Transformation t2 t2' v2+    = Transformation (t1 <> t2) (t2' <> t1') (v1 ^+^ lapp t1 v2)++instance HasLinearMap v => Monoid (Transformation v) where+  mempty = Transformation mempty mempty zeroV+  mappend = (<>)++-- | Transformations can act on transformable things.+instance (HasLinearMap v, v ~ (V a), Transformable a)+         => Action (Transformation v) a where+  act = transform++-- | Apply a transformation to a vector.  Note that any translational+--   component of the transformation will not affect the vector, since+--   vectors are invariant under translation.+apply :: HasLinearMap v => Transformation v -> v -> v+apply (Transformation t _ _) = lapp t++-- | Apply a transformation to a point.+papply :: HasLinearMap v => Transformation v -> Point v -> Point v+papply (Transformation t _ v) (P p) = P $ lapp t p ^+^ v++-- | Create a general affine transformation from an invertible linear+--   transformation and its transpose.  The translational component is+--   assumed to be zero.+fromLinear :: AdditiveGroup v => (v :-: v) -> (v :-: v) -> Transformation v+fromLinear l1 l2 = Transformation l1 l2 zeroV++------------------------------------------------------------+--  The Transformable class  -------------------------------+------------------------------------------------------------++-- | 'HasLinearMap' is a poor man's class constraint synonym, just to+--   help shorten some of the ridiculously long constraint sets.+class (HasBasis v, HasTrie (Basis v), VectorSpace v) => HasLinearMap v+instance (HasBasis v, HasTrie (Basis v), VectorSpace v) => HasLinearMap v++-- | Type class for things @t@ which can be transformed.+class HasLinearMap (V t) => Transformable t where++  -- | Apply a transformation to an object.+  transform :: Transformation (V t) -> t -> t++instance HasLinearMap v => Transformable (Transformation v) where+  transform t1 t2 = t1 <> t2++instance HasLinearMap v => HasOrigin (Transformation v) where+  moveOriginTo p = translate (origin .-. p)++instance (Transformable a, Transformable b, V a ~ V b)+      => Transformable (a,b) where+  transform t (x,y) =  ( transform t x+                       , transform t y+                       )++instance (Transformable a, Transformable b, Transformable c, V a ~ V b, V a ~ V c)+      => Transformable (a,b,c) where+  transform t (x,y,z) = ( transform t x+                        , transform t y+                        , transform t z+                        )++instance Transformable t => Transformable [t] where+  transform = map . transform++instance (Transformable t, Ord t) => Transformable (S.Set t) where+  transform = S.map . transform++instance Transformable t => Transformable (M.Map k t) where+  transform = M.map . transform++instance HasLinearMap v => Transformable (Point v) where+  transform = papply++instance Transformable m => Transformable (Deletable m) where+  transform = fmap . transform++instance Transformable Double where+  transform = apply++instance Transformable Rational where+  transform = apply++------------------------------------------------------------+--  Translational invariance  ------------------------------+------------------------------------------------------------++-- | @TransInv@ is a wrapper which makes a transformable type+--   translationally invariant; the translational component of+--   transformations will no longer affect things wrapped in+--   @TransInv@.+newtype TransInv t = TransInv { unTransInv :: t }+  deriving (Show, Semigroup, Monoid)++type instance V (TransInv t) = V t++instance VectorSpace (V t) => HasOrigin (TransInv t) where+  moveOriginTo = const id++instance Transformable t => Transformable (TransInv t) where+  transform tr (TransInv t) = TransInv (translate (negateV (transl tr)) . transform tr $ t)++------------------------------------------------------------+--  Generic transformations  -------------------------------+------------------------------------------------------------++-- | Create a translation.+translation :: HasLinearMap v => v -> Transformation v+translation = Transformation mempty mempty++-- | Translate by a vector.+translate :: (Transformable t, HasLinearMap (V t)) => V t -> t -> t+translate = transform . translation++-- | Create a uniform scaling transformation.+scaling :: (HasLinearMap v, Fractional (Scalar v))+        => Scalar v -> Transformation v+scaling s = fromLinear lin lin      -- scaling is its own transpose+  where lin = (s *^) <-> (^/ s)++-- | Scale uniformly in every dimension by the given scalar.+scale :: (Transformable t, Fractional (Scalar (V t)), Eq (Scalar (V t)))+      => Scalar (V t) -> t -> t+scale 0 = error "scale by zero!  Halp!"  -- XXX what should be done here?+scale s = transform $ scaling s

@@ -0,0 +1,885 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE EmptyDataDecls #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Core.Types+-- Copyright   :  (c) 2011-2012 diagrams-core team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- The core library of primitives forming the basis of an embedded+-- domain-specific language for describing and rendering diagrams.+--+-- "Diagrams.Core.Types" defines types and classes for+-- primitives, diagrams, and backends.+--+-----------------------------------------------------------------------------++{- ~~~~ Note [breaking up Types module]++   Although it's not as bad as it used to be, this module has a lot of+   stuff in it, and it might seem a good idea in principle to break it up+   into smaller modules.  However, it's not as easy as it sounds: everything+   in this module cyclically depends on everything else.+-}++module Diagrams.Core.Types+       (+         -- * Diagrams++         -- ** Annotations+         UpAnnots, DownAnnots+       , QDiagram(..), mkQD, Diagram++         -- * Operations on diagrams+         -- ** Extracting information+       , prims+       , envelope, trace, subMap, names, query, sample+       , value, resetValue, clearValue++         -- ** Combining diagrams++         -- | For many more ways of combining diagrams, see+         -- "Diagrams.Combinators" from the diagrams-lib package.++       , atop++         -- ** Modifying diagrams+         -- *** Names+       , named+       , nameSub+       , namePoint+       , withName+       , withNameAll+       , withNames++         -- *** Other+       , freeze+       , setEnvelope+       , setTrace++         -- * Subdiagrams++       , Subdiagram(..), mkSubdiagram+       , getSub, rawSub+       , location+       , subPoint++         -- * Subdiagram maps++       , SubMap(..)++       , fromNames, rememberAs, lookupSub++         -- * Primtives+         -- $prim++       , Prim(..), nullPrim++         -- * Backends++       , Backend(..)+       , MultiBackend(..)++         -- ** Null backend++       , NullBackend, D++         -- * Renderable++       , Renderable(..)++       ) where++import           Control.Applicative ((<$>), (<*>))+import           Control.Arrow (first, second, (***))+import           Control.Monad (mplus)+import           Control.Newtype+import           Data.AffineSpace ((.-.))+import           Data.List (isSuffixOf)+import qualified Data.Map as M+import           Data.Maybe (listToMaybe, fromMaybe)+import           Data.Semigroup+import qualified Data.Traversable as T+import           Data.Typeable+import           Data.VectorSpace++import           Data.Monoid.Action+import           Data.Monoid.Coproduct+import           Data.Monoid.Deletable+import           Data.Monoid.MList+import           Data.Monoid.Split+import           Data.Monoid.WithSemigroup+import qualified Data.Tree.DUAL as D++import           Diagrams.Core.Envelope+import           Diagrams.Core.HasOrigin+import           Diagrams.Core.Juxtapose+import           Diagrams.Core.Names+import           Diagrams.Core.Points+import           Diagrams.Core.Query+import           Diagrams.Core.Style+import           Diagrams.Core.Trace+import           Diagrams.Core.Transform+import           Diagrams.Core.V++-- XXX TODO: add lots of actual diagrams to illustrate the+-- documentation!  Haddock supports \<\<inline image urls\>\>.++------------------------------------------------------------+--  Diagrams  ----------------------------------------------+------------------------------------------------------------++-- | Monoidal annotations which travel up the diagram tree, /i.e./ which+--   are aggregated from component diagrams to the whole:+--+--   * envelopes (see "Diagrams.Core.Envelope").+--     The envelopes are \"deletable\" meaning that at any point we can+--     throw away the existing envelope and replace it with a new one;+--     sometimes we want to consider a diagram as having a different+--     envelope unrelated to its \"natural\" envelope.+--+--   * traces (see "Diagrams.Core.Trace"), also+--     deletable.+--+--   * name/subdiagram associations (see "Diagrams.Core.Names")+--+--   * query functions (see "Diagrams.Core.Query")+type UpAnnots b v m = Deletable (Envelope v)+                  ::: Deletable (Trace v)+                  ::: SubMap b v m+                  ::: Query v m+                  ::: ()++-- | Monoidal annotations which travel down the diagram tree,+--   /i.e./ which accumulate along each path to a leaf (and which can+--   act on the upwards-travelling annotations):+--+--   * transformations (split at the innermost freeze): see+--     "Diagrams.Core.Transform"+--+--   * styles (see "Diagrams.Core.Style")+--+--   * names (see "Diagrams.Core.Names")+type DownAnnots v = (Split (Transformation v) :+: Style v)+                ::: Name+                ::: ()++  -- Note that we have to put the transformations and styles together+  -- using a coproduct because the transformations can act on the+  -- styles.++-- | Inject a transformation into a default downwards annotation+--   value.+transfToAnnot :: Transformation v -> DownAnnots v+transfToAnnot+  = inj+  . (inL :: Split (Transformation v) -> Split (Transformation v) :+: Style v)+  . M++-- | Extract the (total) transformation from a downwards annotation+--   value.+transfFromAnnot :: HasLinearMap v => DownAnnots v -> Transformation v+transfFromAnnot = option mempty (unsplit . killR) . fst++-- | The fundamental diagram type is represented by trees of+--   primitives with various monoidal annotations.  The @Q@ in+--   @QDiagram@ stands for \"Queriable\", as distinguished from+--   'Diagram', a synonym for @QDiagram@ with the query type+--   specialized to 'Any'.+newtype QDiagram b v m+  = QD { unQD :: D.DUALTree (DownAnnots v) (UpAnnots b v m) () (Prim b v) }+  deriving (Typeable)++instance Newtype (QDiagram b v m)+                 (D.DUALTree (DownAnnots v) (UpAnnots b v m) () (Prim b v)) where+  pack   = QD+  unpack = unQD++type instance V (QDiagram b v m) = v++-- | The default sort of diagram is one where querying at a point+--   simply tells you whether the diagram contains that point or not.+--   Transforming a default diagram into one with a more interesting+--   query can be done via the 'Functor' instance of @'QDiagram' b@ or+--   the 'value' function.+type Diagram b v = QDiagram b v Any++-- | Create a \"point diagram\", which has no content, no trace, an+--   empty query, and a point envelope.+pointDiagram :: (Fractional (Scalar v), InnerSpace v)+             => Point v -> QDiagram b v m+pointDiagram p = QD $ D.leafU (inj . toDeletable $ pointEnvelope p)++-- | Extract a list of primitives from a diagram, together with their+--   associated transformations and styles.+prims :: HasLinearMap v+      => QDiagram b v m -> [(Prim b v, (Split (Transformation v), Style v))]+prims = (map . second) (untangle . option mempty id . fst)+      . D.flatten+      . unQD++-- | A useful variant of 'getU' which projects out a certain+--   component.+getU' :: (Monoid u', u :>: u') => D.DUALTree d u a l -> u'+getU' = maybe mempty (option mempty id . get) . D.getU++-- | Get the envelope of a diagram.+envelope :: (Ord (Scalar v))+         => QDiagram b v m -> Envelope v+envelope = unDelete . getU' . unQD++-- | Replace the envelope of a diagram.+setEnvelope :: forall b v m. (OrderedField (Scalar v), InnerSpace v, HasLinearMap v, Monoid' m)+          => Envelope v -> QDiagram b v m -> QDiagram b v m+setEnvelope e = over QD ( D.applyUpre (inj . toDeletable $ e)+                        . D.applyUpre (inj (deleteL :: Deletable (Envelope v)))+                        . D.applyUpost (inj (deleteR :: Deletable (Envelope v)))+                        )++-- | Get the trace of a diagram.+trace :: (Ord (Scalar v), VectorSpace v, HasLinearMap v) => QDiagram b v m -> Trace v+trace = unDelete . getU' . unQD++-- | Replace the trace of a diagram.+setTrace :: forall b v m. (OrderedField (Scalar v), InnerSpace v, HasLinearMap v, Semigroup m)+         => Trace v -> QDiagram b v m -> QDiagram b v m+setTrace t = over QD ( D.applyUpre (inj . toDeletable $ t)+                     . D.applyUpre (inj (deleteL :: Deletable (Trace v)))+                     . D.applyUpost (inj (deleteR :: Deletable (Trace v)))+                     )++-- | Get the subdiagram map (/i.e./ an association from names to+--   subdiagrams) of a diagram.+subMap :: QDiagram b v m -> SubMap b v m+subMap = getU' . unQD++-- | Get a list of names of subdiagrams and their locations.+names :: HasLinearMap v => QDiagram b v m -> [(Name, [Point v])]+names = (map . second . map) location . M.assocs . unpack . subMap++-- | Attach an atomic name to a diagram.+named :: ( IsName n+         , HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)+      => n -> QDiagram b v m -> QDiagram b v m+named = nameSub mkSubdiagram++-- | Attach an atomic name to a certain point (which may be computed+--   from the given diagram), treated as a subdiagram with no content+--   and a point envelope.+namePoint :: ( IsName n+             , HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)+          => (QDiagram b v m -> Point v) -> n -> QDiagram b v m -> QDiagram b v m+namePoint p = nameSub (subPoint . p)++-- | Attach an atomic name to a certain subdiagram, computed from the+--   given diagram.+nameSub :: ( IsName n+           , HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)+        => (QDiagram b v m -> Subdiagram b v m) -> n -> QDiagram b v m -> QDiagram b v m+nameSub s n d = over QD (D.applyUpre . inj $ fromNames [(n,s d)]) d++-- | Given a name and a diagram transformation indexed by a+--   subdiagram, perform the transformation using the most recent+--   subdiagram associated with (some qualification of) the name,+--   or perform the identity transformation if the name does not exist.+withName :: IsName n+         => n -> (Subdiagram b v m -> QDiagram b v m -> QDiagram b v m)+         -> QDiagram b v m -> QDiagram b v m+withName n f d = maybe id f (lookupSub (toName n) (subMap d) >>= listToMaybe) d++-- | Given a name and a diagram transformation indexed by a list of+--   subdiagrams, perform the transformation using the+--   collection of all such subdiagrams associated with (some+--   qualification of) the given name.+withNameAll :: IsName n+            => n -> ([Subdiagram b v m] -> QDiagram b v m -> QDiagram b v m)+            -> QDiagram b v m -> QDiagram b v m+withNameAll n f d = f (fromMaybe [] (lookupSub (toName n) (subMap d))) d++-- | Given a list of names and a diagram transformation indexed by a+--   list of subdiagrams, perform the transformation using the+--   list of most recent subdiagrams associated with (some qualification+--   of) each name.  Do nothing (the identity transformation) if any+--   of the names do not exist.+withNames :: IsName n+          => [n] -> ([Subdiagram b v m] -> QDiagram b v m -> QDiagram b v m)+          -> QDiagram b v m -> QDiagram b v m+withNames ns f d = maybe id f (T.sequence (map ((listToMaybe=<<) . ($nd) . lookupSub . toName) ns)) d+  where nd = subMap d++-- | Get the query function associated with a diagram.+query :: Monoid m => QDiagram b v m -> Query v m+query = getU' . unQD++-- | Sample a diagram's query function at a given point.+sample :: Monoid m => QDiagram b v m -> Point v -> m+sample = runQuery . query++-- | Set the query value for 'True' points in a diagram (/i.e./ points+--   \"inside\" the diagram); 'False' points will be set to 'mempty'.+value :: Monoid m => m -> QDiagram b v Any -> QDiagram b v m+value m = fmap fromAny+  where fromAny (Any True)  = m+        fromAny (Any False) = mempty++-- | Reset the query values of a diagram to @True@/@False@: any values+--   equal to 'mempty' are set to 'False'; any other values are set to+--   'True'.+resetValue :: (Eq m, Monoid m) => QDiagram b v m -> QDiagram b v Any+resetValue = fmap toAny+  where toAny m | m == mempty = Any False+                | otherwise   = Any True++-- | Set all the query values of a diagram to 'False'.+clearValue :: QDiagram b v m -> QDiagram b v Any+clearValue = fmap (const (Any False))++-- | Create a diagram from a single primitive, along with an envelope,+--   trace, subdiagram map, and query function.+mkQD :: Prim b v -> Envelope v -> Trace v -> SubMap b v m -> Query v m -> QDiagram b v m+mkQD p e t n q = QD $ D.leaf (toDeletable e *: toDeletable t *: n *: q *: ()) p++------------------------------------------------------------+--  Instances+------------------------------------------------------------++---- Monoid++-- | Diagrams form a monoid since each of their components do: the+--   empty diagram has no primitives, an empty envelope, an empty+--   trace, no named subdiagrams, and a constantly empty query+--   function.+--+--   Diagrams compose by aligning their respective local origins.  The+--   new diagram has all the primitives and all the names from the two+--   diagrams combined, and query functions are combined pointwise.+--   The first diagram goes on top of the second.  \"On top of\"+--   probably only makes sense in vector spaces of dimension lower+--   than 3, but in theory it could make sense for, say, 3-dimensional+--   diagrams when viewed by 4-dimensional beings.+instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)+  => Monoid (QDiagram b v m) where+  mempty  = QD D.empty+  mappend = (<>)++instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)+  => Semigroup (QDiagram b v m) where+  (QD d1) <> (QD d2) = QD (d2 <> d1)+    -- swap order so that primitives of d2 come first, i.e. will be+    -- rendered first, i.e. will be on the bottom.++-- | A convenient synonym for 'mappend' on diagrams, designed to be+--   used infix (to help remember which diagram goes on top of which+--   when combining them, namely, the first on top of the second).+atop :: (HasLinearMap v, OrderedField (Scalar v), InnerSpace v, Semigroup m)+     => QDiagram b v m -> QDiagram b v m -> QDiagram b v m+atop = (<>)++infixl 6 `atop`++---- Functor++instance Functor (QDiagram b v) where+  fmap f = (over QD . D.mapU . second . second)+             ( (first . fmap . fmap) f+             . (second . first . fmap . fmap) f+             )++---- Applicative++-- XXX what to do with this?+-- A diagram with queries of result type @(a -> b)@ can be \"applied\"+--   to a diagram with queries of result type @a@, resulting in a+--   combined diagram with queries of result type @b@.  In particular,+--   all components of the two diagrams are combined as in the+--   @Monoid@ instance, except the queries which are combined via+--   @(<*>)@.++-- instance (Backend b v, s ~ Scalar v, AdditiveGroup s, Ord s)+--            => Applicative (QDiagram b v) where+--   pure a = Diagram mempty mempty mempty (Query $ const a)++--   (Diagram ps1 bs1 ns1 smp1) <*> (Diagram ps2 bs2 ns2 smp2)+--     = Diagram (ps1 <> ps2) (bs1 <> bs2) (ns1 <> ns2) (smp1 <*> smp2)++---- HasStyle++instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)+      => HasStyle (QDiagram b v m) where+  applyStyle = over QD . D.applyD . inj+             . (inR :: Style v -> Split (Transformation v) :+: Style v)++-- | By default, diagram attributes are not affected by+--   transformations.  This means, for example, that @lw 0.01 circle@+--   and @scale 2 (lw 0.01 circle)@ will be drawn with lines of the+--   /same/ width, and @scaleY 3 circle@ will be an ellipse drawn with+--   a uniform line.  Once a diagram is frozen, however,+--   transformations do affect attributes, so, for example, @scale 2+--   (freeze (lw 0.01 circle))@ will be drawn with a line twice as+--   thick as @lw 0.01 circle@, and @scaleY 3 (freeze circle)@ will be+--   drawn with a \"stretched\", variable-width line.+--+--   Another way of thinking about it is that pre-@freeze@, we are+--   transforming the \"abstract idea\" of a diagram, and the+--   transformed version is then drawn; when doing a @freeze@, we+--   produce a concrete drawing of the diagram, and it is this visual+--   representation itself which is acted upon by subsequent+--   transformations.+freeze :: forall v b m. (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)+       => QDiagram b v m -> QDiagram b v m+freeze = over QD . D.applyD . inj+       . (inL :: Split (Transformation v) -> Split (Transformation v) :+: Style v)+       $ split++---- Juxtaposable++instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)+      => Juxtaposable (QDiagram b v m) where+  juxtapose = juxtaposeDefault++---- Enveloped++instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v) )+         => Enveloped (QDiagram b v m) where+  getEnvelope = envelope++---- Traced++instance (HasLinearMap v, VectorSpace v, Ord (Scalar v))+         => Traced (QDiagram b v m) where+  getTrace = trace++---- HasOrigin++-- | Every diagram has an intrinsic \"local origin\" which is the+--   basis for all combining operations.+instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)+      => HasOrigin (QDiagram b v m) where++  moveOriginTo = translate . (origin .-.)++---- Transformable++-- | Diagrams can be transformed by transforming each of their+--   components appropriately.+instance (HasLinearMap v, OrderedField (Scalar v), InnerSpace v, Semigroup m)+      => Transformable (QDiagram b v m) where+  transform = over QD . D.applyD . transfToAnnot++---- Qualifiable++-- | Diagrams can be qualified so that all their named points can+--   now be referred to using the qualification prefix.+instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)+      => Qualifiable (QDiagram b v m) where+  (|>) = over QD . D.applyD . inj . toName+++------------------------------------------------------------+--  Subdiagrams+------------------------------------------------------------++-- | A @Subdiagram@ represents a diagram embedded within the context+--   of a larger diagram.  Essentially, it consists of a diagram+--   paired with any accumulated information from the larger context+--   (transformations, attributes, etc.).++data Subdiagram b v m = Subdiagram (QDiagram b v m) (DownAnnots v)++type instance V (Subdiagram b v m) = v++-- | Turn a diagram into a subdiagram with no accumulated context.+mkSubdiagram :: QDiagram b v m -> Subdiagram b v m+mkSubdiagram d = Subdiagram d empty++-- | Create a \"point subdiagram\", that is, a 'pointDiagram' (with no+--   content and a point envelope) treated as a subdiagram with local+--   origin at the given point.  Note this is not the same as+--   @mkSubdiagram . pointDiagram@, which would result in a subdiagram+--   with local origin at the parent origin, rather than at the given+--   point.+subPoint :: (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)+         => Point v -> Subdiagram b v m+subPoint p = Subdiagram+               (pointDiagram origin)+               (transfToAnnot $ translation (p .-. origin))++instance Functor (Subdiagram b v) where+  fmap f (Subdiagram d a) = Subdiagram (fmap f d) a++instance (OrderedField (Scalar v), InnerSpace v, HasLinearMap v)+      => Enveloped (Subdiagram b v m) where+  getEnvelope (Subdiagram d a) = transform (transfFromAnnot a) $ getEnvelope d++instance (Ord (Scalar v), VectorSpace v, HasLinearMap v)+      => Traced (Subdiagram b v m) where+  getTrace (Subdiagram d a) = transform (transfFromAnnot a) $ getTrace d++instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v))+      => HasOrigin (Subdiagram b v m) where+  moveOriginTo = translate . (origin .-.)++instance ( HasLinearMap v, InnerSpace v, Floating (Scalar v))+    => Transformable (Subdiagram b v m) where+  transform t (Subdiagram d a) = Subdiagram d (transfToAnnot t <> a)++-- | Get the location of a subdiagram; that is, the location of its+--   local origin /with respect to/ the vector space of its parent+--   diagram.  In other words, the point where its local origin+--   \"ended up\".+location :: HasLinearMap v => Subdiagram b v m -> Point v+location (Subdiagram _ a) = transform (transfFromAnnot a) origin++-- | Turn a subdiagram into a normal diagram, including the enclosing+--   context.  Concretely, a subdiagram is a pair of (1) a diagram and+--   (2) a \"context\" consisting of an extra transformation and+--   attributes.  @getSub@ simply applies the transformation and+--   attributes to the diagram to get the corresponding \"top-level\"+--   diagram.+getSub :: ( HasLinearMap v, InnerSpace v+          , Floating (Scalar v), Ord (Scalar v)+          , Semigroup m+          )+       => Subdiagram b v m -> QDiagram b v m+getSub (Subdiagram d a) = over QD (D.applyD a) d++-- | Extract the \"raw\" content of a subdiagram, by throwing away the+--   context.+rawSub :: Subdiagram b v m -> QDiagram b v m+rawSub (Subdiagram d _) = d++------------------------------------------------------------+--  Subdiagram maps  ---------------------------------------+------------------------------------------------------------++-- | A 'SubMap' is a map associating names to subdiagrams. There can+--   be multiple associations for any given name.+newtype SubMap b v m = SubMap (M.Map Name [Subdiagram b v m])+  -- See Note [SubMap Set vs list]++instance Newtype (SubMap b v m) (M.Map Name [Subdiagram b v m]) where+  pack              = SubMap+  unpack (SubMap m) = m++-- ~~~~ [SubMap Set vs list]+-- In some sense it would be nicer to use+-- Sets instead of a list, but then we would have to put Ord+-- constraints on v everywhere. =P++type instance V (SubMap b v m) = v++instance Functor (SubMap b v) where+  fmap = over SubMap . fmap . map . fmap++instance Semigroup (SubMap b v m) where+  SubMap s1 <> SubMap s2 = SubMap $ M.unionWith (++) s1 s2++-- | 'SubMap's form a monoid with the empty map as the identity, and+--   map union as the binary operation.  No information is ever lost:+--   if two maps have the same name in their domain, the resulting map+--   will associate that name to the concatenation of the information+--   associated with that name.+instance Monoid (SubMap b v m) where+  mempty  = SubMap M.empty+  mappend = (<>)++instance (OrderedField (Scalar v), InnerSpace v, HasLinearMap v)+      => HasOrigin (SubMap b v m) where+  moveOriginTo = over SubMap . moveOriginTo++instance (InnerSpace v, Floating (Scalar v), HasLinearMap v)+  => Transformable (SubMap b v m) where+  transform = over SubMap . transform++-- | 'SubMap's are qualifiable: if @ns@ is a 'SubMap', then @a |>+--   ns@ is the same 'SubMap' except with every name qualified by+--   @a@.+instance Qualifiable (SubMap b v m) where+  a |> (SubMap m) = SubMap $ M.mapKeys (a |>) m++-- | Construct a 'SubMap' from a list of associations between names+--   and subdiagrams.+fromNames :: IsName a => [(a, Subdiagram b v m)] -> SubMap b v m+fromNames = SubMap . M.fromListWith (++) . map (toName *** (:[]))++-- | Add a name/diagram association to a submap.+rememberAs :: IsName a => a -> QDiagram b v m -> SubMap b v m -> SubMap b v m+rememberAs n b = over SubMap $ M.insertWith (++) (toName n) [mkSubdiagram b]++-- | A name acts on a name map by qualifying every name in it.+instance Action Name (SubMap b v m) where+  act = (|>)++-- | Names don't act on anything else.+instance Action Name a++-- | Look for the given name in a name map, returning a list of+--   subdiagrams associated with that name.  If no names match the+--   given name exactly, return all the subdiagrams associated with+--   names of which the given name is a suffix.+lookupSub :: IsName n => n -> SubMap b v m -> Maybe [Subdiagram b v m]+lookupSub a (SubMap m)+  = M.lookup n m `mplus`+    (flatten . filter ((n `nameSuffixOf`) . fst) . M.assocs $ m)+  where (Name n1) `nameSuffixOf` (Name n2) = n1 `isSuffixOf` n2+        flatten [] = Nothing+        flatten xs = Just . concatMap snd $ xs+        n = toName a++------------------------------------------------------------+--  Primitives  --------------------------------------------+------------------------------------------------------------++-- $prim+-- Ultimately, every diagram is essentially a list of /primitives/,+-- basic building blocks which can be rendered by backends.  However,+-- not every backend must be able to render every type of primitive;+-- the collection of primitives a given backend knows how to render is+-- determined by instances of 'Renderable'.++-- | A value of type @Prim b v@ is an opaque (existentially quantified)+--   primitive which backend @b@ knows how to render in vector space @v@.+data Prim b v where+  Prim :: Renderable p b => p -> Prim b (V p)++type instance V (Prim b v) = v++-- | The 'Transformable' instance for 'Prim' just pushes calls to+--   'transform' down through the 'Prim' constructor.+instance HasLinearMap v => Transformable (Prim b v) where+  transform v (Prim p) = Prim (transform v p)++-- | The 'Renderable' instance for 'Prim' just pushes calls to+--   'render' down through the 'Prim' constructor.+instance HasLinearMap v => Renderable (Prim b v) b where+  render b (Prim p) = render b p++-- | The null primitive.+data NullPrim v = NullPrim++type instance (V (NullPrim v)) = v++instance HasLinearMap v => Transformable (NullPrim v) where+  transform _ _ = NullPrim++instance (HasLinearMap v, Monoid (Render b v)) => Renderable (NullPrim v) b where+  render _ _ = mempty++-- | The null primitive, which every backend can render by doing+--   nothing.+nullPrim :: (HasLinearMap v, Monoid (Render b v)) => Prim b v+nullPrim = Prim NullPrim++------------------------------------------------------------+-- Backends  -----------------------------------------------+------------------------------------------------------------++-- | Abstract diagrams are rendered to particular formats by+--   /backends/.  Each backend/vector space combination must be an+--   instance of the 'Backend' class. A minimal complete definition+--   consists of the three associated types and implementations for+--   'withStyle' and 'doRender'.+--+class (HasLinearMap v, Monoid (Render b v)) => Backend b v where+  -- | The type of rendering operations used by this backend, which+  --   must be a monoid. For example, if @Render b v = M ()@ for some+  --   monad @M@, a monoid instance can be made with @mempty = return+  --   ()@ and @mappend = (>>)@.+  data Render  b v :: *++  -- | The result of running/interpreting a rendering operation.+  type Result  b v :: *++  -- | Backend-specific rendering options.+  data Options b v :: *++  -- | Perform a rendering operation with a local style.+  withStyle      :: b          -- ^ Backend token (needed only for type inference)+                 -> Style v    -- ^ Style to use+                 -> Transformation v  -- ^ Transformation to be applied to the style+                 -> Render b v -- ^ Rendering operation to run+                 -> Render b v -- ^ Rendering operation using the style locally++  -- | 'doRender' is used to interpret rendering operations.+  doRender       :: b           -- ^ Backend token (needed only for type inference)+                 -> Options b v -- ^ Backend-specific collection of rendering options+                 -> Render b v  -- ^ Rendering operation to perform+                 -> Result b v  -- ^ Output of the rendering operation++  -- | 'adjustDia' allows the backend to make adjustments to the final+  --   diagram (e.g. to adjust the size based on the options) before+  --   rendering it.  It can also make adjustments to the options+  --   record, usually to fill in incompletely specified size+  --   information.  A default implementation is provided which makes+  --   no adjustments.  See the diagrams-lib package for other useful+  --   implementations.+  adjustDia :: Monoid' m => b -> Options b v+            -> QDiagram b v m -> (Options b v, QDiagram b v m)+  adjustDia _ o d = (o,d)++  -- XXX expand this comment.  Explain about freeze, split+  -- transformations, etc.+  -- | Render a diagram.  This has a default implementation in terms+  --   of 'adjustDia', 'withStyle', 'doRender', and the 'render'+  --   operation from the 'Renderable' class (first 'adjustDia' is+  --   used, then 'withStyle' and 'render' are used to render each+  --   primitive, the resulting operations are combined with+  --   'mconcat', and the final operation run with 'doRender') but+  --   backends may override it if desired.+  renderDia :: (InnerSpace v, OrderedField (Scalar v), Monoid' m)+            => b -> Options b v -> QDiagram b v m -> Result b v+  renderDia b opts d =+    doRender b opts' . mconcat . map renderOne . prims $ d'+      where (opts', d') = adjustDia b opts d+            renderOne :: (Prim b v, (Split (Transformation v), Style v))+                      -> Render b v+            renderOne (p, (M t,      s))+              = withStyle b s mempty (render b (transform t p))++            renderOne (p, (t1 :| t2, s))+              = withStyle b s t1 (render b (transform (t1 <> t2) p))++  -- See Note [backend token]++-- | The @D@ type is provided for convenience in situations where you+--   must give a diagram a concrete, monomorphic type, but don't care+--   which one.  Such situations arise when you pass a diagram to a+--   function which is polymorphic in its input but monomorphic in its+--   output, such as 'width', 'height', 'phantom', or 'names'.  Such+--   functions compute some property of the diagram, or use it to+--   accomplish some other purpose, but do not result in the diagram+--   being rendered.  If the diagram does not have a monomorphic type,+--   GHC complains that it cannot determine the diagram's type.+--+--   For example, here is the error we get if we try to compute the+--   width of an image (this example requires @diagrams-lib@):+--+--   > ghci> width (image "foo.png" 200 200)+--   >+--   > <interactive>:8:8:+--   >     No instance for (Renderable Diagrams.TwoD.Image.Image b0)+--   >       arising from a use of `image'+--   >     Possible fix:+--   >       add an instance declaration for+--   >       (Renderable Diagrams.TwoD.Image.Image b0)+--   >     In the first argument of `width', namely+--   >       `(image "foo.png" 200 200)'+--   >     In the expression: width (image "foo.png" 200 200)+--   >     In an equation for `it': it = width (image "foo.png" 200 200)+--+--   GHC complains that there is no instance for @Renderable Image+--   b0@; what is really going on is that it does not have enough+--   information to decide what backend to use (hence the+--   uninstantiated @b0@). This is annoying because /we/ know that the+--   choice of backend cannot possibly affect the width of the image+--   (it's 200! it's right there in the code!); /but/ there is no way+--   for GHC to know that.+--+--   The solution is to annotate the call to 'image' with the type+--   @'D' 'R2'@, like so:+--+--   > ghci> width (image "foo.png" 200 200 :: D R2)+--   > 200.00000000000006+--+--   (It turns out the width wasn't 200 after all...)+--+--   As another example, here is the error we get if we try to compute+--   the width of a radius-1 circle:+--+--   > ghci> width (circle 1)+--   >+--   > <interactive>:4:1:+--   >     Couldn't match type `V a0' with `R2'+--   >     In the expression: width (circle 1)+--   >     In an equation for `it': it = width (circle 1)+--+--   There's even more ambiguity here.  Whereas 'image' always returns+--   a 'Diagram', the 'circle' function can produce any 'PathLike'+--   type, and the 'width' function can consume any 'Enveloped' type,+--   so GHC has no idea what type to pick to go in the middle.+--   However, the solution is the same:+--+--  > ghci> width (circle 1 :: D R2)+--  > 1.9999999999999998++type D v = Diagram NullBackend v+++-- | A null backend which does no actual rendering.  It is provided+--   mainly for convenience in situations where you must give a+--   diagram a concrete, monomorphic type, but don't actually care+--   which one.  See 'D' for more explanation and examples.+--+--   It is courteous, when defining a new primitive @P@, to make an instance+--+--   > instance Renderable P NullBackend where+--   >   render _ _ = mempty+--+--   This ensures that the trick with 'D' annotations can be used for+--   diagrams containing your primitive.+data NullBackend++-- Note: we can't make a once-and-for-all instance+--+-- > instance Renderable a NullBackend where+-- >   render _ _ = mempty+--+-- because it overlaps with the Renderable instance for NullPrim.++instance Monoid (Render NullBackend v) where+  mempty      = NullBackendRender+  mappend _ _ = NullBackendRender++instance HasLinearMap v => Backend NullBackend v where+  data Render NullBackend v = NullBackendRender+  type Result NullBackend v = ()+  data Options NullBackend v++  withStyle _ _ _ _ = NullBackendRender+  doRender _ _ _    = ()++-- | A class for backends which support rendering multiple diagrams,+--   e.g. to a multi-page pdf or something similar.+class Backend b v => MultiBackend b v where++  -- | Render multiple diagrams at once.+  renderDias :: (InnerSpace v, OrderedField (Scalar v), Monoid' m)+             => b -> Options b v -> [QDiagram b v m] -> Result b v++  -- See Note [backend token]+++-- | The Renderable type class connects backends to primitives which+--   they know how to render.+class Transformable t => Renderable t b where+  render :: b -> t -> Render b (V t)+  -- ^ Given a token representing the backend and a+  --   transformable object, render it in the appropriate rendering+  --   context.++  -- See Note [backend token]++{-+~~~~ Note [backend token]++A bunch of methods here take a "backend token" as an argument.  The+backend token is expected to carry no actual information; it is solely+to help out the type system. The problem is that all these methods+return some associated type applied to b (e.g. Render b) and unifying+them with something else will never work, since type families are not+necessarily injective.+-}

@@ -0,0 +1,52 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Core.MList+-- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Type family for identifying associated vector spaces.+--+-----------------------------------------------------------------------------++module Diagrams.Core.V+       ( V++       ) where++import Data.Map+import Data.Monoid.Coproduct+import Data.Monoid.Deletable+import Data.Monoid.Split+import Data.Semigroup+import Data.Set++------------------------------------------------------------+-- Vector spaces -------------------------------------------+------------------------------------------------------------++-- | Many sorts of objects have an associated vector space in which+--   they \"live\".  The type function @V@ maps from object types to+--   the associated vector space.+type family V a :: *++type instance V Double    = Double+type instance V Rational  = Rational++-- Note, to use these instances one often needs a constraint of the form+--   V a ~ V b, etc.+type instance V (a,b)      = V a+type instance V (a,b,c)    = V a++type instance V (a -> b)   = V b+type instance V [a]        = V a+type instance V (Option a) = V a+type instance V (Set a)    = V a+type instance V (Map k a)  = V a++type instance V (Deletable m) = V m+type instance V (Split m)     = V m+type instance V (m :+: n)     = V m

@@ -1,153 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ The core library of primitives forming the basis of an embedded--- domain-specific language for describing and rendering diagrams.--- Normal users of the diagrams library should almost never need to--- import anything from this package directly; instead, import modules--- (especially "Diagrams.Prelude") from the diagrams-lib package,--- which re-exports most things of value to users.------ For most library code needing access to core internals, it should--- be sufficient to import this module, which simply re-exports useful--- functionality from other modules in the core library.  Library--- writers needing finer-grained access or functionality may--- occasionally find it useful to directly import one of the--- constituent core modules.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams-       ( -- * Associated vector spaces--         V--         -- * Points--       , Point, origin, (*.)--         -- * Vectors--       , withLength--         -- * Transformations--         -- ** Invertible linear transformations-       , (:-:), (<->), linv, lapp--         -- ** General transformations-       , Transformation-       , inv, transp, transl-       , apply-       , papply-       , fromLinear--         -- ** Some specific transformations-       , translation, translate, moveTo, place-       , scaling, scale--         -- ** The Transformable class--       , Transformable(..)--         -- ** Translational invariance--       , TransInv(..)--         -- * Names--       , AName-       , Name, IsName(..)-       , Qualifiable(..), (.>)-       , NameMap-       , fromNames, fromNamesB-       , rememberAs--       , lookupN--         -- * Attributes and styles--       , AttributeClass-       , Attribute, mkAttr, mkTAttr, unwrapAttr--       , Style, HasStyle(..)-       , getAttr, combineAttr-       , applyAttr, applyTAttr--         -- * Envelopes--       , Envelope-       , inEnvelope, appEnvelope, onEnvelope, mkEnvelope-       , Enveloped(..)-       , envelopeV, envelopeP, boundaryFrom-       , diameter, radius--       , LocatedEnvelope(..)-       , location, locateEnvelope--         -- * Things with local origins--       , HasOrigin(..), moveOriginBy--         -- * Juxtaposable things--       , Juxtaposable(..), juxtaposeDefault--         -- * Queries--       , Query(..)--         -- * Primtives--       , Prim(..), nullPrim--         -- * Diagrams--       , QDiagram, mkQD, Diagram-       , prims-       , envelope, names, query, sample-       , value, resetValue, clearValue--       , named, namePoint-       , withName-       , withNameAll-       , withNames--       , freeze, setEnvelope--       , atop--         -- * Backends--       , Backend(..)-       , MultiBackend(..)-       , Renderable(..)--         -- ** The null backend--       , NullBackend, D--         -- * Convenience classes--       , HasLinearMap-       , OrderedField-       , Monoid'--       ) where--import Graphics.Rendering.Diagrams.V-import Graphics.Rendering.Diagrams.Util-import Graphics.Rendering.Diagrams.Transform-import Graphics.Rendering.Diagrams.Envelope-import Graphics.Rendering.Diagrams.HasOrigin-import Graphics.Rendering.Diagrams.Juxtapose-import Graphics.Rendering.Diagrams.Query-import Graphics.Rendering.Diagrams.Points-import Graphics.Rendering.Diagrams.Names-import Graphics.Rendering.Diagrams.Style-import Graphics.Rendering.Diagrams.Core-import Graphics.Rendering.Diagrams.Monoids (Monoid')

@@ -1,632 +0,0 @@-{-# LANGUAGE FlexibleContexts-           , FlexibleInstances-           , TypeFamilies-           , MultiParamTypeClasses-           , GADTs-           , ExistentialQuantification-           , ScopedTypeVariables-           , GeneralizedNewtypeDeriving-           , DeriveDataTypeable-           , TypeOperators-           , OverlappingInstances-           , UndecidableInstances-           , TupleSections-           , EmptyDataDecls-           #-}---------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams.Core--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ The core library of primitives forming the basis of an embedded--- domain-specific language for describing and rendering diagrams.------ "Graphics.Rendering.Diagrams.Core" defines types and classes for--- primitives, diagrams, and backends.-----------------------------------------------------------------------------------{- ~~~~ Note [breaking up Core module]--   Although it's not as bad as it used to be, this module has a lot of-   stuff in it, and it might seem a good idea in principle to break it up-   into smaller modules.  However, it's not as easy as it sounds: everything-   in this module cyclically depends on everything else.--}--module Graphics.Rendering.Diagrams.Core-       (-         -- * Diagrams--         -- ** Annotations-         UpAnnots, DownAnnots-       , QDiagram(..), mkQD, Diagram--         -- * Operations on diagrams-         -- ** Extracting information-       , prims-       , envelope, names, query, sample-       , value, resetValue, clearValue--         -- ** Combining diagrams--         -- | For many more ways of combining diagrams, see-         -- "Diagrams.Combinators" from the diagrams-lib package.--       , atop--         -- ** Modifying diagrams-         -- *** Names-       , named-       , namePoint-       , withName-       , withNameAll-       , withNames--         -- *** Other-       , freeze-       , setEnvelope--         -- * Primtives-         -- $prim--       , Prim(..), nullPrim--         -- * Backends--       , Backend(..)-       , MultiBackend(..)--         -- ** Null backend--       , NullBackend, D--         -- * Renderable--       , Renderable(..)--       ) where--import Graphics.Rendering.Diagrams.Monoids-import Graphics.Rendering.Diagrams.MList-import Graphics.Rendering.Diagrams.UDTree--import Graphics.Rendering.Diagrams.V-import Graphics.Rendering.Diagrams.Query-import Graphics.Rendering.Diagrams.Transform-import Graphics.Rendering.Diagrams.Envelope-import Graphics.Rendering.Diagrams.HasOrigin-import Graphics.Rendering.Diagrams.Juxtapose-import Graphics.Rendering.Diagrams.Points-import Graphics.Rendering.Diagrams.Names-import Graphics.Rendering.Diagrams.Style--import Data.VectorSpace-import Data.AffineSpace ((.-.))--import Data.Maybe (listToMaybe, fromMaybe)-import Data.Semigroup-import qualified Data.Traversable as T-import Control.Arrow (second)-import Control.Applicative ((<$>), (<*>))--import Control.Newtype--import Data.Typeable---- XXX TODO: add lots of actual diagrams to illustrate the--- documentation!  Haddock supports \<\<inline image urls\>\>.-----------------------------------------------------------------  Diagrams  --------------------------------------------------------------------------------------------------------------- | Monoidal annotations which travel up the diagram tree, i.e. which---   are aggregated from component diagrams to the whole:------   * envelopes (see "Graphics.Rendering.Diagrams.Envelope").---     The envelopes are \"deletable\" meaning that at any point we can---     throw away the existing envelope and replace it with a new one;---     sometimes we want to consider a diagram as having a different---     envelope unrelated to its \"natural\" envelope.------   * name/point associations (see "Graphics.Rendering.Diagrams.Names")------   * query functions (see "Graphics.Rendering.Diagrams.Query")-type UpAnnots v m = Deletable (Envelope v) ::: NameMap v ::: Query v m ::: Nil---- | Monoidal annotations which travel down the diagram tree,---   i.e. which accumulate along each path to a leaf (and which can---   act on the upwards-travelling annotations):------   * transformations (split at the innermost freeze): see---     "Graphics.Rendering.Diagrams.Transform"------   * styles (see "Graphics.Rendering.Diagrams.Style")------   * names (see "Graphics.Rendering.Diagrams.Names")-type DownAnnots v = (Split (Transformation v) :+: Style v) ::: AM [] Name ::: Nil---- | The fundamental diagram type is represented by trees of---   primitives with various monoidal annotations.  The @Q@ in---   @QDiagram@ stands for \"Queriable\", as distinguished from---   'Diagram', a synonym for @QDiagram@ with the query type---   specialized to 'Any'.-newtype QDiagram b v m-  = QD { unQD :: UDTree (UpAnnots v m) (DownAnnots v) (Prim b v) }-  deriving (Typeable)--instance Newtype (QDiagram b v m)-                 (UDTree (UpAnnots v m) (DownAnnots v) (Prim b v)) where-  pack   = QD-  unpack = unQD--type instance V (QDiagram b v m) = v---- | The default sort of diagram is one where querying at a point---   simply tells you whether that point is occupied or not.---   Transforming a default diagram into one with a more interesting---   query can be done via the 'Functor' instance of @'QDiagram' b@.-type Diagram b v = QDiagram b v Any---- | Extract a list of primitives from a diagram, together with their---   associated transformations and styles.-prims :: (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid m)-      => QDiagram b v m -> [(Prim b v, (Split (Transformation v), Style v))]-prims = (map . second) (untangle . fst . toTuple) . flatten . unQD---- | Get the envelope of a diagram.-envelope :: (OrderedField (Scalar v), InnerSpace v, HasLinearMap v)-       => QDiagram b v m -> Envelope v-envelope = unDelete . getU' . unQD---- | Replace the envelope of a diagram.-setEnvelope :: forall b v m. (OrderedField (Scalar v), InnerSpace v, HasLinearMap v, Monoid' m)-          => Envelope v -> QDiagram b v m -> QDiagram b v m-setEnvelope b = over QD ( applyUpre (inj . toDeletable $ b)-                      . applyUpre (inj (deleteL :: Deletable (Envelope v)))-                      . applyUpost (inj (deleteR :: Deletable (Envelope v)))-                      )---- | Get the name map of a diagram.-names :: (AdditiveGroup (Scalar v), Floating (Scalar v), InnerSpace v, HasLinearMap v)-       => QDiagram b v m -> NameMap v-names = getU' . unQD---- | Attach an atomic name to (the local origin of) a diagram.-named :: forall v b n m.-         ( IsName n-         , HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid' m)-      => n -> QDiagram b v m -> QDiagram b v m-named = namePoint (locateEnvelope <$> const origin <*> envelope)---- | Attach an atomic name to a certain point and envelope, computed---   from the given diagram.-namePoint :: forall v b n m.-         ( IsName n-         , HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid' m)-      => (QDiagram b v m -> LocatedEnvelope v) -> n -> QDiagram b v m -> QDiagram b v m-namePoint p n d = over QD (applyUpre . inj $ fromNamesB [(n,p d)]) d---- | Given a name and a diagram transformation indexed by a located---   envelope, perform the transformation using the most recent---   located envelope associated with (some qualification of) the---   name, or perform the identity transformation if the name does not---   exist.-withName :: ( IsName n, AdditiveGroup (Scalar v), Floating (Scalar v)-            , InnerSpace v, HasLinearMap v)-         => n -> (LocatedEnvelope v -> QDiagram b v m -> QDiagram b v m)-         -> QDiagram b v m -> QDiagram b v m-withName n f d = maybe id f (lookupN (toName n) (names d) >>= listToMaybe) d---- | Given a name and a diagram transformation indexed by a list of---   located envelopes, perform the transformation using the---   collection of all such located envelopes associated with (some---   qualification of) the given name.-withNameAll :: ( IsName n, AdditiveGroup (Scalar v), Floating (Scalar v)-               , InnerSpace v, HasLinearMap v)-            => n -> ([LocatedEnvelope v] -> QDiagram b v m -> QDiagram b v m)-            -> QDiagram b v m -> QDiagram b v m-withNameAll n f d = f (fromMaybe [] (lookupN (toName n) (names d))) d---- | Given a list of names and a diagram transformation indexed by a---   list of located envelopes, perform the transformation using the---   list of most recent envelopes associated with (some qualification---   of) each name.  Do nothing (the identity transformation) if any---   of the names do not exist.-withNames :: ( IsName n, AdditiveGroup (Scalar v), Floating (Scalar v)-             , InnerSpace v, HasLinearMap v)-          => [n] -> ([LocatedEnvelope v] -> QDiagram b v m -> QDiagram b v m)-          -> QDiagram b v m -> QDiagram b v m-withNames ns f d = maybe id f (T.sequence (map ((listToMaybe=<<) . ($nd) . lookupN . toName) ns)) d-  where nd = names d---- | Get the query function associated with a diagram.-query :: (HasLinearMap v, Monoid m) => QDiagram b v m -> Query v m-query = getU' . unQD---- | Sample a diagram's query function at a given point.-sample :: (HasLinearMap v, Monoid m) => QDiagram b v m -> Point v -> m-sample = runQuery . query---- | Set the query value for 'True' points in a diagram (/i.e./ points---   "inside" the diagram); 'False' points will be set to 'mempty'.-value :: Monoid m => m -> QDiagram b v Any -> QDiagram b v m-value m = fmap fromAny-  where fromAny (Any True)  = m-        fromAny (Any False) = mempty---- | Reset the query values of a diagram to True/False: any values---   equal to 'mempty' are set to 'False'; any other values are set to---   'True'.-resetValue :: (Eq m, Monoid m) => QDiagram b v m -> QDiagram b v Any-resetValue = fmap toAny-  where toAny m | m == mempty = Any False-                | otherwise   = Any True---- | Set all the query values of a diagram to 'False'.-clearValue :: QDiagram b v m -> QDiagram b v Any-clearValue = fmap (const (Any False))---- | Create a diagram from a single primitive, along with an envelope,---   name map, and query function.-mkQD :: Prim b v -> Envelope v -> NameMap v -> Query v m -> QDiagram b v m-mkQD p b n a = QD $ leaf (toDeletable b ::: n ::: a ::: Nil) p-----------------------------------------------------------------  Instances------------------------------------------------------------------- Monoid---- | Diagrams form a monoid since each of their components do: the---   empty diagram has no primitives, an empty envelope, no named---   points, and a constantly empty query function.------   Diagrams compose by aligning their respective local origins.  The---   new diagram has all the primitives and all the names from the two---   diagrams combined, and query functions are combined pointwise.---   The first diagram goes on top of the second.  \"On top of\"---   probably only makes sense in vector spaces of dimension lower---   than 3, but in theory it could make sense for, say, 3-dimensional---   diagrams when viewed by 4-dimensional beings.-instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid' m)-  => Monoid (QDiagram b v m) where-  mempty = QD mempty-  (QD d1) `mappend` (QD d2) = QD (d2 `mappend` d1)-    -- swap order so that primitives of d2 come first, i.e. will be-    -- rendered first, i.e. will be on the bottom.--instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid' m)-  => Semigroup (QDiagram b v m) where-  (<>) = mappend---- | A convenient synonym for 'mappend' on diagrams, designed to be---   used infix (to help remember which diagram goes on top of which---   when combining them, namely, the first on top of the second).-atop :: (HasLinearMap v, OrderedField (Scalar v), InnerSpace v, Monoid' m)-     => QDiagram b v m -> QDiagram b v m -> QDiagram b v m-atop = mappend--infixl 6 `atop`------ Functor---- This is a bit ugly, but it will have to do for now...-instance Functor (QDiagram b v) where-  fmap f = over QD (mapU g)-    where g (b ::: n ::: a ::: Nil) = b ::: n ::: fmap f a ::: Nil-          g _ = error "impossible case in Functor (QDiagram b v) instance (g)"------ Applicative---- XXX what to do with this?--- A diagram with queries of result type @(a -> b)@ can be \"applied\"---   to a diagram with queries of result type @a@, resulting in a---   combined diagram with queries of result type @b@.  In particular,---   all components of the two diagrams are combined as in the---   @Monoid@ instance, except the queries which are combined via---   @(<*>)@.---- instance (Backend b v, s ~ Scalar v, AdditiveGroup s, Ord s)---            => Applicative (QDiagram b v) where---   pure a = Diagram mempty mempty mempty (Query $ const a)----   (Diagram ps1 bs1 ns1 smp1) <*> (Diagram ps2 bs2 ns2 smp2)---     = Diagram (ps1 <> ps2) (bs1 <> bs2) (ns1 <> ns2) (smp1 <*> smp2)------ HasStyle--instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid m)-      => HasStyle (QDiagram b v m) where-  applyStyle = over QD . applyD . inj-             . (inR :: Style v -> Split (Transformation v) :+: Style v)---- | By default, diagram attributes are not affected by---   transformations.  This means, for example, that @lw 0.01 circle@---   and @scale 2 (lw 0.01 circle)@ will be drawn with lines of the---   /same/ width, and @scaleY 3 circle@ will be an ellipse drawn with---   a uniform line.  Once a diagram is frozen, however,---   transformations do affect attributes, so, for example, @scale 2---   (freeze (lw 0.01 circle))@ will be drawn with a line twice as---   thick as @lw 0.01 circle@, and @scaleY 3 (freeze circle)@ will be---   drawn with a \"stretched\", variable-width line.------   Another way of thinking about it is that pre-@freeze@, we are---   transforming the \"abstract idea\" of a diagram, and the---   transformed version is then drawn; when doing a @freeze@, we---   produce a concrete drawing of the diagram, and it is this visual---   representation itself which is acted upon by subsequent---   transformations.-freeze :: forall v b m. (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid m)-       => QDiagram b v m -> QDiagram b v m-freeze = over QD . applyD . inj-       . (inL :: Split (Transformation v) -> Split (Transformation v) :+: Style v)-       $ split------ Juxtaposable--instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid' m)-      => Juxtaposable (QDiagram b v m) where-  juxtapose = juxtaposeDefault------ Enveloped--instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v) )-         => Enveloped (QDiagram b v m) where-  getEnvelope = envelope------ HasOrigin---- | Every diagram has an intrinsic \"local origin\" which is the---   basis for all combining operations.-instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid' m)-      => HasOrigin (QDiagram b v m) where--  moveOriginTo = translate . (origin .-.)------ Transformable---- | Diagrams can be transformed by transforming each of their---   components appropriately.-instance (HasLinearMap v, OrderedField (Scalar v), InnerSpace v, Monoid' m)-      => Transformable (QDiagram b v m) where-  transform = over QD . applyD . inj-            . (inL :: Split (Transformation v) -> Split (Transformation v) :+: Style v)-            . M------ Qualifiable---- | Diagrams can be qualified so that all their named points can---   now be referred to using the qualification prefix.-instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid m)-      => Qualifiable (QDiagram b v m) where-  (|>) = over QD . applyD . inj . AM . (:[]) . toName------------------------------------------------------------------  Primitives  ------------------------------------------------------------------------------------------------------------- $prim--- Ultimately, every diagram is essentially a collection of--- /primitives/, basic building blocks which can be rendered by--- backends.  However, not every backend must be able to render every--- type of primitive; the collection of primitives a given backend--- knows how to render is determined by instances of 'Renderable'.---- | A value of type @Prim b v@ is an opaque (existentially quantified)---   primitive which backend @b@ knows how to render in vector space @v@.-data Prim b v where-  Prim :: Renderable t b => t -> Prim b (V t)--type instance V (Prim b v) = v---- | The 'Transformable' instance for 'Prim' just pushes calls to---   'transform' down through the 'Prim' constructor.-instance HasLinearMap v => Transformable (Prim b v) where-  transform v (Prim p) = Prim (transform v p)---- | The 'Renderable' instance for 'Prim' just pushes calls to---   'render' down through the 'Prim' constructor.-instance HasLinearMap v => Renderable (Prim b v) b where-  render b (Prim p) = render b p---- | The null primitive.-data NullPrim v = NullPrim--type instance (V (NullPrim v)) = v--instance HasLinearMap v => Transformable (NullPrim v) where-  transform _ _ = NullPrim--instance (HasLinearMap v, Monoid (Render b v)) => Renderable (NullPrim v) b where-  render _ _ = mempty---- | The null primitive, which every backend can render by doing---   nothing.-nullPrim :: (HasLinearMap v, Monoid (Render b v)) => Prim b v-nullPrim = Prim NullPrim------------------------------------------------------------------ Backends  ---------------------------------------------------------------------------------------------------------------- | Abstract diagrams are rendered to particular formats by---   /backends/.  Each backend/vector space combination must be an---   instance of the 'Backend' class. A minimal complete definition---   consists of the three associated types and implementations for---   'withStyle' and 'doRender'.----class (HasLinearMap v, Monoid (Render b v)) => Backend b v where-  -- | The type of rendering operations used by this backend, which-  --   must be a monoid. For example, if @Render b v = M ()@ for some-  --   monad @M@, a monoid instance can be made with @mempty = return-  --   ()@ and @mappend = (>>)@.-  data Render  b v :: *--  -- | The result of running/interpreting a rendering operation.-  type Result  b v :: *--  -- | Backend-specific rendering options.-  data Options b v :: *--  -- | Perform a rendering operation with a local style.-  withStyle      :: b          -- ^ Backend token (needed only for type inference)-                 -> Style v    -- ^ Style to use-                 -> Transformation v  -- ^ Transformation to be applied to the style-                 -> Render b v -- ^ Rendering operation to run-                 -> Render b v -- ^ Rendering operation using the style locally--  -- | 'doRender' is used to interpret rendering operations.-  doRender       :: b           -- ^ Backend token (needed only for type inference)-                 -> Options b v -- ^ Backend-specific collection of rendering options-                 -> Render b v  -- ^ Rendering operation to perform-                 -> Result b v  -- ^ Output of the rendering operation--  -- | 'adjustDia' allows the backend to make adjustments to the final-  --   diagram (e.g. to adjust the size based on the options) before-  --   rendering it.  It can also make adjustments to the options-  --   record, usually to fill in incompletely specified size-  --   information.  A default implementation is provided which makes-  --   no adjustments.  See the diagrams-lib package for other useful-  --   implementations.-  adjustDia :: Monoid' m => b -> Options b v-            -> QDiagram b v m -> (Options b v, QDiagram b v m)-  adjustDia _ o d = (o,d)--  -- XXX expand this comment.  Explain about freeze, split-  -- transformations, etc.-  -- | Render a diagram.  This has a default implementation in terms-  --   of 'adjustDia', 'withStyle', 'doRender', and the 'render'-  --   operation from the 'Renderable' class (first 'adjustDia' is-  --   used, then 'withStyle' and 'render' are used to render each-  --   primitive, the resulting operations are combined with-  --   'mconcat', and the final operation run with 'doRender') but-  --   backends may override it if desired.-  renderDia :: (InnerSpace v, OrderedField (Scalar v), Monoid' m)-            => b -> Options b v -> QDiagram b v m -> Result b v-  renderDia b opts d =-    doRender b opts' . mconcat . map renderOne . prims $ d'-      where (opts', d') = adjustDia b opts d-            renderOne :: (Prim b v, (Split (Transformation v), Style v))-                      -> Render b v-            renderOne (p, (M t,      s))-              = withStyle b s mempty (render b (transform t p))--            renderOne (p, (t1 :| t2, s))-              = withStyle b s t1 (render b (transform (t1 <> t2) p))--  -- See Note [backend token]---- | The @D@ type is provided for convenience in situations where you---   must give a diagram a concrete, monomorphic type, but don't care---   which one.  Such situations arise when you pass a diagram to a---   function which is polymorphic in its input but monomorphic in its---   output, such as 'width', 'height', 'phantom', or 'names'.  Such---   functions compute some property of the diagram, or use it to---   accomplish some other purpose, but do not result in the diagram---   being rendered.  If the diagram does not have a monomorphic type,---   GHC complains that it cannot determine the diagram's type.------   For example, here is the error we get if we try to compute the---   width of a radius-1 circle (this example requires---   @diagrams-lib@):------   > ghci> width (circle 1)---   >---   > <interactive>:1:8:---   >     No instances for (Backend b0 R2,---   >                       Renderable Diagrams.TwoD.Ellipse.Ellipse b0)---   >       arising from a use of `circle'---   >     Possible fix:---   >       add instance declarations for---   >       (Backend b0 R2, Renderable Diagrams.TwoD.Ellipse.Ellipse b0)---   >     In the first argument of `width', namely `(circle 1)'---   >     In the expression: width (circle 1)---   >     In an equation for `it': it = width (circle 1)------   GHC complains that it cannot find an instance for \"@Backend b0---   R2@\"; what is really going on is that it does not have enough---   information to decide which backend to use for the circle (hence---   the type variable @b0@).  This is annoying because /we/ know that---   the choice of backend cannot possibly affect the width of the---   circle; but there is no way for GHC to know that.------   The solution is to annotate @circle 1@ with the type @'D' 'R2'@,---   like so:------   > ghci> width (circle 1 :: D R2)---   > 2.0--type D v = Diagram NullBackend v----- | A null backend which does no actual rendering.  It is provided---   mainly for convenience in situations where you must give a---   diagram a concrete, monomorphic type, but don't actually care---   which one.  See 'D' for more explanation and examples.------   It is courteous, when defining a new primitive @P@, to make an instance------   > instance Renderable P NullBackend where---   >   render _ _ = mempty------   This ensures that the trick with 'D' annotations can be used for---   diagrams containing your primitive.-data NullBackend---- Note: we can't make a once-and-for-all instance------ > instance Renderable a NullBackend where--- >   render _ _ = mempty------ because it overlaps with the Renderable instance for NullPrim.--instance Monoid (Render NullBackend v) where-  mempty      = NullBackendRender-  mappend _ _ = NullBackendRender--instance HasLinearMap v => Backend NullBackend v where-  data Render NullBackend v = NullBackendRender-  type Result NullBackend v = ()-  data Options NullBackend v--  withStyle _ _ _ _ = NullBackendRender-  doRender _ _ _    = ()---- | A class for backends which support rendering multiple diagrams,---   e.g. to a multi-page pdf or something similar.-class Backend b v => MultiBackend b v where--  -- | Render multiple diagrams at once.-  renderDias :: b -> Options b v -> [QDiagram b v m] -> Result b v--  -- See Note [backend token]----- | The Renderable type class connects backends to primitives which---   they know how to render.-class Transformable t => Renderable t b where-  render :: b -> t -> Render b (V t)-  -- ^ Given a token representing the backend and a-  --   transformable object, render it in the appropriate rendering-  --   context.--  -- See Note [backend token]--{--~~~~ Note [backend token]--A bunch of methods here take a "backend token" as an argument.  The-backend token is expected to carry no actual information; it is solely-to help out the type system. The problem is that all these methods-return some associated type applied to b (e.g. Render b) and unifying-them with something else will never work, since type families are not-necessarily injective.--}-

@@ -1,254 +0,0 @@-{-# LANGUAGE TypeFamilies-           , FlexibleInstances-           , FlexibleContexts-           , UndecidableInstances-           , GeneralizedNewtypeDeriving-           , StandaloneDeriving-           , MultiParamTypeClasses-  #-}--------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams.Envelope--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ "Graphics.Rendering.Diagrams" defines the core library of primitives--- forming the basis of an embedded domain-specific language for--- describing and rendering diagrams.------ The @Envelope@ module defines a data type and type class for--- \"envelopes\", aka functional bounding regions.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Envelope-       ( -- * Envelopes-         Envelope(..)--       , inEnvelope-       , appEnvelope-       , onEnvelope-       , mkEnvelope--       , Enveloped(..)--       , LocatedEnvelope(..)-       , location-       , locateEnvelope--         -- * Utility functions-       , diameter-       , radius-       , envelopeV, envelopeP, boundaryFrom--         -- * Miscellaneous-       , OrderedField-       ) where--import Graphics.Rendering.Diagrams.V-import Graphics.Rendering.Diagrams.Transform-import Graphics.Rendering.Diagrams.Points-import Graphics.Rendering.Diagrams.HasOrigin--import Data.VectorSpace-import Data.AffineSpace ((.+^), (.-^))--import Data.Semigroup-import Control.Applicative ((<$>))--import qualified Data.Map as M-import qualified Data.Set as S-----------------------------------------------------------------  Envelopes  -------------------------------------------------------------------------------------------------------------- | Every diagram comes equipped with an *envelope*.---   Intuitively, the envelope for a diagram tells us the---   minimum distance we have to go in a given direction to get to a---   (hyper)plane entirely containing the diagram on one side of---   it. Formally, given a vector @v@, it returns a scalar @s@ such---   that------     * for every point @u@ inside the diagram,---       if the projection of @(u - origin)@ onto @v@ is @s' *^ v@, then @s' <= s@.------     * @s@ is the smallest such scalar.------   This could probably be expressed in terms of a Galois connection;---   this is left as an exercise for the reader.------   There is also a special \"empty envelope\".------   Essentially, envelopes are a functional representation---   of (a conservative approximation to) convex bounding regions.---   The idea for this representation came from Sebastian Setzer; see---   <http://byorgey.wordpress.com/2009/10/28/collecting-attributes/#comment-2030>.-newtype Envelope v = Envelope { unEnvelope :: Option (v -> Max (Scalar v)) }--inEnvelope :: (Option (v -> Max (Scalar v)) -> Option (v -> Max (Scalar v)))-           -> Envelope v -> Envelope v-inEnvelope f = Envelope . f . unEnvelope--appEnvelope :: Envelope v -> Maybe (v -> Scalar v)-appEnvelope (Envelope (Option b)) = (getMax .) <$> b--onEnvelope :: ((v -> Scalar v) -> (v -> Scalar v)) -> Envelope v -> Envelope v-onEnvelope t = (inEnvelope . fmap) ((Max .) . t . (getMax .))--mkEnvelope :: (v -> Scalar v) -> Envelope v-mkEnvelope = Envelope . Option . Just . (Max .)---- | Envelopes form a semigroup with pointwise maximum as composition.---   Hence, if @b1@ is the envelope for diagram @d1@, and---   @b2@ is the envelope for @d2@, then @b1 \`mappend\` b2@---   is the envelope for @d1 \`atop\` d2@.-deriving instance Ord (Scalar v) => Semigroup (Envelope v)---- | The special empty envelope is the identity for the---   'Monoid' instance.-deriving instance Ord (Scalar v) => Monoid (Envelope v)------   XXX add some diagrams here to illustrate!  Note that Haddock supports---   inline images, using a \<\<url\>\> syntax.--type instance V (Envelope v) = v---- | The local origin of an envelope is the point with respect to---   which bounding queries are made, /i.e./ the point from which the---   input vectors are taken to originate.-instance (InnerSpace v, AdditiveGroup (Scalar v), Fractional (Scalar v))-         => HasOrigin (Envelope v) where-  moveOriginTo (P u) = onEnvelope $ \f v -> f v ^-^ ((u ^/ (v <.> v)) <.> v)--instance Show (Envelope v) where-  show _ = "<envelope>"-----------------------------------------------------------------  Transforming envelopes  ------------------------------------------------------------------------------------------------- XXX can we get away with removing this Floating constraint? It's the---   call to normalized here which is the culprit.-instance ( HasLinearMap v, InnerSpace v-         , Floating (Scalar v), AdditiveGroup (Scalar v) )-    => Transformable (Envelope v) where-  transform t =   -- XXX add lots of comments explaining this!-    moveOriginTo (P . negateV . transl $ t) .-    (onEnvelope $ \f v ->-      let v' = normalized $ lapp (transp t) v-          vi = apply (inv t) v-      in  f v' / (v' <.> vi)-    )-----------------------------------------------------------------  Enveloped class----------------------------------------------------------------- | When dealing with envelopes we often want scalars to be an---   ordered field (i.e. support all four arithmetic operations and be---   totally ordered) so we introduce this class as a convenient---   shorthand.-class (Fractional s, Floating s, Ord s, AdditiveGroup s) => OrderedField s-instance (Fractional s, Floating s, Ord s, AdditiveGroup s) => OrderedField s---- | @Enveloped@ abstracts over things which have an envelope.-class (InnerSpace (V b), OrderedField (Scalar (V b))) => Enveloped b where--  -- | Compute the envelope of an object.  For types with an intrinsic-  --   notion of \"local origin\", the envelope will be based there.-  --   Other types (e.g. 'Trail') may have some other default-  --   reference point at which the envelope will be based; their-  --   instances should document what it is.-  getEnvelope :: b -> Envelope (V b)--instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (Envelope v) where-  getEnvelope = id--instance (OrderedField (Scalar v), InnerSpace v) => Enveloped (Point v) where-  getEnvelope p = moveTo p . mkEnvelope $ const zeroV--instance (Enveloped a, Enveloped b, V a ~ V b) => Enveloped (a,b) where-  getEnvelope (x,y) = getEnvelope x <> getEnvelope y--instance (Enveloped b) => Enveloped [b] where-  getEnvelope = mconcat . map getEnvelope--instance (Enveloped b) => Enveloped (M.Map k b) where-  getEnvelope = mconcat . map getEnvelope . M.elems--instance (Enveloped b) => Enveloped (S.Set b) where-  getEnvelope = mconcat . map getEnvelope . S.elems---- XXX  rename this?  Move it elsewhere?----------------------------------------------------------------  Located envelopes----------------------------------------------------------------- | A @LocatedEnvelope@ value represents an envelope with its---   base point at a particular location.-data LocatedEnvelope v = LocatedEnvelope (Point v) (TransInv (Envelope v))-  deriving (Show)--type instance V (LocatedEnvelope v) = v--instance (OrderedField (Scalar v), InnerSpace v) => Enveloped (LocatedEnvelope v) where-  getEnvelope (LocatedEnvelope _ (TransInv b)) = b--instance VectorSpace v => HasOrigin (LocatedEnvelope v) where-  moveOriginTo (P u) (LocatedEnvelope p b) = LocatedEnvelope (p .-^ u) b--instance ( HasLinearMap v, InnerSpace v-         , Floating (Scalar v), AdditiveGroup (Scalar v) )-    => Transformable (LocatedEnvelope v) where-  transform t (LocatedEnvelope p b) = LocatedEnvelope (papply t p)-                                                  (transform t b)---- | Get the location of a located envelope.-location :: LocatedEnvelope v -> Point v-location (LocatedEnvelope p _) = p---- XXX boundaryFrom really ought to use the 'trace' of a diagram--- instead of the envelope.  Leave it here for now, move it when we--- implement traces so it will have a different semantics.---- | @boundaryFrom v b@ computes the point on the boundary of the---   located envelope @b@ in the direction of @v@ from the---   bounding region's base point.  This is most often used to compute---   a point on the boundary of a named subdiagram.-boundaryFrom :: (OrderedField (Scalar v), InnerSpace v)-             => LocatedEnvelope v -> v -> Point v-boundaryFrom b v = location b .+^ envelopeV v b---- | Create a 'LocatedEnvelope' value by specifying a location and an---   envelope.-locateEnvelope :: Point v -> Envelope v -> LocatedEnvelope v-locateEnvelope p b = LocatedEnvelope p (TransInv b)-----------------------------------------------------------------  Computing with envelopes----------------------------------------------------------------- | Compute the vector from the local origin to a separating---   hyperplane in the given direction.  Returns the zero vector for---   the empty envelope.-envelopeV :: Enveloped a => V a -> a -> V a-envelopeV v a = maybe zeroV ((*^ v) . ($ v)) $ appEnvelope (getEnvelope a)---- | Compute the point on a separating hyperplane in the given---   direction.  Returns the origin for the empty envelope.-envelopeP :: Enveloped a => V a -> a -> Point (V a)-envelopeP v a = P $ envelopeV v a---- | Compute the diameter of a enveloped object along a particular---   vector.  Returns zero for the empty envelope.-diameter :: Enveloped a => V a -> a -> Scalar (V a)-diameter v a = magnitude (envelopeV v a ^-^ envelopeV (negateV v) a)---- | Compute the \"radius\" (1\/2 the diameter) of an enveloped object---   along a particular vector.-radius :: Enveloped a => V a -> a -> Scalar (V a)-radius v a = 0.5 * diameter v a

@@ -1,94 +0,0 @@-{-# LANGUAGE FlexibleInstances-           , FlexibleContexts-           , TypeFamilies-           , UndecidableInstances-  #-}---- The UndecidableInstances flag is needed under 6.12.3 for the--- HasOrigin (a,b) instance.---------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams.HasOrigin--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ Types which have an intrinsic notion of a \"local origin\",--- /i.e./ things which are /not/ invariant under translation.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.HasOrigin-       ( HasOrigin(..), moveOriginBy, moveTo, place-       ) where--import Graphics.Rendering.Diagrams.V-import Graphics.Rendering.Diagrams.Points--import qualified Data.Map as M-import qualified Data.Set as S--import Data.AffineSpace ((.-^), (.-.))-import Data.VectorSpace---- | Class of types which have an intrinsic notion of a \"local---   origin\", i.e. things which are not invariant under translation,---   and which allow the origin to be moved.------   One might wonder why not just use 'Transformable' instead of---   having a separate class for 'HasOrigin'; indeed, for types which---   are instances of both we should have the identity------   > moveOriginTo (origin .^+ v) === translate (negateV v)------   The reason is that some things (e.g. vectors, 'Trail's) are---   transformable but are translationally invariant, i.e. have no---   origin.-class VectorSpace (V t) => HasOrigin t where--  -- | Move the local origin to another point.-  ---  --   Note that this function is in some sense dual to 'translate'-  --   (for types which are also 'Transformable'); moving the origin-  --   itself while leaving the object \"fixed\" is dual to fixing the-  --   origin and translating the diagram.-  moveOriginTo :: Point (V t) -> t -> t---- | Move the local origin by a relative vector.-moveOriginBy :: HasOrigin t => V t -> t -> t-moveOriginBy = moveOriginTo . P---- | Translate the object by the translation that sends the origin to---   the given point. Note that this is dual to 'moveOriginTo', i.e. we---   should have------   > moveTo (origin .^+ v) === moveOriginTo (origin .^- v)------   For types which are also 'Transformable', this is essentially the---   same as 'translate', i.e.------   > moveTo (origin .^+ v) === translate v-moveTo :: HasOrigin t => Point (V t) -> t -> t-moveTo = moveOriginBy . (origin .-.)---- | A flipped variant of 'moveTo', provided for convenience.  Useful---   when writing a function which takes a point as an argument, such---   as when using 'withName' and friends.-place :: HasOrigin t => t -> Point (V t) -> t-place = flip moveTo--instance VectorSpace v => HasOrigin (Point v) where-  moveOriginTo (P u) p = p .-^ u--instance (HasOrigin a, HasOrigin b, V a ~ V b) => HasOrigin (a,b) where-  moveOriginTo p (x,y) = (moveOriginTo p x, moveOriginTo p y)--instance HasOrigin a => HasOrigin [a] where-  moveOriginTo = map . moveOriginTo--instance (HasOrigin a, Ord a) => HasOrigin (S.Set a) where-  moveOriginTo = S.map . moveOriginTo--instance HasOrigin a => HasOrigin (M.Map k a) where-  moveOriginTo = M.map . moveOriginTo

@@ -1,63 +0,0 @@-{-# LANGUAGE FlexibleContexts-           , UndecidableInstances-           , TypeFamilies-  #-}--------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams.Juxtapose--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ Things which can be placed \"next to\" other things, for some--- appropriate notion of \"next to\".-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Juxtapose-       ( Juxtaposable(..), juxtaposeDefault-       ) where--import Graphics.Rendering.Diagrams.V-import Graphics.Rendering.Diagrams.Envelope-import Graphics.Rendering.Diagrams.HasOrigin--import qualified Data.Map as M-import qualified Data.Set as S--import Data.VectorSpace---- | Class of things which can be placed \"next to\" other things, for some---   appropriate notion of \"next to\".-class Juxtaposable a where--  -- | @juxtapose v a1 a2@ positions @a2@ next to @a1@ in the-  --   direction of @v@.  In particular, place @a2@ so that @v@ points-  --   from the local origin of @a1@ towards the old local origin of-  --   @a2@; @a1@'s local origin becomes @a2@'s new local origin.  The-  --   result is just a translated version of @a2@.  (In particular,-  --   this operation does not /combine/ @a1@ and @a2@ in any way.)-  juxtapose :: V a -> a -> a -> a---- | Default implementation of 'juxtapose' for things which are---   instances of 'Enveloped' and 'HasOrigin'.-juxtaposeDefault :: (Enveloped a, HasOrigin a) => V a -> a -> a -> a-juxtaposeDefault v a1 a2 = moveOriginBy (v1 ^+^ v2) a2-  where v1 = negateV (envelopeV v a1)-        v2 = envelopeV (negateV v) a2--instance (InnerSpace v, OrderedField (Scalar v)) => Juxtaposable (Envelope v) where-  juxtapose = juxtaposeDefault--instance (Enveloped a, HasOrigin a, Enveloped b, HasOrigin b, V a ~ V b)-         => Juxtaposable (a,b) where-  juxtapose = juxtaposeDefault--instance (Enveloped b, HasOrigin b) => Juxtaposable [b] where-  juxtapose = juxtaposeDefault--instance (Enveloped b, HasOrigin b) => Juxtaposable (M.Map k b) where-  juxtapose = juxtaposeDefault--instance (Enveloped b, HasOrigin b, Ord b) => Juxtaposable (S.Set b) where-  juxtapose = juxtaposeDefault

@@ -1,180 +0,0 @@-{-# LANGUAGE TypeOperators-           , MultiParamTypeClasses-           , FlexibleInstances-           , OverlappingInstances-           , UndecidableInstances-           , TypeFamilies-           , GeneralizedNewtypeDeriving-  #-}---------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams.MList--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ Heterogeneous lists of monoids.----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.MList-       ( -- * Heterogeneous monoidal lists--         -- $mlist--         Nil(..), (:::)(..)--       , MList(..)--         -- * Converting to tuples-       , Tuple, ToTuple(..)--         -- * Accessing embedded values-       , (:>:)(..)--         -- * Monoid actions of heterogeneous lists--         -- $mlist-actions--       , SM(..)-       ) where--import Data.Semigroup-import Graphics.Rendering.Diagrams.Monoids---- $mlist------ The idea of /heterogeneous lists/ has been around for a long time.--- Here, we adopt heterogeneous lists where the element types are all--- monoids: this allows us to leave out identity values, so that a--- heterogeneous list containing only a single non-identity value can--- be created without incurring constraints due to all the other--- types, by leaving all the other values out.--infixr 5 :::---- | The empty heterogeneous list.-data Nil     = Nil-  deriving (Show, Eq, Ord)---- | Cons for heterogeneous lists.-data a ::: l = Missing l -- ^ The @a@ value is missing, and should be-                         --   construed as 'mempty'.-             | a ::: l   -- ^ An @a@ value followed by a heterogeneous-                         --   list @l@.-  deriving (Show, Eq, Ord)---- MList --------------------------------------- | Type class for heterogeneous monoidal lists, with a single method---   allowing construction of an empty list.-class MList l where-  -- | The /empty/ heterogeneous list of type @l@. Of course, @empty-  -- == 'mempty'@, but unlike 'mempty', @empty@ does not require-  -- 'Monoid' constraints on all the elements of @l@.-  empty   :: l--instance MList Nil where-  empty     = Nil--instance MList l => MList (a ::: l) where-  empty   = Missing empty---- Monoid ------------------------------------instance Semigroup Nil where-  _ <> _ = Nil--instance Monoid Nil where-  mempty  = Nil-  mappend = (<>)--instance (Semigroup a, Semigroup tl) => Semigroup (a ::: tl) where-  (Missing t1) <> (Missing t2) = Missing (t1 <> t2)-  (Missing t1) <> (a2 ::: t2)  = a2 ::: (t1 <> t2)-  (a1 ::: t1)  <> (Missing t2) = a1 ::: (t1 <> t2)-  (a1 ::: t1)  <> (a2 ::: t2)  = (a1 <> a2) ::: (t1 <> t2)---- | Heterogeneous monoidal lists are themselves instances of 'Monoid'---   as long as all their elements are, where 'mappend' is done---   elementwise.-instance (Semigroup a, Semigroup tl, Monoid tl) => Monoid (a ::: tl) where-  mempty  = Missing mempty-  mappend = (<>)---- ToTuple ------------------------------------- | A type function to compute the tuple-based representation for---   instances of 'MList'.-type family Tuple l :: *-type instance Tuple Nil       = ()-type instance Tuple (a ::: b) = (a, Tuple b)---- | @toTuple@ can be used to convert a heterogeneous list to its---   tuple-based representation.-class ToTuple l where-  toTuple :: l -> Tuple l--instance ToTuple Nil where-  toTuple _ = ()--instance (Monoid a, ToTuple l) => ToTuple (a ::: l) where-  toTuple (Missing l) = (mempty, toTuple l)-  toTuple (a ::: l)   = (a, toTuple l)---- Embedding ----------------------------------------------- | The relation @l :>: a@ holds when @a@ is the type of an element---   in @l@.  For example,  @(Char ::: Int ::: Bool ::: Nil) :>: Int@.-class l :>: a where-  -- | Inject a value into an otherwise empty heterogeneous list.-  inj  :: a -> l--  -- | Get the value of type @a@ from a heterogeneous list.-  get  :: l -> a--  -- | Alter the value of type @a@ by applying the given function to it.-  alt  :: (a -> a) -> l -> l--instance (MList t, Monoid a) => (:>:) (a ::: t) a where-  inj a                = a ::: empty-  get (Missing _)      = mempty-  get (a ::: _)        = a-  alt f (Missing l)    = f mempty ::: l-  alt f (a ::: l)      = f a ::: l--instance (t :>: a) => (:>:) (b ::: t) a where-  inj a                = Missing (inj a)-  get (Missing l)      = get l-  get (_ ::: l)        = get l-  alt f (Missing l)    = Missing (alt f l)-  alt f (a ::: l)      = a ::: alt f l---- Monoid actions --------------------------------------------- $mlist-actions--- Monoidal heterogeneous lists may act on one another as you would--- expect, with each element in the first list acting on each in the--- second.  Unfortunately, coding this up in type class instances is a--- bit fiddly.---- | @SM@, an abbreviation for \"single monoid\" (as opposed to a---   heterogeneous list of monoids), is only used internally to help---   guide instance selection when defining the action of---   heterogeneous monoidal lists on each other.-newtype SM m = SM m-  deriving (Monoid)--instance Action Nil l where-  act _ a = a--instance (Monoid a, Action (SM a) l2, Action l1 l2) => Action (a ::: l1) l2 where-  act (Missing l1) l2 = act l1 l2-  act (a ::: l1) l2   = act (SM a) (act l1 l2)--instance Monoid a => Action (SM a) Nil where-  act _ _ = Nil--instance (Action a a', Action (SM a) l) => Action (SM a) (a' ::: l) where-  act (SM a) (Missing l) = Missing (act (SM a) l)-  act (SM a) (a' ::: l)  = act a a' ::: act (SM a) l

@@ -1,467 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses-           , FlexibleInstances-           , GeneralizedNewtypeDeriving-           , DeriveFunctor-           , TypeFamilies-           , TypeOperators-           , UndecidableInstances-  #-}---------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams.Monoids--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ Various monoid-related definitions (monoid actions, split monoids,--- applicative monoids) used in the core diagrams library.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Monoids-       ( -- * Monoids and semigroups--         Monoid'--         -- * Monoid actions--       , Action(..)--         -- * Split monoids-         -- $split--       , Split(..), split--         -- * Forgetful monoids-         -- $forget--       , Forgetful(..), unForget, forget--       , Deletable(..), unDelete, toDeletable, deleteL, deleteR--         -- * Applicative monoids--       , AM(..), inAM2--         -- * Coproduct monoid-       , (:+:)-       , inL, inR-       , mappendL, mappendR-       , killL, killR-       , untangle-       ) where--import Graphics.Rendering.Diagrams.V--import Data.Semigroup-import Data.Foldable-import Control.Applicative-import Data.Either (lefts, rights)-----------------------------------------------------------------  Monoids and semigroups----------------------------------------------------------------- Poor man's constraint synonym.  Eventually, once it becomes--- standard, we can make this a real constraint synonym and get rid of--- the UndecidableInstances flag.  Better yet, hopefully the Monoid--- class will eventually have a Semigroup superclass.---- | The @Monoid'@ class is a synonym for things which are instances---   of both 'Semigroup' and 'Monoid'.  Ideally, the 'Monoid' class---   itself will eventually include a 'Semigroup' superclass and we---   can get rid of this.-class (Semigroup m, Monoid m) => Monoid' m-instance (Semigroup m, Monoid m) => Monoid' m-----------------------------------------------------------------  Monoid actions----------------------------------------------------------------- | Type class for monoid actions, where monoidal values of type @m@---   \"act\" on values of another type @s@.  Instances are required to---   satisfy the laws------   * @act mempty = id@------   * @act (m1 ``mappend`` m2) = act m1 . act m2@------   Additionally, if the type @s@ has any algebraic structure, @act---   m@ should be a homomorphism.  For example, if @s@ is also a---   monoid we should have @act m mempty = mempty@ and @act m (s1---   ``mappend`` s2) = (act m s1) ``mappend`` (act m s2)@.------   By default, @act = const id@, so for a monoidal type @M@ which---   should have no action on anything, it suffices to write------   > instance Action M s------   with no method implementations.-class Action m s where--  -- | Convert a monoidal value of type @m@ to an action on @s@ values.-  act :: m -> s -> s-  act = const id-----------------------------------------------------------------  Split monoids----------------------------------------------------------------- $split--- Sometimes we want to accumulate values from some monoid, but have--- the ability to introduce a \"split\" which separates values on--- either side.  For example, this is used when accumulating--- transformations to be applied to primitive diagrams: the 'freeze'--- operation introduces a split, since only transformations occurring--- outside the freeze should be applied to attributes.--infix 5 :|---- | A value of type @Split m@ is either a single @m@, or a pair of---   @m@'s separated by a divider.-data Split m = M m-             | m :| m---- | If @m@ is a @Semigroup@, then @Split m@ is a semigroup which---   combines values on either side of a split, keeping only the---   rightmost split.-instance Semigroup m => Semigroup (Split m) where-  (M m1)       <> (M m2)       = M (m1 <> m2)-  (M m1)       <> (m1' :| m2)  = m1 <> m1'         :| m2-  (m1  :| m2)  <> (M m2')      = m1                :| m2 <> m2'-  (m11 :| m12) <> (m21 :| m22) = m11 <> m12 <> m21 :| m22--instance (Semigroup m, Monoid m) => Monoid (Split m) where-  mempty  = M mempty-  mappend = (<>)---- | A convenient name for @mempty :| mempty@, so @a \<\> split \<\> b == a :| b@.-split :: Monoid m => Split m-split = mempty :| mempty---- | By default, the action of a split monoid is the same as for---   the underlying monoid, as if the split were removed.-instance Action m n => Action (Split m) n where-  act (M m) n      = act m n-  act (m1 :| m2) n = act m1 (act m2 n)-----------------------------------------------------------------  Forgetful monoids----------------------------------------------------------------- $forget--- Sometimes we want to be able to \"forget\" some information.  We--- define two monoid transformers that allow forgetting information.--- @Forgetful@ introduces special values which cause anything to their--- right to be forgotten.  @Deletable@ introduces special \"left and--- right bracket\" elements which cause everything inside them to be--- forgotten.----- | A value of type @Forgetful m@ is either a \"normal\" value of---   type @m@, which combines normally with other normal values, or a---   \"forgetful\" value, which combines normally with other values to---   its left but discards values combined on the right.  Also, when---   combining a forgetful value with a normal one the result is---   always forgetful.-data Forgetful m = Normal m-                 | Forgetful m-  deriving Functor---- | Project the wrapped value out of a `Forgetful` value.-unForget :: Forgetful m -> m-unForget (Normal m)    = m-unForget (Forgetful m) = m---- | If @m@ is a 'Semigroup', then @Forgetful m@ is a semigroup with two---   sorts of values, \"normal\" and \"forgetful\": the normal ones---   combine normally and the forgetful ones discard anything to the---   right.-instance Semigroup m => Semigroup (Forgetful m) where-  (Normal m1)    <> (Normal m2)    = Normal (m1 <> m2)-  (Normal m1)    <> (Forgetful m2) = Forgetful (m1 <> m2)-  (Forgetful m1) <> _              = Forgetful m1--instance (Semigroup m, Monoid m) => Monoid (Forgetful m) where-  mempty  = Normal mempty-  mappend = (<>)----- | A convenient name for @Forgetful mempty@, so @a \<\> forget \<\>---   b == Forgetful a@.-forget :: Monoid m => Forgetful m-forget = Forgetful mempty--instance Action m n => Action (Forgetful m) n where-  act (Normal m) n    = act m n-  act (Forgetful m) n = act m n--type instance V (Forgetful m) = V m---- | If @m@ is a 'Monoid', then @Deletable m@ (intuitively speaking)---   adds two distinguished new elements @[@ and @]@, such that an---   occurrence of [ \"deletes\" everything from it to the next ]. For---   example,------   > abc[def]gh == abcgh------   This is all you really need to know to /use/ @Deletable m@---   values; to understand the actual implementation, read on.------   To properly deal with nesting and associativity we need to be---   able to assign meanings to things like @[[@, @][@, and so on. (We---   cannot just define, say, @[[ == [@, since then @([[)] == [] ==---   id@ but @[([]) == [id == [@.)  Formally, elements of @Deletable---   m@ are triples of the form (r, m, l) representing words @]^r m---   [^l@.  When combining two triples (r1, m1, l1) and (r2, m2, l2)---   there are three cases:------   * If l1 == r2 then the [s from the left and ]s from the right---     exactly cancel, and we are left with (r1, m1 \<\> m2, l2).------   * If l1 < r2 then all of the [s cancel with some of the ]s, but---     m1 is still inside the remaining ]s and is deleted, yielding (r1---     + r2 - l1, m2, l2)------   * The remaining case is symmetric with the second.--data Deletable m = Deletable Int m Int-  deriving Functor--type instance V (Deletable m) = V m---- | Project the wrapped value out of a `Deletable` value.-unDelete :: Deletable m -> m-unDelete (Deletable _ m _) = m---- | Inject a value into a `Deletable` wrapper.  Satisfies the---   property------ > unDelete . toDeletable === id----toDeletable :: m -> Deletable m-toDeletable m = Deletable 0 m 0--instance Semigroup m => Semigroup (Deletable m) where-  (Deletable r1 m1 l1) <> (Deletable r2 m2 l2)-    | l1 == r2  = Deletable r1 (m1 <> m2) l2-    | l1 <  r2  = Deletable (r1 + r2 - l1) m2 l2-    | otherwise = Deletable r1 m1 (l2 + l1 - r2)--instance (Semigroup m, Monoid m) => Monoid (Deletable m) where-  mempty = Deletable 0 mempty 0-  mappend = (<>)---- | A \"left bracket\", which causes everything between it and the---   next right bracket to be deleted.-deleteL :: Monoid m => Deletable m-deleteL = Deletable 0 mempty 1---- | A \"right bracket\", denoting the end of the section that should---   be deleted.-deleteR :: Monoid m => Deletable m-deleteR = Deletable 1 mempty 0-----------------------------------------------------------------  Applicative monoids----------------------------------------------------------------- | A wrapper for an 'Applicative' structure containing a monoid.---   Such structures have a @Monoid@ instance based on \"idiomatic\"---   application of 'mappend' within the @Applicative@ context.---   @instance Monoid m => Monoid (e -> m)@ is one well-known special---   case.  (However, the standard @Monoid@ instance for @Maybe@ is---   /not/ an instance of this pattern; nor is the standard instance---   for lists.)-newtype AM f m = AM (f m)-  deriving (Functor, Applicative)---- | Apply a binary function inside an 'AM' newtype wrapper.-inAM2 :: (f m -> f m -> f m) -> AM f m -> AM f m -> AM f m-inAM2 g (AM f1) (AM f2) = AM (g f1 f2)--instance (Applicative f, Semigroup m) => Semigroup (AM f m) where-  (<>) = inAM2 (liftA2 (<>))---- | @f1 ``mappend`` f2@ is defined as @'mappend' '<$>' f1 '<*>' f2@.-instance (Applicative f, Monoid m) => Monoid (AM f m) where-  mempty  = pure mempty-  mappend = inAM2 (liftA2 mappend)--{- See Applicative laws here:--http://hackage.haskell.org/packages/archive/base/latest/doc/html/Control-Applicative.html#t:Applicative--}--{- left identity:--  AM (pure mempty) `mappend` AM f-=           { definition }-  AM $ fmap mappend (pure mempty) <*> f-=           { naturality of pure, fmap f . pure = pure . f }-  AM $ pure (mappend mempty) <*> f-=           { monoid law (left identity) }-  AM $ pure id <*> f-=           { applicative law (identity) }-  AM f--}--{- right identity:--  AM f `mappend` AM (pure mempty)-=           { definition }-  AM $ fmap mappend f <*> pure mempty-=           { applicative law (interchange) }-  AM $ pure ($mempty) <*> fmap mappend f-=           { applicative/functor law }-  AM $ pure ($mempty) <*> (pure mappend <*> f)-=           { applicative law (composition) }-  AM $ pure (.) <*> pure ($mempty) <*> pure mappend <*> f-=           { applicative law (homomorphism) }-  AM $ pure ((.) ($mempty)) <*> pure mappend <*> f-=           { applicative law (homomorphism) }-  AM $ pure (($mempty) . mappend) <*> f-=           { monoid law (right identity) }-  AM $ pure id <*> f-=           { applicative law (identity) }-  AM f--}--{- associativity:--  (AM f1 `mappend` AM f2) `mappend` AM f3-=           { definition }-  AM $ fmap mappend (AM f1 `mappend` AM f2) <*> f3-=           { definition }-  AM $ fmap mappend (fmap mappend f1 <*> f2) <*> f3-=           { applicative/functor law }-  AM $ pure mappend <*> (pure mappend <*> f1 <*> f2) <*> f3-=           { applicative law (composition) }-  AM $ pure (.) <*> pure mappend <*> (pure mappend <*> f1) <*> f2 <*> f3-=           { applicative law (homomorphism) }-  AM $ pure (mappend .) <*> (pure mappend <*> f1) <*> f2 <*> f3-=           { applicative law (composition) }-  AM $ pure (.) <*> pure (mappend .) <*> pure mappend <*> f1 <*> f2 <*> f3-=           { applicative law (homomorphism) }-  AM $ pure ((mappend .) . mappend) <*> f1 <*> f2 <*> f3-=           { monoid law (associativity) }-  AM $ pure ((. mappend) . (.) . mappend) <*> f1 <*> f2 <*> f3-=-  -- XXX finish this proof (although I have no doubt it goes through)---=-  AM f1 `mappend` (AM f2 `mappend` AM f3)--}--{--\x y z -> (x `mappend` y) `mappend` z-\x y -> mappend (mappend x y)-\x -> mappend . (mappend x)-(mappend .) . mappend--}--{--\x y z -> x `mappend` (y `mappend` z)-\x y z -> mappend x (mappend y z)-\x y -> mappend x . mappend y-\x -> ((.) (mappend x)) . mappend-\x -> (.) ((.) (mappend x)) mappend-\x -> (.mappend) ((.) (mappend x))-(. mappend) . (.) . mappend--}----- | An applicative monoid acts on a value of a monoidal type by---   having each element in the structure act on the value---   independently, and then folding the resulting structure.-instance (Action m n, Foldable f, Functor f, Monoid n) => Action (AM f m) n where-  act (AM f) n = fold $ fmap (`act` n) f---- XXX need to prove that this satisfies the laws!  There are other--- "obvious" instances too.----------------------------------------------------------------- Monoid coproduct----------------------------------------------------------------- | @m :+: n@ is the coproduct of monoids @m@ and @n@.  Values of---   type @m :+: n@ consist of alternating lists of @m@ and @n@---   values.  The empty list is the identity, and composition is list---   concatenation, with appropriate combining of adjacent elements---   when possible.-newtype m :+: n = MCo { unMCo :: [Either m n] }---- For efficiency and simplicity, we implement it just as [Either m--- n]: of course, this does not preserve the invariant of strictly--- alternating types, but it doesn't really matter as long as we don't--- let anyone inspect the internal representation.---- | Injection from the left monoid into a coproduct.-inL :: m -> m :+: n-inL m = MCo [Left m]---- | Injection from the right monoid into a coproduct.-inR :: n -> m :+: n-inR n = MCo [Right n]---- | Prepend a value from the left monoid.-mappendL :: m -> m :+: n -> m :+: n-mappendL = mappend . inL---- | Prepend a value from the right monoid.-mappendR :: n -> m :+: n -> m :+: n-mappendR = mappend . inR--{--normalize :: (Monoid m, Monoid n) => m :+: n -> m :+: n-normalize (MCo es) = MCo (normalize' es)-  where normalize' []  = []-        normalize' [e] = [e]-        normalize' (Left e1:Left e2 : es) = normalize' (Left (e1 <> e2) : es)-        normalize' (Left e1:es) = Left e1 : normalize' es-        normalize' (Right e1:Right e2:es) = normalize' (Right (e1 <> e2) : es)-        normalize' (Right e1:es) = Right e1 : normalize' es--}--instance Semigroup (m :+: n) where-  (MCo es1) <> (MCo es2) = MCo (es1 ++ es2)---- | The coproduct of two monoids is itself a monoid.-instance Monoid (m :+: n) where-  mempty = MCo []-  mappend = (<>)---- | @killR@ takes a value in a coproduct monoid and sends all the---   values from the right monoid to the identity.-killR :: Monoid m => m :+: n -> m-killR = mconcat . lefts . unMCo---- | @killL@ takes a value in a coproduct monoid and sends all the---   values from the left monoid to the identity.-killL :: Monoid n => m :+: n -> n-killL = mconcat . rights . unMCo---- | Take a value from a coproduct monoid where the left monoid has an---   action on the right, and \"untangle\" it into a pair of values.  In---   particular,------ > m1 <> n1 <> m2 <> n2 <> m3 <> n3 <> ...------   is sent to------ > (m1 <> m2 <> m3 <> ..., (act m1 n1) <> (act (m1 <> m2) n2) <> (act (m1 <> m2 <> m3) n3) <> ...)------   That is, before combining @n@ values, every @n@ value is acted on---   by all the @m@ values to its left.-untangle :: (Action m n, Monoid m, Monoid n) => m :+: n -> (m,n)-untangle (MCo elts) = untangle' mempty elts-  where untangle' cur [] = cur-        untangle' (curM, curN) (Left m : elts')  = untangle' (curM `mappend` m, curN) elts'-        untangle' (curM, curN) (Right n : elts') = untangle' (curM, curN `mappend` act curM n) elts'---- | Coproducts act on other things by having each of the components---   act individually.-instance (Action m r, Action n r) => Action (m :+: n) r where-  act = appEndo . mconcat . map (Endo . either act act) . unMCo

@@ -1,231 +0,0 @@-{-# LANGUAGE TypeSynonymInstances-           , FlexibleInstances-           , FlexibleContexts-           , TypeFamilies-           , GeneralizedNewtypeDeriving-           , MultiParamTypeClasses-           , OverlappingInstances-           , TupleSections-           , GADTs-           , DeriveDataTypeable-           , UndecidableInstances-  #-}--------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams.Names--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ This module defines a type of names which can be used for referring--- to locations within diagrams, and related types.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Names-       (-- * Names-        -- ** Atomic names-         AName(..)--        -- ** Names-       , Name(..), IsName(..), (.>)--        -- ** Qualifiable-       , Qualifiable(..)--         -- * Name maps--       , NameMap(..)--         -- ** Constructing name maps-       , fromNames, fromNamesB-       , rememberAs--         -- ** Searching within name maps-       , lookupN-       ) where--import Graphics.Rendering.Diagrams.V-import Graphics.Rendering.Diagrams.Monoids-import Graphics.Rendering.Diagrams.HasOrigin-import Graphics.Rendering.Diagrams.Points-import Graphics.Rendering.Diagrams.Envelope-import Graphics.Rendering.Diagrams.Transform--import Data.VectorSpace--import Data.List (intercalate, isSuffixOf)-import qualified Data.Map as M-import Data.Semigroup-import Control.Arrow ((***))-import Control.Monad (mplus)--import Control.Newtype--import Data.Typeable-----------------------------------------------------------------  Names  ------------------------------------------------------------------------------------------------------------------ | Class for those types which can be used as names.  They must---   support 'Typeable' (to facilitate extracting them from---   existential wrappers), 'Ord' (for comparison and efficient---   storage) and 'Show'.-class (Typeable a, Ord a, Show a) => IsName a where-  toName :: a -> Name-  toName = Name . (:[]) . AName--instance IsName ()-instance IsName Bool-instance IsName Char-instance IsName Int-instance IsName Float-instance IsName Double-instance IsName Integer-instance IsName String-instance IsName a => IsName [a]-instance (IsName a, IsName b) => IsName (a,b)-instance (IsName a, IsName b, IsName c) => IsName (a,b,c)---- | Atomic names.  @AName@ is just an existential wrapper around---   things which are 'Typeable', 'Ord' and 'Show'.-data AName where-  AName :: (Typeable a, Ord a, Show a) => a -> AName-  deriving (Typeable)--instance IsName AName where-  toName = Name . (:[])--instance Eq AName where-  (AName a1) == (AName a2) =-    case cast a2 of-      Nothing  -> False-      Just a2' -> a1 == a2'--instance Ord AName where-  (AName a1) `compare` (AName a2) =-    case cast a2 of-      Nothing  -> show (typeOf a1) `compare` show (typeOf a2)-      Just a2' -> a1 `compare` a2'--instance Show AName where-  show (AName a) = show a---- | A (qualified) name is a (possibly empty) sequence of atomic names.-newtype Name = Name [AName]-  deriving (Eq, Ord, Semigroup, Monoid, Typeable)--instance Show Name where-  show (Name ns) = intercalate " .> " $ map show ns--instance IsName Name where-  toName = id---- | Convenient operator for writing qualified names with atomic---   components of different types.  Instead of writing @toName a1 \<\>---   toName a2 \<\> toName a3@ you can just write @a1 .> a2 .> a3@.-(.>) :: (IsName a1, IsName a2) => a1 -> a2 -> Name-a1 .> a2 = toName a1 <> toName a2---- | Instances of 'Qualifiable' are things which can be qualified by---   prefixing them with a name.-class Qualifiable q where-  -- | Qualify with the given name.-  (|>) :: IsName a => a -> q -> q---- | Of course, names can be qualified using @(.>)@.-instance Qualifiable Name where-  (|>) = (.>)--infixr 5 |>-infixr 5 .>-----------------------------------------------------------------  Name maps  -------------------------------------------------------------------------------------------------------------- | A 'NameMap' is a map associating names to located envelopes,---   /i.e./ envelopes with concrete locations for their base---   points.  There can be multiple associations for any given name.-newtype NameMap v = NameMap (M.Map Name [LocatedEnvelope v])-  deriving (Show)--instance Newtype (NameMap v) (M.Map Name [LocatedEnvelope v]) where-  pack = NameMap-  unpack (NameMap m) = m---- Note, in some sense it would be nicer to use Sets instead of a--- list, but then we would have to put Ord constraints on v--- everywhere. =P---- Note also that we wrap the envelope with TransInv.  This is because--- the base point of each envelope should be thought of as the paired--- Point, *not* as the origin of the current vector space.  In other--- words, the point gets translated "for both of them".--type instance V (NameMap v) = v--instance Semigroup (NameMap v) where-  NameMap s1 <> NameMap s2 = NameMap $ M.unionWith (++) s1 s2---- | 'NameMap's form a monoid with the empty map as the identity, and---   map union as the binary operation.  No information is ever lost:---   if two maps have the same name in their domain, the resulting map---   will associate that name to the concatenation of the information---   associated with that name.-instance Monoid (NameMap v) where-  mempty = NameMap M.empty-  mappend = (<>)--instance (AdditiveGroup (Scalar v), Fractional (Scalar v), InnerSpace v)-      => HasOrigin (NameMap v) where-  moveOriginTo = over NameMap . moveOriginTo--instance (AdditiveGroup (Scalar v), InnerSpace v, Floating (Scalar v), HasLinearMap v)-  => Transformable (NameMap v) where-  transform = over NameMap . transform---- | 'NameMap's are qualifiable: if @ns@ is a 'NameMap', then @a |>---   ns@ is the same 'NameMap' except with every name qualified by---   @a@.-instance Qualifiable (NameMap v) where-  a |> (NameMap names) = NameMap $ M.mapKeys (a |>) names---- | Construct a 'NameMap' from a list of (name, point) pairs.-fromNames :: (InnerSpace v, AdditiveGroup (Scalar v), Ord (Scalar v), Floating (Scalar v), IsName a)-          => [(a, Point v)] -> NameMap v-fromNames = NameMap . M.fromListWith (++) -          . map (toName *** ((:[]) . (\p -> locateEnvelope p (getEnvelope p))))---- | Construct a 'NameMap' from a list of associations between names---   and located envelopes.-fromNamesB :: IsName a => [(a, LocatedEnvelope v)] -> NameMap v-fromNamesB = NameMap . M.fromListWith (++) . map (toName *** (:[]))---- | Give a name to a located envelope.-rememberAs :: IsName a => a -> LocatedEnvelope v -> NameMap v -> NameMap v-rememberAs n b = over NameMap $ M.insertWith (++) (toName n) [b]---- | A name acts on a name map by qualifying every name in it.-instance Action Name (NameMap v) where-  act = (|>)---- | Names don't act on anything else.-instance Action Name a----- Searching in name maps.---- | Look for the given name in a name map, returning a list of---   located envelopes associated with that name.  If no names match---   the given name exactly, return all the points associated with---   names of which the given name is a suffix.-lookupN :: IsName n => n -> NameMap v -> Maybe [LocatedEnvelope v]-lookupN a (NameMap m)-  = M.lookup n m `mplus`-    (flatten . filter ((n `nameSuffixOf`) . fst) . M.assocs $ m)-  where (Name n1) `nameSuffixOf` (Name n2) = n1 `isSuffixOf` n2-        flatten [] = Nothing-        flatten xs = Just . concatMap snd $ xs-        n = toName a

@@ -1,28 +0,0 @@-{-# LANGUAGE TypeFamilies-  #-}--------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams.Points--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ A type for /points/ (as distinct from vectors).-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Points-       ( -- * Points--         Point(..), origin, (*.)--       ) where---- We just import from Data.AffineSpace.Point (defined in the--- vector-space-points package) and re-export.  We also define an--- instance of V for Point here.-import Data.AffineSpace.Point--import Graphics.Rendering.Diagrams.V--type instance V (Point v) = v

@@ -1,50 +0,0 @@-{-# LANGUAGE TypeFamilies-           , GeneralizedNewtypeDeriving-  #-}--------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams.Query--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ The @Query@ module defines a type for \"queries\" on diagrams, which--- are functions from points in a vector space to some monoid.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Query-       ( Query(..)-       ) where--import Graphics.Rendering.Diagrams.V-import Graphics.Rendering.Diagrams.Transform-import Graphics.Rendering.Diagrams.Points-import Graphics.Rendering.Diagrams.HasOrigin--import Data.VectorSpace-import Data.AffineSpace--import Data.Semigroup-import Control.Applicative-----------------------------------------------------------------  Queries  ---------------------------------------------------------------------------------------------------------------- | A query is a function that maps points in a vector space to---   values in some monoid. Queries naturally form a monoid, with---   two queries being combined pointwise.------   The idea for annotating diagrams with monoidal queries came from---   the graphics-drawingcombinators package, <http://hackage.haskell.org/package/graphics-drawingcombinators>.-newtype Query v m = Query { runQuery :: Point v -> m }-  deriving (Functor, Applicative, Semigroup, Monoid)--type instance V (Query v m) = v--instance VectorSpace v => HasOrigin (Query v m) where-  moveOriginTo (P u) (Query f) = Query $ \p -> f (p .+^ u)--instance HasLinearMap v => Transformable (Query v m) where-  transform t (Query f) = Query $ f . papply (inv t)

@@ -1,239 +0,0 @@-{-# LANGUAGE ScopedTypeVariables-           , GADTs-           , KindSignatures-           , FlexibleInstances-           , MultiParamTypeClasses-           , TypeFamilies-           , UndecidableInstances-  #-}---- The UndecidableInstances flag is needed under 6.12.3 for the--- HasStyle (a,b) instance.---------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams.Style--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ A definition of /styles/ for diagrams as extensible, heterogeneous--- collections of attributes.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Style-       ( -- * Attributes-         -- $attr--         AttributeClass-       , Attribute(..)-       , mkAttr, mkTAttr, unwrapAttr-       , applyAttr, applyTAttr--         -- * Styles-         -- $style--       , Style(..)-       , attrToStyle, tAttrToStyle-       , getAttr, setAttr, addAttr, combineAttr--       , HasStyle(..)--       ) where--import Graphics.Rendering.Diagrams.V-import Graphics.Rendering.Diagrams.Transform-import Graphics.Rendering.Diagrams.Monoids--import Data.Typeable--import Control.Arrow ((***))-import Data.Semigroup-import qualified Data.Map as M-import qualified Data.Set as S-----------------------------------------------------------------  Attributes  ------------------------------------------------------------------------------------------------------------- $attr--- An /attribute/ is anything that determines some aspect of a--- diagram's rendering.  The standard diagrams library defines several--- standard attributes (line color, line width, fill color, etc.) but--- additional attributes may easily be created.  Additionally, a given--- backend need not handle (or even know about) attributes used in--- diagrams it renders.------ The attribute code is inspired by xmonad's @Message@ type, which--- was in turn based on ideas in:------ Simon Marlow.--- /An Extensible Dynamically-Typed Hierarchy of Exceptions/.--- Proceedings of the 2006 ACM SIGPLAN workshop on--- Haskell. <http://research.microsoft.com/apps/pubs/default.aspx?id=67968>.---- | Every attribute must be an instance of @AttributeClass@, which---   simply guarantees 'Typeable' and 'Semigroup' constraints.  The---   'Semigroup' instance for an attribute determines how it will combine---   with other attributes of the same type.-class (Typeable a, Semigroup a) => AttributeClass a where---- | An existential wrapper type to hold attributes.  Some attributes---   are affected by transformations and some are not.-data Attribute v :: * where-  Attribute  :: AttributeClass a => a -> Attribute v-  TAttribute :: (AttributeClass a, Transformable a, V a ~ v) => a -> Attribute v--type instance V (Attribute v) = v---- | Wrap up an attribute.-mkAttr :: AttributeClass a => a -> Attribute v-mkAttr = Attribute---- | Wrap up a transformable attribute.-mkTAttr :: (AttributeClass a, Transformable a, V a ~ v) => a -> Attribute v-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 -> Maybe a-unwrapAttr (Attribute a)  = cast a-unwrapAttr (TAttribute a) = cast a---- | 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 Semigroup (Attribute v) where-  (Attribute a1) <> a2 =-    case unwrapAttr a2 of-      Nothing  -> a2-      Just a2' -> Attribute (a1 <> a2')-  (TAttribute a1) <> a2 =-    case unwrapAttr a2 of-      Nothing  -> a2-      Just a2' -> TAttribute (a1 <> a2')--instance HasLinearMap v => Transformable (Attribute v) where-  transform _ (Attribute  a) = Attribute a-  transform t (TAttribute a) = TAttribute (transform t a)-----------------------------------------------------------------  Styles  ----------------------------------------------------------------------------------------------------------------- $style--- A 'Style' is a heterogeneous collection of attributes, containing--- at most one attribute of any given type.  This is also based on--- ideas stolen from xmonad, specifically xmonad's implementation of--- user-extensible state.---- | A @Style@ is a heterogeneous collection of attributes, containing---   at most one attribute of any given type.-newtype Style v = Style (M.Map String (Attribute v))-  -- The String keys are serialized TypeRep values, corresponding to-  -- the type of the stored attribute.--type instance V (Style v) = v---- | Helper function for operating on styles.-inStyle :: (M.Map String (Attribute v) -> M.Map String (Attribute v))-        -> Style v -> Style v-inStyle f (Style s) = Style (f s)---- | 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.-getAttr :: forall a v. AttributeClass a => Style v -> Maybe a-getAttr (Style s) = M.lookup ty s >>= unwrapAttr-  where ty = show . 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 :: forall a v. AttributeClass a => a -> Style v-attrToStyle a = Style (M.singleton (show . typeOf $ (undefined :: a)) (mkAttr a))---- | Create a style from a single transformable attribute.-tAttrToStyle :: forall a v. (AttributeClass a, Transformable a, V a ~ v) => a -> Style v-tAttrToStyle a = Style (M.singleton (show . typeOf $ (undefined :: a)) (mkTAttr a))---- | Add a new attribute to a style, or replace the old attribute of---   the same type if one exists.-setAttr :: forall a v. AttributeClass a => a -> Style v -> Style v-setAttr a = inStyle $ M.insert (show . typeOf $ (undefined :: 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 => a -> Style v -> Style v-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 :: AttributeClass a => a -> Style v -> Style v-combineAttr a s =-  case getAttr s of-    Nothing -> setAttr a s-    Just a' -> setAttr (a <> a') s--instance Semigroup (Style v) where-  Style s1 <> Style s2 = Style $ M.unionWith (<>) s1 s2---- | 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 Monoid (Style v) where-  mempty = Style M.empty-  mappend = (<>)---instance HasLinearMap v => Transformable (Style v) where-  transform t = inStyle $ M.map (transform t)---- | Styles have no action on other monoids.-instance Action (Style v) m---- | Type class for things which have a style.-class HasStyle a where-  -- | /Apply/ a style by combining it (on the left) with the-  --   existing style.-  applyStyle :: Style (V a) -> a -> a--instance HasStyle (Style v) where-  applyStyle = mappend--instance (HasStyle a, HasStyle b, V a ~ V b) => HasStyle (a,b) where-  applyStyle s = applyStyle s *** applyStyle s--instance HasStyle a => HasStyle [a] where-  applyStyle = fmap . applyStyle--instance HasStyle b => HasStyle (a -> b) where-  applyStyle = fmap . applyStyle--instance HasStyle a => HasStyle (M.Map k a) where-  applyStyle = fmap . applyStyle--instance (HasStyle a, Ord a) => HasStyle (S.Set a) where-  applyStyle = S.map . applyStyle---- | Apply an 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.-applyAttr :: (AttributeClass a, HasStyle d) => a -> d -> d-applyAttr = applyStyle . attrToStyle---- | Apply a transformable 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.-applyTAttr :: (AttributeClass a, Transformable a, V a ~ V d, HasStyle d) => a -> d -> d-applyTAttr = applyStyle . tAttrToStyle

@@ -1,278 +0,0 @@-{-# LANGUAGE TypeOperators-           , FlexibleContexts-           , FlexibleInstances-           , UndecidableInstances-           , TypeFamilies-           , MultiParamTypeClasses-           , GeneralizedNewtypeDeriving-           , TypeSynonymInstances-  #-}---------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams.Transform--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ "Graphics.Rendering.Diagrams" defines the core library of primitives--- forming the basis of an embedded domain-specific language for--- describing and rendering diagrams.------ The @Transform@ module defines generic transformations--- parameterized by any vector space.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Transform-       (-         -- * Transformations--         -- ** Invertible linear transformations-         (:-:)(..), (<->), linv, lapp--         -- ** General transformations-       , Transformation(..)-       , inv, transp, transl-       , apply-       , papply-       , fromLinear--         -- * The Transformable class--       , HasLinearMap-       , Transformable(..)--         -- * Translational invariance--       , TransInv(..)--         -- * Vector space independent transformations-         -- | Most transformations are specific to a particular vector-         --   space, but a few can be defined generically over any-         --   vector space.--       , translation, translate-       , scaling, scale--       ) where--import Data.AdditiveGroup-import Data.VectorSpace-import Data.AffineSpace ((.-.))-import Data.LinearMap-import Data.Basis-import Data.MemoTrie--import Data.Semigroup-import qualified Data.Map as M-import qualified Data.Set as S--import Graphics.Rendering.Diagrams.Monoids-import Graphics.Rendering.Diagrams.V-import Graphics.Rendering.Diagrams.Points-import Graphics.Rendering.Diagrams.HasOrigin-----------------------------------------------------------------  Transformations  ----------------------------------------------------------------------------------------------------------------------------------------------------------------  Invertible linear transformations  ---------------------------------------------------------------------------- | @(v1 :-: v2)@ is a linear map paired with its inverse.-data (:-:) u v = (u :-* v) :-: (v :-* u)-infixr 7 :-:---- | Create an invertible linear map from two functions which are---   assumed to be linear inverses.-(<->) :: (HasLinearMap u, HasLinearMap v) => (u -> v) -> (v -> u) -> (u :-: v)-f <-> g = linear f :-: linear g--instance HasLinearMap v => Semigroup (v :-: v) where-  (f :-: f') <> (g :-: g') = f *.* g :-: g' *.* f'---- | Invertible linear maps from a vector space to itself form a---   monoid under composition.-instance HasLinearMap v => Monoid (v :-: v) where-  mempty = idL :-: idL-  mappend = (<>)---- | Invert a linear map.-linv :: (u :-: v) -> (v :-: u)-linv (f :-: g) = g :-: f---- | Apply a linear map to a vector.-lapp :: (VectorSpace v, Scalar u ~ Scalar v, HasLinearMap u) => (u :-: v) -> u -> v-lapp (f :-: _) = lapply f-------------------------------------------------------  Affine transformations  ----------------------------------------------------------------------------- | General (affine) transformations, represented by an invertible---   linear map, its /transpose/, and a vector representing a---   translation component.------   By the /transpose/ of a linear map we mean simply the linear map---   corresponding to the transpose of the map's matrix---   representation.  For example, any scale is its own transpose,---   since scales are represented by matrices with zeros everywhere---   except the diagonal.  The transpose of a rotation is the same as---   its inverse.------   The reason we need to keep track of transposes is because it---   turns out that when transforming a shape according to some linear---   map L, the shape's /normal vectors/ transform according to L's---   inverse transpose.  This is exactly what we need when---   transforming bounding functions, which are defined in terms of---   /perpendicular/ (i.e. normal) hyperplanes.--data Transformation v = Transformation (v :-: v) (v :-: v) v--type instance V (Transformation v) = v---- | Invert a transformation.-inv :: HasLinearMap v => Transformation v -> Transformation v-inv (Transformation t t' v) = Transformation (linv t) (linv t')-                                             (negateV (lapp (linv t) v))---- | Get the transpose of a transformation (ignoring the translation---   component).-transp :: Transformation v -> (v :-: v)-transp (Transformation _ t' _) = t'---- | Get the translational component of a transformation.-transl :: Transformation v -> v-transl (Transformation _ _ v) = v---- | Transformations are closed under composition; @t1 <> t2@ is the---   transformation which performs first @t2@, then @t1@.-instance HasLinearMap v => Semigroup (Transformation v) where-  Transformation t1 t1' v1 <> Transformation t2 t2' v2-    = Transformation (t1 <> t2) (t2' <> t1') (v1 ^+^ lapp t1 v2)--instance HasLinearMap v => Monoid (Transformation v) where-  mempty = Transformation mempty mempty zeroV-  mappend = (<>)---- | Transformations can act on transformable things.-instance (HasLinearMap v, v ~ (V a), Transformable a)-         => Action (Transformation v) a where-  act = transform---- | Apply a transformation to a vector.  Note that any translational---   component of the transformation will not affect the vector, since---   vectors are invariant under translation.-apply :: HasLinearMap v => Transformation v -> v -> v-apply (Transformation t _ _) = lapp t---- | Apply a transformation to a point.-papply :: HasLinearMap v => Transformation v -> Point v -> Point v-papply (Transformation t _ v) (P p) = P $ lapp t p ^+^ v---- | Create a general affine transformation from an invertible linear---   transformation and its transpose.  The translational component is---   assumed to be zero.-fromLinear :: AdditiveGroup v => (v :-: v) -> (v :-: v) -> Transformation v-fromLinear l1 l2 = Transformation l1 l2 zeroV-----------------------------------------------------------------  The Transformable class  ------------------------------------------------------------------------------------------------ | 'HasLinearMap' is a poor man's class constraint synonym, just to---   help shorten some of the ridiculously long constraint sets.-class (HasBasis v, HasTrie (Basis v), VectorSpace v) => HasLinearMap v-instance (HasBasis v, HasTrie (Basis v), VectorSpace v) => HasLinearMap v---- | Type class for things @t@ which can be transformed.-class HasLinearMap (V t) => Transformable t where--  -- | Apply a transformation to an object.-  transform :: Transformation (V t) -> t -> t--instance HasLinearMap v => Transformable (Transformation v) where-  transform t1 t2 = t1 <> t2--instance HasLinearMap v => HasOrigin (Transformation v) where-  moveOriginTo p = translate (origin .-. p)--instance Transformable t => Transformable (t,t) where-  transform t (x,y) =  ( transform t x-                       , transform t y-                       )--instance Transformable t => Transformable (t,t,t) where-  transform t (x,y,z) = ( transform t x-                        , transform t y-                        , transform t z-                        )--instance Transformable t => Transformable [t] where-  transform = map . transform--instance (Transformable t, Ord t) => Transformable (S.Set t) where-  transform = S.map . transform--instance Transformable t => Transformable (M.Map k t) where-  transform = M.map . transform--instance HasLinearMap v => Transformable (Point v) where-  transform = papply--instance Transformable m => Transformable (Forgetful m) where-  transform = fmap . transform--instance Transformable m => Transformable (Deletable m) where-  transform = fmap . transform--instance Transformable Double where-  transform = apply--instance Transformable Rational where-  transform = apply-----------------------------------------------------------------  Translational invariance  ----------------------------------------------------------------------------------------------- | @TransInv@ is a wrapper which makes a transformable type---   translationally invariant; the translational component of---   transformations will no longer affect things wrapped in---   @TransInv@.-newtype TransInv t = TransInv { unTransInv :: t }-  deriving (Show, Semigroup, Monoid)--type instance V (TransInv t) = V t--instance VectorSpace (V t) => HasOrigin (TransInv t) where-  moveOriginTo = const id--instance Transformable t => Transformable (TransInv t) where-  transform tr (TransInv t) = TransInv (translate (negateV (transl tr)) . transform tr $ t)-----------------------------------------------------------------  Generic transformations  ------------------------------------------------------------------------------------------------ | Create a translation.-translation :: HasLinearMap v => v -> Transformation v-translation = Transformation mempty mempty---- | Translate by a vector.-translate :: (Transformable t, HasLinearMap (V t)) => V t -> t -> t-translate = transform . translation---- | Create a uniform scaling transformation.-scaling :: (HasLinearMap v, Fractional (Scalar v))-        => Scalar v -> Transformation v-scaling s = fromLinear lin lin      -- scaling is its own transpose-  where lin = (s *^) <-> (^/ s)---- | Scale uniformly in every dimension by the given scalar.-scale :: (Transformable t, Fractional (Scalar (V t)), Eq (Scalar (V t)))-      => Scalar (V t) -> t -> t-scale 0 = error "scale by zero!  Halp!"  -- XXX what should be done here?-scale s = transform $ scaling s

@@ -1,161 +0,0 @@-{-# LANGUAGE DeriveFunctor-           , TypeOperators-           , FlexibleContexts-  #-}---------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams.UDTree--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ Rose (n-way) trees with both upwards- and downwards-traveling--- monoidal annotations, used as the basis for representing diagrams.----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.UDTree-       (-         -- * UD-trees-         UDTree(..)--         -- * Constructing UD-trees-       , leaf, branchD, branch--         -- * Modifying UD-trees-       , applyD, applyUpre, applyUpost, mapU--         -- * Accessors and destructors-       , getU, getU', foldUD, flatten--       ) where--import Data.Semigroup--import Graphics.Rendering.Diagrams.Monoids-import Graphics.Rendering.Diagrams.MList---- | Abstractly, a UDTree is a rose (n-way) tree with data at the---   leaves and two types of monoidal annotations, one (called @u@)---   travelling \"up\" the tree and one (called @d@) traveling---   \"down\".------   Specifically, every node (both leaf nodes and internal nodes)---   has two annotations, one of type @d@ and one of type @u@,---   subject to the following constraints:------   * The @d@ annotation at a leaf node is equal to the 'mconcat' of---     all the @d@ annotations along the path from the root to the leaf---     node.------   * The @u@ annotation at an internal node is equal to @v1---     ``mappend`` (mconcat us) ``mappend`` v2@ for some values @v1@---     and @v2@ (possibly 'mempty'), where @us@ is the list (in---     left-right order) of the @u@ annotations on the immediate child---     nodes of the given node.  Intuitively, we are \"caching\" the---     @mconcat@ of @u@ annotations from the leaves up, except that at---     any point we may insert \"extra\" information.------   In addition, @d@ may have an /action/ on @u@ (see the 'Action'---   type class, defined in "Graphics.Rendering.Diagrams.Monoids"), in---   which case applying a @d@ annotation to a tree will transform all---   the @u@ annotations by acting on them.  The constraints on @u@---   annotations are maintained since the action is required to be a---   monoid homomorphism.--data UDTree u d a-  = Leaf u a-  | Branch u [d] [UDTree u d a]-  deriving (Functor)---- XXX need to sort out all the semigroup/monoid stuff in here!--instance (Action d u, Monoid u, Monoid d) => Semigroup (UDTree u d a) where-  t1 <> t2 = branch [t1,t2]---- | @UDTree@s form a monoid where @mappend@ corresponds to adjoining---   two trees under a common parent root.  Note that this technically---   does not satisfy associativity, but it does with respect to---   'flatten' which is what we really care about.  @mconcat@ is---   specialized to put all the trees under a single parent.-instance (Action d u, Monoid u, Monoid d) => Monoid (UDTree u d a) where-  mempty          = Branch mempty mempty []-  t1 `mappend` t2 = branch [t1,t2]-  mconcat         = branch---- | Construct a leaf node from a @u@ annotation and datum.-leaf :: u -> a -> UDTree u d a-leaf = Leaf---- | Construct a branch node with an explicit @d@ annotation.-branchD :: (Action d u, Monoid u) => d -> [UDTree u d a] -> UDTree u d a-branchD d ts = Branch (mconcat . map getU $ ts) [d] ts---- | Construct a branch node with a default (identity) @d@ annotation.-branch :: (Action d u, Monoid u, Monoid d) => [UDTree u d a] -> UDTree u d a-branch ts = Branch (mconcat . map getU $ ts) [] ts---- | Get the @u@ annotation at the root.-getU :: Action d u => UDTree u d a -> u-getU (Leaf u _)      = u-getU (Branch u ds _) = foldr act u ds---- | Get a particular component from a the @u@ annotation at the root.---   This method is provided for convenience, since its context only---   requires an action of @d@ on @u'@, rather than on @u@ in its---   entirety.-getU' :: (Action d (u' ::: Nil), u :>: u') => UDTree u d a -> u'-getU' (Leaf u _)      = get u-getU' (Branch u ds _) = hd $ foldr act (get u ::: Nil) ds-  where hd (u' ::: Nil) = u'-        hd (Missing _)  = error "Impossible case in UDTree.getU' (hd)"---- | Add a @d@ annotation to the root, combining it (on the left) with---   any pre-existing @d@ annotation, and transforming all @u@---   annotations by the action of @d@.-applyD :: Action d u => d -> UDTree u d a -> UDTree u d a-applyD d l@(Leaf {})      = Branch (getU l) [d] [l]-applyD d (Branch u ds ts) = Branch u (d : ds) ts---- | Add a @u@ annotation to the root, combining it (on the left) with---   the existing @u@ annotation.-applyUpre :: (Semigroup u, Action d u) => u -> UDTree u d a -> UDTree u d a-applyUpre u' (Leaf u a) = Leaf (u' <> u) a-applyUpre u' b          = Branch (u' <> getU b) [] [b]---- | Add a @u@ annotation to the root, combining it (on the right) with---   the existing @u@ annotation.-applyUpost :: (Semigroup u, Action d u) => u -> UDTree u d a -> UDTree u d a-applyUpost u' (Leaf u a) = Leaf (u <> u') a-applyUpost u' b          = Branch (getU b <> u') [] [b]---- | Map a function over all the @u@ annotations.  The function must---   be a monoid homomorphism, and must commute with the action of @d@---   on @u@.  That is, to use @mapU f@ safely it must be the case that---   @f (act d u) == act d (f u)@.-mapU :: (u -> u') -> UDTree u d a -> UDTree u' d a-mapU f (Leaf u a)       = Leaf (f u) a-mapU f (Branch u ds ts) = Branch (f u) ds (map (mapU f) ts)---- | A fold for UDTrees.-foldUD :: (Monoid r, Semigroup d, Monoid d, Action d u)-      => (u -> d -> a -> r)  -- ^ Function for processing leaf nodes.-                             --   Given the u annotation at this node, the-                             --   'mconcat' of all d annotations above, and the-                             --   leaf value.-      -> (u -> d -> r -> r)  -- ^ Function for processing internal-                             --   nodes.  Given the u and d-                             --   annotations at this node and the-                             --   'mconcat' of the recursive results.-      -> UDTree u d a -> r-foldUD = foldUD' mempty     -- Pass along accumulated d value-  where foldUD' d l _ (Leaf u a)-          = l (act d u) d a-        foldUD' d l b (Branch u ds ts)-          = b (act (d <> d') u) d' (mconcat $ map (foldUD' (d <> d') l b) ts)-         where d' = mconcat ds---- | A specialized fold provided for convenience: flatten a tree into---   a list of leaves along with their @d@ annotations.-flatten :: (Semigroup d, Monoid d, Action d u) => UDTree u d a -> [(a,d)]-flatten = foldUD (\_ d a -> [(a,d)]) (\_ _ r -> r)

@@ -1,27 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}---------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams.Util--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ Various internal utilities for the diagrams project.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Util-       (-         -- * Vectors--         withLength--       ) where--import Data.VectorSpace---- | Produce a vector with the specified length in the same direction---   as the given vector.-withLength :: (InnerSpace v, Floating (Scalar v)) => Scalar v -> v -> v-withLength l v = (l / magnitude v) *^ v

@@ -1,42 +0,0 @@-{-# LANGUAGE TypeFamilies #-}---------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Diagrams.MList--- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ Type family for identifying associated vector spaces.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.V-       ( V--       ) where--import Data.Set-import Data.Map----------------------------------------------------------------- Vector spaces ------------------------------------------------------------------------------------------------------------ | Many sorts of objects have an associated vector space in which---   they live.  The type function @V@ maps from objects to their---   associated vector space.-type family V a :: *--type instance V Double    = Double-type instance V Rational  = Rational---- Note, to use these instances one often needs a constraint of the form---   V a ~ V b, etc.-type instance V (a,b)     = V a-type instance V (a,b,c)   = V a--type instance V (a -> b)  = V b-type instance V [a]       = V a-type instance V (Set a)   = V a-type instance V (Map k a) = V a