{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE ViewPatterns      #-}
module Graphics.SvgTree.XmlParser
  ( xmlOfDocument
  , unparseDocument
  , unparse
  , xmlOfTree

  , SvgAttributeLens( .. )
  , drawAttributesList
  ) where


import           Text.Read                    (readMaybe)

import           Control.Applicative          (many, (<|>))

import           Codec.Picture                (PixelRGBA8 (..))
import           Control.Lens                 hiding (children, element,
                                               elements, transform)
import           Control.Lens.Unsound
import           Data.Attoparsec.Text         (Parser, parseOnly, string)
import           Data.List                    (foldl', intercalate)
import           Data.Maybe                   (catMaybes, fromMaybe)
import qualified Data.Text                    as T
import           Graphics.SvgTree.ColorParser
import           Graphics.SvgTree.CssParser   (complexNumber, dashArray, num,
                                               numberList, styleString)
import           Graphics.SvgTree.CssTypes    (CssDeclaration (..),
                                               CssElement (..))
import           Graphics.SvgTree.Misc
import           Graphics.SvgTree.PathParser
import           Graphics.SvgTree.Types
import qualified Text.XML.Light               as X
import           Text.XML.Light.Proc          (elChildren, findAttrBy)

import           Text.Printf                  (printf)

{-import Debug.Trace-}

nodeName :: X.Element -> String
nodeName :: Element -> String
nodeName = QName -> String
X.qName (QName -> String) -> (Element -> QName) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> QName
X.elName

setName :: String -> X.Element -> X.Element
setName :: String -> Element -> Element
setName String
name Element
elt = Element
elt{ elName :: QName
X.elName = String -> QName
X.unqual String
name }

attributeFinder :: String -> X.Element -> Maybe String
attributeFinder :: String -> Element -> Maybe String
attributeFinder String
str =
    (QName -> Bool) -> Element -> Maybe String
findAttrBy (\QName
a -> QName -> String
X.qName QName
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
str)

-- | Helper class to help simplify parsing code
-- for various attributes.
class ParseableAttribute a where
  aparse :: String -> Maybe a
  aserialize :: a -> Maybe String

instance ParseableAttribute v => ParseableAttribute (Maybe v) where
  aparse :: String -> Maybe (Maybe v)
aparse = (v -> Maybe v) -> Maybe v -> Maybe (Maybe v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> Maybe v
forall a. a -> Maybe a
Just (Maybe v -> Maybe (Maybe v))
-> (String -> Maybe v) -> String -> Maybe (Maybe v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe v
forall a. ParseableAttribute a => String -> Maybe a
aparse
  aserialize :: Maybe v -> Maybe String
aserialize = (Maybe v -> (v -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= v -> Maybe String
forall a. ParseableAttribute a => a -> Maybe String
aserialize)

instance ParseableAttribute String where
  aparse :: String -> Maybe String
aparse = String -> Maybe String
forall a. a -> Maybe a
Just
  aserialize :: String -> Maybe String
aserialize = String -> Maybe String
forall a. a -> Maybe a
Just

instance ParseableAttribute Number where
  aparse :: String -> Maybe Number
aparse = Parser Number -> String -> Maybe Number
forall a. Parser a -> String -> Maybe a
parseMayStartDot Parser Number
complexNumber
  aserialize :: Number -> Maybe String
aserialize = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Number -> String) -> Number -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Number -> String
serializeNumber

instance ParseableAttribute [Number] where
  aparse :: String -> Maybe [Number]
aparse = Parser [Number] -> String -> Maybe [Number]
forall a. Parser a -> String -> Maybe a
parse Parser [Number]
dashArray
  aserialize :: [Number] -> Maybe String
aserialize = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([Number] -> String) -> [Number] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Number] -> String
serializeDashArray

instance ParseableAttribute [Double] where
  aparse :: String -> Maybe [Double]
aparse = Parser [Double] -> String -> Maybe [Double]
forall a. Parser a -> String -> Maybe a
parse Parser [Double]
numberList
  aserialize :: [Double] -> Maybe String
aserialize = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([Double] -> String) -> [Double] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Number] -> String
serializeDashArray ([Number] -> String)
-> ([Double] -> [Number]) -> [Double] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Number) -> [Double] -> [Number]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Number
Num

instance ParseableAttribute PixelRGBA8 where
  aparse :: String -> Maybe PixelRGBA8
aparse = Parser PixelRGBA8 -> String -> Maybe PixelRGBA8
forall a. Parser a -> String -> Maybe a
parse Parser PixelRGBA8
colorParser
  aserialize :: PixelRGBA8 -> Maybe String
aserialize = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (PixelRGBA8 -> String) -> PixelRGBA8 -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelRGBA8 -> String
colorSerializer

instance ParseableAttribute [PathCommand] where
  aparse :: String -> Maybe [PathCommand]
aparse = Parser [PathCommand] -> String -> Maybe [PathCommand]
forall a. Parser a -> String -> Maybe a
parse Parser [PathCommand]
pathParser
  aserialize :: [PathCommand] -> Maybe String
aserialize [PathCommand]
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [PathCommand] -> ShowS
serializeCommands [PathCommand]
v String
""

instance ParseableAttribute GradientPathCommand where
  aparse :: String -> Maybe GradientPathCommand
aparse = Parser GradientPathCommand -> String -> Maybe GradientPathCommand
forall a. Parser a -> String -> Maybe a
parse Parser GradientPathCommand
gradientCommand
  aserialize :: GradientPathCommand -> Maybe String
aserialize GradientPathCommand
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ GradientPathCommand -> ShowS
serializeGradientCommand GradientPathCommand
v String
""

instance ParseableAttribute [RPoint] where
  aparse :: String -> Maybe [RPoint]
aparse = Parser [RPoint] -> String -> Maybe [RPoint]
forall a. Parser a -> String -> Maybe a
parse Parser [RPoint]
pointData
  aserialize :: [RPoint] -> Maybe String
aserialize [RPoint]
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [RPoint] -> ShowS
serializePoints [RPoint]
v String
""

instance ParseableAttribute Double where
  aparse :: String -> Maybe Double
aparse = Parser Double -> String -> Maybe Double
forall a. Parser a -> String -> Maybe a
parseMayStartDot Parser Double
num
  aserialize :: Double -> Maybe String
aserialize Double
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%s" (Double -> String
ppD Double
v)

instance ParseableAttribute Int where
  aparse :: String -> Maybe Int
aparse = (Double -> Int) -> Maybe Double -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round :: Double -> Int) (Maybe Double -> Maybe Int)
-> (String -> Maybe Double) -> String -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Double
forall a. ParseableAttribute a => String -> Maybe a
aparse
  aserialize :: Int -> Maybe String
aserialize Int
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%d" Int
v

instance ParseableAttribute Texture where
  aparse :: String -> Maybe Texture
aparse = Parser Texture -> String -> Maybe Texture
forall a. Parser a -> String -> Maybe a
parse Parser Texture
textureParser
  aserialize :: Texture -> Maybe String
aserialize = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Texture -> String) -> Texture -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Texture -> String
textureSerializer

instance ParseableAttribute [Transformation] where
  aparse :: String -> Maybe [Transformation]
aparse = Parser [Transformation] -> String -> Maybe [Transformation]
forall a. Parser a -> String -> Maybe a
parse (Parser [Transformation] -> String -> Maybe [Transformation])
-> Parser [Transformation] -> String -> Maybe [Transformation]
forall a b. (a -> b) -> a -> b
$ Parser Text Transformation -> Parser [Transformation]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text Transformation
transformParser
  aserialize :: [Transformation] -> Maybe String
aserialize = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([Transformation] -> String) -> [Transformation] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transformation] -> String
serializeTransformations

instance ParseableAttribute Alignment where
  aparse :: String -> Maybe Alignment
aparse String
s = Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just (Alignment -> Maybe Alignment) -> Alignment -> Maybe Alignment
forall a b. (a -> b) -> a -> b
$ case String
s of
    String
"none"     -> Alignment
AlignNone
    String
"xMinYMin" -> Alignment
AlignxMinYMin
    String
"xMidYMin" -> Alignment
AlignxMidYMin
    String
"xMaxYMin" -> Alignment
AlignxMaxYMin
    String
"xMinYMid" -> Alignment
AlignxMinYMid
    String
"xMidYMid" -> Alignment
AlignxMidYMid
    String
"xMaxYMid" -> Alignment
AlignxMaxYMid
    String
"xMinYMax" -> Alignment
AlignxMinYMax
    String
"xMidYMax" -> Alignment
AlignxMidYMax
    String
"xMaxYMax" -> Alignment
AlignxMaxYMax
    String
_          -> PreserveAspectRatio -> Alignment
_aspectRatioAlign PreserveAspectRatio
forall a. WithDefaultSvg a => a
defaultSvg

  aserialize :: Alignment -> Maybe String
aserialize Alignment
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case Alignment
v of
    Alignment
AlignNone     -> String
"none"
    Alignment
AlignxMinYMin -> String
"xMinYMin"
    Alignment
AlignxMidYMin -> String
"xMidYMin"
    Alignment
AlignxMaxYMin -> String
"xMaxYMin"
    Alignment
AlignxMinYMid -> String
"xMinYMid"
    Alignment
AlignxMidYMid -> String
"xMidYMid"
    Alignment
AlignxMaxYMid -> String
"xMaxYMid"
    Alignment
AlignxMinYMax -> String
"xMinYMax"
    Alignment
AlignxMidYMax -> String
"xMidYMax"
    Alignment
AlignxMaxYMax -> String
"xMaxYMax"

instance ParseableAttribute MeshGradientType where
  aparse :: String -> Maybe MeshGradientType
aparse String
s = MeshGradientType -> Maybe MeshGradientType
forall a. a -> Maybe a
Just (MeshGradientType -> Maybe MeshGradientType)
-> MeshGradientType -> Maybe MeshGradientType
forall a b. (a -> b) -> a -> b
$ case String
s of
    String
"bilinear" -> MeshGradientType
GradientBilinear
    String
"bicubic"  -> MeshGradientType
GradientBicubic
    String
_          -> MeshGradientType
GradientBilinear

  aserialize :: MeshGradientType -> Maybe String
aserialize MeshGradientType
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case MeshGradientType
v of
    MeshGradientType
GradientBilinear -> String
"bilinear"
    MeshGradientType
GradientBicubic  -> String
"bicubic"

instance ParseableAttribute MeetSlice where
  aparse :: String -> Maybe MeetSlice
aparse String
s = case String
s of
    String
"meet"  -> MeetSlice -> Maybe MeetSlice
forall a. a -> Maybe a
Just MeetSlice
Meet
    String
"slice" -> MeetSlice -> Maybe MeetSlice
forall a. a -> Maybe a
Just MeetSlice
Slice
    String
_       -> Maybe MeetSlice
forall a. Maybe a
Nothing

  aserialize :: MeetSlice -> Maybe String
aserialize MeetSlice
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case MeetSlice
v of
    MeetSlice
Meet  -> String
"meet"
    MeetSlice
Slice -> String
"slice"

instance ParseableAttribute PreserveAspectRatio where
  aserialize :: PreserveAspectRatio -> Maybe String
aserialize PreserveAspectRatio
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
defer String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
align String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
meetSlice where
    defer :: String
defer = if PreserveAspectRatio -> Bool
_aspectRatioDefer PreserveAspectRatio
v then String
"defer " else String
""
    align :: String
align = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (Alignment -> Maybe String) -> Alignment -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Maybe String
forall a. ParseableAttribute a => a -> Maybe String
aserialize (Alignment -> String) -> Alignment -> String
forall a b. (a -> b) -> a -> b
$ PreserveAspectRatio -> Alignment
_aspectRatioAlign PreserveAspectRatio
v
    meetSlice :: String
meetSlice = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ MeetSlice -> Maybe String
forall a. ParseableAttribute a => a -> Maybe String
aserialize (MeetSlice -> Maybe String) -> Maybe MeetSlice -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PreserveAspectRatio -> Maybe MeetSlice
_aspectRatioMeetSlice PreserveAspectRatio
v

  aparse :: String -> Maybe PreserveAspectRatio
aparse String
s = case String -> [String]
words String
s of
      [] -> Maybe PreserveAspectRatio
forall a. Maybe a
Nothing
      [String
align] -> PreserveAspectRatio -> Maybe PreserveAspectRatio
forall a. a -> Maybe a
Just (PreserveAspectRatio -> Maybe PreserveAspectRatio)
-> PreserveAspectRatio -> Maybe PreserveAspectRatio
forall a b. (a -> b) -> a -> b
$ PreserveAspectRatio
forall a. WithDefaultSvg a => a
defaultSvg { _aspectRatioAlign :: Alignment
_aspectRatioAlign = String -> Alignment
alignOf String
align }
      [String
"defer", String
align] ->
          PreserveAspectRatio -> Maybe PreserveAspectRatio
forall a. a -> Maybe a
Just (PreserveAspectRatio -> Maybe PreserveAspectRatio)
-> PreserveAspectRatio -> Maybe PreserveAspectRatio
forall a b. (a -> b) -> a -> b
$ PreserveAspectRatio
forall a. WithDefaultSvg a => a
defaultSvg
            { _aspectRatioDefer :: Bool
_aspectRatioDefer = Bool
True
            , _aspectRatioAlign :: Alignment
_aspectRatioAlign = String -> Alignment
alignOf String
align
            }
      [String
align, String
meet] ->
          PreserveAspectRatio -> Maybe PreserveAspectRatio
forall a. a -> Maybe a
Just (PreserveAspectRatio -> Maybe PreserveAspectRatio)
-> PreserveAspectRatio -> Maybe PreserveAspectRatio
forall a b. (a -> b) -> a -> b
$ PreserveAspectRatio
forall a. WithDefaultSvg a => a
defaultSvg
            { _aspectRatioMeetSlice :: Maybe MeetSlice
_aspectRatioMeetSlice = String -> Maybe MeetSlice
forall a. ParseableAttribute a => String -> Maybe a
aparse String
meet
            , _aspectRatioAlign :: Alignment
_aspectRatioAlign = String -> Alignment
alignOf String
align
            }
      [String
"defer", String
align, String
meet] ->
          PreserveAspectRatio -> Maybe PreserveAspectRatio
forall a. a -> Maybe a
Just (PreserveAspectRatio -> Maybe PreserveAspectRatio)
-> PreserveAspectRatio -> Maybe PreserveAspectRatio
forall a b. (a -> b) -> a -> b
$ PreserveAspectRatio :: Bool -> Alignment -> Maybe MeetSlice -> PreserveAspectRatio
PreserveAspectRatio
              { _aspectRatioDefer :: Bool
_aspectRatioDefer = Bool
True
              , _aspectRatioAlign :: Alignment
_aspectRatioAlign = String -> Alignment
alignOf String
align
              , _aspectRatioMeetSlice :: Maybe MeetSlice
_aspectRatioMeetSlice = String -> Maybe MeetSlice
forall a. ParseableAttribute a => String -> Maybe a
aparse String
meet
              }
      [String]
_ -> Maybe PreserveAspectRatio
forall a. Maybe a
Nothing
    where
      alignOf :: String -> Alignment
alignOf = Alignment -> Maybe Alignment -> Alignment
forall a. a -> Maybe a -> a
fromMaybe (PreserveAspectRatio -> Alignment
_aspectRatioAlign PreserveAspectRatio
forall a. WithDefaultSvg a => a
defaultSvg) (Maybe Alignment -> Alignment)
-> (String -> Maybe Alignment) -> String -> Alignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Alignment
forall a. ParseableAttribute a => String -> Maybe a
aparse

instance ParseableAttribute Cap where
  aparse :: String -> Maybe Cap
aparse String
s = case String
s of
    String
"butt"   -> Cap -> Maybe Cap
forall a. a -> Maybe a
Just Cap
CapButt
    String
"round"  -> Cap -> Maybe Cap
forall a. a -> Maybe a
Just Cap
CapRound
    String
"square" -> Cap -> Maybe Cap
forall a. a -> Maybe a
Just Cap
CapSquare
    String
_        -> Maybe Cap
forall a. Maybe a
Nothing

  aserialize :: Cap -> Maybe String
aserialize Cap
c = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case Cap
c of
    Cap
CapButt   -> String
"butt"
    Cap
CapRound  -> String
"round"
    Cap
CapSquare -> String
"square"

instance ParseableAttribute TextAnchor where
  aparse :: String -> Maybe TextAnchor
aparse String
s = case String
s of
    String
"middle" -> TextAnchor -> Maybe TextAnchor
forall a. a -> Maybe a
Just TextAnchor
TextAnchorMiddle
    String
"start"  -> TextAnchor -> Maybe TextAnchor
forall a. a -> Maybe a
Just TextAnchor
TextAnchorStart
    String
"end"    -> TextAnchor -> Maybe TextAnchor
forall a. a -> Maybe a
Just TextAnchor
TextAnchorEnd
    String
_        -> Maybe TextAnchor
forall a. Maybe a
Nothing

  aserialize :: TextAnchor -> Maybe String
aserialize TextAnchor
t = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case TextAnchor
t of
    TextAnchor
TextAnchorMiddle -> String
"middle"
    TextAnchor
TextAnchorStart  -> String
"start"
    TextAnchor
TextAnchorEnd    -> String
"end"

instance ParseableAttribute ElementRef where
  aparse :: String -> Maybe ElementRef
aparse String
s = case Parser ElementRef -> Text -> Either String ElementRef
forall a. Parser a -> Text -> Either String a
parseOnly Parser ElementRef
pa (Text -> Either String ElementRef)
-> Text -> Either String ElementRef
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s of
     Left String
_  -> Maybe ElementRef
forall a. Maybe a
Nothing
     Right ElementRef
v -> ElementRef -> Maybe ElementRef
forall a. a -> Maybe a
Just ElementRef
v
    where
      pa :: Parser ElementRef
pa = (ElementRef
RefNone ElementRef -> Parser Text Text -> Parser ElementRef
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
string Text
"none")
        Parser ElementRef -> Parser ElementRef -> Parser ElementRef
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> ElementRef
Ref (String -> ElementRef) -> Parser Text String -> Parser ElementRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text String
urlRef)

  aserialize :: ElementRef -> Maybe String
aserialize ElementRef
c = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case ElementRef
c of
    Ref String
r   -> String
"url(#" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
r String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
    ElementRef
RefNone -> String
"none"

instance ParseableAttribute LineJoin where
  aparse :: String -> Maybe LineJoin
aparse String
s = case String
s of
    String
"miter" -> LineJoin -> Maybe LineJoin
forall a. a -> Maybe a
Just LineJoin
JoinMiter
    String
"round" -> LineJoin -> Maybe LineJoin
forall a. a -> Maybe a
Just LineJoin
JoinRound
    String
"bevel" -> LineJoin -> Maybe LineJoin
forall a. a -> Maybe a
Just LineJoin
JoinBevel
    String
_       -> Maybe LineJoin
forall a. Maybe a
Nothing

  aserialize :: LineJoin -> Maybe String
aserialize LineJoin
j = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case LineJoin
j of
    LineJoin
JoinMiter -> String
"miter"
    LineJoin
JoinRound -> String
"round"
    LineJoin
JoinBevel -> String
"bevel"

instance ParseableAttribute CoordinateUnits where
  aparse :: String -> Maybe CoordinateUnits
aparse String
s = case String
s of
    String
"userSpaceOnUse"    -> CoordinateUnits -> Maybe CoordinateUnits
forall a. a -> Maybe a
Just CoordinateUnits
CoordUserSpace
    String
"objectBoundingBox" -> CoordinateUnits -> Maybe CoordinateUnits
forall a. a -> Maybe a
Just CoordinateUnits
CoordBoundingBox
    String
_                   -> CoordinateUnits -> Maybe CoordinateUnits
forall a. a -> Maybe a
Just CoordinateUnits
CoordBoundingBox

  aserialize :: CoordinateUnits -> Maybe String
aserialize CoordinateUnits
uni = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case CoordinateUnits
uni of
    CoordinateUnits
CoordUserSpace   -> String
"userSpaceOnUse"
    CoordinateUnits
CoordBoundingBox -> String
"objectBoundingBox"

instance ParseableAttribute Spread where
  aparse :: String -> Maybe Spread
aparse String
s = case String
s of
    String
"pad"     -> Spread -> Maybe Spread
forall a. a -> Maybe a
Just Spread
SpreadPad
    String
"reflect" -> Spread -> Maybe Spread
forall a. a -> Maybe a
Just Spread
SpreadReflect
    String
"repeat"  -> Spread -> Maybe Spread
forall a. a -> Maybe a
Just Spread
SpreadRepeat
    String
_         -> Maybe Spread
forall a. Maybe a
Nothing

  aserialize :: Spread -> Maybe String
aserialize Spread
s = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case Spread
s of
    Spread
SpreadPad     -> String
"pad"
    Spread
SpreadReflect -> String
"reflect"
    Spread
SpreadRepeat  -> String
"repeat"

instance ParseableAttribute FillRule where
  aparse :: String -> Maybe FillRule
aparse String
s = case String
s of
    String
"nonzero" -> FillRule -> Maybe FillRule
forall a. a -> Maybe a
Just FillRule
FillNonZero
    String
"evenodd" -> FillRule -> Maybe FillRule
forall a. a -> Maybe a
Just FillRule
FillEvenOdd
    String
_         -> Maybe FillRule
forall a. Maybe a
Nothing

  aserialize :: FillRule -> Maybe String
aserialize FillRule
f = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case FillRule
f of
    FillRule
FillNonZero -> String
"nonzero"
    FillRule
FillEvenOdd -> String
"evenodd"

instance ParseableAttribute TextAdjust where
  aparse :: String -> Maybe TextAdjust
aparse String
s = TextAdjust -> Maybe TextAdjust
forall a. a -> Maybe a
Just (TextAdjust -> Maybe TextAdjust) -> TextAdjust -> Maybe TextAdjust
forall a b. (a -> b) -> a -> b
$ case String
s of
    String
"spacing"          -> TextAdjust
TextAdjustSpacing
    String
"spacingAndGlyphs" -> TextAdjust
TextAdjustSpacingAndGlyphs
    String
_                  -> TextAdjust
TextAdjustSpacing

  aserialize :: TextAdjust -> Maybe String
aserialize TextAdjust
a = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case TextAdjust
a of
    TextAdjust
TextAdjustSpacing          -> String
"spacing"
    TextAdjust
TextAdjustSpacingAndGlyphs -> String
"spacingAndGlyphs"

instance ParseableAttribute MarkerUnit where
  aparse :: String -> Maybe MarkerUnit
aparse String
s = case String
s of
    String
"strokeWidth"    -> MarkerUnit -> Maybe MarkerUnit
forall a. a -> Maybe a
Just MarkerUnit
MarkerUnitStrokeWidth
    String
"userSpaceOnUse" -> MarkerUnit -> Maybe MarkerUnit
forall a. a -> Maybe a
Just MarkerUnit
MarkerUnitUserSpaceOnUse
    String
_                -> Maybe MarkerUnit
forall a. Maybe a
Nothing

  aserialize :: MarkerUnit -> Maybe String
aserialize MarkerUnit
u = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case MarkerUnit
u of
    MarkerUnit
MarkerUnitStrokeWidth    -> String
"strokeWidth"
    MarkerUnit
MarkerUnitUserSpaceOnUse -> String
"userSpaceOnUse"

instance ParseableAttribute Overflow where
  aparse :: String -> Maybe Overflow
aparse String
s = case String
s of
    String
"visible" -> Overflow -> Maybe Overflow
forall a. a -> Maybe a
Just Overflow
OverflowVisible
    String
"hidden"  -> Overflow -> Maybe Overflow
forall a. a -> Maybe a
Just Overflow
OverflowHidden
    String
