Add Hashable instance for Options SVG R2

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

src/Diagrams/Backend/SVG.hs

@@ -1,11 +1,15 @@
 {-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE StandaloneDeriving    #-}
 {-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
 
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  Diagrams.Backend.SVG
@@ -83,31 +87,36 @@ 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
 
 -- 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.TwoD.Path           (Clip (Clip))
 import           Diagrams.TwoD.Text
 
 -- from blaze-svg
+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
-import qualified Text.Blaze.Svg.Renderer.String as StringSvg
 
 -- from this package
 import qualified Graphics.Rendering.SVG       as R
@@ -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,18 +235,63 @@ setSVGDefs o d = o {_svgDefinitions = d}
 svgDefinitions :: Lens' (Options SVG R2) (Maybe S.Svg)
 svgDefinitions = lens getSVGDefs setSVGDefs
 
-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 Hashable (Options SVG R2)
+
+instance Hashable StaticString where
+  hashWithSalt s (StaticString dl bs txt)
+    = s `hashWithSalt` dl [] `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`
+    x          `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 Renderable (Segment Closed R2) SVG where
   render c = render c . (fromSegments :: [Segment Closed R2] -> Path R2) . (:[])