{-# OPTIONS_GHC -Wno-orphans #-}
module Graphics.SvgTree.Types.Instances where

import Control.Lens ((&), (.~), (^.), lens, view)
import qualified Data.Text as T
import Graphics.SvgTree.CssTypes (CssMatcheable (..))
import Graphics.SvgTree.Types.Hashable
import Graphics.SvgTree.Types.Internal

instance CssMatcheable Tree where
  cssAttribOf :: Tree -> Text -> Maybe Text
cssAttribOf Tree
_ Text
_ = Maybe Text
forall a. Maybe a
Nothing
  cssClassOf :: Tree -> [Text]
cssClassOf = Getting [Text] Tree [Text] -> Tree -> [Text]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((DrawAttributes -> Const [Text] DrawAttributes)
-> Tree -> Const [Text] Tree
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Const [Text] DrawAttributes)
 -> Tree -> Const [Text] Tree)
-> (([Text] -> Const [Text] [Text])
    -> DrawAttributes -> Const [Text] DrawAttributes)
-> Getting [Text] Tree [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Const [Text] [Text])
-> DrawAttributes -> Const [Text] DrawAttributes
forall c. HasDrawAttributes c => Lens' c [Text]
attrClass)
  cssIdOf :: Tree -> Maybe Text
cssIdOf = (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Maybe String -> Maybe Text)
-> (Tree -> Maybe String) -> Tree -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Maybe String) Tree (Maybe String) -> Tree -> Maybe String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((DrawAttributes -> Const (Maybe String) DrawAttributes)
-> Tree -> Const (Maybe String) Tree
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Const (Maybe String) DrawAttributes)
 -> Tree -> Const (Maybe String) Tree)
-> ((Maybe String -> Const (Maybe String) (Maybe String))
    -> DrawAttributes -> Const (Maybe String) DrawAttributes)
-> Getting (Maybe String) Tree (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String -> Const (Maybe String) (Maybe String))
-> DrawAttributes -> Const (Maybe String) DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe String)
attrId)
  cssNameOf :: Tree -> Text
cssNameOf = Tree -> Text
nameOfTree

instance HasDrawAttributes Tree where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Tree -> f Tree
drawAttributes = (TreeBranch -> f TreeBranch) -> Tree -> f Tree
Lens' Tree TreeBranch
treeBranch ((TreeBranch -> f TreeBranch) -> Tree -> f Tree)
-> ((DrawAttributes -> f DrawAttributes)
    -> TreeBranch -> f TreeBranch)
-> (DrawAttributes -> f DrawAttributes)
-> Tree
-> f Tree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DrawAttributes -> f DrawAttributes) -> TreeBranch -> f TreeBranch
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes

instance HasDrawAttributes Filter where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Filter -> f Filter
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Filter -> f Filter
Lens' Filter DrawAttributes
filterDrawAttributes

instance HasDrawAttributes Use where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Use -> f Use
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Use -> f Use
Lens' Use DrawAttributes
useDrawAttributes

instance HasDrawAttributes Group where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Group -> f Group
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Group -> f Group
Lens' Group DrawAttributes
groupDrawAttributes

instance HasDrawAttributes Rectangle where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Rectangle -> f Rectangle
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Rectangle -> f Rectangle
Lens' Rectangle DrawAttributes
rectangleDrawAttributes

instance HasDrawAttributes Line where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Line -> f Line
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Line -> f Line
Lens' Line DrawAttributes
lineDrawAttributes

instance HasDrawAttributes Ellipse where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Ellipse -> f Ellipse
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Ellipse -> f Ellipse
Lens' Ellipse DrawAttributes
ellipseDrawAttributes

instance HasDrawAttributes Polygon where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Polygon -> f Polygon
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Polygon -> f Polygon
Lens' Polygon DrawAttributes
polygonDrawAttributes

instance HasDrawAttributes PolyLine where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> PolyLine -> f PolyLine
drawAttributes = (DrawAttributes -> f DrawAttributes) -> PolyLine -> f PolyLine
Lens' PolyLine DrawAttributes
polyLineDrawAttributes

instance HasDrawAttributes Circle where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Circle -> f Circle
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Circle -> f Circle
Lens' Circle DrawAttributes
circleDrawAttributes

instance HasDrawAttributes Path where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Path -> f Path
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Path -> f Path
Lens' Path DrawAttributes
pathDrawAttributes

instance HasDrawAttributes ClipPath where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> ClipPath -> f ClipPath
drawAttributes = (DrawAttributes -> f DrawAttributes) -> ClipPath -> f ClipPath
Lens' ClipPath DrawAttributes
clipPathDrawAttributes

instance HasDrawAttributes Mask where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Mask -> f Mask
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Mask -> f Mask
Lens' Mask DrawAttributes
maskDrawAttributes

instance HasDrawAttributes Marker where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Marker -> f Marker
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Marker -> f Marker
Lens' Marker DrawAttributes
markerDrawAttributes

instance HasDrawAttributes Image where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Image -> f Image
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Image -> f Image
Lens' Image DrawAttributes
imageDrawAttributes

instance HasDrawAttributes Pattern where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Pattern -> f Pattern
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Pattern -> f Pattern
Lens' Pattern DrawAttributes
patternDrawAttributes

instance HasDrawAttributes MeshGradient where
  drawAttributes :: (DrawAttributes -> f DrawAttributes)
