Add support for dominant-baseline attribute

reanimate-svg.cabal

@@ -28,7 +28,7 @@ Source-Repository head
 
 library
   hs-source-dirs: src
-  ghc-options: -Wall -fsimpl-tick-factor=300
+  ghc-options: -Wall -fsimpl-tick-factor=1000
   default-language: Haskell2010
   exposed-modules: Graphics.SvgTree
                  , Graphics.SvgTree.CssTypes
@@ -59,8 +59,8 @@ library
                , linear            >= 1.20
                , vector            >= 0.10
                , text              >= 1.1
-               , transformers      >= 0.3 && < 0.6
-               , mtl               >= 2.1 && < 2.3
+               , transformers      >= 0.3 && < 0.7
+               , mtl               >= 2.1 && < 2.4
                , lens              >= 4.6 && < 6
                , double-conversion >= 2.0.0.0 && < 3.0.0.0
                , hashable          >= 1.3.0.0

src/Graphics/SvgTree/Types.hs

@@ -356,6 +356,7 @@ module Graphics.SvgTree.Types
     , textAdjust
     , textRoot
     , TextAnchor( .. )
+    , DominantBaseline( .. )
     , textAt
 
       -- ** Text path

src/Graphics/SvgTree/Types/Hashable.hs

@@ -185,6 +185,8 @@ deriving instance Hashable FontStyle
 
 deriving instance Hashable TextAnchor
 
+deriving instance Hashable DominantBaseline
+
 instance Hashable Tree where
   hashWithSalt s = hashWithSalt s . _treeHash
 

src/Graphics/SvgTree/Types/Internal.hs

@@ -338,6 +338,7 @@ module Graphics.SvgTree.Types.Internal
     textAdjust,
     textRoot,
     TextAnchor (..),
+    DominantBaseline (..),
     textAt,
 
     -- ** Text path
@@ -619,6 +620,18 @@ data TextAnchor
     TextAnchorEnd
   deriving (Eq, Show, Generic)
 
+data DominantBaseline
+  = DominantBaselineAuto
+  | DominantBaselineTextBottom
+  | DominantBaselineAlphabetic
+  | DominantBaselineIdeographic
+  | DominantBaselineMiddle
+  | DominantBaselineCentral
+  | DominantBaselineMathematical
+  | DominantBaselineHanging
+  | DominantBaselineTextTop
+  deriving (Eq, Show, Generic)
+
 -- | Corresponds to the possible values of
 -- SVG attributes which are either @none@ or
 -- @url(\<string\>)@.
@@ -719,6 +732,8 @@ data DrawAttributes = DrawAttributes
     -- | Defines how to interpret the text position, corresponds
     -- to the @text-anchor@ SVG attribute.
     _textAnchor :: !(Maybe TextAnchor),
+    -- | Corresponds to the @dominant-baseline@ SVG attribute.
+    _dominantBaseline :: !(Maybe DominantBaseline),
     -- | Defines the marker used for the start of the line.
     -- Corresponds to the @marker-start@ SVG attribute.
     _markerStart :: !(Maybe ElementRef),
@@ -2199,6 +2214,7 @@ instance Semigroup DrawAttributes where
         _fontFamily = chooseLast _fontFamily,
         _fontStyle = chooseLast _fontStyle,
         _textAnchor = chooseLast _textAnchor,
+        _dominantBaseline = chooseLast _dominantBaseline,
         _maskRef = chooseLast _maskRef,
         _clipPathRef = chooseLast _clipPathRef,
         _clipRule = chooseLast _clipRule,
@@ -2237,6 +2253,7 @@ instance Monoid DrawAttributes where
         _strokeOffset = Nothing,
         _strokeDashArray = Nothing,
         _textAnchor = Nothing,
+        _dominantBaseline = Nothing,
         _maskRef = Nothing,
         _clipPathRef = Nothing,
         _clipRule = Nothing,

src/Graphics/SvgTree/XmlParser.hs

@@ -208,6 +208,30 @@ instance ParseableAttribute TextAnchor where
     TextAnchorStart  -> "start"
     TextAnchorEnd    -> "end"
 
+instance ParseableAttribute DominantBaseline where
+  aparse s = case s of
+    "auto" -> Just DominantBaselineAuto
+    "text-bottom" -> Just DominantBaselineTextBottom
+    "alphabetic" -> Just DominantBaselineAlphabetic
+    "ideographic" -> Just DominantBaselineIdeographic
+    "middle" -> Just DominantBaselineMiddle
+    "central" -> Just DominantBaselineCentral
+    "mathematical" -> Just DominantBaselineMathematical
+    "hanging" -> Just DominantBaselineHanging
+    "text-top " -> Just DominantBaselineTextTop
+    _        -> Nothing
+
+  aserialize t = Just $ case t of
+    DominantBaselineAuto -> "auto"
+    DominantBaselineTextBottom -> "text-bottom"
+    DominantBaselineAlphabetic -> "alphabetic"
+    DominantBaselineIdeographic -> "ideographic"
+    DominantBaselineMiddle -> "middle"
+    DominantBaselineCentral -> "central"
+    DominantBaselineMathematical -> "mathematical"
+    DominantBaselineHanging -> "hanging"
+    DominantBaselineTextTop -> "text-top "
+
 instance ParseableAttribute ElementRef where
   aparse s = case parseOnly pa $ T.pack s of
      Left _  -> Nothing
@@ -776,6 +800,7 @@ drawAttributesList =
       cssUniqueNumber strokeOffset)
   ,("stroke-dasharray" `parseIn` strokeDashArray, cssDashArray strokeDashArray)
   ,("text-anchor" `parseIn` textAnchor, cssIdentAttr textAnchor)
+  ,("dominant-baseline" `parseIn` dominantBaseline, cssIdentAttr dominantBaseline)
   ,("clip-path" `parseIn` clipPathRef, cssElementRefSetter clipPathRef)
   ,("marker-end" `parseIn` markerEnd, cssElementRefSetter markerEnd)
   ,("marker-start" `parseIn` markerStart, cssElementRefSetter markerStart)