_         -> Maybe Overflow
forall a. Maybe a
Nothing

  aserialize :: Overflow -> Maybe String
aserialize Overflow
u = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case Overflow
u of
    Overflow
OverflowVisible -> String
"visible"
    Overflow
OverflowHidden  -> String
"hidden"

instance ParseableAttribute MarkerOrientation where
  aparse :: String -> Maybe MarkerOrientation
aparse String
s = case (String
s, String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe String
s) of
    (String
"auto", Maybe Double
_) -> MarkerOrientation -> Maybe MarkerOrientation
forall a. a -> Maybe a
Just MarkerOrientation
OrientationAuto
    (String
_, Just Double
f) -> MarkerOrientation -> Maybe MarkerOrientation
forall a. a -> Maybe a
Just (MarkerOrientation -> Maybe MarkerOrientation)
-> MarkerOrientation -> Maybe MarkerOrientation
forall a b. (a -> b) -> a -> b
$ Double -> MarkerOrientation
OrientationAngle Double
f
    (String, Maybe Double)
_           -> Maybe MarkerOrientation
forall a. Maybe a
Nothing

  aserialize :: MarkerOrientation -> Maybe String
aserialize MarkerOrientation
s = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case MarkerOrientation
s of
    MarkerOrientation
OrientationAuto    -> String
"auto"
    OrientationAngle Double
f -> Double -> String
forall a. Show a => a -> String
show Double
f

instance ParseableAttribute (Double, Double, Double, Double) where
  aparse :: String -> Maybe (Double, Double, Double, Double)
aparse = Parser (Double, Double, Double, Double)
-> String -> Maybe (Double, Double, Double, Double)
forall a. Parser a -> String -> Maybe a
parse Parser (Double, Double, Double, Double)
viewBoxParser
  aserialize :: (Double, Double, Double, Double) -> Maybe String
aserialize = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ((Double, Double, Double, Double) -> String)
-> (Double, Double, Double, Double)
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double, Double, Double) -> String
serializeViewBox

instance ParseableAttribute TextPathMethod where
  aparse :: String -> Maybe TextPathMethod
aparse String
s = case String
s of
    String
"align"   -> TextPathMethod -> Maybe TextPathMethod
forall a. a -> Maybe a
Just TextPathMethod
TextPathAlign
    String
"stretch" -> TextPathMethod -> Maybe TextPathMethod
forall a. a -> Maybe a
Just TextPathMethod
TextPathStretch
    String
_         -> Maybe TextPathMethod
forall a. Maybe a
Nothing
  aserialize :: TextPathMethod -> Maybe String
aserialize TextPathMethod
m = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case TextPathMethod
m of
    TextPathMethod
TextPathAlign   -> String
"align"
    TextPathMethod
TextPathStretch -> String
"stretch"

instance ParseableAttribute TextPathSpacing where
  aparse :: String -> Maybe TextPathSpacing
aparse String
s = case String
s of
    String
"auto"  -> TextPathSpacing -> Maybe TextPathSpacing
forall a. a -> Maybe a
Just TextPathSpacing
TextPathSpacingAuto
    String
"exact" -> TextPathSpacing -> Maybe TextPathSpacing
forall a. a -> Maybe a
Just TextPathSpacing
TextPathSpacingExact
    String
_       -> Maybe TextPathSpacing
forall a. Maybe a
Nothing

  aserialize :: TextPathSpacing -> Maybe String
aserialize TextPathSpacing
s = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case TextPathSpacing
s of
    TextPathSpacing
TextPathSpacingAuto  -> String
"auto"
    TextPathSpacing
TextPathSpacingExact -> String
"exact"

instance ParseableAttribute CompositeOperator where
  aparse :: String -> Maybe CompositeOperator
aparse String
s = case String
s of
    String
"over"       -> CompositeOperator -> Maybe CompositeOperator
forall a. a -> Maybe a
Just CompositeOperator
CompositeOver
    String
"in"         -> CompositeOperator -> Maybe CompositeOperator
forall a. a -> Maybe a
Just CompositeOperator
CompositeIn
    String
"out"        -> CompositeOperator -> Maybe CompositeOperator
forall a. a -> Maybe a
Just CompositeOperator
CompositeOut
    String
"atop"       -> CompositeOperator -> Maybe CompositeOperator
forall a. a -> Maybe a
Just CompositeOperator
CompositeAtop
    String
"xor"        -> CompositeOperator -> Maybe CompositeOperator
forall a. a -> Maybe a
Just CompositeOperator
CompositeXor
    String
"arithmetic" -> CompositeOperator -> Maybe CompositeOperator
forall a. a -> Maybe a
Just CompositeOperator
CompositeArithmetic
    String
_            -> Maybe CompositeOperator
forall a. Maybe a
Nothing

  aserialize :: CompositeOperator -> Maybe String
aserialize CompositeOperator
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case CompositeOperator
v of
    CompositeOperator
CompositeOver       -> String
"over"
    CompositeOperator
CompositeIn         -> String
"in"
    CompositeOperator
CompositeOut        -> String
"out"
    CompositeOperator
CompositeAtop       -> String
"atop"
    CompositeOperator
CompositeXor        -> String
"xor"
    CompositeOperator
CompositeArithmetic -> String
"arithmetic"

instance ParseableAttribute FilterSource where
  aparse :: String -> Maybe FilterSource
aparse String
s = FilterSource -> Maybe FilterSource
forall a. a -> Maybe a
Just (FilterSource -> Maybe FilterSource)
-> FilterSource -> Maybe FilterSource
forall a b. (a -> b) -> a -> b
$ case String
s of
    String
"SourceGraphic"   -> FilterSource
SourceGraphic
    String
"SourceAlpha"     -> FilterSource
SourceAlpha
    String
"BackgroundImage" -> FilterSource
BackgroundImage
    String
"BackgroundAlpha" -> FilterSource
BackgroundAlpha
    String
"FillPaint"       -> FilterSource
FillPaint
    String
"StrokePaint"     -> FilterSource
StrokePaint
    String
_                 -> String -> FilterSource
SourceRef String
s

  aserialize :: FilterSource -> Maybe String
aserialize FilterSource
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case FilterSource
v of
    FilterSource
SourceGraphic   -> String
"SourceGraphic"
    FilterSource
SourceAlpha     -> String
"SourceAlpha"
    FilterSource
BackgroundImage -> String
"BackgroundImage"
    FilterSource
BackgroundAlpha -> String
"BackgroundAlpha"
    FilterSource
FillPaint       -> String
"FillPaint"
    FilterSource
StrokePaint     -> String
"StrokePaint"
    SourceRef String
s     -> String
s

instance ParseableAttribute FuncType where
  aparse :: String -> Maybe FuncType
aparse String
s = case String
s of
    String
"identity" -> FuncType -> Maybe FuncType
forall a. a -> Maybe a
Just FuncType
FIdentity
    String
"table"    -> FuncType -> Maybe FuncType
forall a. a -> Maybe a
Just FuncType
FTable
    String
"discrete" -> FuncType -> Maybe FuncType
forall a. a -> Maybe a
Just FuncType
FDiscrete
    String
"linear"   -> FuncType -> Maybe FuncType
forall a. a -> Maybe a
Just FuncType
FLinear
    String
"gamma"    -> FuncType -> Maybe FuncType
forall a. a -> Maybe a
Just FuncType
FGamma
    String
_          -> Maybe FuncType
forall a. Maybe a
Nothing

  aserialize :: FuncType -> Maybe String
aserialize FuncType
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case FuncType
v of
    FuncType
FIdentity -> String
"identity"
    FuncType
FTable    -> String
"table"
    FuncType
FDiscrete -> String
"discrete"
    FuncType
FLinear   -> String
"linear"
    FuncType
FGamma    -> String
"gamma"

instance ParseableAttribute BlendMode where
  aparse :: String -> Maybe BlendMode
aparse String
s = case String
s of
    String
"normal"      -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
Normal
    String
"multiply"    -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
Multiply
    String
"screen"      -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
Screen
    String
"overlay"     -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
Overlay
    String
"darken"      -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
Darken
    String
"lighten"     -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
Lighten
    String
"color-dodge" -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
ColorDodge
    String
"color-burn"  -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
ColorBurn
    String
"hard-light"  -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
HardLight
    String
"soft-light"  -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
SoftLight
    String
"difference"  -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
Difference
    String
"exclusion"   -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
Exclusion
    String
"hue"         -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
Hue
    String
"saturation"  -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
Saturation
    String
"color"       -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
Color
    String
"luminosity"  -> BlendMode -> Maybe BlendMode
forall a. a -> Maybe a
Just BlendMode
Luminosity
    String
_             -> Maybe BlendMode
forall a. Maybe a
Nothing

  aserialize :: BlendMode -> Maybe String
aserialize BlendMode
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case BlendMode
v of
    BlendMode
Normal     -> String
"normal"
    BlendMode
Multiply   -> String
"multiply"
    BlendMode
Screen     -> String
"screen"
    BlendMode
Overlay    -> String
"overlay"
    BlendMode
Darken     -> String
"darken"
    BlendMode
Lighten    -> String
"lighten"
    BlendMode
ColorDodge -> String
"color-dodge"
    BlendMode
ColorBurn  -> String
"color-burn"
    BlendMode
HardLight  -> String
"hard-light"
    BlendMode
SoftLight  -> String
"soft-light"
    BlendMode
Difference -> String
"difference"
    BlendMode
Exclusion  -> String
"exclusion"
    BlendMode
Hue        -> String
"hue"
    BlendMode
Saturation -> String
"saturation"
    BlendMode
Color      -> String
"color"
    BlendMode
Luminosity -> String
"luminosity"


instance ParseableAttribute ColorMatrixType where
  aparse :: String -> Maybe ColorMatrixType
aparse String
s = case String
s of
    String
"matrix"           -> ColorMatrixType -> Maybe ColorMatrixType
forall a. a -> Maybe a
Just ColorMatrixType
Matrix
    String
"saturate"         -> ColorMatrixType -> Maybe ColorMatrixType
forall a. a -> Maybe a
Just ColorMatrixType
Saturate
    String
"hueRotate"        -> ColorMatrixType -> Maybe ColorMatrixType
forall a. a -> Maybe a
Just ColorMatrixType
HueRotate
    String
"luminanceToAlpha" -> ColorMatrixType -> Maybe ColorMatrixType
forall a. a -> Maybe a
Just ColorMatrixType
LuminanceToAlpha
    String
_                  -> Maybe ColorMatrixType
forall a. Maybe a
Nothing

  aserialize :: ColorMatrixType -> Maybe String
aserialize ColorMatrixType
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case ColorMatrixType
v of
    ColorMatrixType
Matrix           -> String
"matrix"
    ColorMatrixType
Saturate         -> String
"saturate"
    ColorMatrixType
HueRotate        -> String
"hueRotate"
    ColorMatrixType
LuminanceToAlpha -> String
"luminanceToAlpha"

instance ParseableAttribute StitchTiles where
  aparse :: String -> Maybe StitchTiles
aparse String
s = case String
s of
    String
"noStitch" -> StitchTiles -> Maybe StitchTiles
forall a. a -> Maybe a
Just StitchTiles
NoStitch
    String
"stitch"   -> StitchTiles -> Maybe StitchTiles
forall a. a -> Maybe a
Just StitchTiles
Stitch
    String
_          -> Maybe StitchTiles
forall a. Maybe a
Nothing

  aserialize :: StitchTiles -> Maybe String
aserialize StitchTiles
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case StitchTiles
v of
    StitchTiles
NoStitch -> String
"noStitch"
    StitchTiles
Stitch   -> String
"stitch"

instance ParseableAttribute TurbulenceType where
  aparse :: String -> Maybe TurbulenceType
aparse String
s = case String
s of
    String
"fractalNoise" -> TurbulenceType -> Maybe TurbulenceType
forall a. a -> Maybe a
Just TurbulenceType
FractalNoiseType
    String
"turbulence"   -> TurbulenceType -> Maybe TurbulenceType
forall a. a -> Maybe a
Just TurbulenceType
TurbulenceType
    String
_              -> Maybe TurbulenceType
forall a. Maybe a
Nothing

  aserialize :: TurbulenceType -> Maybe String
aserialize TurbulenceType
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case TurbulenceType
v of
    TurbulenceType
FractalNoiseType -> String
"fractalNoise"
    TurbulenceType
TurbulenceType   -> String
"turbulence"

instance ParseableAttribute ChannelSelector where
  aparse :: String -> Maybe ChannelSelector
aparse String
s = case String
s of
    String
"R" -> ChannelSelector -> Maybe ChannelSelector
forall a. a -> Maybe a
Just ChannelSelector
ChannelR
    String
"G" -> ChannelSelector -> Maybe ChannelSelector
forall a. a -> Maybe a
Just ChannelSelector
ChannelG
    String
"B" -> ChannelSelector -> Maybe ChannelSelector
forall a. a -> Maybe a
Just ChannelSelector
ChannelB
    String
"A" -> ChannelSelector -> Maybe ChannelSelector
forall a. a -> Maybe a
Just ChannelSelector
ChannelA
    String
_   -> Maybe ChannelSelector
forall a. Maybe a
Nothing

  aserialize :: ChannelSelector -> Maybe String
aserialize ChannelSelector
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case ChannelSelector
v of
    ChannelSelector
ChannelR -> String
"R"
    ChannelSelector
ChannelG -> String
"G"
    ChannelSelector
ChannelB -> String
"B"
    ChannelSelector
ChannelA -> String
"A"

instance ParseableAttribute OperatorType where
  aparse :: String -> Maybe OperatorType
aparse String
s = case String
s of
    String
"over"       -> OperatorType -> Maybe OperatorType
forall a. a -> Maybe a
Just OperatorType
OperatorOver
    String
"in"         -> OperatorType -> Maybe OperatorType
forall a. a -> Maybe a
Just OperatorType
OperatorIn
    String
"out"        -> OperatorType -> Maybe OperatorType
forall a. a -> Maybe a
Just OperatorType
OperatorOut
    String
"atop"       -> OperatorType -> Maybe OperatorType
forall a. a -> Maybe a
Just OperatorType
OperatorAtop
    String
"xor"        -> OperatorType -> Maybe OperatorType
forall a. a -> Maybe a
Just OperatorType
OperatorXor
    String
"lighter"    -> OperatorType -> Maybe OperatorType
forall a. a -> Maybe a
Just OperatorType
OperatorLighter
    String
"arithmetic" -> OperatorType -> Maybe OperatorType
forall a. a -> Maybe a
Just OperatorType
OperatorArithmetic
    String
_            -> Maybe OperatorType
forall a. Maybe a
Nothing

  aserialize :: OperatorType -> Maybe String
aserialize OperatorType
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case OperatorType
v of
    OperatorType
OperatorOver       -> String
"over"
    OperatorType
OperatorIn         -> String
"in"
    OperatorType
OperatorOut        -> String
"out"
    OperatorType
OperatorAtop       -> String
"atop"
    OperatorType
OperatorXor        -> String
"xor"
    OperatorType
OperatorLighter    -> String
"lighter"
    OperatorType
OperatorArithmetic -> String
"arithmetic"

instance ParseableAttribute NumberOptionalNumber where
  aparse :: String -> Maybe NumberOptionalNumber
aparse String
s = case String
s of
    String
_  -> Maybe NumberOptionalNumber
forall a. Maybe a
Nothing                                        -- TODO

  aserialize :: NumberOptionalNumber -> Maybe String
aserialize NumberOptionalNumber
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case NumberOptionalNumber
v of
    Num1 Double
a   -> Double -> String
forall a. Show a => a -> String
show Double
a
    Num2 Double
a Double
b -> Double -> String
forall a. Show a => a -> String
show Double
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
b

instance ParseableAttribute Bool where
  aparse :: String -> Maybe Bool
aparse String
s = case String
s of
    String
"false" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    String
"true"  -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    String
_       -> Maybe Bool
forall a. Maybe a
Nothing

  aserialize :: Bool -> Maybe String
aserialize Bool
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case Bool
v of
    Bool
False -> String
"false"
    Bool
True  -> String
"true"

instance ParseableAttribute EdgeMode where
  aparse :: String -> Maybe EdgeMode
aparse String
s = case String
s of
    String
"duplicate" -> EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
EdgeDuplicate
    String
"wrap"      -> EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
EdgeWrap
    String
"none"      -> EdgeMode -> Maybe EdgeMode
forall a. a -> Maybe a
Just EdgeMode
EdgeNone
    String
_           -> Maybe EdgeMode
forall a. Maybe a
Nothing

  aserialize :: EdgeMode -> Maybe String
aserialize EdgeMode
v = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case EdgeMode
v of
    EdgeMode
EdgeDuplicate -> String
"duplicate"
    EdgeMode
EdgeWrap      -> String
"wrap"
    EdgeMode
EdgeNone      -> String
"none"

instance ParseableAttribute (Number, Maybe Number) where
  aparse :: String -> Maybe (Number, Maybe Number)
aparse String
s = case String -> Maybe [Number]
forall a. ParseableAttribute a => String -> Maybe a
aparse String
s of
    Just [Number
x]   -> (Number, Maybe Number) -> Maybe (Number, Maybe Number)
forall a. a -> Maybe a
Just (Number
x, Maybe Number
forall a. Maybe a
Nothing)
    Just [Number
x,Number
y] -> (Number, Maybe Number) -> Maybe (Number, Maybe Number)
forall a. a -> Maybe a
Just (Number
x, Number -> Maybe Number
forall a. a -> Maybe a
Just Number
y)
    Maybe [Number]
_          -> Maybe (Number, Maybe Number)
forall a. Maybe a
Nothing

  aserialize :: (Number, Maybe Number) -> Maybe String
aserialize (Number
x, Maybe Number
Nothing)  = [Number] -> Maybe String
forall a. ParseableAttribute a => a -> Maybe String
aserialize [Number
x]
  aserialize (Number
x, Just Number
y) = [Number] -> Maybe String
forall a. ParseableAttribute a => a -> Maybe String
aserialize [Number
x, Number
y]

instance ParseableAttribute (Double, Maybe Double) where
  aparse :: String -> Maybe (Double, Maybe Double)
aparse String
s = case String -> Maybe [Double]
forall a. ParseableAttribute a => String -> Maybe a
aparse String
s of
    Just [Double
x]   -> (Double, Maybe Double) -> Maybe (Double, Maybe Double)
forall a. a -> Maybe a
Just (Double
x, Maybe Double
forall a. Maybe a
Nothing)
    Just [Double
x,Double
y] -> (Double, Maybe Double) -> Maybe (Double, Maybe Double)
forall a. a -> Maybe a
Just (Double
x, Double -> Maybe Double
forall a. a -> Maybe a
Just Double
y)
    Maybe [Double]
_          -> Maybe (Double, Maybe Double)
forall a. Maybe a
Nothing

  aserialize :: (Double, Maybe Double) -> Maybe String
aserialize (Double
x, Maybe Double
Nothing)  = [Double] -> Maybe String
forall a. ParseableAttribute a => a -> Maybe String
aserialize [Double
x]
  aserialize (Double
x, Just Double
y) = [Double] -> Maybe String
forall a. ParseableAttribute a => a -> Maybe String
aserialize [Double
x, Double
y]

parse :: Parser a -> String -> Maybe a
parse :: Parser a -> String -> Maybe a
parse Parser a
p String
str = case Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
parseOnly Parser a
p (String -> Text
T.pack String
str) of
  Left String
_  -> Maybe a
forall a. Maybe a
Nothing
  Right a
r -> a -> Maybe a
forall a. a -> Maybe a
Just a
r

parseMayStartDot :: Parser a -> String -> Maybe a
parseMayStartDot :: Parser a -> String -> Maybe a
parseMayStartDot Parser a
p l :: String
l@(Char
'.':String
_) = Parser a -> String -> Maybe a
forall a. Parser a -> String -> Maybe a
parse Parser a
p (Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:String
l)
parseMayStartDot Parser a
p String
l         = Parser a -> String -> Maybe a
forall a. Parser a -> String -> Maybe a
parse Parser a
p String
l

xmlUpdate :: (XMLUpdatable a) => a -> X.Element -> a
xmlUpdate :: a -> Element -> a
xmlUpdate a
initial Element
el = (a -> SvgAttributeLens a -> a) -> a -> [SvgAttributeLens a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> SvgAttributeLens a -> a
forall t. t -> SvgAttributeLens t -> t
grab a
initial [SvgAttributeLens a]
forall treeNode.
XMLUpdatable treeNode =>
[SvgAttributeLens treeNode]
attributes
  where
    grab :: t -> SvgAttributeLens t -> t
grab t
value SvgAttributeLens t
updater =
        case String -> Element -> Maybe String
attributeFinder (SvgAttributeLens t -> String
forall t. SvgAttributeLens t -> String
_attributeName SvgAttributeLens t
updater) Element
el of
          Maybe String
Nothing -> t
value
          Just String
v  -> SvgAttributeLens t -> t -> String -> t
forall t. SvgAttributeLens t -> t -> String -> t
_attributeUpdater SvgAttributeLens t
updater t
value String
v

xmlUnparse :: (WithDefaultSvg a, XMLUpdatable a) => X.Element -> a
xmlUnparse :: Element -> a
xmlUnparse = a -> Element -> a
forall a. XMLUpdatable a => a -> Element -> a
xmlUpdate a
forall a. WithDefaultSvg a => a
defaultSvg

xmlUnparseWithDrawAttr
    :: (WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a)
    => X.Element -> a
xmlUnparseWithDrawAttr :: Element -> a
xmlUnparseWithDrawAttr Element
e =
    Element -> a
forall a. (WithDefaultSvg a, XMLUpdatable a) => Element -> a
xmlUnparse Element
e a -> (a -> a) -> a
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes) -> a -> Identity a
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes) -> a -> Identity a)
-> DrawAttributes -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Element -> DrawAttributes
forall a. (WithDefaultSvg a, XMLUpdatable a) => Element -> a
xmlUnparse Element
e

data SvgAttributeLens t = SvgAttributeLens
  { SvgAttributeLens t -> String
_attributeName       :: String
  , SvgAttributeLens t -> t -> String -> t
_attributeUpdater    :: t -> String -> t
  , SvgAttributeLens t -> t -> Maybe String
_attributeSerializer :: t -> Maybe String
  }

class XMLUpdatable treeNode where
  xmlTagName :: treeNode -> String
  attributes :: [SvgAttributeLens treeNode]

  serializeTreeNode :: treeNode -> Maybe X.Element

setChildren :: X.Element -> [X.Content] -> X.Element
setChildren :: Element -> [Content] -> Element
setChildren Element
xNode [Content]
children = Element
xNode { elContent :: [Content]
X.elContent = [Content]
children }

updateWithAccessor :: XMLUpdatable b => (a -> [b]) -> a -> Maybe X.Element -> Maybe X.Element
updateWithAccessor :: (a -> [b]) -> a -> Maybe Element -> Maybe Element
updateWithAccessor        a -> [b]
_    a
_ Maybe Element
Nothing = Maybe Element
forall a. Maybe a
Nothing
updateWithAccessor a -> [b]
accessor a
node (Just Element
xNode) =
    Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element)
-> ([Maybe Element] -> Element) -> [Maybe Element] -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Content] -> Element
setChildren Element
xNode ([Content] -> Element)
-> ([Maybe Element] -> [Content]) -> [Maybe Element] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Content) -> [Element] -> [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap  Element -> Content
X.Elem ([Element] -> [Content])
-> ([Maybe Element] -> [Element]) -> [Maybe Element] -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Element] -> Maybe Element)
-> [Maybe Element] -> Maybe Element
forall a b. (a -> b) -> a -> b
$ b -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode (b -> Maybe Element) -> [b] -> [Maybe Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [b]
accessor a
node

genericSerializeNode :: (XMLUpdatable treeNode) => treeNode -> Maybe X.Element
genericSerializeNode :: treeNode -> Maybe Element
genericSerializeNode treeNode
node =
    Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element)