-> MeshGradient -> f MeshGradient
drawAttributes = (DrawAttributes -> f DrawAttributes)
-> MeshGradient -> f MeshGradient
Lens' MeshGradient DrawAttributes
meshGradientDrawAttributes

instance HasDrawAttributes RadialGradient where
  drawAttributes :: (DrawAttributes -> f DrawAttributes)
-> RadialGradient -> f RadialGradient
drawAttributes = (DrawAttributes -> f DrawAttributes)
-> RadialGradient -> f RadialGradient
Lens' RadialGradient DrawAttributes
radialGradientDrawAttributes

instance HasDrawAttributes LinearGradient where
  drawAttributes :: (DrawAttributes -> f DrawAttributes)
-> LinearGradient -> f LinearGradient
drawAttributes = (DrawAttributes -> f DrawAttributes)
-> LinearGradient -> f LinearGradient
Lens' LinearGradient DrawAttributes
linearGradientDrawAttributes

instance HasDrawAttributes Composite where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Composite -> f Composite
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Composite -> f Composite
Lens' Composite DrawAttributes
compositeDrawAttributes

instance HasDrawAttributes Blend where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Blend -> f Blend
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Blend -> f Blend
Lens' Blend DrawAttributes
blendDrawAttributes

instance HasDrawAttributes ConvolveMatrix where
  drawAttributes :: (DrawAttributes -> f DrawAttributes)
-> ConvolveMatrix -> f ConvolveMatrix
drawAttributes = (DrawAttributes -> f DrawAttributes)
-> ConvolveMatrix -> f ConvolveMatrix
Lens' ConvolveMatrix DrawAttributes
convolveMatrixDrawAttributes

instance HasDrawAttributes Morphology where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Morphology -> f Morphology
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Morphology -> f Morphology
Lens' Morphology DrawAttributes
morphologyDrawAttributes

instance HasDrawAttributes SpecularLighting where
  drawAttributes :: (DrawAttributes -> f DrawAttributes)
-> SpecularLighting -> f SpecularLighting
drawAttributes = (DrawAttributes -> f DrawAttributes)
-> SpecularLighting -> f SpecularLighting
Lens' SpecularLighting DrawAttributes
specLightingDrawAttributes

instance HasDrawAttributes DropShadow where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> DropShadow -> f DropShadow
drawAttributes = (DrawAttributes -> f DrawAttributes) -> DropShadow -> f DropShadow
Lens' DropShadow DrawAttributes
dropShadowDrawAttributes

instance HasDrawAttributes DiffuseLighting where
  drawAttributes :: (DrawAttributes -> f DrawAttributes)
-> DiffuseLighting -> f DiffuseLighting
drawAttributes = (DrawAttributes -> f DrawAttributes)
-> DiffuseLighting -> f DiffuseLighting
Lens' DiffuseLighting DrawAttributes
diffuseLightingDrawAttributes

instance HasDrawAttributes ComponentTransfer where
  drawAttributes :: (DrawAttributes -> f DrawAttributes)
-> ComponentTransfer -> f ComponentTransfer
drawAttributes = (DrawAttributes -> f DrawAttributes)
-> ComponentTransfer -> f ComponentTransfer
Lens' ComponentTransfer DrawAttributes
compTransferDrawAttributes

instance HasDrawAttributes FuncA where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> FuncA -> f FuncA
drawAttributes = (DrawAttributes -> f DrawAttributes) -> FuncA -> f FuncA
Lens' FuncA DrawAttributes
funcADrawAttributes
instance HasDrawAttributes FuncR where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> FuncR -> f FuncR
drawAttributes = (DrawAttributes -> f DrawAttributes) -> FuncR -> f FuncR
Lens' FuncR DrawAttributes
funcRDrawAttributes
instance HasDrawAttributes FuncG where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> FuncG -> f FuncG
drawAttributes = (DrawAttributes -> f DrawAttributes) -> FuncG -> f FuncG
Lens' FuncG DrawAttributes
funcGDrawAttributes
instance HasDrawAttributes FuncB where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> FuncB -> f FuncB
drawAttributes = (DrawAttributes -> f DrawAttributes) -> FuncB -> f FuncB
Lens' FuncB DrawAttributes
funcBDrawAttributes

instance HasDrawAttributes Flood where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Flood -> f Flood
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Flood -> f Flood
Lens' Flood DrawAttributes
floodDrawAttributes

instance HasDrawAttributes Tile where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Tile -> f Tile
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Tile -> f Tile
Lens' Tile DrawAttributes
tileDrawAttributes

instance HasDrawAttributes Offset where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Offset -> f Offset
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Offset -> f Offset
Lens' Offset DrawAttributes
offsetDrawAttributes

instance HasDrawAttributes Merge where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Merge -> f Merge
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Merge -> f Merge
Lens' Merge DrawAttributes
mergeDrawAttributes

instance HasDrawAttributes ImageF where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> ImageF -> f ImageF
drawAttributes = (DrawAttributes -> f DrawAttributes) -> ImageF -> f ImageF
Lens' ImageF DrawAttributes
imageFDrawAttributes

instance HasDrawAttributes MergeNode where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> MergeNode -> f MergeNode
drawAttributes = (DrawAttributes -> f DrawAttributes) -> MergeNode -> f MergeNode
Lens' MergeNode DrawAttributes
mergeNodeDrawAttributes

