Simplify dual

diagrams-lib.cabal

@@ -34,7 +34,6 @@ Library
                        Diagrams.Animation,
                        Diagrams.Animation.Active,
                        Diagrams.Attributes,
-                       Diagrams.Attributes.Compile,
                        Diagrams.Backend.CmdLine,
                        Diagrams.BoundingBox,
                        Diagrams.Combinators,

src/Diagrams/Combinators.hs

@@ -40,14 +40,10 @@ module Diagrams.Combinators
 
 import           Control.Lens          hiding (beside, ( # ))
 import           Data.Default.Class
-import           Data.Monoid.Deletable (toDeletable)
-import           Data.Monoid.MList     (inj)
 import           Data.Proxy
 import           Data.Semigroup
-import qualified Data.Tree.DUAL        as D
 
 import           Diagrams.Core
-import           Diagrams.Core.Types   (QDiagram (QD))
 import           Diagrams.Direction
 import           Diagrams.Segment      (straight)
 import           Diagrams.Util
@@ -86,7 +82,9 @@ withTrace = setTrace . getTrace
 -- | @phantom x@ produces a \"phantom\" diagram, which has the same
 --   envelope and trace as @x@ but produces no output.
 phantom :: (InSpace v n a, Monoid' m, Enveloped a, Traced a) => a -> QDiagram b v n m
-phantom a = QD $ D.leafU ((inj . toDeletable . getEnvelope $ a) <> (inj . toDeletable . getTrace $ a))
+phantom a = mempty & setEnvelope (getEnvelope a)
+                   & setTrace (getTrace a)
+  -- QD $ D.leafU ((inj . toDeletable . getEnvelope $ a) <> (inj . toDeletable . getTrace $ a))
 
 -- | @pad s@ \"pads\" a diagram, expanding its envelope by a factor of
 --   @s@ (factors between 0 and 1 can be used to shrink the envelope).
@@ -119,7 +117,7 @@ frame s = over envelope (onEnvelope $ \f x -> f x + s)
 --   > strutEx = (circle 1 ||| strut unitX ||| circle 1) # centerXY # pad 1.1
 strut :: (Metric v, OrderedField n, Monoid' m)
       => v n -> QDiagram b v n m
-strut v = QD $ D.leafU (inj . toDeletable $ env)
+strut v = mempty & setEnvelope env -- QD $ D.leafU (inj . toDeletable $ env)
   where env = translate ((-0.5) *^ v) . getEnvelope $ straight v
   -- note we can't use 'phantom' here because it tries to construct a
   -- trace as well, and segments do not have a trace in general (only

src/Diagrams/Names.hs

@@ -54,7 +54,7 @@ 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 nm , Metric v, OrderedField n, Semigroup m)
+namePoint :: (IsName nm , Metric v, OrderedField n, Semigroup m, Monoid m)
           => (QDiagram b v n m -> Point v n) -> nm -> QDiagram b v n m -> QDiagram b v n m
 namePoint p = nameSub (subPoint . p)
 

src/Diagrams/TwoD/Arrow.hs

@@ -402,7 +402,7 @@ arrow' opts len = mkQD' (DelayedLeaf delayedArrow)
     -- uniformly as the transformation applied to the entire arrow.
     -- See https://github.com/diagrams/diagrams-lib/issues/112.
     delayedArrow da g n =
-      let (trans, globalSty) = option mempty untangle . fst $ da
+      let (trans, globalSty) = untangle da
       in  dArrow globalSty trans len g n
 
     -- Build an arrow and set its endpoints to the image under tr of origin and (len,0).

src/Diagrams/TwoD/Attributes.hs

@@ -58,9 +58,6 @@ module Diagrams.TwoD.Attributes (
   -- ** Fill color
   , fillColor, fc, fcA, recommendFillColor
 
-  -- * Compilation utilities
-  , splitTextureFills
-
   ) where
 
 import           Control.Lens                hiding (transform)
@@ -71,12 +68,7 @@ import           Data.Monoid.Recommend
 import           Data.Semigroup
 
 import           Diagrams.Attributes
-import           Diagrams.Attributes.Compile
 import           Diagrams.Core
-import           Diagrams.Core.Types         (RTree)
-import           Diagrams.Located            (unLoc)
-import           Diagrams.Path               (Path, pathTrails)
-import           Diagrams.Trail              (isLoop)
 import           Diagrams.TwoD.Types
 import           Diagrams.Util
 
@@ -402,29 +394,3 @@ fc = fillColor
 fcA :: (InSpace V2 n a, Floating n, Typeable n, HasStyle a) => AlphaColour Double -> a -> a
 fcA = fillColor
 
--- Split fills ---------------------------------------------------------
-
-data FillTextureLoops n = FillTextureLoops
-
-instance Typeable n => SplitAttribute (FillTextureLoops n) where
-  type AttrType (FillTextureLoops n) = FillTexture n
-  type PrimType (FillTextureLoops n) = Path V2 n
-
-  primOK _ = all (isLoop . unLoc) . pathTrails
-
--- | Push fill attributes down until they are at the root of subtrees
---   containing only loops. This makes life much easier for backends,
---   which typically have a semantics where fill attributes are
---   applied to lines/non-closed paths as well as loops/closed paths,
---   whereas in the semantics of diagrams, fill attributes only apply
---   to loops.
-splitTextureFills
-  :: forall b v n a. (
-#if __GLASGOW_HASKELL__ > 707
-                       Typeable v
-#else
-                       Typeable1 v
-#endif
-
-                     , Typeable n) => RTree b v n a -> RTree b v n a
-splitTextureFills = splitAttr (FillTextureLoops :: FillTextureLoops n)