-> ([Attr] -> Element) -> [Attr] -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Attr] -> Element
forall t. Node t => String -> t -> Element
X.unode (treeNode -> String
forall treeNode. XMLUpdatable treeNode => treeNode -> String
xmlTagName treeNode
node) ([Attr] -> Maybe Element) -> [Attr] -> Maybe Element
forall a b. (a -> b) -> a -> b
$ (SvgAttributeLens treeNode -> [Attr])
-> [SvgAttributeLens treeNode] -> [Attr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SvgAttributeLens treeNode -> [Attr]
generateAttribute [SvgAttributeLens treeNode]
forall treeNode.
XMLUpdatable treeNode =>
[SvgAttributeLens treeNode]
attributes
  where
    generateAttribute :: SvgAttributeLens treeNode -> [Attr]
generateAttribute SvgAttributeLens treeNode
attr = case SvgAttributeLens treeNode -> treeNode -> Maybe String
forall t. SvgAttributeLens t -> t -> Maybe String
_attributeSerializer SvgAttributeLens treeNode
attr treeNode
node of
      Maybe String
Nothing -> []
      Just String
str -> Attr -> [Attr]
forall (m :: * -> *) a. Monad m => a -> m a
return Attr :: QName -> String -> Attr
X.Attr
        { attrKey :: QName
X.attrKey = String -> QName
xName (String -> QName) -> String -> QName
forall a b. (a -> b) -> a -> b
$ SvgAttributeLens treeNode -> String
forall t. SvgAttributeLens t -> String
_attributeName SvgAttributeLens treeNode
attr
        , attrVal :: String
X.attrVal = String
str
        }
        where
         xName :: String -> QName
xName String
"href" =
            QName :: String -> Maybe String -> Maybe String -> QName
X.QName { qName :: String
X.qName = String
"href"
                    , qURI :: Maybe String
X.qURI = Maybe String
forall a. Maybe a
Nothing
                    , qPrefix :: Maybe String
X.qPrefix = String -> Maybe String
forall a. a -> Maybe a
Just String
"xlink" }
         xName String
h = String -> QName
X.unqual String
h


mergeAttributes :: X.Element -> X.Element -> X.Element
mergeAttributes :: Element -> Element -> Element
mergeAttributes Element
thisXml Element
otherXml =
    Element
thisXml { elAttribs :: [Attr]
X.elAttribs = Element -> [Attr]
X.elAttribs Element
otherXml [Attr] -> [Attr] -> [Attr]
forall a. [a] -> [a] -> [a]
++ Element -> [Attr]
X.elAttribs Element
thisXml }

genericSerializeWithDrawAttr :: (XMLUpdatable treeNode, HasDrawAttributes treeNode)
                             => treeNode -> Maybe X.Element
genericSerializeWithDrawAttr :: treeNode -> Maybe Element
genericSerializeWithDrawAttr treeNode
node = Element -> Element -> Element
mergeAttributes (Element -> Element -> Element)
-> Maybe Element -> Maybe (Element -> Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Element
thisXml Maybe (Element -> Element) -> Maybe Element -> Maybe Element
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Element
drawAttrNode where
  thisXml :: Maybe Element
thisXml = treeNode -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
genericSerializeNode treeNode
node
  drawAttrNode :: Maybe Element
drawAttrNode = DrawAttributes -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
genericSerializeNode (DrawAttributes -> Maybe Element)
-> DrawAttributes -> Maybe Element
forall a b. (a -> b) -> a -> b
$ treeNode
node treeNode
-> Getting DrawAttributes treeNode DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes treeNode DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes

type CssUpdater a =
    a -> [[CssElement]] -> a

opacitySetter :: String -> Lens' a (Maybe Float) -> SvgAttributeLens a
opacitySetter :: String -> Lens' a (Maybe Float) -> SvgAttributeLens a
opacitySetter String
attribute Lens' a (Maybe Float)
elLens =
    String
-> (a -> String -> a) -> (a -> Maybe String) -> SvgAttributeLens a
forall t.
String
-> (t -> String -> t) -> (t -> Maybe String) -> SvgAttributeLens t
SvgAttributeLens String
attribute a -> String -> a
updater a -> Maybe String
forall b. PrintfType b => a -> Maybe b
serializer
  where
    serializer :: a -> Maybe b
serializer a
a = String -> String -> b
forall r. PrintfType r => String -> r
printf String
"%s" (String -> b) -> (Float -> String) -> Float -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> String
ppF (Float -> b) -> Maybe Float -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a
a a -> Getting (Maybe Float) a (Maybe Float) -> Maybe Float
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Float) a (Maybe Float)
Lens' a (Maybe Float)
elLens
    updater :: a -> String -> a
updater a
el String
str = case Parser Double -> String -> Maybe Double
forall a. Parser a -> String -> Maybe a
parseMayStartDot Parser Double
num String
str of
        Maybe Double
Nothing -> a
el
        Just Double
v  -> a
el a -> (a -> a) -> a
forall a b. a -> (a -> b) -> b
& (Maybe Float -> Identity (Maybe Float)) -> a -> Identity a
Lens' a (Maybe Float)
elLens ((Maybe Float -> Identity (Maybe Float)) -> a -> Identity a)
-> Float -> a -> a
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
v

type Serializer e = e -> Maybe String

parserSetter :: String -> Lens' a e -> (String -> Maybe e) -> Serializer e
             -> SvgAttributeLens a
parserSetter :: String
-> Lens' a e
-> (String -> Maybe e)
-> Serializer e
-> SvgAttributeLens a
parserSetter String
attribute Lens' a e
elLens String -> Maybe e
parser Serializer e
serialize =
    String
-> (a -> String -> a) -> (a -> Maybe String) -> SvgAttributeLens a
forall t.
String
-> (t -> String -> t) -> (t -> Maybe String) -> SvgAttributeLens t
SvgAttributeLens String
attribute a -> String -> a
updater a -> Maybe String
serializer
  where
    updater :: a -> String -> a
updater a
el String
str = case String -> Maybe e
parser String
str of
        Maybe e
Nothing -> a
el
        Just e
v  -> a
el a -> (a -> a) -> a
forall a b. a -> (a -> b) -> b
& (e -> Identity e) -> a -> Identity a
Lens' a e
elLens ((e -> Identity e) -> a -> Identity a) -> e -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ e
v

    serializer :: a -> Maybe String
serializer  a
a = Serializer e
serialize Serializer e -> Serializer e
forall a b. (a -> b) -> a -> b
$ a
a a -> Getting e a e -> e
forall s a. s -> Getting a s a -> a
^. Getting e a e
Lens' a e
elLens

parseIn :: (Eq a, WithDefaultSvg s, ParseableAttribute a)
        => String -> Lens' s a -> SvgAttributeLens s
parseIn :: String -> Lens' s a -> SvgAttributeLens s
parseIn String
attribute Lens' s a
elLens =
    String
-> (s -> String -> s) -> (s -> Maybe String) -> SvgAttributeLens s
forall t.
String
-> (t -> String -> t) -> (t -> Maybe String) -> SvgAttributeLens t
SvgAttributeLens String
attribute s -> String -> s
updater s -> Maybe String
serializer
  where
    updater :: s -> String -> s
updater s
el String
str = case String -> Maybe a
forall a. ParseableAttribute a => String -> Maybe a
aparse String
str of
        Maybe a
Nothing -> s
el
        Just a
v  -> s
el s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> s -> Identity s
Lens' s a
elLens ((a -> Identity a) -> s -> Identity s) -> a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ a
v

    serializer :: s -> Maybe String
serializer s
a
      | a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
defaultVal = a -> Maybe String
forall a. ParseableAttribute a => a -> Maybe String
aserialize a
v
      | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
      where
        v :: a
v = s
a s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
Lens' s a
elLens
        defaultVal :: a
defaultVal = s
forall a. WithDefaultSvg a => a
defaultSvg s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
Lens' s a
elLens

parserMaybeSetter :: String -> Lens' a (Maybe e) -> (String -> Maybe e) -> Serializer e
                 -> SvgAttributeLens a
parserMaybeSetter :: String
-> Lens' a (Maybe e)
-> (String -> Maybe e)
-> Serializer e
-> SvgAttributeLens a
parserMaybeSetter String
attribute Lens' a (Maybe e)
elLens String -> Maybe e
parser Serializer e
serialize =
    String
-> (a -> String -> a) -> (a -> Maybe String) -> SvgAttributeLens a
forall t.
String
-> (t -> String -> t) -> (t -> Maybe String) -> SvgAttributeLens t
SvgAttributeLens String
attribute a -> String -> a
updater a -> Maybe String
serializer
  where
    updater :: a -> String -> a
updater a
el String
str = case String -> Maybe e
parser String
str of
        Maybe e
Nothing -> a
el
        Just e
v  -> a
el a -> (a -> a) -> a
forall a b. a -> (a -> b) -> b
& (Maybe e -> Identity (Maybe e)) -> a -> Identity a
Lens' a (Maybe e)
elLens ((Maybe e -> Identity (Maybe e)) -> a -> Identity a) -> e -> a -> a
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ e
v

    serializer :: a -> Maybe String
serializer a
a = (a
a a -> Getting (Maybe e) a (Maybe e) -> Maybe e
forall s a. s -> Getting a s a -> a
^. Getting (Maybe e) a (Maybe e)
Lens' a (Maybe e)
elLens) Maybe e -> Serializer e -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Serializer e
serialize

classSetter :: SvgAttributeLens DrawAttributes
classSetter :: SvgAttributeLens DrawAttributes
classSetter = String
-> (DrawAttributes -> String -> DrawAttributes)
-> (DrawAttributes -> Maybe String)
-> SvgAttributeLens DrawAttributes
forall t.
String
-> (t -> String -> t) -> (t -> Maybe String) -> SvgAttributeLens t
SvgAttributeLens String
"class" DrawAttributes -> String -> DrawAttributes
forall b. HasDrawAttributes b => b -> String -> b
updater DrawAttributes -> Maybe String
forall s. HasDrawAttributes s => s -> Maybe String
serializer
  where
    updater :: b -> String -> b
updater b
el String
str =
      b
el b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> b -> Identity b
forall c. HasDrawAttributes c => Lens' c [Text]
attrClass (([Text] -> Identity [Text]) -> b -> Identity b)
-> [Text] -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (String -> Text
T.pack String
str)

    serializer :: s -> Maybe String
serializer s
a = case s
a s -> Getting [Text] s [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. Getting [Text] s [Text]
forall c. HasDrawAttributes c => Lens' c [Text]
attrClass of
      []  -> Maybe String
forall a. Maybe a
Nothing
      [Text]
lst -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Text -> String) -> Text -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe String) -> Text -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
" " [Text]
lst

cssUniqueNumber :: ASetter el el
                   a (Maybe Number)
                -> CssUpdater el
cssUniqueNumber :: ASetter el el a (Maybe Number) -> CssUpdater el
cssUniqueNumber ASetter el el a (Maybe Number)
setter el
attr ((CssNumber Number
n:[CssElement]
_):[[CssElement]]
_) =
    el
attr el -> (el -> el) -> el
forall a b. a -> (a -> b) -> b
& ASetter el el a (Maybe Number)
setter ASetter el el a (Maybe Number) -> Number -> el -> el
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Number
n
cssUniqueNumber ASetter el el a (Maybe Number)
_ el
attr [[CssElement]]
_ = el
attr

cssUniqueFloat :: (Fractional n)
               => ASetter el el a (Maybe n)
               -> CssUpdater el
cssUniqueFloat :: ASetter el el a (Maybe n) -> CssUpdater el
cssUniqueFloat ASetter el el a (Maybe n)
setter el
attr ((CssNumber (Num Double
n):[CssElement]
_):[[CssElement]]
_) =
    el
attr el -> (el -> el) -> el
forall a b. a -> (a -> b) -> b
& ASetter el el a (Maybe n)
setter ASetter el el a (Maybe n) -> n -> el -> el
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
n
cssUniqueFloat ASetter el el a (Maybe n)
_ el
attr [[CssElement]]
_ = el
attr

cssUniqueMayFloat :: ASetter el el a (Maybe Double)
               -> CssUpdater el
cssUniqueMayFloat :: ASetter el el a (Maybe Double) -> CssUpdater el
cssUniqueMayFloat ASetter el el a (Maybe Double)
setter el
attr ((CssNumber (Num Double
n):[CssElement]
_):[[CssElement]]
_) =
    el
attr el -> (el -> el) -> el
forall a b. a -> (a -> b) -> b
& ASetter el el a (Maybe Double)
setter ASetter el el a (Maybe Double) -> Double -> el -> el
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double
n
cssUniqueMayFloat ASetter el el a (Maybe Double)
_ el
attr [[CssElement]]
_ = el
attr

cssIdentAttr :: ParseableAttribute a => Lens' el a -> CssUpdater el
cssIdentAttr :: Lens' el a -> CssUpdater el
cssIdentAttr Lens' el a
setter el
attr ((CssIdent Text
i:[CssElement]
_):[[CssElement]]
_) = case String -> Maybe a
forall a. ParseableAttribute a => String -> Maybe a
aparse (String -> Maybe a) -> String -> Maybe a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
i of
    Maybe a
Nothing -> el
attr
    Just a
v  -> el
attr el -> (el -> el) -> el
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> el -> Identity el
Lens' el a
setter ((a -> Identity a) -> el -> Identity el) -> a -> el -> el
forall s t a b. ASetter s t a b -> b -> s -> t
.~ a
v
cssIdentAttr Lens' el a
_ el
attr [[CssElement]]
_ = el
attr

fontFamilyParser :: CssUpdater DrawAttributes
fontFamilyParser :: CssUpdater DrawAttributes
fontFamilyParser DrawAttributes
attr ([CssElement]
lst:[[CssElement]]
_) = DrawAttributes
attr DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (Maybe [String] -> Identity (Maybe [String]))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe [String])
fontFamily ((Maybe [String] -> Identity (Maybe [String]))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe [String] -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe [String]
fontNames
  where
    fontNames :: Maybe [String]
fontNames = [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CssElement] -> [Text]
extractString [CssElement]
lst

    extractString :: [CssElement] -> [Text]
extractString []                 = []
    extractString (CssIdent Text
n:[CssElement]
rest)  = Text
n Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [CssElement] -> [Text]
extractString [CssElement]
rest
    extractString (CssString Text
n:[CssElement]
rest) = Text
n Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [CssElement] -> [Text]
extractString [CssElement]
rest
    extractString (CssElement
_:[CssElement]
rest)           = [CssElement] -> [Text]
extractString [CssElement]
rest
fontFamilyParser DrawAttributes
attr [[CssElement]]
_ = DrawAttributes
attr


cssUniqueTexture :: ASetter el el
                    a (Maybe Texture)
                 -> CssUpdater el
cssUniqueTexture :: ASetter el el a (Maybe Texture) -> CssUpdater el
cssUniqueTexture ASetter el el a (Maybe Texture)
setter el
attr [[CssElement]]
css = case [[CssElement]]
css of
  ((CssIdent Text
"none":[CssElement]
_):[[CssElement]]
_) -> el
attr el -> (el -> el) -> el
forall a b. a -> (a -> b) -> b
& ASetter el el a (Maybe Texture)
setter ASetter el el a (Maybe Texture) -> Texture -> el -> el
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Texture
FillNone
  ((CssColor PixelRGBA8
c:[CssElement]
_):[[CssElement]]
_) -> el
attr el -> (el -> el) -> el
forall a b. a -> (a -> b) -> b
& ASetter el el a (Maybe Texture)
setter ASetter el el a (Maybe Texture) -> Texture -> el -> el
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ PixelRGBA8 -> Texture
ColorRef PixelRGBA8
c
  ((CssFunction Text
"url" [CssReference Text
c]:[CssElement]
_):[[CssElement]]
_) ->
        el
attr el -> (el -> el) -> el
forall a b. a -> (a -> b) -> b
& ASetter el el a (Maybe Texture)
setter ASetter el el a (Maybe Texture) -> Texture -> el -> el
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ String -> Texture
TextureRef (Text -> String
T.unpack Text
c)
  [[CssElement]]
_ -> el
attr

cssUniqueColor :: ASetter el el a PixelRGBA8 -> CssUpdater el
cssUniqueColor :: ASetter el el a PixelRGBA8 -> CssUpdater el
cssUniqueColor ASetter el el a PixelRGBA8
setter el
attr [[CssElement]]
css = case [[CssElement]]
css of
  ((CssColor PixelRGBA8
c:[CssElement]
_):[[CssElement]]
_) -> el
attr el -> (el -> el) -> el
forall a b. a -> (a -> b) -> b
& ASetter el el a PixelRGBA8
setter ASetter el el a PixelRGBA8 -> PixelRGBA8 -> el -> el
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PixelRGBA8
c
  [[CssElement]]
_                  -> el
attr

cssElementRefSetter :: Lens' el (Maybe ElementRef) -> CssUpdater el
cssElementRefSetter :: Lens' el (Maybe ElementRef) -> CssUpdater el
cssElementRefSetter Lens' el (Maybe ElementRef)
setter el
attr ((CssFunction Text
"url" [CssReference Text
c]:[CssElement]
_):[[CssElement]]
_) =
    el
attr el -> (el -> el) -> el
forall a b. a -> (a -> b) -> b
& (Maybe ElementRef -> Identity (Maybe ElementRef))
-> el -> Identity el
Lens' el (Maybe ElementRef)
setter ((Maybe ElementRef -> Identity (Maybe ElementRef))
 -> el -> Identity el)
-> ElementRef -> el -> el
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ String -> ElementRef
Ref (Text -> String
T.unpack Text
c)
cssElementRefSetter Lens' el (Maybe ElementRef)
setter el
attr ((CssIdent Text
"none":[CssElement]
_):[[CssElement]]
_) =
    el
attr el -> (el -> el) -> el
forall a b. a -> (a -> b) -> b
& (Maybe ElementRef -> Identity (Maybe ElementRef))
-> el -> Identity el
Lens' el (Maybe ElementRef)
setter ((Maybe ElementRef -> Identity (Maybe ElementRef))
 -> el -> Identity el)
-> ElementRef -> el -> el
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ElementRef
RefNone
cssElementRefSetter Lens' el (Maybe ElementRef)
_ el
attr [[CssElement]]
_ = el
attr

cssMayStringSetter :: ASetter el el a (Maybe String) -> CssUpdater el
cssMayStringSetter :: ASetter el el a (Maybe String) -> CssUpdater el
cssMayStringSetter ASetter el el a (Maybe String)
setter el
attr ((CssIdent Text
i:[CssElement]
_):[[CssElement]]
_) =
    el
attr el -> (el -> el) -> el
forall a b. a -> (a -> b) -> b
& ASetter el el a (Maybe String)
setter ASetter el el a (Maybe String) -> String -> el -> el
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> String
T.unpack Text
i
cssMayStringSetter ASetter el el a (Maybe String)
setter el
attr ((CssString Text
i:[CssElement]
_):[[CssElement]]
_) =
    el
attr el -> (el -> el) -> el
forall a b. a -> (a -> b) -> b
& ASetter el el a (Maybe String)
setter ASetter el el a (Maybe String) -> String -> el -> el
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> String
T.unpack Text
i
cssMayStringSetter ASetter el el a (Maybe String)
_ el
attr [[CssElement]]
_ = el
attr

cssNullSetter :: CssUpdater a
cssNullSetter :: CssUpdater a
cssNullSetter a
attr [[CssElement]]
_ = a
attr

cssDashArray :: ASetter el el a (Maybe [Number]) -> CssUpdater el
cssDashArray :: ASetter el el a (Maybe [Number]) -> CssUpdater el
cssDashArray ASetter el el a (Maybe [Number])
setter el
attr ([CssElement]
lst:[[CssElement]]
_) =
  case [Number
n | CssNumber Number
n <- [CssElement]
lst ] of
    [] -> el
attr
    [Number]
v  -> el
attr el -> (el -> el) -> el
forall a b. a -> (a -> b) -> b
& ASetter el el a (Maybe [Number])
setter ASetter el el a (Maybe [Number]) -> [Number] -> el -> el
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Number]
v
cssDashArray ASetter el el a (Maybe [Number])
_ el
attr [[CssElement]]
_ = el
attr