instance HasDrawAttributes ColorMatrix where
  drawAttributes :: (DrawAttributes -> f DrawAttributes)
-> ColorMatrix -> f ColorMatrix
drawAttributes = (DrawAttributes -> f DrawAttributes)
-> ColorMatrix -> f ColorMatrix
Lens' ColorMatrix DrawAttributes
colorMatrixDrawAttributes

instance HasDrawAttributes GaussianBlur where
  drawAttributes :: (DrawAttributes -> f DrawAttributes)
-> GaussianBlur -> f GaussianBlur
drawAttributes = (DrawAttributes -> f DrawAttributes)
-> GaussianBlur -> f GaussianBlur
Lens' GaussianBlur DrawAttributes
gaussianBlurDrawAttributes

instance HasDrawAttributes Turbulence where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Turbulence -> f Turbulence
drawAttributes = (DrawAttributes -> f DrawAttributes) -> Turbulence -> f Turbulence
Lens' Turbulence DrawAttributes
turbulenceDrawAttributes

instance HasDrawAttributes DisplacementMap where
  drawAttributes :: (DrawAttributes -> f DrawAttributes)
-> DisplacementMap -> f DisplacementMap
drawAttributes = (DrawAttributes -> f DrawAttributes)
-> DisplacementMap -> f DisplacementMap
Lens' DisplacementMap DrawAttributes
displacementMapDrawAttributes

instance HasDrawAttributes Text where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> Text -> f Text
drawAttributes = (TextSpan -> f TextSpan) -> Text -> f Text
Lens' Text TextSpan
textRoot ((TextSpan -> f TextSpan) -> Text -> f Text)
-> ((DrawAttributes -> f DrawAttributes) -> TextSpan -> f TextSpan)
-> (DrawAttributes -> f DrawAttributes)
-> Text
-> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DrawAttributes -> f DrawAttributes) -> TextSpan -> f TextSpan
Lens' TextSpan DrawAttributes
spanDrawAttributes


instance HasFilterAttributes Filter where
  filterAttributes :: (FilterAttributes -> f FilterAttributes) -> Filter -> f Filter
filterAttributes = (FilterAttributes -> f FilterAttributes) -> Filter -> f Filter
Lens' Filter FilterAttributes
filterSelfAttributes

instance HasFilterAttributes Blend where
  filterAttributes :: (FilterAttributes -> f FilterAttributes) -> Blend -> f Blend
filterAttributes = (FilterAttributes -> f FilterAttributes) -> Blend -> f Blend
Lens' Blend FilterAttributes
blendFilterAttr

instance HasFilterAttributes ConvolveMatrix where
  filterAttributes :: (FilterAttributes -> f FilterAttributes)
-> ConvolveMatrix -> f ConvolveMatrix
filterAttributes = (FilterAttributes -> f FilterAttributes)
-> ConvolveMatrix -> f ConvolveMatrix
Lens' ConvolveMatrix FilterAttributes
convolveMatrixFilterAttr

instance HasFilterAttributes Morphology where
  filterAttributes :: (FilterAttributes -> f FilterAttributes)
-> Morphology -> f Morphology
filterAttributes = (FilterAttributes -> f FilterAttributes)
-> Morphology -> f Morphology
Lens' Morphology FilterAttributes
morphologyFilterAttr

instance HasFilterAttributes SpecularLighting where
  filterAttributes :: (FilterAttributes -> f FilterAttributes)
-> SpecularLighting -> f SpecularLighting
filterAttributes = (FilterAttributes -> f FilterAttributes)
-> SpecularLighting -> f SpecularLighting
Lens' SpecularLighting FilterAttributes
specLightingFilterAttr

instance HasFilterAttributes DropShadow where
  filterAttributes :: (FilterAttributes -> f FilterAttributes)
-> DropShadow -> f DropShadow
filterAttributes = (FilterAttributes -> f FilterAttributes)
-> DropShadow -> f DropShadow
Lens' DropShadow FilterAttributes
dropShadowFilterAttr

instance HasFilterAttributes DiffuseLighting where
  filterAttributes :: (FilterAttributes -> f FilterAttributes)
-> DiffuseLighting -> f DiffuseLighting
filterAttributes = (FilterAttributes -> f FilterAttributes)
-> DiffuseLighting -> f DiffuseLighting
Lens' DiffuseLighting FilterAttributes
diffuseLightingFilterAttr

instance HasFilterAttributes Flood where
  filterAttributes :: (FilterAttributes -> f FilterAttributes) -> Flood -> f Flood
filterAttributes = (FilterAttributes -> f FilterAttributes) -> Flood -> f Flood
Lens' Flood FilterAttributes
floodFilterAttr

instance HasFilterAttributes Tile where
  filterAttributes :: (FilterAttributes -> f FilterAttributes) -> Tile -> f Tile
filterAttributes = (FilterAttributes -> f FilterAttributes) -> Tile -> f Tile
Lens' Tile FilterAttributes
tileFilterAttr

instance HasFilterAttributes Offset where
  filterAttributes :: (FilterAttributes -> f FilterAttributes) -> Offset -> f Offset
filterAttributes = (FilterAttributes -> f FilterAttributes) -> Offset -> f Offset
Lens' Offset FilterAttributes
offsetFilterAttr

instance HasFilterAttributes Composite where
  filterAttributes :: (FilterAttributes -> f FilterAttributes)
