Instances.hs

{-# 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 _ _ = Nothing
  cssClassOf = view (drawAttributes . attrClass)
  cssIdOf = fmap T.pack . view (drawAttributes . attrId)
  cssNameOf = nameOfTree

instance HasDrawAttributes Tree where
  drawAttributes = treeBranch . drawAttributes

instance HasDrawAttributes Filter where
  drawAttributes = filterDrawAttributes

instance HasDrawAttributes Use where
  drawAttributes = useDrawAttributes

instance HasDrawAttributes Group where
  drawAttributes = groupDrawAttributes

instance HasDrawAttributes Rectangle where
  drawAttributes = rectangleDrawAttributes

instance HasDrawAttributes Line where
  drawAttributes = lineDrawAttributes

instance HasDrawAttributes Ellipse where
  drawAttributes = ellipseDrawAttributes

instance HasDrawAttributes Polygon where
  drawAttributes = polygonDrawAttributes

instance HasDrawAttributes PolyLine where
  drawAttributes = polyLineDrawAttributes

instance HasDrawAttributes Circle where
  drawAttributes = circleDrawAttributes

instance HasDrawAttributes Path where
  drawAttributes = pathDrawAttributes

instance HasDrawAttributes ClipPath where
  drawAttributes = clipPathDrawAttributes

instance HasDrawAttributes Mask where
  drawAttributes = maskDrawAttributes

instance HasDrawAttributes Marker where
  drawAttributes = markerDrawAttributes

instance HasDrawAttributes Image where
  drawAttributes = imageDrawAttributes

instance HasDrawAttributes Pattern where
  drawAttributes = patternDrawAttributes

instance HasDrawAttributes MeshGradient where
  drawAttributes = meshGradientDrawAttributes

instance HasDrawAttributes RadialGradient where
  drawAttributes = radialGradientDrawAttributes

instance HasDrawAttributes LinearGradient where
  drawAttributes = linearGradientDrawAttributes

instance HasDrawAttributes Composite where
  drawAttributes = compositeDrawAttributes

instance HasDrawAttributes ColorMatrix where
  drawAttributes = colorMatrixDrawAttributes

instance HasDrawAttributes GaussianBlur where
  drawAttributes = gaussianBlurDrawAttributes

instance HasDrawAttributes Turbulence where
  drawAttributes = turbulenceDrawAttributes

instance HasDrawAttributes DisplacementMap where
  drawAttributes = displacementMapDrawAttributes

instance HasDrawAttributes Text where
  drawAttributes = textRoot . spanDrawAttributes

instance HasFilterAttributes Filter where
  filterAttributes = filterSelfAttributes

instance HasFilterAttributes Composite where
  filterAttributes = compositeFilterAttr

instance HasFilterAttributes ColorMatrix where
  filterAttributes = colorMatrixFilterAttr

instance HasFilterAttributes GaussianBlur where
  filterAttributes = gaussianBlurFilterAttr

instance HasFilterAttributes Turbulence where
  filterAttributes = turbulenceFilterAttr

instance HasFilterAttributes DisplacementMap where
  filterAttributes = displacementMapFilterAttr

instance HasFilterAttributes FilterElement where
  filterAttributes = lens getter setter
    where
      getter fe = case fe of
        FEBlend -> defaultSvg
        FEColorMatrix m -> m ^. filterAttributes
        FEComponentTransfer -> defaultSvg
        FEComposite c -> c ^. filterAttributes
        FEConvolveMatrix -> defaultSvg
        FEDiffuseLighting -> defaultSvg
        FEDisplacementMap d -> d ^. filterAttributes
        FEDropShadow -> defaultSvg
        FEFlood -> defaultSvg
        FEFuncA -> defaultSvg
        FEFuncB -> defaultSvg
        FEFuncG -> defaultSvg
        FEFuncR -> defaultSvg
        FEGaussianBlur g -> g ^. filterAttributes
        FEImage -> defaultSvg
        FEMerge -> defaultSvg
        FEMergeNode -> defaultSvg
        FEMorphology -> defaultSvg
        FEOffset -> defaultSvg
        FESpecularLighting -> defaultSvg
        FETile -> defaultSvg
        FETurbulence t -> t ^. filterAttributes
        FENone -> defaultSvg
      setter fe attr = case fe of
        FEBlend -> fe
        FEColorMatrix m -> FEColorMatrix $ m & filterAttributes .~ attr
        FEComponentTransfer -> fe
        FEComposite c -> FEComposite $ c & filterAttributes .~ attr
        FEConvolveMatrix -> fe
        FEDiffuseLighting -> fe
        FEDisplacementMap d -> FEDisplacementMap $ d & filterAttributes .~ attr
        FEDropShadow -> fe
        FEFlood -> fe
        FEFuncA -> fe
        FEFuncB -> fe
        FEFuncG -> fe
        FEFuncR -> fe
        FEGaussianBlur g -> FEGaussianBlur $ g & filterAttributes .~ attr
        FEImage -> fe
        FEMerge -> fe
        FEMergeNode -> fe
        FEMorphology -> fe
        FEOffset -> fe
        FESpecularLighting -> fe
        FETile -> fe
        FETurbulence t -> FETurbulence $ t & filterAttributes .~ attr
        FENone -> fe

instance HasDrawAttributes TreeBranch where
  drawAttributes = lens getter setter
    where
      getter b = case b of
        NoNode -> defaultSvg
        UseNode use _subNode -> use ^. drawAttributes
        GroupNode t -> t ^. drawAttributes
        SymbolNode t -> t ^. drawAttributes
        DefinitionNode t -> t ^. drawAttributes
        FilterNode t -> t ^. drawAttributes
        PathNode t -> t ^. drawAttributes
        CircleNode t -> t ^. drawAttributes
        PolyLineNode t -> t ^. drawAttributes
        PolygonNode t -> t ^. drawAttributes
        EllipseNode t -> t ^. drawAttributes
        LineNode t -> t ^. drawAttributes
        RectangleNode t -> t ^. drawAttributes
        TextNode _ t -> t ^. drawAttributes
        ImageNode t -> t ^. drawAttributes
        LinearGradientNode t -> t ^. drawAttributes
        RadialGradientNode t -> t ^. drawAttributes
        MeshGradientNode t -> t ^. drawAttributes
        PatternNode t -> t ^. drawAttributes
        MarkerNode t -> t ^. drawAttributes
        MaskNode t -> t ^. drawAttributes
        ClipPathNode t -> t ^. drawAttributes
        SvgNode{} -> defaultSvg
      setter b attr = case b of
        NoNode -> b
        UseNode use subNode -> UseNode (use & drawAttributes .~ attr) subNode
        GroupNode t -> GroupNode $ t & drawAttributes .~ attr
        SymbolNode t -> SymbolNode $ t & drawAttributes .~ attr
        DefinitionNode t -> DefinitionNode $ t & drawAttributes .~ attr
        FilterNode t -> FilterNode $ t & drawAttributes .~ attr
        PathNode t -> PathNode $ t & drawAttributes .~ attr
        CircleNode t -> CircleNode $ t & drawAttributes .~ attr
        PolyLineNode t -> PolyLineNode $ t & drawAttributes .~ attr
        PolygonNode t -> PolygonNode $ t & drawAttributes .~ attr
        EllipseNode t -> EllipseNode $ t & drawAttributes .~ attr
        LineNode t -> LineNode $ t & drawAttributes .~ attr
        RectangleNode t -> RectangleNode $ t & drawAttributes .~ attr
        TextNode path t -> TextNode path $ t & drawAttributes .~ attr
        ImageNode t -> ImageNode $ t & drawAttributes .~ attr
        LinearGradientNode t -> LinearGradientNode $ t & drawAttributes .~ attr
        RadialGradientNode t -> RadialGradientNode $ t & drawAttributes .~ attr
        MeshGradientNode t -> MeshGradientNode $ t & drawAttributes .~ attr
        PatternNode t -> PatternNode $ t & drawAttributes .~ attr
        MarkerNode t -> MarkerNode $ t & drawAttributes .~ attr
        MaskNode t -> MaskNode $ t & drawAttributes .~ attr
        ClipPathNode t -> ClipPathNode $ t & drawAttributes .~ attr
        SvgNode {} -> GroupNode $ defaultSvg & groupChildren .~ [Tree b] & drawAttributes .~ attr