drawAttributesList :: [(SvgAttributeLens DrawAttributes, CssUpdater DrawAttributes)]
drawAttributesList :: [(SvgAttributeLens DrawAttributes, CssUpdater DrawAttributes)]
drawAttributesList =
  [(String
"stroke-width" String
-> Lens' DrawAttributes (Maybe Number)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe Number)
Lens' DrawAttributes (Maybe Number)
strokeWidth, ASetter DrawAttributes DrawAttributes (Maybe Number) (Maybe Number)
-> CssUpdater DrawAttributes
forall el a. ASetter el el a (Maybe Number) -> CssUpdater el
cssUniqueNumber ASetter DrawAttributes DrawAttributes (Maybe Number) (Maybe Number)
forall c. HasDrawAttributes c => Lens' c (Maybe Number)
strokeWidth)
  ,(String
"stroke" String
-> Lens' DrawAttributes (Maybe Texture)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe Texture)
Lens' DrawAttributes (Maybe Texture)
strokeColor, ASetter
  DrawAttributes DrawAttributes (Maybe Texture) (Maybe Texture)
-> CssUpdater DrawAttributes
forall el a. ASetter el el a (Maybe Texture) -> CssUpdater el
cssUniqueTexture ASetter
  DrawAttributes DrawAttributes (Maybe Texture) (Maybe Texture)
forall c. HasDrawAttributes c => Lens' c (Maybe Texture)
strokeColor)
  ,(String
"fill" String
-> Lens' DrawAttributes (Maybe Texture)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe Texture)
Lens' DrawAttributes (Maybe Texture)
fillColor, ASetter
  DrawAttributes DrawAttributes (Maybe Texture) (Maybe Texture)
-> CssUpdater DrawAttributes
forall el a. ASetter el el a (Maybe Texture) -> CssUpdater el
cssUniqueTexture ASetter
  DrawAttributes DrawAttributes (Maybe Texture) (Maybe Texture)
forall c. HasDrawAttributes c => Lens' c (Maybe Texture)
fillColor)
  ,(String
"stroke-linecap" String
-> Lens' DrawAttributes (Maybe Cap)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe Cap)
Lens' DrawAttributes (Maybe Cap)
strokeLineCap, Lens' DrawAttributes (Maybe Cap) -> CssUpdater DrawAttributes
forall a el. ParseableAttribute a => Lens' el a -> CssUpdater el
cssIdentAttr forall c. HasDrawAttributes c => Lens' c (Maybe Cap)
Lens' DrawAttributes (Maybe Cap)
strokeLineCap)
  ,(String
"stroke-linejoin" String
-> Lens' DrawAttributes (Maybe LineJoin)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe LineJoin)
Lens' DrawAttributes (Maybe LineJoin)
strokeLineJoin, Lens' DrawAttributes (Maybe LineJoin) -> CssUpdater DrawAttributes
forall a el. ParseableAttribute a => Lens' el a -> CssUpdater el
cssIdentAttr forall c. HasDrawAttributes c => Lens' c (Maybe LineJoin)
Lens' DrawAttributes (Maybe LineJoin)
strokeLineJoin)
  ,(String
"stroke-miterlimit" String
-> Lens' DrawAttributes (Maybe Double)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe Double)
Lens' DrawAttributes (Maybe Double)
strokeMiterLimit,
       ASetter DrawAttributes DrawAttributes (Maybe Double) (Maybe Double)
-> CssUpdater DrawAttributes
forall el a. ASetter el el a (Maybe Double) -> CssUpdater el
cssUniqueMayFloat ASetter DrawAttributes DrawAttributes (Maybe Double) (Maybe Double)
forall c. HasDrawAttributes c => Lens' c (Maybe Double)
strokeMiterLimit)

  ,(String
"transform" String
-> Lens' DrawAttributes (Maybe [Transformation])
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe [Transformation])
Lens' DrawAttributes (Maybe [Transformation])
transform, CssUpdater DrawAttributes
forall a b. a -> b -> a
const)
  ,(String
-> Lens' DrawAttributes (Maybe Float)
-> SvgAttributeLens DrawAttributes
forall a. String -> Lens' a (Maybe Float) -> SvgAttributeLens a
opacitySetter String
"opacity" forall c. HasDrawAttributes c => Lens' c (Maybe Float)
Lens' DrawAttributes (Maybe Float)
groupOpacity, ASetter DrawAttributes DrawAttributes (Maybe Float) (Maybe Float)
-> CssUpdater DrawAttributes
forall n el a.
Fractional n =>
ASetter el el a (Maybe n) -> CssUpdater el
cssUniqueFloat ASetter DrawAttributes DrawAttributes (Maybe Float) (Maybe Float)
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
groupOpacity)
  ,(String
-> Lens' DrawAttributes (Maybe Float)
-> SvgAttributeLens DrawAttributes
forall a. String -> Lens' a (Maybe Float) -> SvgAttributeLens a
opacitySetter String
"fill-opacity" forall c. HasDrawAttributes c => Lens' c (Maybe Float)
Lens' DrawAttributes (Maybe Float)
fillOpacity, ASetter DrawAttributes DrawAttributes (Maybe Float) (Maybe Float)
-> CssUpdater DrawAttributes
forall n el a.
Fractional n =>
ASetter el el a (Maybe n) -> CssUpdater el
cssUniqueFloat ASetter DrawAttributes DrawAttributes (Maybe Float) (Maybe Float)
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
fillOpacity)
  ,(String
-> Lens' DrawAttributes (Maybe Float)
-> SvgAttributeLens DrawAttributes
forall a. String -> Lens' a (Maybe Float) -> SvgAttributeLens a
opacitySetter String
"stroke-opacity" forall c. HasDrawAttributes c => Lens' c (Maybe Float)
Lens' DrawAttributes (Maybe Float)
strokeOpacity, ASetter DrawAttributes DrawAttributes (Maybe Float) (Maybe Float)
-> CssUpdater DrawAttributes
forall n el a.
Fractional n =>
ASetter el el a (Maybe n) -> CssUpdater el
cssUniqueFloat ASetter DrawAttributes DrawAttributes (Maybe Float) (Maybe Float)
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
strokeOpacity)
  ,(String
"font-size" String
-> Lens' DrawAttributes (Maybe Number)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe Number)
Lens' DrawAttributes (Maybe Number)
fontSize, ASetter DrawAttributes DrawAttributes (Maybe Number) (Maybe Number)
-> CssUpdater DrawAttributes
forall el a. ASetter el el a (Maybe Number) -> CssUpdater el
cssUniqueNumber ASetter DrawAttributes DrawAttributes (Maybe Number) (Maybe Number)
forall c. HasDrawAttributes c => Lens' c (Maybe Number)
fontSize)
  ,(String
-> Lens' DrawAttributes (Maybe [String])
-> (String -> Maybe [String])
-> Serializer [String]
-> SvgAttributeLens DrawAttributes
forall a e.
String
-> Lens' a (Maybe e)
-> (String -> Maybe e)
-> Serializer e
-> SvgAttributeLens a
parserMaybeSetter String
"font-family" forall c. HasDrawAttributes c => Lens' c (Maybe [String])
Lens' DrawAttributes (Maybe [String])
fontFamily ([String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String])
-> (String -> [String]) -> String -> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
commaSeparate)
      (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([String] -> String) -> Serializer [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", "), CssUpdater DrawAttributes
fontFamilyParser)

  ,(String
"fill-rule" String
-> Lens' DrawAttributes (Maybe FillRule)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe FillRule)
Lens' DrawAttributes (Maybe FillRule)
fillRule, Lens' DrawAttributes (Maybe FillRule) -> CssUpdater DrawAttributes
forall a el. ParseableAttribute a => Lens' el a -> CssUpdater el
cssIdentAttr forall c. HasDrawAttributes c => Lens' c (Maybe FillRule)
Lens' DrawAttributes (Maybe FillRule)
fillRule)
  ,(String
"clip-rule" String
-> Lens' DrawAttributes (Maybe FillRule)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe FillRule)
Lens' DrawAttributes (Maybe FillRule)
clipRule, Lens' DrawAttributes (Maybe FillRule) -> CssUpdater DrawAttributes
forall a el. ParseableAttribute a => Lens' el a -> CssUpdater el
cssIdentAttr forall c. HasDrawAttributes c => Lens' c (Maybe FillRule)
Lens' DrawAttributes (Maybe FillRule)
clipRule)
  ,(String
"mask" String
-> Lens' DrawAttributes (Maybe ElementRef)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe ElementRef)
Lens' DrawAttributes (Maybe ElementRef)
maskRef, Lens' DrawAttributes (Maybe ElementRef)
-> CssUpdater DrawAttributes
forall el. Lens' el (Maybe ElementRef) -> CssUpdater el
cssElementRefSetter forall c. HasDrawAttributes c => Lens' c (Maybe ElementRef)
Lens' DrawAttributes (Maybe ElementRef)
maskRef)
  ,(SvgAttributeLens DrawAttributes
classSetter, CssUpdater DrawAttributes
forall a. CssUpdater a
cssNullSetter) -- can't set class in CSS
  ,(String
"id" String
-> Lens' DrawAttributes (Maybe String)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe String)
Lens' DrawAttributes (Maybe String)
attrId, ASetter DrawAttributes DrawAttributes (Maybe String) (Maybe String)
-> CssUpdater DrawAttributes
forall el a. ASetter el el a (Maybe String) -> CssUpdater el
cssMayStringSetter ASetter DrawAttributes DrawAttributes (Maybe String) (Maybe String)
forall c. HasDrawAttributes c => Lens' c (Maybe String)
attrId)
  ,(String
"stroke-dashoffset" String
-> Lens' DrawAttributes (Maybe Number)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe Number)
Lens' DrawAttributes (Maybe Number)
strokeOffset,
      ASetter DrawAttributes DrawAttributes (Maybe Number) (Maybe Number)
-> CssUpdater DrawAttributes
forall el a. ASetter el el a (Maybe Number) -> CssUpdater el
cssUniqueNumber ASetter DrawAttributes DrawAttributes (Maybe Number) (Maybe Number)
forall c. HasDrawAttributes c => Lens' c (Maybe Number)
strokeOffset)
  ,(String
"stroke-dasharray" String
-> Lens' DrawAttributes (Maybe [Number])
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe [Number])
Lens' DrawAttributes (Maybe [Number])
strokeDashArray, ASetter
  DrawAttributes DrawAttributes (Maybe [Number]) (Maybe [Number])
-> CssUpdater DrawAttributes
forall el a. ASetter el el a (Maybe [Number]) -> CssUpdater el
cssDashArray ASetter
  DrawAttributes DrawAttributes (Maybe [Number]) (Maybe [Number])
forall c. HasDrawAttributes c => Lens' c (Maybe [Number])
strokeDashArray)
  ,(String
"text-anchor" String
-> Lens' DrawAttributes (Maybe TextAnchor)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe TextAnchor)
Lens' DrawAttributes (Maybe TextAnchor)
textAnchor, Lens' DrawAttributes (Maybe TextAnchor)
-> CssUpdater DrawAttributes
forall a el. ParseableAttribute a => Lens' el a -> CssUpdater el
cssIdentAttr forall c. HasDrawAttributes c => Lens' c (Maybe TextAnchor)
Lens' DrawAttributes (Maybe TextAnchor)
textAnchor)
  ,(String
"clip-path" String
-> Lens' DrawAttributes (Maybe ElementRef)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe ElementRef)
Lens' DrawAttributes (Maybe ElementRef)
clipPathRef, Lens' DrawAttributes (Maybe ElementRef)
-> CssUpdater DrawAttributes
forall el. Lens' el (Maybe ElementRef) -> CssUpdater el
cssElementRefSetter forall c. HasDrawAttributes c => Lens' c (Maybe ElementRef)
Lens' DrawAttributes (Maybe ElementRef)
clipPathRef)
  ,(String
"marker-end" String
-> Lens' DrawAttributes (Maybe ElementRef)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe ElementRef)
Lens' DrawAttributes (Maybe ElementRef)
markerEnd, Lens' DrawAttributes (Maybe ElementRef)
-> CssUpdater DrawAttributes
forall el. Lens' el (Maybe ElementRef) -> CssUpdater el
cssElementRefSetter forall c. HasDrawAttributes c => Lens' c (Maybe ElementRef)
Lens' DrawAttributes (Maybe ElementRef)
markerEnd)
  ,(String
"marker-start" String
-> Lens' DrawAttributes (Maybe ElementRef)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe ElementRef)
Lens' DrawAttributes (Maybe ElementRef)
markerStart, Lens' DrawAttributes (Maybe ElementRef)
-> CssUpdater DrawAttributes
forall el. Lens' el (Maybe ElementRef) -> CssUpdater el
cssElementRefSetter forall c. HasDrawAttributes c => Lens' c (Maybe ElementRef)
Lens' DrawAttributes (Maybe ElementRef)
markerStart)
  ,(String
"marker-mid" String
-> Lens' DrawAttributes (Maybe ElementRef)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe ElementRef)
Lens' DrawAttributes (Maybe ElementRef)
markerMid, Lens' DrawAttributes (Maybe ElementRef)
-> CssUpdater DrawAttributes
forall el. Lens' el (Maybe ElementRef) -> CssUpdater el
cssElementRefSetter forall c. HasDrawAttributes c => Lens' c (Maybe ElementRef)
Lens' DrawAttributes (Maybe ElementRef)
markerMid)
  ,(String
"filter" String
-> Lens' DrawAttributes (Maybe ElementRef)
-> SvgAttributeLens DrawAttributes
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasDrawAttributes c => Lens' c (Maybe ElementRef)
Lens' DrawAttributes (Maybe ElementRef)
filterRef, CssUpdater DrawAttributes
forall a. CssUpdater a
cssNullSetter)
  ]
  where
    commaSeparate :: String -> [String]
commaSeparate =
        (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip) ([Text] -> [String]) -> (String -> [Text]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char
',' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

serializeDashArray :: [Number] -> String
serializeDashArray :: [Number] -> String
serializeDashArray =
   String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String)
-> ([Number] -> [String]) -> [Number] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Number -> String) -> [Number] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Number -> String
serializeNumber

instance XMLUpdatable DrawAttributes where
  xmlTagName :: DrawAttributes -> String
xmlTagName DrawAttributes
_ = String
"DRAWATTRIBUTES"
  attributes :: [SvgAttributeLens DrawAttributes]
attributes =
      [(SvgAttributeLens DrawAttributes, CssUpdater DrawAttributes)]
-> SvgAttributeLens DrawAttributes
forall a.
[(SvgAttributeLens a, CssUpdater a)] -> SvgAttributeLens a
styleAttribute [(SvgAttributeLens DrawAttributes, CssUpdater DrawAttributes)]
drawAttributesList SvgAttributeLens DrawAttributes
-> [SvgAttributeLens DrawAttributes]
-> [SvgAttributeLens DrawAttributes]
forall a. a -> [a] -> [a]
: ((SvgAttributeLens DrawAttributes, CssUpdater DrawAttributes)
 -> SvgAttributeLens DrawAttributes)
-> [(SvgAttributeLens DrawAttributes, CssUpdater DrawAttributes)]
-> [SvgAttributeLens DrawAttributes]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SvgAttributeLens DrawAttributes, CssUpdater DrawAttributes)
-> SvgAttributeLens DrawAttributes
forall a b. (a, b) -> a
fst [(SvgAttributeLens DrawAttributes, CssUpdater DrawAttributes)]
drawAttributesList
  serializeTreeNode :: DrawAttributes -> Maybe Element
serializeTreeNode = DrawAttributes -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
genericSerializeNode

styleAttribute :: [(SvgAttributeLens a, CssUpdater a)] -> SvgAttributeLens a
styleAttribute :: [(SvgAttributeLens a, CssUpdater a)] -> SvgAttributeLens a
styleAttribute [(SvgAttributeLens a, CssUpdater a)]
styleAttrs = SvgAttributeLens :: forall t.
String
-> (t -> String -> t) -> (t -> Maybe String) -> SvgAttributeLens t
SvgAttributeLens
  { _attributeName :: String
_attributeName       = String
"style"
  , _attributeUpdater :: a -> String -> a
_attributeUpdater    = a -> String -> a
updater
  , _attributeSerializer :: a -> Maybe String
_attributeSerializer = Maybe String -> a -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing
  }
  where
    updater :: a -> String -> a
updater a
attrs String
style = case Parser [CssDeclaration] -> String -> Maybe [CssDeclaration]
forall a. Parser a -> String -> Maybe a
parse Parser [CssDeclaration]
styleString String
style of
        Maybe [CssDeclaration]
Nothing    -> a
attrs
        Just [CssDeclaration]
decls -> (a -> CssDeclaration -> a) -> a -> [CssDeclaration] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> CssDeclaration -> a
applyer a
attrs [CssDeclaration]
decls

    cssUpdaters :: [(Text, CssUpdater a)]
cssUpdaters = [(String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SvgAttributeLens a -> String
forall t. SvgAttributeLens t -> String
_attributeName SvgAttributeLens a
n, CssUpdater a
u) | (SvgAttributeLens a
n, CssUpdater a
u) <- [(SvgAttributeLens a, CssUpdater a)]
styleAttrs]
    applyer :: a -> CssDeclaration -> a
applyer a
value (CssDeclaration Text
txt [[CssElement]]
elems) =
        case Text -> [(Text, CssUpdater a)] -> Maybe (CssUpdater a)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
txt [(Text, CssUpdater a)]
cssUpdaters of
          Maybe (CssUpdater a)
Nothing -> a
value
          Just CssUpdater a
f  -> CssUpdater a
f a
value [[CssElement]]
elems

instance XMLUpdatable Rectangle where
  xmlTagName :: Rectangle -> String
xmlTagName Rectangle
_ = String
"rect"
  serializeTreeNode :: Rectangle -> Maybe Element
serializeTreeNode = Rectangle -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Rectangle]
attributes =
    [String
"width" String
-> Lens' Rectangle (Maybe Number) -> SvgAttributeLens Rectangle
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Rectangle (Maybe Number)
rectWidth
    ,String
"height" String
-> Lens' Rectangle (Maybe Number) -> SvgAttributeLens Rectangle
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Rectangle (Maybe Number)
rectHeight
    ,String
"x" String -> Lens' Rectangle Number -> SvgAttributeLens Rectangle
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Rectangle -> f Rectangle
Lens' Rectangle Point
rectUpperLeftCorner((Point -> f Point) -> Rectangle -> f Rectangle)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Rectangle
-> f Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    ,String
"y" String -> Lens' Rectangle Number -> SvgAttributeLens Rectangle
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Rectangle -> f Rectangle
Lens' Rectangle Point
rectUpperLeftCorner((Point -> f Point) -> Rectangle -> f Rectangle)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Rectangle
-> f Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field2 s t a b => Lens s t a b
_2)
    ,String
"rx" String
-> Lens' Rectangle (Maybe Number) -> SvgAttributeLens Rectangle
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` (((Maybe Number, Maybe Number) -> f (Maybe Number, Maybe Number))
-> Rectangle -> f Rectangle
Lens' Rectangle (Maybe Number, Maybe Number)
rectCornerRadius(((Maybe Number, Maybe Number) -> f (Maybe Number, Maybe Number))
 -> Rectangle -> f Rectangle)
-> ((Maybe Number -> f (Maybe Number))
    -> (Maybe Number, Maybe Number) -> f (Maybe Number, Maybe Number))
-> (Maybe Number -> f (Maybe Number))
-> Rectangle
-> f Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Number -> f (Maybe Number))
-> (Maybe Number, Maybe Number) -> f (Maybe Number, Maybe Number)
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    ,String
"ry" String
-> Lens' Rectangle (Maybe Number) -> SvgAttributeLens Rectangle
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` (((Maybe Number, Maybe Number) -> f (Maybe Number, Maybe Number))
-> Rectangle -> f Rectangle
Lens' Rectangle (Maybe Number, Maybe Number)
rectCornerRadius(((Maybe Number, Maybe Number) -> f (Maybe Number, Maybe Number))
 -> Rectangle -> f Rectangle)
-> ((Maybe Number -> f (Maybe Number))
    -> (Maybe Number, Maybe Number) -> f (Maybe Number, Maybe Number))
-> (Maybe Number -> f (Maybe Number))
-> Rectangle
-> f Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Number -> f (Maybe Number))
-> (Maybe Number, Maybe Number) -> f (Maybe Number, Maybe Number)
forall s t a b. Field2 s t a b => Lens s t a b
_2)
    ]

instance XMLUpdatable Image where
  xmlTagName :: Image -> String
xmlTagName Image
_ = String
"image"
  serializeTreeNode :: Image -> Maybe Element
serializeTreeNode = Image -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Image]
attributes =
    [String
"width" String -> Lens' Image Number -> SvgAttributeLens Image
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Image Number
imageWidth
    ,String
"height" String -> Lens' Image Number -> SvgAttributeLens Image
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Image Number
imageHeight
    ,String
"x" String -> Lens' Image Number -> SvgAttributeLens Image
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Image -> f Image
Lens' Image Point
imageCornerUpperLeft((Point -> f Point) -> Image -> f Image)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Image
-> f Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    ,String
"y" String -> Lens' Image Number -> SvgAttributeLens Image
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Image -> f Image
Lens' Image Point
imageCornerUpperLeft((Point -> f Point) -> Image -> f Image)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Image
-> f Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field2 s t a b => Lens s t a b
_2)
    ,String
-> Lens' Image String
-> (String -> Maybe String)
-> (String -> Maybe String)
-> SvgAttributeLens Image
forall a e.
String
-> Lens' a e
-> (String -> Maybe e)
-> Serializer e
-> SvgAttributeLens a
parserSetter String
"href" Lens' Image String
imageHref (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
dropSharp) String -> Maybe String
forall a. a -> Maybe a
Just
    ,String
"preserveAspectRatio" String -> Lens' Image PreserveAspectRatio -> SvgAttributeLens Image
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Image PreserveAspectRatio
imageAspectRatio
    ]

instance XMLUpdatable Line where
  xmlTagName :: Line -> String
xmlTagName Line
_ = String
"line"
  serializeTreeNode :: Line -> Maybe Element
serializeTreeNode = Line -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Line]
attributes =
    [String
"x1" String -> Lens' Line Number -> SvgAttributeLens Line
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Line -> f Line
Lens' Line Point
linePoint1((Point -> f Point) -> Line -> f Line)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Line
-> f Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    ,String
"y1" String -> Lens' Line Number -> SvgAttributeLens Line
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Line -> f Line
Lens' Line Point
linePoint1((Point -> f Point) -> Line -> f Line)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Line
-> f Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field2 s t a b => Lens s t a b
_2)
    ,String
"x2" String -> Lens' Line Number -> SvgAttributeLens Line
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Line -> f Line
Lens' Line Point
linePoint2((Point -> f Point) -> Line -> f Line)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Line
-> f Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    ,String
"y2" String -> Lens' Line Number -> SvgAttributeLens Line
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Line -> f Line
Lens' Line Point
linePoint2((Point -> f Point) -> Line -> f Line)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Line
-> f Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field2 s t a b => Lens s t a b
_2)
    ]

instance XMLUpdatable Ellipse where
  xmlTagName :: Ellipse -> String
xmlTagName Ellipse
_ = String
"ellipse"
  serializeTreeNode :: Ellipse -> Maybe Element
serializeTreeNode = Ellipse -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Ellipse]
attributes =
    [String
"cx" String -> Lens' Ellipse Number -> SvgAttributeLens Ellipse
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Ellipse -> f Ellipse
Lens' Ellipse Point
ellipseCenter((Point -> f Point) -> Ellipse -> f Ellipse)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Ellipse
-> f Ellipse
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    ,String
"cy" String -> Lens' Ellipse Number -> SvgAttributeLens Ellipse
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Ellipse -> f Ellipse
Lens' Ellipse Point
ellipseCenter((Point -> f Point) -> Ellipse -> f Ellipse)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Ellipse
-> f Ellipse
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field2 s t a b => Lens s t a b
_2)
    ,String
"rx" String -> Lens' Ellipse Number -> SvgAttributeLens Ellipse
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Ellipse Number
ellipseXRadius
    ,String
"ry" String -> Lens' Ellipse Number -> SvgAttributeLens Ellipse
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Ellipse Number
ellipseYRadius
    ]

instance XMLUpdatable Circle where
  xmlTagName :: Circle -> String
xmlTagName Circle
_ = String
"circle"
  serializeTreeNode :: Circle -> Maybe Element
serializeTreeNode = Circle -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Circle]
attributes =
    [String
"cx" String -> Lens' Circle Number -> SvgAttributeLens Circle
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Circle -> f Circle
Lens' Circle Point
circleCenter((Point -> f Point) -> Circle -> f Circle)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Circle
-> f Circle
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    ,String
"cy" String -> Lens' Circle Number -> SvgAttributeLens Circle
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Circle -> f Circle
Lens' Circle Point
circleCenter((Point -> f Point) -> Circle -> f Circle)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Circle
-> f Circle
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field2 s t a b => Lens s t a b
_2)
    ,String
"r" String -> Lens' Circle Number -> SvgAttributeLens Circle
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Circle Number
circleRadius
    ]

instance XMLUpdatable Mask where
  xmlTagName :: Mask -> String
xmlTagName Mask
_ = String
"mask"
  serializeTreeNode :: Mask -> Maybe Element
serializeTreeNode Mask
node =
      (Mask -> [Tree]) -> Mask -> Maybe Element -> Maybe Element
forall b a.
XMLUpdatable b =>
(a -> [b]) -> a -> Maybe Element -> Maybe Element
updateWithAccessor Mask -> [Tree]
_maskContent Mask
node (Maybe Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$
          Mask -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr Mask
node

  attributes :: [SvgAttributeLens Mask]
attributes =
    [String
"x" String -> Lens' Mask Number -> SvgAttributeLens Mask
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Mask -> f Mask
Lens' Mask Point
maskPosition((Point -> f Point) -> Mask -> f Mask)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Mask
-> f Mask
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    ,String
"y" String -> Lens' Mask Number -> SvgAttributeLens Mask
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Mask -> f Mask
Lens' Mask Point
maskPosition((Point -> f Point) -> Mask -> f Mask)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Mask
-> f Mask
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field2 s t a b => Lens s t a b
_2)
    ,String
"width" String -> Lens' Mask Number -> SvgAttributeLens Mask
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Mask Number
maskWidth
    ,String
"height" String -> Lens' Mask Number -> SvgAttributeLens Mask
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Mask Number
maskHeight
    ,String
"maskContentUnits" String -> Lens' Mask CoordinateUnits -> SvgAttributeLens Mask
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Mask CoordinateUnits
maskContentUnits
    ,String
"maskUnits" String -> Lens' Mask CoordinateUnits -> SvgAttributeLens Mask
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Mask CoordinateUnits
maskUnits
    ]

instance XMLUpdatable ClipPath where
  xmlTagName :: ClipPath -> String
xmlTagName ClipPath
_ = String
"clipPath"
  serializeTreeNode :: ClipPath -> Maybe Element
