diff --git a/diagrams-cairo.cabal b/diagrams-cairo.cabal index 089cdf6..b9864cd 100644 --- a/diagrams-cairo.cabal +++ b/diagrams-cairo.cabal @@ -63,7 +63,10 @@ Library containers >= 0.3 && < 0.6, lens >= 3.8 && < 4, data-default-class >= 0.0.1 && < 0.1, - statestack >= 0.2 && < 0.3 + statestack >= 0.2 && < 0.3, + hashable >= 1.1 && < 1.3 + if impl(ghc < 7.6) + Build-depends: ghc-prim default-language: Haskell2010 if !os(windows) diff --git a/src/Diagrams/Backend/Cairo/Internal.hs b/src/Diagrams/Backend/Cairo/Internal.hs index 193cbff..7039573 100644 --- a/src/Diagrams/Backend/Cairo/Internal.hs +++ b/src/Diagrams/Backend/Cairo/Internal.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -51,21 +52,19 @@ import Diagrams.TwoD.Text import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Cairo.Matrix as CM +import Control.Exception (try) +import Control.Lens hiding (transform, ( # )) import Control.Monad (when) import qualified Control.Monad.StateStack as SS import Control.Monad.Trans (lift, liftIO) import Data.Default.Class +import qualified Data.Foldable as F +import Data.Hashable (Hashable) import Data.List (isSuffixOf) import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.Tree - -import Control.Lens hiding (transform, ( # )) - -import Control.Exception (try) - -import qualified Data.Foldable as F - import Data.Typeable +import GHC.Generics (Generic) -- | This data declaration is simply used as a token to distinguish -- the cairo backend: (1) when calling functions where the type @@ -89,7 +88,9 @@ data OutputType = -- action will do nothing, but the @Render ()@ -- action can be used (/e.g./ to draw to a Gtk -- window; see the @diagrams-gtk@ package). - deriving (Eq, Ord, Read, Show, Bounded, Enum, Typeable) + deriving (Eq, Ord, Read, Show, Bounded, Enum, Typeable, Generic) + +instance Hashable OutputType -- | Custom state tracked in the 'RenderM' monad. data CairoState @@ -141,7 +142,7 @@ instance Backend Cairo R2 where , _cairoOutputType :: OutputType -- ^ the output format and associated options , _cairoBypassAdjust :: Bool -- ^ Should the 'adjustDia' step be bypassed during rendering? } - deriving Show + deriving (Show, Generic) doRender _ (CairoOptions file size out _) (C r) = (renderIO, r') where r' = runRenderM r @@ -185,6 +186,8 @@ instance Monoid (Render Cairo R2) where mempty = C $ return () (C rd1) `mappend` (C rd2) = C (rd1 >> rd2) +instance Hashable (Options Cairo R2) + renderRTree :: RTree Cairo R2 a -> Render Cairo R2 renderRTree (Node (RPrim accTr p) _) = render Cairo (transform accTr p) renderRTree (Node (RStyle sty) ts) = C $ do