-> Composite -> f Composite
filterAttributes = (FilterAttributes -> f FilterAttributes)
-> Composite -> f Composite
Lens' Composite FilterAttributes
compositeFilterAttr

instance HasFilterAttributes ColorMatrix where
  filterAttributes :: (FilterAttributes -> f FilterAttributes)
-> ColorMatrix -> f ColorMatrix
filterAttributes = (FilterAttributes -> f FilterAttributes)
-> ColorMatrix -> f ColorMatrix
Lens' ColorMatrix FilterAttributes
colorMatrixFilterAttr

instance HasFilterAttributes GaussianBlur where
  filterAttributes :: (FilterAttributes -> f FilterAttributes)
-> GaussianBlur -> f GaussianBlur
filterAttributes = (FilterAttributes -> f FilterAttributes)
-> GaussianBlur -> f GaussianBlur
Lens' GaussianBlur FilterAttributes
gaussianBlurFilterAttr

instance HasFilterAttributes Turbulence where
  filterAttributes :: (FilterAttributes -> f FilterAttributes)
-> Turbulence -> f Turbulence
filterAttributes = (FilterAttributes -> f FilterAttributes)
-> Turbulence -> f Turbulence
Lens' Turbulence FilterAttributes
turbulenceFilterAttr

instance HasFilterAttributes DisplacementMap where
  filterAttributes :: (FilterAttributes -> f FilterAttributes)
-> DisplacementMap -> f DisplacementMap
filterAttributes = (FilterAttributes -> f FilterAttributes)
-> DisplacementMap -> f DisplacementMap
Lens' DisplacementMap FilterAttributes
displacementMapFilterAttr

instance HasFilterAttributes Merge where
  filterAttributes :: (FilterAttributes -> f FilterAttributes) -> Merge -> f Merge
filterAttributes = (FilterAttributes -> f FilterAttributes) -> Merge -> f Merge
Lens' Merge FilterAttributes
mergeFilterAttributes

instance HasFilterAttributes ImageF where
  filterAttributes :: (FilterAttributes -> f FilterAttributes) -> ImageF -> f ImageF
filterAttributes = (FilterAttributes -> f FilterAttributes) -> ImageF -> f ImageF
Lens' ImageF FilterAttributes
imageFFilterAttr

instance HasFilterAttributes ComponentTransfer where
  filterAttributes :: (FilterAttributes -> f FilterAttributes)
-> ComponentTransfer -> f ComponentTransfer
filterAttributes = (FilterAttributes -> f FilterAttributes)
-> ComponentTransfer -> f ComponentTransfer
Lens' ComponentTransfer FilterAttributes
compTransferFilterAttr



instance HasFilterAttributes FilterElement where
  filterAttributes :: (FilterAttributes -> f FilterAttributes)
-> FilterElement -> f FilterElement
filterAttributes = (FilterElement -> FilterAttributes)
-> (FilterElement -> FilterAttributes -> FilterElement)
-> Lens' FilterElement FilterAttributes
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FilterElement -> FilterAttributes
getter FilterElement -> FilterAttributes -> FilterElement
setter
    where
      getter :: FilterElement -> FilterAttributes
getter FilterElement
fe = case FilterElement
fe of
        FEBlend Blend
b -> Blend
b Blend
-> Getting FilterAttributes Blend FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes Blend FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FEColorMatrix ColorMatrix
m -> ColorMatrix
m ColorMatrix
-> Getting FilterAttributes ColorMatrix FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes ColorMatrix FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FEComponentTransfer ComponentTransfer
c -> ComponentTransfer
c ComponentTransfer
-> Getting FilterAttributes ComponentTransfer FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes ComponentTransfer FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FEComposite Composite
c -> Composite
c Composite
-> Getting FilterAttributes Composite FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes Composite FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FEConvolveMatrix ConvolveMatrix
c -> ConvolveMatrix
c ConvolveMatrix
-> Getting FilterAttributes ConvolveMatrix FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes ConvolveMatrix FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FEDiffuseLighting DiffuseLighting
d -> DiffuseLighting
d DiffuseLighting
-> Getting FilterAttributes DiffuseLighting FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes DiffuseLighting FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FEDisplacementMap DisplacementMap
d -> DisplacementMap
d DisplacementMap
-> Getting FilterAttributes DisplacementMap FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes DisplacementMap FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FEDropShadow DropShadow
d -> DropShadow
d DropShadow
-> Getting FilterAttributes DropShadow FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes DropShadow FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FEFlood Flood
f -> Flood
f Flood
-> Getting FilterAttributes Flood FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes Flood FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FEFuncA FuncA
_ -> FilterAttributes
forall a. WithDefaultSvg a => a
defaultSvg --FuncA has no filter attributes
        FEFuncR FuncR
_ -> FilterAttributes
forall a. WithDefaultSvg a => a
defaultSvg --FuncR has no filter attributes
        FEFuncG FuncG
_ -> FilterAttributes
forall a. WithDefaultSvg a => a
defaultSvg --FuncG has no filter attributes
        FEFuncB FuncB
_ -> FilterAttributes
forall a. WithDefaultSvg a => a
defaultSvg --FuncB has no filter attributes
        FEGaussianBlur GaussianBlur
g -> GaussianBlur
g GaussianBlur
-> Getting FilterAttributes GaussianBlur FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes GaussianBlur FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FEImage ImageF
i -> ImageF
i ImageF
-> Getting FilterAttributes ImageF FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes ImageF FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FEMergeNode MergeNode
_ -> FilterAttributes
forall a. WithDefaultSvg a => a
defaultSvg --MergeNode has no filterAttributes!
        FEMerge Merge