serializeTreeNode ClipPath
node =
      (ClipPath -> [Tree]) -> ClipPath -> Maybe Element -> Maybe Element
forall b a.
XMLUpdatable b =>
(a -> [b]) -> a -> Maybe Element -> Maybe Element
updateWithAccessor ClipPath -> [Tree]
_clipPathContent ClipPath
node (Maybe Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$
          ClipPath -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr ClipPath
node
  attributes :: [SvgAttributeLens ClipPath]
attributes =
    [String
"clipPathUnits" String
-> Lens' ClipPath CoordinateUnits -> SvgAttributeLens ClipPath
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ClipPath CoordinateUnits
clipPathUnits]

instance XMLUpdatable Polygon where
  xmlTagName :: Polygon -> String
xmlTagName Polygon
_ = String
"polygon"
  serializeTreeNode :: Polygon -> Maybe Element
serializeTreeNode = Polygon -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Polygon]
attributes = [String
"points" String -> Lens' Polygon [RPoint] -> SvgAttributeLens Polygon
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Polygon [RPoint]
polygonPoints]

instance XMLUpdatable PolyLine where
  xmlTagName :: PolyLine -> String
xmlTagName PolyLine
_ =  String
"polyline"
  serializeTreeNode :: PolyLine -> Maybe Element
serializeTreeNode = PolyLine -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens PolyLine]
attributes = [String
"points" String -> Lens' PolyLine [RPoint] -> SvgAttributeLens PolyLine
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' PolyLine [RPoint]
polyLinePoints]

instance XMLUpdatable Path where
  xmlTagName :: Path -> String
xmlTagName Path
_ =  String
"path"
  serializeTreeNode :: Path -> Maybe Element
serializeTreeNode = Path -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Path]
attributes = [String
"d" String -> Lens' Path [PathCommand] -> SvgAttributeLens Path
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Path [PathCommand]
pathDefinition]

instance XMLUpdatable MeshGradientPatch where
  xmlTagName :: MeshGradientPatch -> String
xmlTagName MeshGradientPatch
_ = String
"meshpatch"
  attributes :: [SvgAttributeLens MeshGradientPatch]
attributes = []
  serializeTreeNode :: MeshGradientPatch -> Maybe Element
serializeTreeNode MeshGradientPatch
node =
     (MeshGradientPatch -> [GradientStop])
-> MeshGradientPatch -> Maybe Element -> Maybe Element
forall b a.
XMLUpdatable b =>
(a -> [b]) -> a -> Maybe Element -> Maybe Element
updateWithAccessor MeshGradientPatch -> [GradientStop]
_meshGradientPatchStops MeshGradientPatch
node (Maybe Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ MeshGradientPatch -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
genericSerializeNode MeshGradientPatch
node

instance XMLUpdatable MeshGradientRow where
  xmlTagName :: MeshGradientRow -> String
xmlTagName MeshGradientRow
_ = String
"meshrow"
  serializeTreeNode :: MeshGradientRow -> Maybe Element
serializeTreeNode MeshGradientRow
node =
     (MeshGradientRow -> [MeshGradientPatch])
-> MeshGradientRow -> Maybe Element -> Maybe Element
forall b a.
XMLUpdatable b =>
(a -> [b]) -> a -> Maybe Element -> Maybe Element
updateWithAccessor MeshGradientRow -> [MeshGradientPatch]
_meshGradientRowPatches MeshGradientRow
node (Maybe Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ MeshGradientRow -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
genericSerializeNode MeshGradientRow
node
  attributes :: [SvgAttributeLens MeshGradientRow]
attributes = []

instance XMLUpdatable MeshGradient where
  xmlTagName :: MeshGradient -> String
xmlTagName MeshGradient
_ = String
"meshgradient"
  serializeTreeNode :: MeshGradient -> Maybe Element
serializeTreeNode MeshGradient
node =
     (MeshGradient -> [MeshGradientRow])
-> MeshGradient -> Maybe Element -> Maybe Element
forall b a.
XMLUpdatable b =>
(a -> [b]) -> a -> Maybe Element -> Maybe Element
updateWithAccessor MeshGradient -> [MeshGradientRow]
_meshGradientRows MeshGradient
node (Maybe Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ MeshGradient -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr MeshGradient
node
  attributes :: [SvgAttributeLens MeshGradient]
attributes =
    [String
"x" String
-> Lens' MeshGradient Number -> SvgAttributeLens MeshGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' MeshGradient Number
meshGradientX
    ,String
"y" String
-> Lens' MeshGradient Number -> SvgAttributeLens MeshGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' MeshGradient Number
meshGradientY
    ,String
"type" String
-> Lens' MeshGradient MeshGradientType
-> SvgAttributeLens MeshGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' MeshGradient MeshGradientType
meshGradientType
    ,String
"gradientUnits" String
-> Lens' MeshGradient CoordinateUnits
-> SvgAttributeLens MeshGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' MeshGradient CoordinateUnits
meshGradientUnits
    ,String
"gradientTransform" String
-> Lens' MeshGradient [Transformation]
-> SvgAttributeLens MeshGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' MeshGradient [Transformation]
meshGradientTransform
    ]


instance XMLUpdatable LinearGradient where
  xmlTagName :: LinearGradient -> String
xmlTagName LinearGradient
_ = String
"linearGradient"
  serializeTreeNode :: LinearGradient -> Maybe Element
serializeTreeNode LinearGradient
node =
     (LinearGradient -> [GradientStop])
-> LinearGradient -> Maybe Element -> Maybe Element
forall b a.
XMLUpdatable b =>
(a -> [b]) -> a -> Maybe Element -> Maybe Element
updateWithAccessor LinearGradient -> [GradientStop]
_linearGradientStops LinearGradient
node (Maybe Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ LinearGradient -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
genericSerializeNode LinearGradient
node

  attributes :: [SvgAttributeLens LinearGradient]
attributes =
    [String
"gradientTransform" String
-> Lens' LinearGradient [Transformation]
-> SvgAttributeLens LinearGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' LinearGradient [Transformation]
linearGradientTransform
    ,String
"gradientUnits" String
-> Lens' LinearGradient CoordinateUnits
-> SvgAttributeLens LinearGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' LinearGradient CoordinateUnits
linearGradientUnits
    ,String
"spreadMethod" String
-> Lens' LinearGradient Spread -> SvgAttributeLens LinearGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' LinearGradient Spread
linearGradientSpread
    ,String
"x1" String
-> Lens' LinearGradient Number -> SvgAttributeLens LinearGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> LinearGradient -> f LinearGradient
Lens' LinearGradient Point
linearGradientStart((Point -> f Point) -> LinearGradient -> f LinearGradient)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> LinearGradient
-> f LinearGradient
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    ,String
"y1" String
-> Lens' LinearGradient Number -> SvgAttributeLens LinearGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> LinearGradient -> f LinearGradient
Lens' LinearGradient Point
linearGradientStart((Point -> f Point) -> LinearGradient -> f LinearGradient)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> LinearGradient
-> f LinearGradient
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field2 s t a b => Lens s t a b
_2)
    ,String
"x2" String
-> Lens' LinearGradient Number -> SvgAttributeLens LinearGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> LinearGradient -> f LinearGradient
Lens' LinearGradient Point
linearGradientStop((Point -> f Point) -> LinearGradient -> f LinearGradient)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> LinearGradient
-> f LinearGradient
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    ,String
"y2" String
-> Lens' LinearGradient Number -> SvgAttributeLens LinearGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> LinearGradient -> f LinearGradient
Lens' LinearGradient Point
linearGradientStop((Point -> f Point) -> LinearGradient -> f LinearGradient)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> LinearGradient
-> f LinearGradient
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field2 s t a b => Lens s t a b
_2)
    ]

instance XMLUpdatable Tree where
  xmlTagName :: Tree -> String
xmlTagName Tree
_ = String
"TREE"
  attributes :: [SvgAttributeLens Tree]
attributes = []
  serializeTreeNode :: Tree -> Maybe Element
serializeTreeNode Tree
e = case Tree
e Tree -> Getting TreeBranch Tree TreeBranch -> TreeBranch
forall s a. s -> Getting a s a -> a
^. Getting TreeBranch Tree TreeBranch
Lens' Tree TreeBranch
treeBranch of
    TreeBranch
NoNode -> Maybe Element
forall a. Maybe a
Nothing
    UseNode Use
u Maybe Tree
_ -> Use -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Use
u
    GroupNode Group
g -> Group -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Group
g
    SymbolNode Group
s -> String -> Element -> Element
setName String
"symbol" (Element -> Element) -> Maybe Element -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Group -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Group
s
    DefinitionNode Group
d -> String -> Element -> Element
setName String
"defs" (Element -> Element) -> Maybe Element -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Group -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Group
d
    FilterNode Filter
g -> Filter -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Filter
g
    PathNode Path
p -> Path -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Path
p
    CircleNode Circle
c -> Circle -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Circle
c
    PolyLineNode PolyLine
p -> PolyLine -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode PolyLine
p
    PolygonNode Polygon
p -> Polygon -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Polygon
p
    EllipseNode Ellipse
el -> Ellipse -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Ellipse
el
    LineNode Line
l -> Line -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Line
l
    RectangleNode Rectangle
r -> Rectangle -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Rectangle
r
    TextNode Maybe TextPath
Nothing Text
t -> Text -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Text
t
    ImageNode Image
i -> Image -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Image
i
    LinearGradientNode LinearGradient
l -> LinearGradient -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode LinearGradient
l
    RadialGradientNode RadialGradient
r -> RadialGradient -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode RadialGradient
r
    MeshGradientNode MeshGradient
m -> MeshGradient -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode MeshGradient
m
    PatternNode Pattern
p -> Pattern -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Pattern
p
    MarkerNode Marker
m -> Marker -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Marker
m
    MaskNode Mask
m -> Mask -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Mask
m
    ClipPathNode ClipPath
c -> ClipPath -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode ClipPath
c
    TextNode (Just TextPath
p) Text
t -> do
       Element
textNode <- Text -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Text
t
       Element
pathNode <- TextPath -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode TextPath
p
       let sub :: [Content]
sub = [Element -> Content
X.Elem (Element -> Content)
-> ([Content] -> Element) -> [Content] -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Content] -> Element
setChildren Element
pathNode ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
X.elContent Element
textNode]
       Element -> Maybe Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> Maybe Element) -> Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Element -> [Content] -> Element
setChildren Element
textNode [Content]
sub
    SvgNode Document
doc -> Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element) -> Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Document -> Element
xmlOfDocument Document
doc


isNotNone :: Tree -> Bool
isNotNone :: Tree -> Bool
isNotNone Tree
None = Bool
False
isNotNone Tree
_ = Bool
True

instance XMLUpdatable Group where
  xmlTagName :: Group -> String
xmlTagName Group
_ = String
"g"
  serializeTreeNode :: Group -> Maybe Element
serializeTreeNode Group
node =
     (Group -> [Tree]) -> Group -> Maybe Element -> Maybe Element
