Remove unecessary "StyleParam"

src/Diagrams/Backend/Cairo/Text.hs

@@ -15,7 +15,7 @@ module Diagrams.Backend.Cairo.Text
   (
     -- * Cairo Utilities
     queryCairo, unsafeCairo
-  , StyleParam, cairoWithStyle
+  , cairoWithStyle
 
     -- * Extents
 
@@ -60,19 +60,14 @@ queryCairo c = C.withImageSurface C.FormatA1 0 0 (`C.renderWith` c)
 unsafeCairo :: C.Render a -> a
 unsafeCairo = unsafePerformIO . queryCairo
 
--- | Existential type for mutations on objects that \"have style\". This is
---   used as a parameter to @getTextExtents@ and @getFontExtents@ in order to
---   set font-size and font-face.
-type StyleParam = forall a. HasStyle a => a -> a
-
 -- | Executes the given cairo action, with styling applied.
 --   This does not do all styling - just attributes that are processed by
 --   \"cairoMiscStyle\", which does clip, fill color, fill rule, and,
 --   importantly for this module, font face, style, and weight.
-cairoWithStyle :: C.Render a -> StyleParam -> C.Render a
+cairoWithStyle :: C.Render a -> Style R2 -> C.Render a
 cairoWithStyle f style = do
   C.save
-  evalStateT (cairoMiscStyle (style mempty)) ()
+  evalStateT (cairoMiscStyle style) ()
   result <- f
   C.restore
   return result
@@ -86,7 +81,7 @@ processTextExtents (C.TextExtents  xb yb  w h  xa ya)
                     = TextExtents (r2 (xb,yb)) (r2 (w,h)) (r2 (xa,ya))
 
 -- | Get the extents of a string of text, given a style to render it with.
-getTextExtents :: StyleParam -> String -> C.Render TextExtents
+getTextExtents :: Style R2 -> String -> C.Render TextExtents
 getTextExtents style txt
   = cairoWithStyle (processTextExtents <$> C.textExtents txt) style
 
@@ -101,14 +96,14 @@ processFontExtents (C.FontExtents a d h  mx my)
                     = FontExtents a d h (r2 (mx,my))
 
 -- | Gets the intrinsic extents of a font.
-getFontExtents :: StyleParam -> C.Render FontExtents
+getFontExtents :: Style R2 -> C.Render FontExtents
 getFontExtents style
   = cairoWithStyle (processFontExtents <$> C.fontExtents) style
 
 -- | Gets both the "FontExtents" and "TextExtents" of the string with the a
 --   particular style applied.  This is more efficient than calling both
 --   @getFontExtents@ and @getTextExtents@.
-getExtents :: StyleParam -> String -> C.Render (FontExtents, TextExtents)
+getExtents :: Style R2 -> String -> C.Render (FontExtents, TextExtents)
 getExtents style str = cairoWithStyle (do
     fe <- processFontExtents <$> C.fontExtents
     te <- processTextExtents <$> C.textExtents str
@@ -118,7 +113,7 @@ getExtents style str = cairoWithStyle (do
 -- | Queries the amount of horizontal offset that needs to be applied in order to
 --   position the second character properly, in the event that it is @hcat@-ed
 --   @baselineText@.
-kerningCorrectionIO :: StyleParam -> Char -> Char -> IO Double
+kerningCorrectionIO :: Style R2 -> Char -> Char -> IO Double
 kerningCorrectionIO style a b = do
   let ax t = fst . unr2 . advance <$> queryCairo (getTextExtents style t)
   l  <- ax [a, b]
@@ -129,25 +124,25 @@ kerningCorrectionIO style a b = do
 -- | Creates text diagrams with their envelopes set such that using
 --   @vcat . map (textLineBounded style)@ stacks them in the way that
 --   the font designer intended.
-textLineBoundedIO :: StyleParam -> String -> IO (Diagram Cairo R2)
+textLineBoundedIO :: Style R2 -> String -> IO (Diagram Cairo R2)
 textLineBoundedIO style str = do
   (fe, te) <- queryCairo $ getExtents style str
   let box = fromCorners (p2 (0,      negate $ descent fe))
                         (p2 (fst . unr2 $ advance te, ascent fe))
-  return . setEnvelope (getEnvelope box) $ style (baselineText str)
+  return . setEnvelope (getEnvelope box) . applyStyle style $ baselineText str
 
 -- | Creates a text diagram with its envelope set to enclose the glyphs of the text,
 --   including leading (though not trailing) whitespace.
-textVisualBoundedIO :: StyleParam -> String -> IO (Diagram Cairo R2)
+textVisualBoundedIO :: Style R2 -> String -> IO (Diagram Cairo R2)
 textVisualBoundedIO style str = do
   te <- queryCairo $ getTextExtents style str
   let box = fromCorners (origin .+^ bearing te)
                         (origin .+^ bearing te ^+^ (textSize te))
-  return . setEnvelope (getEnvelope box) $ style (baselineText str)
+  return . setEnvelope (getEnvelope box) . applyStyle style $ baselineText str
 
-kerningCorrection :: StyleParam -> Char -> Char -> Double
+kerningCorrection :: Style R2 -> Char -> Char -> Double
 kerningCorrection style a = unsafePerformIO . kerningCorrectionIO style a
 
-textLineBounded, textVisualBounded :: StyleParam -> String -> Diagram Cairo R2
-textLineBounded style   = unsafePerformIO . textLineBoundedIO   style
+textLineBounded, textVisualBounded :: Style R2 -> String -> Diagram Cairo R2
+textLineBounded   style = unsafePerformIO . textLineBoundedIO   style
 textVisualBounded style = unsafePerformIO . textVisualBoundedIO style