m -> Merge
m Merge
-> Getting FilterAttributes Merge FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes Merge FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FEMorphology Morphology
m -> Morphology
m Morphology
-> Getting FilterAttributes Morphology FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes Morphology FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FEOffset Offset
o -> Offset
o Offset
-> Getting FilterAttributes Offset FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes Offset FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FESpecularLighting SpecularLighting
s -> SpecularLighting
s SpecularLighting
-> Getting FilterAttributes SpecularLighting FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes SpecularLighting FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FETile Tile
t -> Tile
t Tile
-> Getting FilterAttributes Tile FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes Tile FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FETurbulence Turbulence
t -> Turbulence
t Turbulence
-> Getting FilterAttributes Turbulence FilterAttributes
-> FilterAttributes
forall s a. s -> Getting a s a -> a
^. Getting FilterAttributes Turbulence FilterAttributes
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes
        FilterElement
FENone -> FilterAttributes
forall a. WithDefaultSvg a => a
defaultSvg
      setter :: FilterElement -> FilterAttributes -> FilterElement
setter FilterElement
fe FilterAttributes
attr = case FilterElement
fe of
        FEBlend Blend
b -> Blend -> FilterElement
FEBlend (Blend -> FilterElement) -> Blend -> FilterElement
forall a b. (a -> b) -> a -> b
$ Blend
b Blend -> (Blend -> Blend) -> Blend
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> Blend -> Identity Blend
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> Blend -> Identity Blend)
-> FilterAttributes -> Blend -> Blend
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FEColorMatrix ColorMatrix
m -> ColorMatrix -> FilterElement
FEColorMatrix (ColorMatrix -> FilterElement) -> ColorMatrix -> FilterElement
forall a b. (a -> b) -> a -> b
$ ColorMatrix
m ColorMatrix -> (ColorMatrix -> ColorMatrix) -> ColorMatrix
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> ColorMatrix -> Identity ColorMatrix
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> ColorMatrix -> Identity ColorMatrix)
-> FilterAttributes -> ColorMatrix -> ColorMatrix
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FEComponentTransfer ComponentTransfer
c -> ComponentTransfer -> FilterElement
FEComponentTransfer (ComponentTransfer -> FilterElement)
-> ComponentTransfer -> FilterElement
forall a b. (a -> b) -> a -> b
$ ComponentTransfer
c ComponentTransfer
-> (ComponentTransfer -> ComponentTransfer) -> ComponentTransfer
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> ComponentTransfer -> Identity ComponentTransfer
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> ComponentTransfer -> Identity ComponentTransfer)
-> FilterAttributes -> ComponentTransfer -> ComponentTransfer
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FEComposite Composite
c -> Composite -> FilterElement
FEComposite (Composite -> FilterElement) -> Composite -> FilterElement
forall a b. (a -> b) -> a -> b
$ Composite
c Composite -> (Composite -> Composite) -> Composite
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> Composite -> Identity Composite
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> Composite -> Identity Composite)
-> FilterAttributes -> Composite -> Composite
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FEConvolveMatrix ConvolveMatrix
c -> ConvolveMatrix -> FilterElement
FEConvolveMatrix (ConvolveMatrix -> FilterElement)
-> ConvolveMatrix -> FilterElement
forall a b. (a -> b) -> a -> b
$ ConvolveMatrix
c ConvolveMatrix
-> (ConvolveMatrix -> ConvolveMatrix) -> ConvolveMatrix
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> ConvolveMatrix -> Identity ConvolveMatrix
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> ConvolveMatrix -> Identity ConvolveMatrix)
-> FilterAttributes -> ConvolveMatrix -> ConvolveMatrix
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FEDiffuseLighting DiffuseLighting
d -> DiffuseLighting -> FilterElement
FEDiffuseLighting (DiffuseLighting -> FilterElement)
-> DiffuseLighting -> FilterElement
forall a b. (a -> b) -> a -> b
$ DiffuseLighting
d DiffuseLighting
-> (DiffuseLighting -> DiffuseLighting) -> DiffuseLighting
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> DiffuseLighting -> Identity DiffuseLighting
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> DiffuseLighting -> Identity DiffuseLighting)
-> FilterAttributes -> DiffuseLighting -> DiffuseLighting
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FEDisplacementMap DisplacementMap
d -> DisplacementMap -> FilterElement
FEDisplacementMap (DisplacementMap -> FilterElement)
-> DisplacementMap -> FilterElement
forall a b. (a -> b) -> a -> b
$ DisplacementMap
d DisplacementMap
-> (DisplacementMap -> DisplacementMap) -> DisplacementMap
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> DisplacementMap -> Identity DisplacementMap
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> DisplacementMap -> Identity DisplacementMap)
-> FilterAttributes -> DisplacementMap -> DisplacementMap
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FEDropShadow DropShadow
d -> DropShadow -> FilterElement
FEDropShadow (DropShadow -> FilterElement) -> DropShadow -> FilterElement
forall a b. (a -> b) -> a -> b
$ DropShadow
d DropShadow -> (DropShadow -> DropShadow) -> DropShadow
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> DropShadow -> Identity DropShadow
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> DropShadow -> Identity DropShadow)
-> FilterAttributes -> DropShadow -> DropShadow
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FEFlood Flood
f -> Flood -> FilterElement
FEFlood (Flood -> FilterElement) -> Flood -> FilterElement
forall a b. (a -> b) -> a -> b
$ Flood
f Flood -> (Flood -> Flood) -> Flood
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> Flood -> Identity Flood
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> Flood -> Identity Flood)
-> FilterAttributes -> Flood -> Flood
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FEFuncA FuncA
_ -> FilterElement
fe --FuncA has no filter atributes
        FEFuncR FuncR