forall b a.
XMLUpdatable b =>
(a -> [b]) -> a -> Maybe Element -> Maybe Element
updateWithAccessor ((Tree -> Bool) -> [Tree] -> [Tree]
forall a. (a -> Bool) -> [a] -> [a]
filter Tree -> Bool
isNotNone ([Tree] -> [Tree]) -> (Group -> [Tree]) -> Group -> [Tree]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Group -> [Tree]
_groupChildren) Group
node (Maybe Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$
        Group -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr Group
node
  attributes :: [SvgAttributeLens Group]
attributes =
     [String
"viewBox" String
-> Lens' Group (Maybe (Double, Double, Double, Double))
-> SvgAttributeLens Group
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Group (Maybe (Double, Double, Double, Double))
groupViewBox
     ,String
"preserveAspectRatio" String -> Lens' Group PreserveAspectRatio -> SvgAttributeLens Group
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Group PreserveAspectRatio
groupAspectRatio
     ]

instance XMLUpdatable Filter where
  xmlTagName :: Filter -> String
xmlTagName Filter
_ = String
"filter"
  serializeTreeNode :: Filter -> Maybe Element
serializeTreeNode Filter
node =
     (Filter -> [FilterElement])
-> Filter -> Maybe Element -> Maybe Element
forall b a.
XMLUpdatable b =>
(a -> [b]) -> a -> Maybe Element -> Maybe Element
updateWithAccessor Filter -> [FilterElement]
_filterChildren Filter
node (Maybe Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$
        Filter -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr Filter
node
  attributes :: [SvgAttributeLens Filter]
attributes =
    [ String
"width" String -> Lens' Filter (Maybe Number) -> SvgAttributeLens Filter
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasFilterAttributes c => Lens' c (Maybe Number)
Lens' Filter (Maybe Number)
filterWidth
    , String
"height" String -> Lens' Filter (Maybe Number) -> SvgAttributeLens Filter
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasFilterAttributes c => Lens' c (Maybe Number)
Lens' Filter (Maybe Number)
filterHeight
    , String
"x" String -> Lens' Filter (Maybe Number) -> SvgAttributeLens Filter
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasFilterAttributes c => Lens' c (Maybe Number)
Lens' Filter (Maybe Number)
filterX
    , String
"y" String -> Lens' Filter (Maybe Number) -> SvgAttributeLens Filter
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` forall c. HasFilterAttributes c => Lens' c (Maybe Number)
Lens' Filter (Maybe Number)
filterY ]

instance XMLUpdatable FilterElement where
  xmlTagName :: FilterElement -> String
xmlTagName FilterElement
_ = String
"FilterElement"
  serializeTreeNode :: FilterElement -> Maybe Element
serializeTreeNode FilterElement
fe = (Element -> Element -> Element) -> Element -> Element -> Element
forall a b c. (a -> b -> c) -> b -> a -> c
flip Element -> Element -> Element
mergeAttributes (Element -> Element -> Element)
-> Maybe Element -> Maybe (Element -> Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilterElement -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
genericSerializeNode FilterElement
fe Maybe (Element -> Element) -> Maybe Element -> Maybe Element
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    case FilterElement
fe of
      FEBlend Blend
b             -> Blend -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Blend
b
      FEColorMatrix ColorMatrix
m       -> ColorMatrix -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode ColorMatrix
m
      FEComposite Composite
c         -> Composite -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Composite
c
      FEGaussianBlur GaussianBlur
b      -> GaussianBlur -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode GaussianBlur
b
      FETurbulence Turbulence
t        -> Turbulence -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Turbulence
t
      FEDisplacementMap DisplacementMap
d   -> DisplacementMap -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode DisplacementMap
d
      FETile Tile
t              -> Tile -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Tile
t
      FEFlood Flood
f             -> Flood -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Flood
f
      FEOffset Offset
o            -> Offset -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Offset
o
      FEMerge Merge
m             -> Merge -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Merge
m
      FEMergeNode MergeNode
n         -> MergeNode -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode MergeNode
n
      FEImage ImageF
i             -> ImageF -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode ImageF
i
      FEComponentTransfer ComponentTransfer
f -> ComponentTransfer -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode ComponentTransfer
f
      FEFuncA FuncA
f             -> FuncA -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode FuncA
f
      FEFuncR FuncR
f             -> FuncR -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode FuncR
f
      FEFuncG FuncG
f             -> FuncG -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode FuncG
f
      FEFuncB FuncB
f             -> FuncB -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode FuncB
f
      FESpecularLighting SpecularLighting
s  -> SpecularLighting -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode SpecularLighting
s
      FEConvolveMatrix ConvolveMatrix
c    -> ConvolveMatrix -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode ConvolveMatrix
c
      FEDiffuseLighting DiffuseLighting
d   -> DiffuseLighting -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode DiffuseLighting
d
      FEMorphology Morphology
m        -> Morphology -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Morphology
m
      FEDropShadow DropShadow
d        -> DropShadow -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode DropShadow
d
      FilterElement
_                     -> String -> Maybe Element
forall a. HasCallStack => String -> a
error (String -> Maybe Element) -> String -> Maybe Element
forall a b. (a -> b) -> a -> b
$
        String
"Unsupported element: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FilterElement -> String
forall a. Show a => a -> String
show FilterElement
fe String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Please submit bug on github."
  attributes :: [SvgAttributeLens FilterElement]
attributes =
    [ String
"result" String
-> Lens' FilterElement (Maybe String)
-> SvgAttributeLens FilterElement
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((FilterAttributes -> f FilterAttributes)
-> FilterElement -> f FilterElement
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> f FilterAttributes)
 -> FilterElement -> f FilterElement)
-> ((Maybe String -> f (Maybe String))
    -> FilterAttributes -> f FilterAttributes)
-> (Maybe String -> f (Maybe String))
-> FilterElement
-> f FilterElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String -> f (Maybe String))
-> FilterAttributes -> f FilterAttributes
forall c. HasFilterAttributes c => Lens' c (Maybe String)
filterResult)]

instance XMLUpdatable ConvolveMatrix where
  xmlTagName :: ConvolveMatrix -> String
xmlTagName ConvolveMatrix
_ = String
"feConvolveMatrix"
  serializeTreeNode :: ConvolveMatrix -> Maybe Element
serializeTreeNode = ConvolveMatrix -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens ConvolveMatrix]
attributes =
    [ String
"in" String
-> Lens' ConvolveMatrix (Maybe FilterSource)
-> SvgAttributeLens ConvolveMatrix
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ConvolveMatrix (Maybe FilterSource)
convolveMatrixIn,
      String
"order" String
-> Lens' ConvolveMatrix NumberOptionalNumber
-> SvgAttributeLens ConvolveMatrix
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ConvolveMatrix NumberOptionalNumber
convolveMatrixOrder,
      String
"kernelMatrix" String
-> Lens' ConvolveMatrix [Double] -> SvgAttributeLens ConvolveMatrix
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ConvolveMatrix [Double]
convolveMatrixKernelMatrix,
      String
"divisor" String
-> Lens' ConvolveMatrix Double -> SvgAttributeLens ConvolveMatrix
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ConvolveMatrix Double
convolveMatrixDivisor,
      String
"bias" String
-> Lens' ConvolveMatrix Double -> SvgAttributeLens ConvolveMatrix
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ConvolveMatrix Double
convolveMatrixBias,
      String
"targetX" String
-> Lens' ConvolveMatrix Int -> SvgAttributeLens ConvolveMatrix
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ConvolveMatrix Int
convolveMatrixTargetX,
      String
"targetY" String
-> Lens' ConvolveMatrix Int -> SvgAttributeLens ConvolveMatrix
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ConvolveMatrix Int
convolveMatrixTargetY,
      String
"edgeMode" String
-> Lens' ConvolveMatrix EdgeMode -> SvgAttributeLens ConvolveMatrix
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ConvolveMatrix EdgeMode
convolveMatrixEdgeMode,
      String
"preserveAlpha" String
-> Lens' ConvolveMatrix Bool -> SvgAttributeLens ConvolveMatrix
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ConvolveMatrix Bool
convolveMatrixPreserveAlpha ]

instance XMLUpdatable SpecularLighting where
  xmlTagName :: SpecularLighting -> String
xmlTagName SpecularLighting
_ = String
"feSpecularLighting"
  serializeTreeNode :: SpecularLighting -> Maybe Element
serializeTreeNode = SpecularLighting -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens SpecularLighting]
attributes =
    [ String
"in" String
-> Lens' SpecularLighting (Maybe FilterSource)
-> SvgAttributeLens SpecularLighting
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' SpecularLighting (Maybe FilterSource)
specLightingIn,
      String
"surfaceScale" String
-> Lens' SpecularLighting Double
-> SvgAttributeLens SpecularLighting
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' SpecularLighting Double
specLightingSurfaceScale,
      String
"specularConstant" String
-> Lens' SpecularLighting Double
-> SvgAttributeLens SpecularLighting
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' SpecularLighting Double
specLightingSpecularConst,
      String
"specularExponent" String
-> Lens' SpecularLighting Double
-> SvgAttributeLens SpecularLighting
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' SpecularLighting Double
specLightingSpecularExp,
      String
"kernelUnitLength" String
-> Lens' SpecularLighting NumberOptionalNumber
-> SvgAttributeLens SpecularLighting
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' SpecularLighting NumberOptionalNumber
specLightingKernelUnitLength ]

instance XMLUpdatable DiffuseLighting where
  xmlTagName :: DiffuseLighting -> String
xmlTagName DiffuseLighting
_ = String
"feDiffuseLighting"
  serializeTreeNode :: DiffuseLighting -> Maybe Element
serializeTreeNode = DiffuseLighting -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens DiffuseLighting]
attributes =
    [ String
"in" String
-> Lens' DiffuseLighting (Maybe FilterSource)
-> SvgAttributeLens DiffuseLighting
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' DiffuseLighting (Maybe FilterSource)
diffuseLightingIn,
      String
"surfaceScale" String
-> Lens' DiffuseLighting Double -> SvgAttributeLens DiffuseLighting
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' DiffuseLighting Double
diffuseLightingSurfaceScale,
      String
"diffuseConstant" String
-> Lens' DiffuseLighting Double -> SvgAttributeLens DiffuseLighting
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' DiffuseLighting Double
diffuseLightingDiffuseConst,
      String
"kernelUnitLength" String
-> Lens' DiffuseLighting NumberOptionalNumber
-> SvgAttributeLens DiffuseLighting
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' DiffuseLighting NumberOptionalNumber
diffuseLightingKernelUnitLength]

instance XMLUpdatable Morphology where
  xmlTagName :: Morphology -> String
xmlTagName Morphology
_ = String
"feMorphology"
  serializeTreeNode :: Morphology -> Maybe Element
serializeTreeNode = Morphology -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Morphology]
attributes =
    [ String
"in" String
-> Lens' Morphology (Maybe FilterSource)
-> SvgAttributeLens Morphology
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Morphology (Maybe FilterSource)
morphologyIn,
      String
"operator" String
-> Lens' Morphology OperatorType -> SvgAttributeLens Morphology
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Morphology OperatorType
morphologyOperator,
      String
"radius" String
-> Lens' Morphology NumberOptionalNumber
-> SvgAttributeLens Morphology
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Morphology NumberOptionalNumber
morphologyRadius ]

instance XMLUpdatable DropShadow where
  xmlTagName :: DropShadow -> String
xmlTagName DropShadow
_ = String
"feDropShadow"
  serializeTreeNode :: DropShadow -> Maybe Element
serializeTreeNode = DropShadow -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens DropShadow]
attributes =
    [ String
"dx" String -> Lens' DropShadow Double -> SvgAttributeLens DropShadow
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' DropShadow Double
dropShadowDx,
      String
"dy" String -> Lens' DropShadow Double -> SvgAttributeLens DropShadow
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' DropShadow Double
dropShadowDy,
      String
"stdDeviation" String
-> Lens' DropShadow NumberOptionalNumber
-> SvgAttributeLens DropShadow
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' DropShadow NumberOptionalNumber
dropShadowStdDeviation ]

instance XMLUpdatable Blend where
  xmlTagName :: Blend -> String
xmlTagName Blend
_ = String
"feBlend"
  serializeTreeNode :: Blend -> Maybe Element
serializeTreeNode = Blend -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Blend]
attributes =
    [ String
"in" String
-> Lens' Blend (Maybe FilterSource) -> SvgAttributeLens Blend
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Blend (Maybe FilterSource)
blendIn
    , String
"in2" String
-> Lens' Blend (Maybe FilterSource) -> SvgAttributeLens Blend
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Blend (Maybe FilterSource)
blendIn2
    , String
"mode"  String -> Lens' Blend BlendMode -> SvgAttributeLens Blend
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Blend BlendMode
blendMode ]

instance XMLUpdatable FuncA where
  xmlTagName :: FuncA -> String
xmlTagName FuncA
_ = String
"feFuncA"
  serializeTreeNode :: FuncA -> Maybe Element
serializeTreeNode = FuncA -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens FuncA]
attributes =
    [ String
"type" String -> Lens' FuncA FuncType -> SvgAttributeLens FuncA
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncA FuncType
funcAType
    , String
"tableValues" String -> Lens' FuncA [Number] -> SvgAttributeLens FuncA
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncA [Number]
funcATableValues
    , String
"slope" String -> Lens' FuncA Number -> SvgAttributeLens FuncA
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncA Number
funcASlope
    , String
"intercept" String -> Lens' FuncA Number -> SvgAttributeLens FuncA
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncA Number
funcAIntercept
    , String
"amplitude" String -> Lens' FuncA Number -> SvgAttributeLens FuncA
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncA Number
funcAAmplitude
    , String
"exponent" String -> Lens' FuncA Number -> SvgAttributeLens FuncA
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncA Number
funcAExponent ]

instance XMLUpdatable FuncR where
  xmlTagName :: FuncR -> String
xmlTagName FuncR
_ = String
"feFuncR"
  serializeTreeNode :: FuncR -> Maybe Element
serializeTreeNode = FuncR -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens FuncR]
attributes =
    [ String
"type" String -> Lens' FuncR FuncType -> SvgAttributeLens FuncR
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncR FuncType
funcRType
    , String
"tableValues" String -> Lens' FuncR [Number] -> SvgAttributeLens FuncR
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncR [Number]
funcRTableValues
    , String
"slope" String -> Lens' FuncR Number -> SvgAttributeLens FuncR
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncR Number
funcRSlope
    , String
"intercept" String -> Lens' FuncR Number -> SvgAttributeLens FuncR
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncR Number
funcRIntercept
    , String
"amplitude" String -> Lens' FuncR Number -> SvgAttributeLens FuncR
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncR Number
funcRAmplitude
    , String
"exponent" String -> Lens' FuncR Number -> SvgAttributeLens FuncR
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncR Number
funcRExponent ]

instance XMLUpdatable FuncG where
  xmlTagName :: FuncG -> String
xmlTagName FuncG
_ = String
"feFuncG"
  serializeTreeNode :: FuncG -> Maybe Element
serializeTreeNode = FuncG -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens FuncG]
attributes =
    [ String
"type" String -> Lens' FuncG FuncType -> SvgAttributeLens FuncG
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncG FuncType
funcGType
    , String
"tableValues" String -> Lens' FuncG [Number] -> SvgAttributeLens FuncG
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncG [Number]
funcGTableValues
    , String
"slope" String -> Lens' FuncG Number -> SvgAttributeLens FuncG
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncG Number
funcGSlope
    , String
"intercept" String -> Lens' FuncG Number -> SvgAttributeLens FuncG
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncG Number
funcGIntercept
    , String
"amplitude" String -> Lens' FuncG Number -> SvgAttributeLens FuncG
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncG Number
funcGAmplitude
    , String
"exponent" String -> Lens' FuncG Number -> SvgAttributeLens FuncG
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncG Number
funcGExponent ]

instance XMLUpdatable FuncB where
  xmlTagName :: FuncB -> String
xmlTagName FuncB
_ = String
"feFuncB"
  serializeTreeNode :: FuncB -> Maybe Element
serializeTreeNode = FuncB -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens FuncB]
attributes =
    [ String
"type" String -> Lens' FuncB FuncType -> SvgAttributeLens FuncB
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncB FuncType
funcBType
    , String
"tableValues" String -> Lens' FuncB [Number] -> SvgAttributeLens FuncB
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncB [Number]
funcBTableValues
    , String
"slope" String -> Lens' FuncB Number -> SvgAttributeLens FuncB
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncB Number
funcBSlope
    , String
"intercept" String -> Lens' FuncB Number -> SvgAttributeLens FuncB
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncB Number
funcBIntercept
    , String
"amplitude" String -> Lens' FuncB Number -> SvgAttributeLens FuncB
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncB Number
funcBAmplitude
    , String
"exponent" String -> Lens' FuncB Number -> SvgAttributeLens FuncB
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' FuncB Number
funcBExponent ]

instance XMLUpdatable Flood where
  xmlTagName :: Flood -> String
xmlTagName Flood
_ = String
"feFlood"
  serializeTreeNode :: Flood -> Maybe Element
serializeTreeNode = Flood -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Flood]
attributes =
    [ String
"flood-color" String -> Lens' Flood PixelRGBA8 -> SvgAttributeLens Flood
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Flood PixelRGBA8
floodColor
    , String
"flood-opacity" String -> Lens' Flood (Maybe Double) -> SvgAttributeLens Flood
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Flood (Maybe Double)
floodOpacity]

instance XMLUpdatable Tile where
  xmlTagName :: Tile -> String
xmlTagName Tile
_ = String
"feTile"
  serializeTreeNode :: Tile -> Maybe Element
serializeTreeNode = Tile -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Tile]
attributes =
    [ String
"in" String -> Lens' Tile (Maybe FilterSource) -> SvgAttributeLens Tile
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Tile (Maybe FilterSource)
tileIn]

instance XMLUpdatable Offset where
  xmlTagName :: Offset -> String
xmlTagName Offset
_ = String
"feOffset"
  serializeTreeNode :: Offset -> Maybe Element
serializeTreeNode = Offset -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Offset]
attributes =
    [ String
"in" String
-> Lens' Offset (Maybe FilterSource) -> SvgAttributeLens Offset
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Offset (Maybe FilterSource)
offsetIn
    , String
"dx" String -> Lens' Offset Number -> SvgAttributeLens Offset
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Offset Number
offsetDX
    , String
"dy" String -> Lens' Offset Number -> SvgAttributeLens Offset
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Offset Number
offsetDY ]

instance XMLUpdatable Merge where
  xmlTagName :: Merge -> String
xmlTagName Merge
_ = String
"feMerge"
  serializeTreeNode :: Merge -> Maybe Element
serializeTreeNode Merge
node =
     (Merge -> [FilterElement])
-> Merge -> Maybe Element -> Maybe Element
forall b a.
XMLUpdatable b =>
(a -> [b]) -> a -> Maybe Element -> Maybe Element
updateWithAccessor Merge -> [FilterElement]
_mergeChildren Merge
node (Maybe Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$
        Merge -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr Merge
node
  attributes :: [SvgAttributeLens Merge]
attributes = []

instance XMLUpdatable ComponentTransfer where
  xmlTagName :: ComponentTransfer -> String
xmlTagName ComponentTransfer
_ = String
"feComponentTransfer"
  serializeTreeNode :: ComponentTransfer -> Maybe Element
serializeTreeNode ComponentTransfer
node =
     (ComponentTransfer -> [FilterElement])
-> ComponentTransfer -> Maybe Element -> Maybe Element
forall b a.
XMLUpdatable b =>
(a -> [b]) -> a -> Maybe Element -> Maybe Element
updateWithAccessor ComponentTransfer -> [FilterElement]
_compTransferChildren ComponentTransfer
node (Maybe Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$
        ComponentTransfer -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr ComponentTransfer
node
  attributes :: [SvgAttributeLens ComponentTransfer]
attributes =
    [ String
"in" String
-> Lens' ComponentTransfer (Maybe FilterSource)
-> SvgAttributeLens ComponentTransfer
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ComponentTransfer (Maybe FilterSource)
compTransferIn ]


instance XMLUpdatable MergeNode where
  xmlTagName :: MergeNode -> String
xmlTagName MergeNode
_ = String
"feMergeNode"
  serializeTreeNode :: MergeNode -> Maybe Element
serializeTreeNode = MergeNode -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens MergeNode]
attributes =
    [ String
"in" String
-> Lens' MergeNode (Maybe FilterSource)
-> SvgAttributeLens MergeNode
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' MergeNode (Maybe FilterSource)
mergeNodeIn ]

instance XMLUpdatable ImageF where
  xmlTagName :: ImageF -> String
xmlTagName ImageF
_ = String
"feImage"
  serializeTreeNode :: ImageF -> Maybe Element
serializeTreeNode = ImageF -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens ImageF]
attributes =
    [ --parserSetter "href" imageFHref (Just . dropSharp) Just
      String
"href" String -> Lens' ImageF String -> SvgAttributeLens ImageF
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ImageF String
imageFHref
    , String
"preserveAspectRatio" String
-> Lens' ImageF PreserveAspectRatio -> SvgAttributeLens ImageF
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ImageF PreserveAspectRatio
imageFAspectRatio
    ]

instance XMLUpdatable ColorMatrix where
  xmlTagName :: ColorMatrix -> String
xmlTagName ColorMatrix
_ = String
"feColorMatrix"
  serializeTreeNode :: ColorMatrix -> Maybe Element
serializeTreeNode = ColorMatrix -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens ColorMatrix]
attributes =
    [ String
"in" String
-> Lens' ColorMatrix (Maybe FilterSource)
-> SvgAttributeLens ColorMatrix
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ColorMatrix (Maybe FilterSource)
colorMatrixIn
    , String
"type" String
-> Lens' ColorMatrix ColorMatrixType
-> SvgAttributeLens ColorMatrix
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ColorMatrix ColorMatrixType
colorMatrixType
    , String
"values" String -> Lens' ColorMatrix String -> SvgAttributeLens ColorMatrix
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' ColorMatrix String
colorMatrixValues ]

instance XMLUpdatable Composite where
  xmlTagName :: Composite -> String
xmlTagName Composite
_ = String
"feComposite"
  serializeTreeNode :: Composite -> Maybe Element
serializeTreeNode = Composite -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Composite]
attributes =
    [ String
"in" String
-> Lens' Composite (Maybe FilterSource)
-> SvgAttributeLens Composite
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Composite (Maybe FilterSource)
compositeIn
    , String
"in2" String
-> Lens' Composite (Maybe FilterSource)
-> SvgAttributeLens Composite
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Composite (Maybe FilterSource)
compositeIn2
    , String
"operator" String
-> Lens' Composite CompositeOperator -> SvgAttributeLens Composite
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Composite CompositeOperator
compositeOperator
    , String
"k1" String -> Lens' Composite Number -> SvgAttributeLens Composite
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Composite Number
compositeK1
    , String
"k2" String -> Lens' Composite Number -> SvgAttributeLens Composite
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Composite Number
compositeK2
    , String
"k3" String -> Lens' Composite Number -> SvgAttributeLens Composite
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Composite Number
compositeK3
    , String
"k4" String -> Lens' Composite Number -> SvgAttributeLens Composite
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Composite Number
compositeK4 ]

instance XMLUpdatable GaussianBlur where
  xmlTagName :: GaussianBlur -> String
xmlTagName GaussianBlur
_ = String
"feGaussianBlur"
  serializeTreeNode :: GaussianBlur -> Maybe Element
serializeTreeNode = GaussianBlur -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens GaussianBlur]
attributes =
    [ String
"in" String
-> Lens' GaussianBlur (Maybe FilterSource)
-> SvgAttributeLens GaussianBlur
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' GaussianBlur (Maybe FilterSource)
gaussianBlurIn
    , String
"stdDeviation" String
-> Lens' GaussianBlur (Number, Maybe Number)
-> SvgAttributeLens GaussianBlur
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ALens' GaussianBlur Number
-> ALens' GaussianBlur (Maybe Number)
-> Lens' GaussianBlur (Number, Maybe Number)
forall s a b. ALens' s a -> ALens' s b -> Lens' s (a, b)
lensProduct ALens' GaussianBlur Number
Lens' GaussianBlur Number
gaussianBlurStdDeviationX ALens' GaussianBlur (Maybe Number)
Lens' GaussianBlur (Maybe Number)
gaussianBlurStdDeviationY
    , String
"edgeMode" String
-> Lens' GaussianBlur EdgeMode -> SvgAttributeLens GaussianBlur
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' GaussianBlur EdgeMode
gaussianBlurEdgeMode ]

instance XMLUpdatable DisplacementMap where
  xmlTagName :: DisplacementMap -> String
xmlTagName DisplacementMap
_ = String
"feDisplacementMap"
  serializeTreeNode :: DisplacementMap -> Maybe Element
serializeTreeNode = DisplacementMap -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens DisplacementMap]
attributes =
    [ String
"in" String
-> Lens' DisplacementMap (Maybe FilterSource)
-> SvgAttributeLens DisplacementMap
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' DisplacementMap (Maybe FilterSource)
displacementMapIn
    , String
"in2" String
-> Lens' DisplacementMap (Maybe FilterSource)
-> SvgAttributeLens DisplacementMap
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' DisplacementMap (Maybe FilterSource)
displacementMapIn2
    , String
"scale" String
-> Lens' DisplacementMap (Maybe Double)
-> SvgAttributeLens DisplacementMap
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' DisplacementMap (Maybe Double)
displacementMapScale
    , String
"xChannelSelector" String
-> Lens' DisplacementMap ChannelSelector
-> SvgAttributeLens DisplacementMap
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' DisplacementMap ChannelSelector
displacementMapXChannelSelector
    , String
"yChannelSelector" String
-> Lens' DisplacementMap ChannelSelector
-> SvgAttributeLens DisplacementMap
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' DisplacementMap ChannelSelector
displacementMapYChannelSelector ]

instance XMLUpdatable Turbulence where
  xmlTagName :: Turbulence -> String
xmlTagName Turbulence
_ = String
"feTurbulence"
  serializeTreeNode :: Turbulence -> Maybe Element
serializeTreeNode = Turbulence -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Turbulence]
attributes =
    [ String
"baseFrequency" String
-> Lens' Turbulence (Double, Maybe Double)
-> SvgAttributeLens Turbulence
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Turbulence (Double, Maybe Double)
turbulenceBaseFrequency
    , String
"numOctaves" String -> Lens' Turbulence Int -> SvgAttributeLens Turbulence
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Turbulence Int
turbulenceNumOctaves
    , String
"seed" String -> Lens' Turbulence Double -> SvgAttributeLens Turbulence
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Turbulence Double
turbulenceSeed
    , String
"stitchTiles" String
-> Lens' Turbulence StitchTiles -> SvgAttributeLens Turbulence
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Turbulence StitchTiles
turbulenceStitchTiles
    , String
"type" String
-> Lens' Turbulence TurbulenceType -> SvgAttributeLens Turbulence
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Turbulence TurbulenceType
turbulenceType ]

instance XMLUpdatable RadialGradient where
  xmlTagName :: RadialGradient -> String
xmlTagName RadialGradient
_ = String
"radialGradient"
  serializeTreeNode :: RadialGradient -> Maybe Element
serializeTreeNode RadialGradient
node =
     (RadialGradient -> [GradientStop])
-> RadialGradient -> Maybe Element -> Maybe Element
forall b a.
XMLUpdatable b =>
(a -> [b]) -> a -> Maybe Element -> Maybe Element
updateWithAccessor RadialGradient -> [GradientStop]
_radialGradientStops RadialGradient
node (Maybe Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ RadialGradient -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
genericSerializeNode RadialGradient
node
  attributes :: [SvgAttributeLens RadialGradient]
attributes =
    [String
"gradientTransform" String
-> Lens' RadialGradient [Transformation]
-> SvgAttributeLens RadialGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' RadialGradient [Transformation]
radialGradientTransform
    ,String
"gradientUnits" String
-> Lens' RadialGradient CoordinateUnits
-> SvgAttributeLens RadialGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' RadialGradient CoordinateUnits
radialGradientUnits
    ,String
"spreadMethod" String
-> Lens' RadialGradient Spread -> SvgAttributeLens RadialGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' RadialGradient Spread
radialGradientSpread
    ,String
"cx" String
-> Lens' RadialGradient Number -> SvgAttributeLens RadialGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> RadialGradient -> f RadialGradient
Lens' RadialGradient Point
radialGradientCenter((Point -> f Point) -> RadialGradient -> f RadialGradient)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> RadialGradient
-> f RadialGradient
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    ,String
"cy" String
-> Lens' RadialGradient Number -> SvgAttributeLens RadialGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> RadialGradient -> f RadialGradient
Lens' RadialGradient Point
radialGradientCenter((Point -> f Point) -> RadialGradient -> f RadialGradient)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> RadialGradient
-> f RadialGradient
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field2 s t a b => Lens s t a b
_2)
    ,String
"r"  String
-> Lens' RadialGradient Number -> SvgAttributeLens RadialGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' RadialGradient Number
radialGradientRadius
    ,String
"fx" String
-> Lens' RadialGradient (Maybe Number)
-> SvgAttributeLens RadialGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' RadialGradient (Maybe Number)
radialGradientFocusX
    ,String
"fy" String
-> Lens' RadialGradient (Maybe Number)
-> SvgAttributeLens RadialGradient
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' RadialGradient (Maybe Number)
radialGradientFocusY
    ]

instance XMLUpdatable Use where
  xmlTagName :: Use -> String
xmlTagName Use
_ = String
"use"
  serializeTreeNode :: Use -> Maybe Element
serializeTreeNode = Use -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr
  attributes :: [SvgAttributeLens Use]
attributes =
    [String
"x" String -> Lens' Use Number -> SvgAttributeLens Use
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Use -> f Use
Lens' Use Point
useBase((Point -> f Point) -> Use -> f Use)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Use
-> f Use
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    ,String
"y" String -> Lens' Use Number -> SvgAttributeLens Use
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Use -> f Use
Lens' Use Point
useBase((Point -> f Point) -> Use -> f Use)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Use
-> f Use
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field2 s t a b => Lens s t a b
_2)
    ,String
"width" String -> Lens' Use (Maybe Number) -> SvgAttributeLens Use
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Use (Maybe Number)
useWidth
    ,String
"height" String -> Lens' Use (Maybe Number) -> SvgAttributeLens Use
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Use (Maybe Number)
useHeight
    ,String
-> Lens' Use String
-> (String -> Maybe String)
-> (String -> Maybe String)
-> SvgAttributeLens Use
forall a e.
String
-> Lens' a e
-> (String -> Maybe e)
-> Serializer e
-> SvgAttributeLens a
parserSetter String
"href" Lens' Use String
useName (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
dropSharp) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'#'Char -> ShowS
forall a. a -> [a] -> [a]
:))
    ]

dropSharp :: String -> String
dropSharp :: ShowS
dropSharp (Char
'#':String
rest) = String
rest
dropSharp String
a          = String
a

instance XMLUpdatable TextInfo where
  xmlTagName :: TextInfo -> String
xmlTagName TextInfo
_ = String
"tspan"
  serializeTreeNode :: TextInfo -> Maybe Element
serializeTreeNode = TextInfo -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
genericSerializeNode
  attributes :: [SvgAttributeLens TextInfo]
attributes =
    [String
-> Lens' TextInfo [Number]
-> (String -> Maybe [Number])
-> ([Number] -> Maybe String)
-> SvgAttributeLens TextInfo
forall a e.
String
-> Lens' a e
-> (String -> Maybe e)
-> Serializer e
-> SvgAttributeLens a
parserSetter String
"x" Lens' TextInfo [Number]
textInfoX (Parser [Number] -> String -> Maybe [Number]
forall a. Parser a -> String -> Maybe a
parse Parser [Number]
dashArray) [Number] -> Maybe String
dashNotEmpty
    ,String
-> Lens' TextInfo [Number]
-> (String -> Maybe [Number])
-> ([Number] -> Maybe String)
-> SvgAttributeLens TextInfo
forall a e.
String
-> Lens' a e
-> (String -> Maybe e)
-> Serializer e
-> SvgAttributeLens a
parserSetter String
"y" Lens' TextInfo [Number]
textInfoY (Parser [Number] -> String -> Maybe [Number]
forall a. Parser a -> String -> Maybe a
parse Parser [Number]
dashArray) [Number] -> Maybe String
dashNotEmpty
    ,String
-> Lens' TextInfo [Number]
-> (String -> Maybe [Number])
-> ([Number] -> Maybe String)
-> SvgAttributeLens TextInfo
forall a e.
String
-> Lens' a e
-> (String -> Maybe e)
-> Serializer e
-> SvgAttributeLens a
parserSetter String
"dx" Lens' TextInfo [Number]
textInfoDX (Parser [Number] -> String -> Maybe [Number]
forall a. Parser a -> String -> Maybe a
parse Parser [Number]
dashArray) [Number] -> Maybe String
dashNotEmpty
    ,String
-> Lens' TextInfo [Number]
-> (String -> Maybe [Number])
-> ([Number] -> Maybe String)
-> SvgAttributeLens TextInfo
forall a e.
String
-> Lens' a e
-> (String -> Maybe e)
-> Serializer e
-> SvgAttributeLens a
parserSetter String
"dy" Lens' TextInfo [Number]
textInfoDY (Parser [Number] -> String -> Maybe [Number]
forall a. Parser a -> String -> Maybe a
parse Parser [Number]
dashArray) [Number] -> Maybe String
dashNotEmpty
    ,String
-> Lens' TextInfo [Double]
-> (String -> Maybe [Double])
-> ([Double] -> Maybe String)
-> SvgAttributeLens TextInfo
forall a e.
String
-> Lens' a e
-> (String -> Maybe e)
-> Serializer e
-> SvgAttributeLens a
parserSetter String
"rotate" Lens' TextInfo [Double]
textInfoRotate
        (Parser [Double] -> String -> Maybe [Double]
forall a. Parser a -> String -> Maybe a
parse Parser [Double]
numberList)
        [Double] -> Maybe String
rotateNotEmpty
    ,String
"textLength" String
-> Lens' TextInfo (Maybe Number) -> SvgAttributeLens TextInfo
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' TextInfo (Maybe Number)
textInfoLength
    ]
    where
      dashNotEmpty :: [Number] -> Maybe String
dashNotEmpty []  = Maybe String
forall a. Maybe a
Nothing
      dashNotEmpty [Number]
lst = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [Number] -> String
serializeDashArray [Number]
lst

      rotateNotEmpty :: [Double] -> Maybe String
rotateNotEmpty [] = Maybe String
forall a. Maybe a
Nothing
      rotateNotEmpty [Double]
lst =
          String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([String] -> String) -> Serializer [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords Serializer [String] -> Serializer [String]
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%s" ShowS -> (Double -> String) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
ppD (Double -> String) -> [Double] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
lst


instance XMLUpdatable TextPath where
  xmlTagName :: TextPath -> String
xmlTagName TextPath
_ =  String
"textPath"
  serializeTreeNode :: TextPath -> Maybe Element
serializeTreeNode = TextPath -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
genericSerializeNode
  attributes :: [SvgAttributeLens TextPath]
attributes =
    [String
"startOffset" String -> Lens' TextPath Number -> SvgAttributeLens TextPath
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' TextPath Number
textPathStartOffset
    ,String
"method" String
-> Lens' TextPath TextPathMethod -> SvgAttributeLens TextPath
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' TextPath TextPathMethod
textPathMethod
    ,String
"spacing" String
-> Lens' TextPath TextPathSpacing -> SvgAttributeLens TextPath
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' TextPath TextPathSpacing
textPathSpacing
    ,String
-> Lens' TextPath String
-> (String -> Maybe String)
-> (String -> Maybe String)
-> SvgAttributeLens TextPath
forall a e.
String
-> Lens' a e
-> (String -> Maybe e)
-> Serializer e
-> SvgAttributeLens a
parserSetter String
"href" Lens' TextPath String
textPathName (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
dropSharp) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'#'Char -> ShowS
forall a. a -> [a] -> [a]
:))
    ]

instance XMLUpdatable Text where
  xmlTagName :: Text -> String
xmlTagName Text
_ = String
"text"
  serializeTreeNode :: Text -> Maybe Element
serializeTreeNode = Text -> Maybe Element
serializeText
  attributes :: [SvgAttributeLens Text]
attributes = [String
"lengthAdjust" String -> Lens' Text TextAdjust -> SvgAttributeLens Text
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Text TextAdjust
textAdjust]


instance XMLUpdatable Pattern where
  xmlTagName :: Pattern -> String
xmlTagName Pattern
_ = String
"pattern"
  serializeTreeNode :: Pattern -> Maybe Element
serializeTreeNode Pattern
node =
     (Pattern -> [Tree]) -> Pattern -> Maybe Element -> Maybe Element
forall b a.
XMLUpdatable b =>
(a -> [b]) -> a -> Maybe Element -> Maybe Element
updateWithAccessor Pattern -> [Tree]
_patternElements Pattern
node (Maybe Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Pattern -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr Pattern
node
  attributes :: [SvgAttributeLens Pattern]
attributes =
    [String
"viewBox" String
-> Lens' Pattern (Maybe (Double, Double, Double, Double))
-> SvgAttributeLens Pattern
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Pattern (Maybe (Double, Double, Double, Double))
patternViewBox
    ,String
"patternUnits" String -> Lens' Pattern CoordinateUnits -> SvgAttributeLens Pattern
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Pattern CoordinateUnits
patternUnit
    ,String
"width" String -> Lens' Pattern Number -> SvgAttributeLens Pattern
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Pattern Number
patternWidth
    ,String
"height" String -> Lens' Pattern Number -> SvgAttributeLens Pattern
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Pattern Number
patternHeight
    ,String
"x" String -> Lens' Pattern Number -> SvgAttributeLens Pattern
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Pattern -> f Pattern
Lens' Pattern Point
patternPos((Point -> f Point) -> Pattern -> f Pattern)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Pattern
-> f Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    ,String
"y" String -> Lens' Pattern Number -> SvgAttributeLens Pattern
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Pattern -> f Pattern
Lens' Pattern Point
patternPos((Point -> f Point) -> Pattern -> f Pattern)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Pattern
-> f Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field2 s t a b => Lens s t a b
_2)
    ,String
"preserveAspectRatio" String
-> Lens' Pattern PreserveAspectRatio -> SvgAttributeLens Pattern
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Pattern PreserveAspectRatio
patternAspectRatio
    ,String
-> Lens' Pattern String
-> (String -> Maybe String)
-> (String -> Maybe String)
-> SvgAttributeLens Pattern
forall a e.
String
-> Lens' a e
-> (String -> Maybe e)
-> Serializer e
-> SvgAttributeLens a
parserSetter String
"href" Lens' Pattern String
patternHref (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
dropSharp) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> ShowS -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'#'Char -> ShowS
forall a. a -> [a] -> [a]
:))
    ,String
"patternTransform" String
-> Lens' Pattern (Maybe [Transformation])
-> SvgAttributeLens Pattern
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Pattern (Maybe [Transformation])
patternTransform
    ]

instance XMLUpdatable Marker where
  xmlTagName :: Marker -> String
xmlTagName Marker
_ = String
"marker"
  serializeTreeNode :: Marker -> Maybe Element
serializeTreeNode Marker
node =
     (Marker -> [Tree]) -> Marker -> Maybe Element -> Maybe Element
forall b a.
XMLUpdatable b =>
(a -> [b]) -> a -> Maybe Element -> Maybe Element
updateWithAccessor Marker -> [Tree]
_markerElements Marker
node (Maybe Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Marker -> Maybe Element
forall treeNode.
(XMLUpdatable treeNode, HasDrawAttributes treeNode) =>
treeNode -> Maybe Element
genericSerializeWithDrawAttr Marker
node
  attributes :: [SvgAttributeLens Marker]
attributes =
    [String
"refX" String -> Lens' Marker Number -> SvgAttributeLens Marker
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Marker -> f Marker
Lens' Marker Point
markerRefPoint((Point -> f Point) -> Marker -> f Marker)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Marker
-> f Marker
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    ,String
"refY" String -> Lens' Marker Number -> SvgAttributeLens Marker
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` ((Point -> f Point) -> Marker -> f Marker
Lens' Marker Point
markerRefPoint((Point -> f Point) -> Marker -> f Marker)
-> ((Number -> f Number) -> Point -> f Point)
-> (Number -> f Number)
-> Marker
-> f Marker
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Number -> f Number) -> Point -> f Point
forall s t a b. Field2 s t a b => Lens s t a b
_2)
    ,String
"markerWidth" String -> Lens' Marker (Maybe Number) -> SvgAttributeLens Marker
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Marker (Maybe Number)
markerWidth
    ,String
"markerHeight" String -> Lens' Marker (Maybe Number) -> SvgAttributeLens Marker
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Marker (Maybe Number)
markerHeight
    ,String
"patternUnits" String
-> Lens' Marker (Maybe MarkerUnit) -> SvgAttributeLens Marker
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Marker (Maybe MarkerUnit)
markerUnits
    ,String
"orient" String
-> Lens' Marker (Maybe MarkerOrientation)
-> SvgAttributeLens Marker
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Marker (Maybe MarkerOrientation)
markerOrient
    ,String
"viewBox" String
-> Lens' Marker (Maybe (Double, Double, Double, Double))
-> SvgAttributeLens Marker
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Marker (Maybe (Double, Double, Double, Double))
markerViewBox
    ,String
"overflow" String -> Lens' Marker (Maybe Overflow) -> SvgAttributeLens Marker
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Marker (Maybe Overflow)
markerOverflow
    ,String
"preserveAspectRatio" String
-> Lens' Marker PreserveAspectRatio -> SvgAttributeLens Marker
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' Marker PreserveAspectRatio
markerAspectRatio
    ]

serializeText :: Text -> Maybe X.Element
serializeText :: Text -> Maybe Element
serializeText Text
topText = Maybe Element
namedNode where
  namedNode :: Maybe Element
namedNode = (Element -> Element) -> Maybe Element -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Element
x -> Element
x { elName :: QName
X.elName = String -> QName
X.unqual String
"text" }) Maybe Element
topNode
  topNode :: Maybe Element
