From 23dae4e09fa3b4d62382f4a42c6aba84d273edaa Mon Sep 17 00:00:00 2001 From: Brent Yorgey <byorgey@cis.upenn.edu> Date: Thu, 28 Nov 2013 13:45:45 -0500 Subject: [PATCH 1/3] add Hashable instance for Options SVG R2 (and remove Show) unfortunately we also have to add some orphan Hashable instances for blaze-markup types. We could contribute them back upstream to blaze-markup, but that would require adding a hashable constraint. --- diagrams-svg.cabal | 4 ++ src/Diagrams/Backend/SVG.hs | 89 ++++++++++++++++++++++++++++++++----- 2 files changed, 82 insertions(+), 11 deletions(-) diff --git a/diagrams-svg.cabal b/diagrams-svg.cabal index 0e85f6a..b4fa573 100644 --- a/diagrams-svg.cabal +++ b/diagrams-svg.cabal @@ -53,10 +53,14 @@ Library , diagrams-lib >= 1.0 && < 1.1 , monoid-extras >= 0.3 && < 0.4 , blaze-svg >= 0.3.3 + , blaze-markup >= 0.5 && < 0.6 , split >= 0.1.2 && < 0.3 , time , containers >= 0.3 && < 0.6 , lens >= 3.8 && < 4 + , hashable >= 1.1 && < 1.3 + if impl(ghc < 7.6) + build-depends: ghc-prim if !os(windows) cpp-options: -DCMDLINELOOP Build-depends: unix >= 2.4 && < 2.8 diff --git a/src/Diagrams/Backend/SVG.hs b/src/Diagrams/Backend/SVG.hs index f45f36f..7ebff4d 100644 --- a/src/Diagrams/Backend/SVG.hs +++ b/src/Diagrams/Backend/SVG.hs @@ -1,7 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -83,34 +85,41 @@ module Diagrams.Backend.SVG ) where -- for testing -import Diagrams.Core.Compile +import Data.Foldable (foldMap) import Data.Tree -import Data.Foldable (foldMap) +import Diagrams.Core.Compile -- from base import Control.Monad.State import Data.Typeable +import GHC.Generics (Generic) + +-- from hashable +import Data.Hashable (Hashable (..)) -- from bytestring -import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy as BS -- from lens -import Control.Lens hiding ((#), transform) +import Control.Lens hiding (transform, ( # )) -- from diagrams-lib -import Diagrams.Prelude hiding (view) -import Diagrams.TwoD.Adjust (adjustDia2D) -import Diagrams.TwoD.Path (Clip(Clip)) +import Diagrams.Prelude hiding (view) +import Diagrams.TwoD.Adjust (adjustDia2D) +import Diagrams.TwoD.Path (Clip (Clip)) import Diagrams.TwoD.Text -- from blaze-svg -import Text.Blaze.Svg.Renderer.Utf8 (renderSvg) -import Text.Blaze.Svg11 ((!)) -import qualified Text.Blaze.Svg11 as S +import Text.Blaze.Internal (ChoiceString (..), + MarkupM (..), + StaticString (..)) import qualified Text.Blaze.Svg.Renderer.String as StringSvg +import Text.Blaze.Svg.Renderer.Utf8 (renderSvg) +import Text.Blaze.Svg11 ((!)) +import qualified Text.Blaze.Svg11 as S -- from this package -import qualified Graphics.Rendering.SVG as R +import qualified Graphics.Rendering.SVG as R -- | @SVG@ is simply a token used to identify this rendering backend -- (to aid type inference). @@ -185,6 +194,7 @@ instance Backend SVG R2 where -- ^ Custom definitions that will be added to the @defs@ -- section of the output. } + deriving (Generic) doRender _ opts (R r) = evalState svgOutput initialSvgRenderState @@ -225,6 +235,63 @@ setSVGDefs o d = o {_svgDefinitions = d} svgDefinitions :: Lens' (Options SVG R2) (Maybe S.Svg) svgDefinitions = lens getSVGDefs setSVGDefs +instance Hashable (Options SVG R2) + +instance Hashable StaticString where + hashWithSalt s (StaticString diff bs txt) + = s `hashWithSalt` diff [] `hashWithSalt` bs `hashWithSalt` txt + +deriving instance Generic ChoiceString + +instance Hashable ChoiceString + +instance Hashable (MarkupM a) where + hashWithSalt s (Parent w x y z) = + s `hashWithSalt` + (0 :: Int) `hashWithSalt` + w `hashWithSalt` + y `hashWithSalt` + z + hashWithSalt s (CustomParent cs m) = + s `hashWithSalt` + (1 :: Int) `hashWithSalt` + cs `hashWithSalt` + m + hashWithSalt s (Leaf s1 s2 s3) = + s `hashWithSalt` + (2 :: Int) `hashWithSalt` + s1 `hashWithSalt` + s2 `hashWithSalt` + s3 + hashWithSalt s (CustomLeaf cs b) = + s `hashWithSalt` + (3 :: Int) `hashWithSalt` + cs `hashWithSalt` + b + hashWithSalt s (Content cs) = + s `hashWithSalt` + (4 :: Int) `hashWithSalt` + cs + hashWithSalt s (Append m1 m2) = + s `hashWithSalt` + (5 :: Int) `hashWithSalt` + m1 `hashWithSalt` + m2 + hashWithSalt s (AddAttribute s1 s2 s3 m) = + s `hashWithSalt` + (6 :: Int) `hashWithSalt` + s1 `hashWithSalt` + s2 `hashWithSalt` + s3 `hashWithSalt` + m + hashWithSalt s (AddCustomAttribute s1 s2 m) = + s `hashWithSalt` + (7 :: Int) `hashWithSalt` + s1 `hashWithSalt` + s2 `hashWithSalt` + m + hashWithSalt s Empty = s `hashWithSalt` (8 :: Int) + instance Show (Options SVG R2) where show opts = concat $ [ "SVGOptions { " From 82943f5d9980bc66870e0c74f9ecb3db69fa514e Mon Sep 17 00:00:00 2001 From: Brent Yorgey <byorgey@cis.upenn.edu> Date: Thu, 28 Nov 2013 13:46:08 -0500 Subject: [PATCH 2/3] actually remove Show (Options SVG R2) instance --- src/Diagrams/Backend/SVG.hs | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/src/Diagrams/Backend/SVG.hs b/src/Diagrams/Backend/SVG.hs index 7ebff4d..645dd17 100644 --- a/src/Diagrams/Backend/SVG.hs +++ b/src/Diagrams/Backend/SVG.hs @@ -292,19 +292,6 @@ instance Hashable (MarkupM a) where m hashWithSalt s Empty = s `hashWithSalt` (8 :: Int) -instance Show (Options SVG R2) where - show opts = concat $ - [ "SVGOptions { " - , "size = " - , show $ opts^.size - , " , " - , "svgDefinitions = " - , case opts^.svgDefinitions of - Nothing -> "Nothing" - Just svg -> "Just " ++ StringSvg.renderSvg svg - , " }" - ] - instance Renderable (Segment Closed R2) SVG where render c = render c . (fromSegments :: [Segment Closed R2] -> Path R2) . (:[]) From 213c673ec0210afde7b992451d550155985c61d8 Mon Sep 17 00:00:00 2001 From: Brent Yorgey <byorgey@cis.upenn.edu> Date: Thu, 28 Nov 2013 13:47:42 -0500 Subject: [PATCH 3/3] clean up warnings --- src/Diagrams/Backend/SVG.hs | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/src/Diagrams/Backend/SVG.hs b/src/Diagrams/Backend/SVG.hs index 645dd17..b97e94e 100644 --- a/src/Diagrams/Backend/SVG.hs +++ b/src/Diagrams/Backend/SVG.hs @@ -8,6 +8,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + ---------------------------------------------------------------------------- -- | -- Module : Diagrams.Backend.SVG @@ -85,41 +87,39 @@ module Diagrams.Backend.SVG ) where -- for testing -import Data.Foldable (foldMap) +import Data.Foldable (foldMap) import Data.Tree import Diagrams.Core.Compile -- from base import Control.Monad.State import Data.Typeable -import GHC.Generics (Generic) +import GHC.Generics (Generic) -- from hashable -import Data.Hashable (Hashable (..)) +import Data.Hashable (Hashable (..)) -- from bytestring -import qualified Data.ByteString.Lazy as BS +import qualified Data.ByteString.Lazy as BS -- from lens -import Control.Lens hiding (transform, ( # )) +import Control.Lens hiding (transform, ( # )) -- from diagrams-lib -import Diagrams.Prelude hiding (view) -import Diagrams.TwoD.Adjust (adjustDia2D) -import Diagrams.TwoD.Path (Clip (Clip)) +import Diagrams.Prelude hiding (view) +import Diagrams.TwoD.Adjust (adjustDia2D) +import Diagrams.TwoD.Path (Clip (Clip)) import Diagrams.TwoD.Text -- from blaze-svg -import Text.Blaze.Internal (ChoiceString (..), - MarkupM (..), - StaticString (..)) -import qualified Text.Blaze.Svg.Renderer.String as StringSvg -import Text.Blaze.Svg.Renderer.Utf8 (renderSvg) -import Text.Blaze.Svg11 ((!)) -import qualified Text.Blaze.Svg11 as S +import Text.Blaze.Internal (ChoiceString (..), MarkupM (..), + StaticString (..)) +import Text.Blaze.Svg.Renderer.Utf8 (renderSvg) +import Text.Blaze.Svg11 ((!)) +import qualified Text.Blaze.Svg11 as S -- from this package -import qualified Graphics.Rendering.SVG as R +import qualified Graphics.Rendering.SVG as R -- | @SVG@ is simply a token used to identify this rendering backend -- (to aid type inference). @@ -238,8 +238,8 @@ svgDefinitions = lens getSVGDefs setSVGDefs instance Hashable (Options SVG R2) instance Hashable StaticString where - hashWithSalt s (StaticString diff bs txt) - = s `hashWithSalt` diff [] `hashWithSalt` bs `hashWithSalt` txt + hashWithSalt s (StaticString dl bs txt) + = s `hashWithSalt` dl [] `hashWithSalt` bs `hashWithSalt` txt deriving instance Generic ChoiceString @@ -250,6 +250,7 @@ instance Hashable (MarkupM a) where s `hashWithSalt` (0 :: Int) `hashWithSalt` w `hashWithSalt` + x `hashWithSalt` y `hashWithSalt` z hashWithSalt s (CustomParent cs m) =