_ -> FilterElement
fe --FuncR has no filter atributes
        FEFuncG FuncG
_ -> FilterElement
fe --FuncG has no filter atributes
        FEFuncB FuncB
_ -> FilterElement
fe --FuncB has no filter atributes
        FEGaussianBlur GaussianBlur
g -> GaussianBlur -> FilterElement
FEGaussianBlur (GaussianBlur -> FilterElement) -> GaussianBlur -> FilterElement
forall a b. (a -> b) -> a -> b
$ GaussianBlur
g GaussianBlur -> (GaussianBlur -> GaussianBlur) -> GaussianBlur
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> GaussianBlur -> Identity GaussianBlur
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> GaussianBlur -> Identity GaussianBlur)
-> FilterAttributes -> GaussianBlur -> GaussianBlur
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FEImage ImageF
i -> ImageF -> FilterElement
FEImage (ImageF -> FilterElement) -> ImageF -> FilterElement
forall a b. (a -> b) -> a -> b
$ ImageF
i ImageF -> (ImageF -> ImageF) -> ImageF
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> ImageF -> Identity ImageF
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> ImageF -> Identity ImageF)
-> FilterAttributes -> ImageF -> ImageF
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FEMerge Merge
m -> Merge -> FilterElement
FEMerge (Merge -> FilterElement) -> Merge -> FilterElement
forall a b. (a -> b) -> a -> b
$ Merge
m Merge -> (Merge -> Merge) -> Merge
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> Merge -> Identity Merge
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> Merge -> Identity Merge)
-> FilterAttributes -> Merge -> Merge
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FEMergeNode MergeNode
_ -> FilterElement
fe --MergeNode has no filterAttributes!
        FEMorphology Morphology
m -> Morphology -> FilterElement
FEMorphology (Morphology -> FilterElement) -> Morphology -> FilterElement
forall a b. (a -> b) -> a -> b
$ Morphology
m Morphology -> (Morphology -> Morphology) -> Morphology
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> Morphology -> Identity Morphology
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> Morphology -> Identity Morphology)
-> FilterAttributes -> Morphology -> Morphology
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FEOffset Offset
o -> Offset -> FilterElement
FEOffset (Offset -> FilterElement) -> Offset -> FilterElement
forall a b. (a -> b) -> a -> b
$ Offset
o Offset -> (Offset -> Offset) -> Offset
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> Offset -> Identity Offset
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> Offset -> Identity Offset)
-> FilterAttributes -> Offset -> Offset
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FESpecularLighting SpecularLighting
s -> SpecularLighting -> FilterElement
FESpecularLighting (SpecularLighting -> FilterElement)
-> SpecularLighting -> FilterElement
forall a b. (a -> b) -> a -> b
$ SpecularLighting
s SpecularLighting
-> (SpecularLighting -> SpecularLighting) -> SpecularLighting
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> SpecularLighting -> Identity SpecularLighting
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> SpecularLighting -> Identity SpecularLighting)
-> FilterAttributes -> SpecularLighting -> SpecularLighting
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FETile Tile
t -> Tile -> FilterElement
FETile (Tile -> FilterElement) -> Tile -> FilterElement
forall a b. (a -> b) -> a -> b
$ Tile
t Tile -> (Tile -> Tile) -> Tile
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> Tile -> Identity Tile
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> Tile -> Identity Tile)
-> FilterAttributes -> Tile -> Tile
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FETurbulence Turbulence
t -> Turbulence -> FilterElement
FETurbulence (Turbulence -> FilterElement) -> Turbulence -> FilterElement
forall a b. (a -> b) -> a -> b
$ Turbulence
t Turbulence -> (Turbulence -> Turbulence) -> Turbulence
forall a b. a -> (a -> b) -> b
& (FilterAttributes -> Identity FilterAttributes)
-> Turbulence -> Identity Turbulence
forall c. HasFilterAttributes c => Lens' c FilterAttributes
filterAttributes ((FilterAttributes -> Identity FilterAttributes)
 -> Turbulence -> Identity Turbulence)
-> FilterAttributes -> Turbulence -> Turbulence
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilterAttributes
attr
        FilterElement
FENone -> FilterElement
fe

instance HasDrawAttributes TreeBranch where
  drawAttributes :: (DrawAttributes -> f DrawAttributes) -> TreeBranch -> f TreeBranch
drawAttributes = (TreeBranch -> DrawAttributes)
-> (TreeBranch -> DrawAttributes -> TreeBranch)
-> Lens' TreeBranch DrawAttributes
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TreeBranch -> DrawAttributes
getter TreeBranch -> DrawAttributes -> TreeBranch
setter
    where
      getter :: TreeBranch -> DrawAttributes
getter TreeBranch
b = case TreeBranch
b of
        TreeBranch
NoNode -> DrawAttributes
forall a. WithDefaultSvg a => a
defaultSvg
        UseNode Use