topNode = TextSpan -> Maybe Element
serializeSpan (TextSpan -> Maybe Element) -> TextSpan -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Text -> TextSpan
_textRoot Text
topText

  serializeSpan :: TextSpan -> Maybe Element
serializeSpan TextSpan
tspan = case (Maybe Element
info, Maybe Element
drawInfo) of
    (Maybe Element
Nothing, Maybe Element
Nothing) -> Maybe Element
forall a. Maybe a
Nothing
    (Just Element
a, Maybe Element
Nothing) -> Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element) -> Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Element -> [Content] -> Element
setChildren Element
a [Content]
subContent
    (Maybe Element
Nothing, Just Element
b) -> Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element) -> Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Element -> [Content] -> Element
setChildren Element
b [Content]
subContent
    (Just Element
a, Just Element
b) ->
        Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element) -> Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Element -> [Content] -> Element
setChildren (Element -> Element -> Element
mergeAttributes Element
a Element
b) [Content]
subContent
    where
      info :: Maybe Element
info = TextInfo -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
genericSerializeNode (TextInfo -> Maybe Element) -> TextInfo -> Maybe Element
forall a b. (a -> b) -> a -> b
$ TextSpan -> TextInfo
_spanInfo TextSpan
tspan
      drawInfo :: Maybe Element
drawInfo = DrawAttributes -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
genericSerializeNode (DrawAttributes -> Maybe Element)
-> DrawAttributes -> Maybe Element
forall a b. (a -> b) -> a -> b
$ TextSpan -> DrawAttributes
_spanDrawAttributes TextSpan
tspan
      subContent :: [Content]
subContent = [Maybe Content] -> [Content]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Content] -> [Content]) -> [Maybe Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ TextSpanContent -> Maybe Content
serializeContent (TextSpanContent -> Maybe Content)
-> [TextSpanContent] -> [Maybe Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextSpan -> [TextSpanContent]
_spanContent TextSpan
tspan

  serializeContent :: TextSpanContent -> Maybe Content
serializeContent (SpanText Text
t) = Content -> Maybe Content
forall a. a -> Maybe a
Just (Content -> Maybe Content)
-> (CData -> Content) -> CData -> Maybe Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CData -> Content
X.Text (CData -> Maybe Content) -> CData -> Maybe Content
forall a b. (a -> b) -> a -> b
$ CData
X.blank_cdata { cdData :: String
X.cdData = Text -> String
T.unpack Text
t }
  serializeContent (SpanTextRef String
_t) = Content -> Maybe Content
forall a. a -> Maybe a
Just (Content -> Maybe Content)
-> (CData -> Content) -> CData -> Maybe Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CData -> Content
X.Text (CData -> Maybe Content) -> CData -> Maybe Content
forall a b. (a -> b) -> a -> b
$ CData
X.blank_cdata { cdData :: String
X.cdData = String
"" }
  serializeContent (SpanSub TextSpan
sub) = Element -> Content
X.Elem (Element -> Content) -> Maybe Element -> Maybe Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextSpan -> Maybe Element
serializeSpan TextSpan
sub

unparseText :: [X.Content] -> ([TextSpanContent], Maybe TextPath)
unparseText :: [Content] -> ([TextSpanContent], Maybe TextPath)
unparseText = ([TextSpanContent], Maybe TextPath, Bool)
-> ([TextSpanContent], Maybe TextPath)
forall a b c. (a, b, c) -> (a, b)
extractResult (([TextSpanContent], Maybe TextPath, Bool)
 -> ([TextSpanContent], Maybe TextPath))
-> ([Content] -> ([TextSpanContent], Maybe TextPath, Bool))
-> [Content]
-> ([TextSpanContent], Maybe TextPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
go Bool
True
  where
    extractResult :: (a, b, c) -> (a, b)
extractResult (a
a, b
b, c
_) = (a
a, b
b)

    go :: Bool -> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
go Bool
startStrip [] = ([], Maybe TextPath
forall a. Maybe a
Nothing, Bool
startStrip)
    go Bool
startStrip (X.CRef String
_:[Content]
rest) = Bool -> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
go Bool
startStrip [Content]
rest
    go Bool
startStrip (X.Elem e :: Element
e@(Element -> String
nodeName -> String
"tspan"):[Content]
rest) =
        (TextSpan -> TextSpanContent
SpanSub TextSpan
spans TextSpanContent -> [TextSpanContent] -> [TextSpanContent]
forall a. a -> [a] -> [a]
: [TextSpanContent]
trest, Maybe TextPath
mpath, Bool
retStrip)
      where
        ([TextSpanContent]
trest, Maybe TextPath
mpath, Bool
retStrip) = Bool -> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
go Bool
restStrip [Content]
rest
        ([TextSpanContent]
sub, Maybe TextPath
_, Bool
restStrip) = Bool -> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
go Bool
startStrip ([Content] -> ([TextSpanContent], Maybe TextPath, Bool))
-> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
X.elContent Element
e
        spans :: TextSpan
spans = TextInfo -> DrawAttributes -> [TextSpanContent] -> TextSpan
TextSpan (Element -> TextInfo
forall a. (WithDefaultSvg a, XMLUpdatable a) => Element -> a
xmlUnparse Element
e) (Element -> DrawAttributes
forall a. (WithDefaultSvg a, XMLUpdatable a) => Element -> a
xmlUnparse Element
e) [TextSpanContent]
sub

    go Bool
startStrip (X.Elem e :: Element
e@(Element -> String
nodeName -> String
"tref"):[Content]
rest) =
        case String -> Element -> Maybe String
attributeFinder String
"href" Element
e of
          Maybe String
Nothing -> Bool -> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
go Bool
startStrip [Content]
rest
          Just String
v -> (String -> TextSpanContent
SpanTextRef String
v TextSpanContent -> [TextSpanContent] -> [TextSpanContent]
forall a. a -> [a] -> [a]
: [TextSpanContent]
trest, Maybe TextPath
mpath, Bool
stripRet)
            where ([TextSpanContent]
trest, Maybe TextPath
mpath, Bool
stripRet) = Bool -> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
go Bool
startStrip [Content]
rest

    go Bool
startStrip (X.Elem e :: Element
e@(Element -> String
nodeName -> String
"textPath"):[Content]
rest) =
        case String -> Element -> Maybe String
attributeFinder String
"href" Element
e of
          Maybe String
Nothing -> Bool -> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
go Bool
startStrip [Content]
rest
          Just String
v -> ([TextSpanContent]
tsub [TextSpanContent] -> [TextSpanContent] -> [TextSpanContent]
forall a. [a] -> [a] -> [a]
++ [TextSpanContent]
trest, TextPath -> Maybe TextPath
forall (f :: * -> *) a. Applicative f => a -> f a
pure TextPath
p, Bool
retStrp)
            where
              p :: TextPath
p = (Element -> TextPath
forall a. (WithDefaultSvg a, XMLUpdatable a) => Element -> a
xmlUnparse Element
e) { _textPathName :: String
_textPathName = ShowS
dropSharp String
v }
              ([TextSpanContent]
trest, Maybe TextPath
_, Bool
retStrp) = Bool -> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
go Bool
restStrip [Content]
rest
              ([TextSpanContent]
tsub, Maybe TextPath
_, Bool
restStrip) = Bool -> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
go Bool
startStrip ([Content] -> ([TextSpanContent], Maybe TextPath, Bool))
-> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
X.elContent Element
e

    go Bool
startStrip (X.Elem Element
_:[Content]
rest) = Bool -> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
go Bool
startStrip [Content]
rest
    go Bool
startStrip (X.Text CData
t:[Content]
rest)
      | Text -> Int
T.length Text
cleanText Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool -> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
go Bool
startStrip [Content]
rest
      | Bool
otherwise =
        (Text -> TextSpanContent
SpanText Text
cleanText TextSpanContent -> [TextSpanContent] -> [TextSpanContent]
forall a. a -> [a] -> [a]
: [TextSpanContent]
trest, Maybe TextPath
mpath, Bool
stripRet)
       where
         ([TextSpanContent]
trest, Maybe TextPath
mpath, Bool
stripRet) = Bool -> [Content] -> ([TextSpanContent], Maybe TextPath, Bool)
go Bool
subShouldStrip [Content]
rest

         subShouldStrip :: Bool
subShouldStrip = String -> Text
T.pack String
" " Text -> Text -> Bool
`T.isSuffixOf` Text
cleanText

         space :: Text
space = Char -> Text
T.singleton Char
' '
         singulariseSpaces :: Text -> Text
singulariseSpaces Text
tt
            | Text
space Text -> Text -> Bool
`T.isPrefixOf` Text
tt = Text
space
            | Bool
otherwise = Text
tt

         stripStart :: Text -> Text
stripStart | Bool
startStrip = Text -> Text
T.stripStart
                    | Bool
otherwise = Text -> Text
forall a. a -> a
id

         cleanText :: Text
cleanText = Text -> Text
stripStart
                   (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat
                   ([Text] -> Text) -> (String -> [Text]) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
singulariseSpaces
                   ([Text] -> [Text]) -> (String -> [Text]) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy (\Char
a Char
b -> (Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ' Bool -> Bool -> Bool
&& Char
b Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') Bool -> Bool -> Bool
|| Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
b)
                   (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r')
                   (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' then Char
' ' else Char
c)
                   (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
                   (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ CData -> String
X.cdData CData
t

gradientOffsetSetter :: SvgAttributeLens GradientStop
gradientOffsetSetter :: SvgAttributeLens GradientStop
gradientOffsetSetter = String
-> (GradientStop -> String -> GradientStop)
-> (GradientStop -> Maybe String)
-> SvgAttributeLens GradientStop
forall t.
String
-> (t -> String -> t) -> (t -> Maybe String) -> SvgAttributeLens t
SvgAttributeLens String
"offset" GradientStop -> String -> GradientStop
setter GradientStop -> Maybe String
forall a. PrintfType a => GradientStop -> Maybe a
serialize
  where
    serialize :: GradientStop -> Maybe a
serialize GradientStop
a = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ String -> Int -> a
forall r. PrintfType r => String -> r
printf String
"%d%%" Int
percentage
      where percentage :: Int
percentage = Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Float -> Int) -> (Float -> Float) -> Float -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
*) (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ GradientStop
a GradientStop -> Getting Float GradientStop Float -> Float
forall s a. s -> Getting a s a -> a
^. Getting Float GradientStop Float
Lens' GradientStop Float
gradientOffset :: Int

    setter :: GradientStop -> String -> GradientStop
setter GradientStop
el String
str = GradientStop
el GradientStop -> (GradientStop -> GradientStop) -> GradientStop
forall a b. a -> (a -> b) -> b
& (Float -> Identity Float) -> GradientStop -> Identity GradientStop
Lens' GradientStop Float
gradientOffset ((Float -> Identity Float)
 -> GradientStop -> Identity GradientStop)
-> Float -> GradientStop -> GradientStop
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Float
val
      where
        val :: Float
val = Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Float) -> Double -> Float
forall a b. (a -> b) -> a -> b
$ case Parser Number -> String -> Maybe Number
forall a. Parser a -> String -> Maybe a
parseMayStartDot Parser Number
complexNumber String
str of
            Maybe Number
Nothing          -> Double
0
            Just (Num Double
n)     -> Double
n
            Just (Px Double
n)      -> Double
n
            Just (Percent Double
n) -> Double
n
            Just (Em Double
n)      -> Double
n
            Just (Pc Double
n)      -> Double
n
            Just (Mm Double
n)      -> Double
n
            Just (Cm Double
n)      -> Double
n
            Just (Point Double
n)   -> Double
n
            Just (Inches Double
n)  -> Double
n

instance XMLUpdatable GradientStop where
    xmlTagName :: GradientStop -> String
xmlTagName GradientStop
_ = String
"stop"
    serializeTreeNode :: GradientStop -> Maybe Element
serializeTreeNode = GradientStop -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
genericSerializeNode
    attributes :: [SvgAttributeLens GradientStop]
attributes = [(SvgAttributeLens GradientStop, CssUpdater GradientStop)]
-> SvgAttributeLens GradientStop
forall a.
[(SvgAttributeLens a, CssUpdater a)] -> SvgAttributeLens a
styleAttribute [(SvgAttributeLens GradientStop, CssUpdater GradientStop)]
cssAvailable SvgAttributeLens GradientStop
-> [SvgAttributeLens GradientStop]
-> [SvgAttributeLens GradientStop]
forall a. a -> [a] -> [a]
: ((SvgAttributeLens GradientStop, CssUpdater GradientStop)
 -> SvgAttributeLens GradientStop)
-> [(SvgAttributeLens GradientStop, CssUpdater GradientStop)]
-> [SvgAttributeLens GradientStop]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SvgAttributeLens GradientStop, CssUpdater GradientStop)
-> SvgAttributeLens GradientStop
forall a b. (a, b) -> a
fst [(SvgAttributeLens GradientStop, CssUpdater GradientStop)]
cssAvailable [SvgAttributeLens GradientStop]
-> [SvgAttributeLens GradientStop]
-> [SvgAttributeLens GradientStop]
forall a. [a] -> [a] -> [a]
++ [SvgAttributeLens GradientStop]
lst where
      cssAvailable :: [(SvgAttributeLens GradientStop, CssUpdater GradientStop)]
      cssAvailable :: [(SvgAttributeLens GradientStop, CssUpdater GradientStop)]
cssAvailable =
          [(String
-> Lens' GradientStop (Maybe Float)
-> SvgAttributeLens GradientStop
forall a. String -> Lens' a (Maybe Float) -> SvgAttributeLens a
opacitySetter String
"stop-opacity" Lens' GradientStop (Maybe Float)
gradientOpacity, ASetter GradientStop GradientStop (Maybe Float) (Maybe Float)
-> CssUpdater GradientStop
forall n el a.
Fractional n =>
ASetter el el a (Maybe n) -> CssUpdater el
cssUniqueFloat ASetter GradientStop GradientStop (Maybe Float) (Maybe Float)
Lens' GradientStop (Maybe Float)
gradientOpacity)
          ,(String
"stop-color" String
-> Lens' GradientStop PixelRGBA8 -> SvgAttributeLens GradientStop
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' GradientStop PixelRGBA8
gradientColor, ASetter GradientStop GradientStop PixelRGBA8 PixelRGBA8
-> CssUpdater GradientStop
forall el a. ASetter el el a PixelRGBA8 -> CssUpdater el
cssUniqueColor ASetter GradientStop GradientStop PixelRGBA8 PixelRGBA8
Lens' GradientStop PixelRGBA8
gradientColor)
          ]

      lst :: [SvgAttributeLens GradientStop]
lst =
        [SvgAttributeLens GradientStop
gradientOffsetSetter
        ,String
"path" String
-> Lens' GradientStop (Maybe GradientPathCommand)
-> SvgAttributeLens GradientStop
forall a s.
(Eq a, WithDefaultSvg s, ParseableAttribute a) =>
String -> Lens' s a -> SvgAttributeLens s
`parseIn` Lens' GradientStop (Maybe GradientPathCommand)
gradientPath
        ]


parseGradientStops :: X.Element -> [GradientStop]
parseGradientStops :: Element -> [GradientStop]
parseGradientStops = (Element -> [GradientStop]) -> [Element] -> [GradientStop]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Element -> [GradientStop]
forall a. (WithDefaultSvg a, XMLUpdatable a) => Element -> [a]
unStop ([Element] -> [GradientStop])
-> (Element -> [Element]) -> Element -> [GradientStop]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Element]
elChildren
  where
    unStop :: Element -> [a]
unStop e :: Element
e@(Element -> String
nodeName -> String
"stop") = [Element -> a
forall a. (WithDefaultSvg a, XMLUpdatable a) => Element -> a
xmlUnparse Element
e]
    unStop Element
_                      = []

parseMeshGradientPatches :: X.Element -> [MeshGradientPatch]
parseMeshGradientPatches :: Element -> [MeshGradientPatch]
parseMeshGradientPatches = (Element -> [MeshGradientPatch])
-> [Element] -> [MeshGradientPatch]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Element -> [MeshGradientPatch]
unparsePatch ([Element] -> [MeshGradientPatch])
-> (Element -> [Element]) -> Element -> [MeshGradientPatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Element]
elChildren where
  unparsePatch :: Element -> [MeshGradientPatch]
unparsePatch e :: Element
e@(Element -> String
nodeName -> String
"meshpatch") = [[GradientStop] -> MeshGradientPatch
MeshGradientPatch ([GradientStop] -> MeshGradientPatch)
-> [GradientStop] -> MeshGradientPatch
forall a b. (a -> b) -> a -> b
$ Element -> [GradientStop]
parseGradientStops Element
e]
  unparsePatch Element
_ = []

parseMeshGradientRows :: X.Element -> [MeshGradientRow]
parseMeshGradientRows :: Element -> [MeshGradientRow]
parseMeshGradientRows = (Element -> [MeshGradientRow]) -> [Element] -> [MeshGradientRow]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Element -> [MeshGradientRow]
unRows ([Element] -> [MeshGradientRow])
-> (Element -> [Element]) -> Element -> [MeshGradientRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Element]
elChildren where
  unRows :: Element -> [MeshGradientRow]
unRows e :: Element
e@(Element -> String
nodeName -> String
"meshrow") = [[MeshGradientPatch] -> MeshGradientRow
MeshGradientRow ([MeshGradientPatch] -> MeshGradientRow)
-> [MeshGradientPatch] -> MeshGradientRow
forall a b. (a -> b) -> a -> b
$ Element -> [MeshGradientPatch]
parseMeshGradientPatches Element
e]
  unRows Element
_ = []

-- This is to guarantee there will be only "feMergeNode" elements inside any "feMerge" element.
unparseMergeNode :: X.Element -> FilterElement
unparseMergeNode :: Element -> FilterElement
unparseMergeNode e :: Element
e@(Element -> String
nodeName -> String
"feMergeNode") =
  MergeNode -> FilterElement
FEMergeNode (MergeNode -> FilterElement) -> MergeNode -> FilterElement
forall a b. (a -> b) -> a -> b
$ Element -> MergeNode
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e
unparseMergeNode Element
_ = FilterElement
FENone

-- This is to guarantee there will be only "feFunc_" elements inside any "feComponentTransfer" element.
unparseFunc :: X.Element -> FilterElement
unparseFunc :: Element -> FilterElement
unparseFunc Element
e = case Element -> String
nodeName Element
e of
  String
"feFuncA" -> FuncA -> FilterElement
FEFuncA (FuncA -> FilterElement) -> FuncA -> FilterElement
forall a b. (a -> b) -> a -> b
$ Element -> FuncA
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e
  String
"feFuncR" -> FuncR -> FilterElement
FEFuncR (FuncR -> FilterElement) -> FuncR -> FilterElement
forall a b. (a -> b) -> a -> b
$ Element -> FuncR
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e
  String
"feFuncG" -> FuncG -> FilterElement
FEFuncG (FuncG -> FilterElement) -> FuncG -> FilterElement
forall a b. (a -> b) -> a -> b
$ Element -> FuncG
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e
  String
"feFuncB" -> FuncB -> FilterElement
FEFuncB (FuncB -> FilterElement) -> FuncB -> FilterElement
forall a b. (a -> b) -> a -> b
$ Element -> FuncB
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e
  String
_         -> FilterElement
FENone

unparseFE :: X.Element -> FilterElement
unparseFE :: Element -> FilterElement
unparseFE Element
e = (FilterElement -> Element -> FilterElement)
-> Element -> FilterElement -> FilterElement
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilterElement -> Element -> FilterElement
forall a. XMLUpdatable a => a -> Element -> a
xmlUpdate Element
e (FilterElement -> FilterElement) -> FilterElement -> FilterElement
forall a b. (a -> b) -> a -> b
$
  case Element -> String
nodeName Element
e of
    String
"feMerge" ->
      Merge -> FilterElement
FEMerge (Merge -> FilterElement) -> Merge -> FilterElement
forall a b. (a -> b) -> a -> b
$ Element -> Merge
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e
        Merge -> (Merge -> Merge) -> Merge
forall a b. a -> (a -> b) -> b
& ([FilterElement] -> Identity [FilterElement])
-> Merge -> Identity Merge
Lens' Merge [FilterElement]
mergeChildren (([FilterElement] -> Identity [FilterElement])
 -> Merge -> Identity Merge)
-> [FilterElement] -> Merge -> Merge
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Element -> FilterElement) -> [Element] -> [FilterElement]
forall a b. (a -> b) -> [a] -> [b]
map Element -> FilterElement
unparseMergeNode (Element -> [Element]
elChildren Element
e)
    String
"feComponentTransfer" ->
      ComponentTransfer -> FilterElement
FEComponentTransfer (ComponentTransfer -> FilterElement)
-> ComponentTransfer -> FilterElement
forall a b. (a -> b) -> a -> b
$ Element -> ComponentTransfer
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e
        ComponentTransfer
-> (ComponentTransfer -> ComponentTransfer) -> ComponentTransfer
forall a b. a -> (a -> b) -> b
& ([FilterElement] -> Identity [FilterElement])
-> ComponentTransfer -> Identity ComponentTransfer
Lens' ComponentTransfer [FilterElement]
compTransferChildren (([FilterElement] -> Identity [FilterElement])
 -> ComponentTransfer -> Identity ComponentTransfer)
-> [FilterElement] -> ComponentTransfer -> ComponentTransfer
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Element -> FilterElement) -> [Element] -> [FilterElement]
forall a b. (a -> b) -> [a] -> [b]
map Element -> FilterElement
unparseFunc (Element -> [Element]
elChildren Element
e)
    String
"feBlend"            -> Blend -> FilterElement
FEBlend Blend
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"feColorMatrix"      -> ColorMatrix -> FilterElement
FEColorMatrix ColorMatrix
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"feComposite"        -> Composite -> FilterElement
FEComposite Composite
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"feDisplacementMap"  -> DisplacementMap -> FilterElement
FEDisplacementMap DisplacementMap
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"feGaussianBlur"     -> GaussianBlur -> FilterElement
FEGaussianBlur GaussianBlur
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"feTurbulence"       -> Turbulence -> FilterElement
FETurbulence Turbulence
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"feTile"             -> Tile -> FilterElement
FETile Tile
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"feFlood"            -> Flood -> FilterElement
FEFlood Flood
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"feOffset"           -> Offset -> FilterElement
FEOffset Offset
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"feImage"            -> ImageF -> FilterElement
FEImage ImageF
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"feMergeNode"        -> MergeNode -> FilterElement
FEMergeNode MergeNode
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed -- Potential bug: allow the "feMergeNode" element to appear outside a "feMerge" element.
    String
"feFuncA"            -> FuncA -> FilterElement
FEFuncA FuncA
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed -- Potential bug: allow the "feFuncA" element to appear outside a "feComponentTransfer" element.
    String
"feFuncR"            -> FuncR -> FilterElement
FEFuncR FuncR
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed -- Potential bug: allow the "feFuncR" element to appear outside a "feComponentTransfer" element.
    String
"feFuncG"            -> FuncG -> FilterElement
FEFuncG FuncG
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed -- Potential bug: allow the "feFuncG" element to appear outside a "feComponentTransfer" element.
    String
"feFuncB"            -> FuncB -> FilterElement
FEFuncB FuncB
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed -- Potential bug: allow the "feFuncB" element to appear outside a "feComponentTransfer" element.
    String
"feSpecularLighting" -> SpecularLighting -> FilterElement
FESpecularLighting SpecularLighting
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"feConvolveMatrix"   -> ConvolveMatrix -> FilterElement
FEConvolveMatrix ConvolveMatrix
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"feDiffuseLighting"  -> DiffuseLighting -> FilterElement
FEDiffuseLighting DiffuseLighting
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"feMorphology"       -> Morphology -> FilterElement
FEMorphology Morphology
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"feDropShadow"       -> DropShadow -> FilterElement
FEDropShadow DropShadow
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
_                    -> FilterElement
FENone
  where
    parsed :: (WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) => a
    parsed :: a
parsed = Element -> a
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e

unparse :: X.Element -> Tree
unparse :: Element -> Tree
unparse e :: Element
e@(Element -> String
nodeName -> String
"pattern") =
  Pattern -> Tree
PatternTree (Pattern -> Tree) -> Pattern -> Tree
forall a b. (a -> b) -> a -> b
$ Element -> Pattern
forall a. (WithDefaultSvg a, XMLUpdatable a) => Element -> a
xmlUnparse Element
e Pattern -> (Pattern -> Pattern) -> Pattern
forall a b. a -> (a -> b) -> b
& ([Tree] -> Identity [Tree]) -> Pattern -> Identity Pattern
Lens' Pattern [Tree]
patternElements (([Tree] -> Identity [Tree]) -> Pattern -> Identity Pattern)
-> [Tree] -> Pattern -> Pattern
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Element -> Tree) -> [Element] -> [Tree]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Tree
unparse (Element -> [Element]
elChildren Element
e)
unparse e :: Element
e@(Element -> String
nodeName -> String
"marker") =
  Marker -> Tree
MarkerTree (Marker -> Tree) -> Marker -> Tree
forall a b. (a -> b) -> a -> b
$ Element -> Marker
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e Marker -> (Marker -> Marker) -> Marker
forall a b. a -> (a -> b) -> b
& ([Tree] -> Identity [Tree]) -> Marker -> Identity Marker
Lens' Marker [Tree]
markerElements (([Tree] -> Identity [Tree]) -> Marker -> Identity Marker)
-> [Tree] -> Marker -> Marker
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Element -> Tree) -> [Element] -> [Tree]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Tree
unparse (Element -> [Element]
elChildren Element
e)
unparse e :: Element
e@(Element -> String
nodeName -> String
"mask") =
  Mask -> Tree