use Maybe Tree
_subNode -> Use
use Use -> Getting DrawAttributes Use DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Use DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        GroupNode Group
t -> Group
t Group
-> Getting DrawAttributes Group DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Group DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        SymbolNode Group
t -> Group
t Group
-> Getting DrawAttributes Group DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Group DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        DefinitionNode Group
t -> Group
t Group
-> Getting DrawAttributes Group DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Group DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        FilterNode Filter
t -> Filter
t Filter
-> Getting DrawAttributes Filter DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Filter DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        PathNode Path
t -> Path
t Path
-> Getting DrawAttributes Path DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Path DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        CircleNode Circle
t -> Circle
t Circle
-> Getting DrawAttributes Circle DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Circle DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        PolyLineNode PolyLine
t -> PolyLine
t PolyLine
-> Getting DrawAttributes PolyLine DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes PolyLine DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        PolygonNode Polygon
t -> Polygon
t Polygon
-> Getting DrawAttributes Polygon DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Polygon DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        EllipseNode Ellipse
t -> Ellipse
t Ellipse
-> Getting DrawAttributes Ellipse DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Ellipse DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        LineNode Line
t -> Line
t Line
-> Getting DrawAttributes Line DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Line DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        RectangleNode Rectangle
t -> Rectangle
t Rectangle
-> Getting DrawAttributes Rectangle DrawAttributes
-> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Rectangle DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        TextNode Maybe TextPath
_ Text
t -> Text
t Text
-> Getting DrawAttributes Text DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Text DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        ImageNode Image
t -> Image
t Image
-> Getting DrawAttributes Image DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Image DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        LinearGradientNode LinearGradient
t -> LinearGradient
t LinearGradient
-> Getting DrawAttributes LinearGradient DrawAttributes
-> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes LinearGradient DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        RadialGradientNode RadialGradient
t -> RadialGradient
t RadialGradient
-> Getting DrawAttributes RadialGradient DrawAttributes
-> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes RadialGradient DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        MeshGradientNode MeshGradient
t -> MeshGradient
t MeshGradient
-> Getting DrawAttributes MeshGradient DrawAttributes
-> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes MeshGradient DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        PatternNode Pattern
t -> Pattern
t Pattern
-> Getting DrawAttributes Pattern DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Pattern DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        MarkerNode Marker
t -> Marker
t Marker
-> Getting DrawAttributes Marker DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Marker DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        MaskNode Mask
t -> Mask
t Mask
-> Getting DrawAttributes Mask DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Mask DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        ClipPathNode ClipPath
t -> ClipPath
t ClipPath
-> Getting DrawAttributes ClipPath DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes ClipPath DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
        SvgNode{} -> DrawAttributes
forall a. WithDefaultSvg a => a
defaultSvg
      setter :: TreeBranch -> DrawAttributes -> TreeBranch
setter TreeBranch
b DrawAttributes
attr = case TreeBranch
b of
        TreeBranch
NoNode -> TreeBranch
b
        UseNode Use
use Maybe Tree
subNode -> Use -> Maybe Tree -> TreeBranch
UseNode (Use
use Use -> (Use -> Use) -> Use
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes) -> Use -> Identity Use
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Use -> Identity Use)
-> DrawAttributes -> Use -> Use
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr) Maybe Tree
subNode
        GroupNode Group
t -> Group -> TreeBranch
GroupNode (Group -> TreeBranch) -> Group -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Group
t Group -> (Group -> Group) -> Group
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Group -> Identity Group
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Group -> Identity Group)
-> DrawAttributes -> Group -> Group
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        SymbolNode Group
t -> Group -> TreeBranch
SymbolNode (Group -> TreeBranch) -> Group -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Group
t Group -> (Group -> Group) -> Group
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Group -> Identity Group
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Group -> Identity Group)
-> DrawAttributes -> Group -> Group
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        DefinitionNode Group
t -> Group -> TreeBranch
DefinitionNode (Group -> TreeBranch) -> Group -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Group
t Group -> (Group -> Group) -> Group
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Group -> Identity Group
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Group -> Identity Group)
-> DrawAttributes -> Group -> Group
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        FilterNode Filter
t -> Filter -> TreeBranch
FilterNode (Filter -> TreeBranch) -> Filter -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Filter
t Filter -> (Filter -> Filter) -> Filter
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Filter -> Identity Filter
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Filter -> Identity Filter)
-> DrawAttributes -> Filter -> Filter
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        PathNode Path
t -> Path -> TreeBranch
PathNode (Path -> TreeBranch) -> Path -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Path
t Path -> (Path -> Path) -> Path
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Path -> Identity Path
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Path -> Identity Path)
-> DrawAttributes -> Path -> Path
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        CircleNode Circle
t -> Circle -> TreeBranch
CircleNode (Circle -> TreeBranch) -> Circle -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Circle
t Circle -> (Circle -> Circle) -> Circle
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Circle -> Identity Circle
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Circle -> Identity Circle)
-> DrawAttributes -> Circle -> Circle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        PolyLineNode PolyLine
t -> PolyLine -> TreeBranch
PolyLineNode (PolyLine -> TreeBranch) -> PolyLine -> TreeBranch
forall a b. (a -> b) -> a -> b
$ PolyLine
t PolyLine -> (PolyLine -> PolyLine) -> PolyLine
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> PolyLine -> Identity PolyLine
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> PolyLine -> Identity PolyLine)
-> DrawAttributes -> PolyLine -> PolyLine
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        PolygonNode Polygon
t -> Polygon -> TreeBranch
PolygonNode (Polygon -> TreeBranch) -> Polygon -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Polygon
t Polygon -> (Polygon -> Polygon) -> Polygon
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Polygon -> Identity Polygon
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Polygon -> Identity Polygon)
-> DrawAttributes -> Polygon -> Polygon
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        EllipseNode Ellipse
t -> Ellipse -> TreeBranch
EllipseNode (Ellipse -> TreeBranch) -> Ellipse -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Ellipse
t Ellipse -> (Ellipse -> Ellipse) -> Ellipse
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Ellipse -> Identity Ellipse
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Ellipse -> Identity Ellipse)
-> DrawAttributes -> Ellipse -> Ellipse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        LineNode Line
t -> Line -> TreeBranch
LineNode (Line -> TreeBranch) -> Line -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Line
t Line -> (Line -> Line) -> Line
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Line -> Identity Line
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Line -> Identity Line)
-> DrawAttributes -> Line -> Line
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        RectangleNode Rectangle
t -> Rectangle -> TreeBranch
RectangleNode (Rectangle -> TreeBranch) -> Rectangle -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Rectangle
t Rectangle -> (Rectangle -> Rectangle) -> Rectangle
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Rectangle -> Identity Rectangle
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Rectangle -> Identity Rectangle)
-> DrawAttributes -> Rectangle -> Rectangle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        TextNode Maybe TextPath
path Text
t -> Maybe TextPath -> Text -> TreeBranch
TextNode Maybe TextPath
path (Text -> TreeBranch) -> Text -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Text
t Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Text -> Identity Text
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Text -> Identity Text)
-> DrawAttributes -> Text -> Text
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        ImageNode Image
t -> Image -> TreeBranch
ImageNode (Image -> TreeBranch) -> Image -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Image
t Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Image -> Identity Image
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Image -> Identity Image)
-> DrawAttributes -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        LinearGradientNode LinearGradient
t -> LinearGradient -> TreeBranch
LinearGradientNode (LinearGradient -> TreeBranch) -> LinearGradient -> TreeBranch
forall a b. (a -> b) -> a -> b
$ LinearGradient
t LinearGradient
-> (LinearGradient -> LinearGradient) -> LinearGradient
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> LinearGradient -> Identity LinearGradient
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> LinearGradient -> Identity LinearGradient)
-> DrawAttributes -> LinearGradient -> LinearGradient
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        RadialGradientNode RadialGradient
t -> RadialGradient -> TreeBranch
RadialGradientNode (RadialGradient -> TreeBranch) -> RadialGradient -> TreeBranch
forall a b. (a -> b) -> a -> b
$ RadialGradient
t RadialGradient
-> (RadialGradient -> RadialGradient) -> RadialGradient
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> RadialGradient -> Identity RadialGradient
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> RadialGradient -> Identity RadialGradient)
-> DrawAttributes -> RadialGradient -> RadialGradient
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        MeshGradientNode MeshGradient
t -> MeshGradient -> TreeBranch
MeshGradientNode (MeshGradient -> TreeBranch) -> MeshGradient -> TreeBranch
forall a b. (a -> b) -> a -> b
$ MeshGradient
t MeshGradient -> (MeshGradient -> MeshGradient) -> MeshGradient
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> MeshGradient -> Identity MeshGradient
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> MeshGradient -> Identity MeshGradient)
-> DrawAttributes -> MeshGradient -> MeshGradient
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        PatternNode Pattern
t -> Pattern -> TreeBranch
PatternNode (Pattern -> TreeBranch) -> Pattern -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Pattern
t Pattern -> (Pattern -> Pattern) -> Pattern
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Pattern -> Identity Pattern
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Pattern -> Identity Pattern)
-> DrawAttributes -> Pattern -> Pattern
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        MarkerNode Marker
t -> Marker -> TreeBranch
MarkerNode (Marker -> TreeBranch) -> Marker -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Marker
t Marker -> (Marker -> Marker) -> Marker
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Marker -> Identity Marker
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Marker -> Identity Marker)
-> DrawAttributes -> Marker -> Marker
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        MaskNode Mask
t -> Mask -> TreeBranch
MaskNode (Mask -> TreeBranch) -> Mask -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Mask
t Mask -> (Mask -> Mask) -> Mask
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Mask -> Identity Mask
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Mask -> Identity Mask)
-> DrawAttributes -> Mask -> Mask
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        ClipPathNode ClipPath
t -> ClipPath -> TreeBranch
ClipPathNode (ClipPath -> TreeBranch) -> ClipPath -> TreeBranch
forall a b. (a -> b) -> a -> b
$ ClipPath
t ClipPath -> (ClipPath -> ClipPath) -> ClipPath
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> ClipPath -> Identity ClipPath
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> ClipPath -> Identity ClipPath)
-> DrawAttributes -> ClipPath -> ClipPath
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr
        SvgNode {} -> Group -> TreeBranch
GroupNode (Group -> TreeBranch) -> Group -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Group
forall a. WithDefaultSvg a => a
defaultSvg 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
.~ [TreeBranch -> Tree
Tree TreeBranch
b] Group -> (Group -> Group) -> Group
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> Group -> Identity Group
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Group -> Identity Group)
-> DrawAttributes -> Group -> Group
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DrawAttributes
attr