MaskTree (Mask -> Tree) -> Mask -> Tree
forall a b. (a -> b) -> a -> b
$ Element -> Mask
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e Mask -> (Mask -> Mask) -> Mask
forall a b. a -> (a -> b) -> b
& ([Tree] -> Identity [Tree]) -> Mask -> Identity Mask
Lens' Mask [Tree]
maskContent (([Tree] -> Identity [Tree]) -> Mask -> Identity Mask)
-> [Tree] -> Mask -> Mask
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Element -> Tree) -> [Element] -> [Tree]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Tree
unparse (Element -> [Element]
elChildren Element
e)
unparse e :: Element
e@(Element -> String
nodeName -> String
"clipPath") =
  ClipPath -> Tree
ClipPathTree (ClipPath -> Tree) -> ClipPath -> Tree
forall a b. (a -> b) -> a -> b
$ Element -> ClipPath
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e ClipPath -> (ClipPath -> ClipPath) -> ClipPath
forall a b. a -> (a -> b) -> b
& ([Tree] -> Identity [Tree]) -> ClipPath -> Identity ClipPath
Lens' ClipPath [Tree]
clipPathContent (([Tree] -> Identity [Tree]) -> ClipPath -> Identity ClipPath)
-> [Tree] -> ClipPath -> ClipPath
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Element -> Tree) -> [Element] -> [Tree]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Tree
unparse (Element -> [Element]
elChildren Element
e)
unparse (Element -> String
nodeName -> String
"style") = Tree
None -- XXX: Create a style node?
unparse e :: Element
e@(Element -> String
nodeName -> String
"defs") =
  Group -> Tree
DefinitionTree (Group -> Tree) -> Group -> Tree
forall a b. (a -> b) -> a -> b
$ Element -> Group
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e Group -> (Group -> Group) -> Group
forall a b. a -> (a -> b) -> b
& ([Tree] -> Identity [Tree]) -> Group -> Identity Group
Lens' Group [Tree]
groupChildren (([Tree] -> Identity [Tree]) -> Group -> Identity Group)
-> [Tree] -> Group -> Group
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Element -> Tree) -> [Element] -> [Tree]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Tree
unparse (Element -> [Element]
elChildren Element
e)
unparse e :: Element
e@(Element -> String
nodeName -> String
"filter") =
  Filter -> Tree
FilterTree (Filter -> Tree) -> Filter -> Tree
forall a b. (a -> b) -> a -> b
$ Element -> Filter
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e Filter -> (Filter -> Filter) -> Filter
forall a b. a -> (a -> b) -> b
& ([FilterElement] -> Identity [FilterElement])
-> Filter -> Identity Filter
Lens' Filter [FilterElement]
filterChildren (([FilterElement] -> Identity [FilterElement])
 -> Filter -> Identity Filter)
-> [FilterElement] -> Filter -> Filter
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Element -> FilterElement) -> [Element] -> [FilterElement]
forall a b. (a -> b) -> [a] -> [b]
map Element -> FilterElement
unparseFE (Element -> [Element]
elChildren Element
e)
unparse e :: Element
e@(Element -> String
nodeName -> String
"symbol") =
  Group -> Tree
SymbolTree (Group -> Tree) -> Group -> Tree
forall a b. (a -> b) -> a -> b
$ Element -> Group
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e Group -> (Group -> Group) -> Group
forall a b. a -> (a -> b) -> b
& ([Tree] -> Identity [Tree]) -> Group -> Identity Group
Lens' Group [Tree]
groupChildren (([Tree] -> Identity [Tree]) -> Group -> Identity Group)
-> [Tree] -> Group -> Group
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Element -> Tree) -> [Element] -> [Tree]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Tree
unparse (Element -> [Element]
elChildren Element
e)
unparse e :: Element
e@(Element -> String
nodeName -> String
"g") =
  Group -> Tree
GroupTree (Group -> Tree) -> Group -> Tree
forall a b. (a -> b) -> a -> b
$ Element -> Group
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e Group -> (Group -> Group) -> Group
forall a b. a -> (a -> b) -> b
& ([Tree] -> Identity [Tree]) -> Group -> Identity Group
Lens' Group [Tree]
groupChildren (([Tree] -> Identity [Tree]) -> Group -> Identity Group)
-> [Tree] -> Group -> Group
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Element -> Tree) -> [Element] -> [Tree]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Tree
unparse (Element -> [Element]
elChildren Element
e)
unparse e :: Element
e@(Element -> String
nodeName -> String
"svg") =
  Tree -> (Document -> Tree) -> Maybe Document -> Tree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Tree
None Document -> Tree
SvgTree (Maybe Document -> Tree) -> Maybe Document -> Tree
forall a b. (a -> b) -> a -> b
$ String -> Element -> Maybe Document
unparseDocument String
"" Element
e
unparse e :: Element
e@(Element -> String
nodeName -> String
"text") =
  Maybe TextPath -> Text -> Tree
TextTree Maybe TextPath
tPath (Text -> Tree) -> Text -> Tree
forall a b. (a -> b) -> a -> b
$ Element -> Text
forall a. (WithDefaultSvg a, XMLUpdatable a) => Element -> a
xmlUnparse Element
e Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (TextSpan -> Identity TextSpan) -> Text -> Identity Text
Lens' Text TextSpan
textRoot ((TextSpan -> Identity TextSpan) -> Text -> Identity Text)
-> TextSpan -> Text -> Text
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TextSpan
root
    where
      ([TextSpanContent]
textContent, Maybe TextPath
tPath) = [Content] -> ([TextSpanContent], Maybe TextPath)
unparseText ([Content] -> ([TextSpanContent], Maybe TextPath))
-> [Content] -> ([TextSpanContent], Maybe TextPath)
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
X.elContent Element
e

      root :: TextSpan
root = TextSpan :: TextInfo -> DrawAttributes -> [TextSpanContent] -> TextSpan
TextSpan
           { _spanInfo :: TextInfo
_spanInfo = Element -> TextInfo
forall a. (WithDefaultSvg a, XMLUpdatable a) => Element -> a
xmlUnparse Element
e
           , _spanDrawAttributes :: DrawAttributes
_spanDrawAttributes = Element -> DrawAttributes
forall a. (WithDefaultSvg a, XMLUpdatable a) => Element -> a
xmlUnparse Element
e
           , _spanContent :: [TextSpanContent]
_spanContent = [TextSpanContent]
textContent
           }

unparse Element
e = case Element -> String
nodeName Element
e of
    String
"image"    -> Image -> Tree
ImageTree Image
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"ellipse"  -> Ellipse -> Tree
EllipseTree Ellipse
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"rect"     -> Rectangle -> Tree
RectangleTree Rectangle
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"polyline" -> PolyLine -> Tree
PolyLineTree PolyLine
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"polygon"  -> Polygon -> Tree
PolygonTree Polygon
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"circle"   -> Circle -> Tree
CircleTree Circle
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"line"     -> Line -> Tree
LineTree Line
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"path"     -> Path -> Tree
PathTree Path
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed
    String
"linearGradient" ->
      LinearGradient -> Tree
LinearGradientTree (LinearGradient -> Tree) -> LinearGradient -> Tree
forall a b. (a -> b) -> a -> b
$ LinearGradient
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed LinearGradient
-> (LinearGradient -> LinearGradient) -> LinearGradient
forall a b. a -> (a -> b) -> b
& ([GradientStop] -> Identity [GradientStop])
-> LinearGradient -> Identity LinearGradient
Lens' LinearGradient [GradientStop]
linearGradientStops (([GradientStop] -> Identity [GradientStop])
 -> LinearGradient -> Identity LinearGradient)
-> [GradientStop] -> LinearGradient -> LinearGradient
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Element -> [GradientStop]
parseGradientStops Element
e
    String
"radialGradient" ->
      RadialGradient -> Tree
RadialGradientTree (RadialGradient -> Tree) -> RadialGradient -> Tree
forall a b. (a -> b) -> a -> b
$ RadialGradient
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed RadialGradient
-> (RadialGradient -> RadialGradient) -> RadialGradient
forall a b. a -> (a -> b) -> b
& ([GradientStop] -> Identity [GradientStop])
-> RadialGradient -> Identity RadialGradient
Lens' RadialGradient [GradientStop]
radialGradientStops (([GradientStop] -> Identity [GradientStop])
 -> RadialGradient -> Identity RadialGradient)
-> [GradientStop] -> RadialGradient -> RadialGradient
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Element -> [GradientStop]
parseGradientStops Element
e
    String
"meshgradient" ->
      MeshGradient -> Tree
MeshGradientTree (MeshGradient -> Tree) -> MeshGradient -> Tree
forall a b. (a -> b) -> a -> b
$ MeshGradient
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed MeshGradient -> (MeshGradient -> MeshGradient) -> MeshGradient
forall a b. a -> (a -> b) -> b
& ([MeshGradientRow] -> Identity [MeshGradientRow])
-> MeshGradient -> Identity MeshGradient
Lens' MeshGradient [MeshGradientRow]
meshGradientRows (([MeshGradientRow] -> Identity [MeshGradientRow])
 -> MeshGradient -> Identity MeshGradient)
-> [MeshGradientRow] -> MeshGradient -> MeshGradient
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Element -> [MeshGradientRow]
parseMeshGradientRows Element
e
    String
"use" -> Use -> Maybe Tree -> Tree
UseTree Use
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
a
parsed Maybe Tree
forall a. Maybe a
Nothing
    String
_ -> Tree
None
  where
    parsed :: (WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) => a
    parsed :: a
parsed = Element -> a
forall a.
(WithDefaultSvg a, XMLUpdatable a, HasDrawAttributes a) =>
Element -> a
xmlUnparseWithDrawAttr Element
e

unparseDocument :: FilePath -> X.Element -> Maybe Document
unparseDocument :: String -> Element -> Maybe Document
unparseDocument String
rootLocation e :: Element
e@(Element -> String
nodeName -> String
"svg") = Document -> Maybe Document
forall a. a -> Maybe a
Just Document :: Maybe (Double, Double, Double, Double)
-> Maybe Number
-> Maybe Number
-> [Tree]
-> String
-> String
-> PreserveAspectRatio
-> Document
Document
    { _documentViewBox :: Maybe (Double, Double, Double, Double)
_documentViewBox =
        String -> Element -> Maybe String
attributeFinder String
"viewBox" Element
e Maybe String
-> (String -> Maybe (Double, Double, Double, Double))
-> Maybe (Double, Double, Double, Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser (Double, Double, Double, Double)
-> String -> Maybe (Double, Double, Double, Double)
forall a. Parser a -> String -> Maybe a
parse Parser (Double, Double, Double, Double)
viewBoxParser
    , _documentElements :: [Tree]
_documentElements = [Tree]
parsedElements
    , _documentWidth :: Maybe Number
_documentWidth = String -> Maybe Number
lengthFind String
"width"
    , _documentHeight :: Maybe Number
_documentHeight = String -> Maybe Number
lengthFind String
"height"
    , _documentDescription :: String
_documentDescription = String
""
    , _documentLocation :: String
_documentLocation = String
rootLocation
    , _documentAspectRatio :: PreserveAspectRatio
_documentAspectRatio =
        PreserveAspectRatio
-> Maybe PreserveAspectRatio -> PreserveAspectRatio
forall a. a -> Maybe a -> a
fromMaybe PreserveAspectRatio
forall a. WithDefaultSvg a => a
defaultSvg (Maybe PreserveAspectRatio -> PreserveAspectRatio)
-> Maybe PreserveAspectRatio -> PreserveAspectRatio
forall a b. (a -> b) -> a -> b
$
        String -> Element -> Maybe String
attributeFinder String
"preserveAspectRatio" Element
e Maybe String
-> (String -> Maybe PreserveAspectRatio)
-> Maybe PreserveAspectRatio
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe PreserveAspectRatio
forall a. ParseableAttribute a => String -> Maybe a
aparse
    }
  where
    parsedElements :: [Tree]
parsedElements = (Element -> Tree) -> [Element] -> [Tree]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Tree
unparse ([Element] -> [Tree]) -> [Element] -> [Tree]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
e
    lengthFind :: String -> Maybe Number
lengthFind String
n =
        String -> Element -> Maybe String
attributeFinder String
n Element
e Maybe String -> (String -> Maybe Number) -> Maybe Number
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser Number -> String -> Maybe Number
forall a. Parser a -> String -> Maybe a
parse Parser Number
complexNumber
unparseDocument String
_ Element
_ = Maybe Document
forall a. Maybe a
Nothing

-- | Transform a SVG document to a XML node.
xmlOfDocument :: Document -> X.Element
xmlOfDocument :: Document -> Element
xmlOfDocument Document
doc =
    QName -> ([Attr], [Element]) -> Element
forall t. Node t => QName -> t -> Element
X.node (String -> QName
X.unqual String
"svg") ([Attr]
attrs, [Element]
descTag [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
children)
  where
    attr :: String -> String -> Attr
attr String
name = QName -> String -> Attr
X.Attr (String -> QName
X.unqual String
name)
    children :: [Element]
children = [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes [Tree -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode Tree
el | Tree
el <- Document -> [Tree]
_documentElements Document
doc]

    docViewBox :: [Attr]
docViewBox = case Document -> Maybe (Double, Double, Double, Double)
_documentViewBox Document
doc of
        Maybe (Double, Double, Double, Double)
Nothing -> []
        Just (Double, Double, Double, Double)
b  -> [String -> String -> Attr
attr String
"viewBox" (String -> Attr) -> String -> Attr
forall a b. (a -> b) -> a -> b
$ (Double, Double, Double, Double) -> String
serializeViewBox (Double, Double, Double, Double)
b]

    descTag :: [Element]
descTag = case Document -> String
_documentDescription Document
doc of
        String
""  -> []
        String
txt -> [QName -> String -> Element
forall t. Node t => QName -> t -> Element
X.node (String -> QName
X.unqual String
"desc") String
txt]

    attrs :: [Attr]
attrs =
        [Attr]
docViewBox [Attr] -> [Attr] -> [Attr]
forall a. [a] -> [a] -> [a]
++
        [String -> String -> Attr
attr String
"xmlns" String
"http://www.w3.org/2000/svg"
        ,String -> String -> Attr
attr String
"xmlns:xlink" String
"http://www.w3.org/1999/xlink"
        ,String -> String -> Attr
attr String
"version" String
"1.1"] [Attr] -> [Attr] -> [Attr]
forall a. [a] -> [a] -> [a]
++
        [Maybe Attr] -> [Attr]
forall a. [Maybe a] -> [a]
catMaybes [String -> String -> Attr
attr String
"width" (String -> Attr) -> (Number -> String) -> Number -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Number -> String
serializeNumber (Number -> Attr) -> Maybe Number -> Maybe Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Document -> Maybe Number
_documentWidth Document
doc
                  ,String -> String -> Attr
attr String
"height" (String -> Attr) -> (Number -> String) -> Number -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Number -> String
serializeNumber (Number -> Attr) -> Maybe Number -> Maybe Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Document -> Maybe Number
_documentHeight Document
doc
                  ] [Attr] -> [Attr] -> [Attr]
forall a. [a] -> [a] -> [a]
++
        [Maybe Attr] -> [Attr]
forall a. [Maybe a] -> [a]
catMaybes [String -> String -> Attr
attr String
"preserveAspectRatio" (String -> Attr) -> Maybe String -> Maybe Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  PreserveAspectRatio -> Maybe String
forall a. ParseableAttribute a => a -> Maybe String
aserialize (Document -> PreserveAspectRatio
_documentAspectRatio Document
doc)
                  | Document -> PreserveAspectRatio
_documentAspectRatio Document
doc PreserveAspectRatio -> PreserveAspectRatio -> Bool
forall a. Eq a => a -> a -> Bool
/= PreserveAspectRatio
forall a. WithDefaultSvg a => a
defaultSvg ]

xmlOfTree :: Tree -> Maybe X.Element
xmlOfTree :: Tree -> Maybe Element
xmlOfTree = Tree -> Maybe Element
forall treeNode. XMLUpdatable treeNode => treeNode -> Maybe Element
serializeTreeNode