{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-orphans -O0 #-}

module Graphics.SvgTree.Types.Hashable where

import Codec.Picture (PixelRGBA8 (..))
import Control.Lens
import Data.Hashable
import GHC.Generics (Generic)
import Graphics.SvgTree.Types.Internal

-- Orphan instances :(

deriving instance Generic PixelRGBA8

instance Hashable PixelRGBA8

deriving instance Hashable DrawAttributes

deriving instance Hashable Pattern

deriving instance Hashable Element

deriving instance Hashable ClipPath

deriving instance Hashable Mask

deriving instance Hashable CoordinateUnits

deriving instance Hashable TreeBranch

deriving instance Hashable Group

deriving instance Hashable PreserveAspectRatio

deriving instance Hashable Alignment

deriving instance Hashable MeetSlice

deriving instance Hashable LinearGradient

deriving instance Hashable Spread

deriving instance Hashable Transformation

deriving instance Hashable GradientStop

deriving instance Hashable GradientPathCommand

deriving instance Hashable Origin

deriving instance Hashable Use

deriving instance Hashable Filter

deriving instance Hashable FilterAttributes

deriving instance Hashable FilterElement

deriving instance Hashable Blend
deriving instance Hashable BlendMode

deriving instance Hashable ConvolveMatrix

deriving instance Hashable Morphology
deriving instance Hashable OperatorType
deriving instance Hashable NumberOptionalNumber

deriving instance Hashable SpecularLighting

deriving instance Hashable DropShadow

deriving instance Hashable DiffuseLighting

deriving instance Hashable Flood

deriving instance Hashable Tile

deriving instance Hashable Offset

deriving instance Hashable Merge
deriving instance Hashable MergeNode

deriving instance Hashable ImageF

deriving instance Hashable ComponentTransfer
deriving instance Hashable FuncType
deriving instance Hashable FuncA
deriving instance Hashable FuncR
deriving instance Hashable FuncG
deriving instance Hashable FuncB

deriving instance Hashable ColorMatrix

deriving instance Hashable FilterSource

deriving instance Hashable ColorMatrixType

deriving instance Hashable Composite

deriving instance Hashable CompositeOperator

deriving instance Hashable DisplacementMap

deriving instance Hashable ChannelSelector

deriving instance Hashable GaussianBlur

deriving instance Hashable EdgeMode

deriving instance Hashable Turbulence

deriving instance Hashable StitchTiles

deriving instance Hashable TurbulenceType

deriving instance Hashable Path

deriving instance Hashable PathCommand

deriving instance Hashable Circle

deriving instance Hashable PolyLine

deriving instance Hashable Polygon

deriving instance Hashable Ellipse

deriving instance Hashable Line

deriving instance Hashable Rectangle

deriving instance Hashable TextPath

deriving instance Hashable TextPathMethod

deriving instance Hashable TextPathSpacing

deriving instance Hashable Text

deriving instance Hashable TextAdjust

deriving instance Hashable TextSpan

deriving instance Hashable TextInfo

deriving instance Hashable TextSpanContent

deriving instance Hashable Image

deriving instance Hashable RadialGradient

deriving instance Hashable MeshGradient

deriving instance Hashable MeshGradientType

deriving instance Hashable MeshGradientRow

deriving instance Hashable MeshGradientPatch

deriving instance Hashable Marker

deriving instance Hashable MarkerOrientation

deriving instance Hashable MarkerUnit

deriving instance Hashable Overflow

deriving instance Hashable Document

deriving instance Hashable Texture

deriving instance Hashable Cap

deriving instance Hashable LineJoin

deriving instance Hashable FillRule

deriving instance Hashable ElementRef

deriving instance Hashable FontStyle

deriving instance Hashable TextAnchor

instance Hashable Tree where
  hashWithSalt :: Int -> Tree -> Int
hashWithSalt Int
s = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int -> Int) -> (Tree -> Int) -> Tree -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree -> Int
_treeHash

treeBranch :: Lens' Tree TreeBranch
treeBranch :: (TreeBranch -> f TreeBranch) -> Tree -> f Tree
treeBranch = (Tree -> TreeBranch)
-> (Tree -> TreeBranch -> Tree)
-> Lens Tree Tree TreeBranch TreeBranch
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Tree -> TreeBranch
_treeBranch ((Tree -> TreeBranch -> Tree)
 -> Lens Tree Tree TreeBranch TreeBranch)
-> (Tree -> TreeBranch -> Tree)
-> Lens Tree Tree TreeBranch TreeBranch
forall a b. (a -> b) -> a -> b
$ (TreeBranch -> Tree) -> Tree -> TreeBranch -> Tree
forall a b. a -> b -> a
const TreeBranch -> Tree
Tree

instance WithDefaultSvg Tree where
  defaultSvg :: Tree
defaultSvg = TreeBranch -> Tree
Tree TreeBranch
NoNode

unpack :: Tree -> TreeBranch
unpack :: Tree -> TreeBranch
unpack = Tree -> TreeBranch
_treeBranch

pattern Tree :: TreeBranch -> Tree
pattern $bTree :: TreeBranch -> Tree
$mTree :: forall r. Tree -> (TreeBranch -> r) -> (Void# -> r) -> r
Tree branch <-
  CachedTree {_treeBranch = branch}
  where
    Tree TreeBranch
branch =
      CachedTree :: TreeBranch -> Int -> Tree
CachedTree
        { _treeBranch :: TreeBranch
_treeBranch = TreeBranch
branch,
          _treeHash :: Int
_treeHash = TreeBranch -> Int
forall a. Hashable a => a -> Int
hash TreeBranch
branch
        }

pattern GroupTree :: Group -> Tree
pattern $bGroupTree :: Group -> Tree
$mGroupTree :: forall r. Tree -> (Group -> r) -> (Void# -> r) -> r
GroupTree g = Tree (GroupNode g)

pattern SymbolTree :: Group -> Tree
pattern $bSymbolTree :: Group -> Tree
$mSymbolTree :: forall r. Tree -> (Group -> r) -> (Void# -> r) -> r
SymbolTree g = Tree (SymbolNode g)

pattern DefinitionTree :: Group -> Tree
pattern $bDefinitionTree :: Group -> Tree
$mDefinitionTree :: forall r. Tree -> (Group -> r) -> (Void# -> r) -> r
DefinitionTree g = Tree (DefinitionNode g)

pattern None :: Tree
pattern $bNone :: Tree
$mNone :: forall r. Tree -> (Void# -> r) -> (Void# -> r) -> r
None = Tree NoNode

pattern UseTree :: Use -> Maybe Tree -> Tree
pattern $bUseTree :: Use -> Maybe Tree -> Tree
$mUseTree :: forall r. Tree -> (Use -> Maybe Tree -> r) -> (Void# -> r) -> r
UseTree info sub = Tree (UseNode info sub)

pattern FilterTree :: Filter -> Tree
pattern $bFilterTree :: Filter -> Tree
$mFilterTree :: forall r. Tree -> (Filter -> r) -> (Void# -> r) -> r
FilterTree f = Tree (FilterNode f)

pattern PathTree :: Path -> Tree
pattern $bPathTree :: Path -> Tree
$mPathTree :: forall r. Tree -> (Path -> r) -> (Void# -> r) -> r
PathTree f = Tree (PathNode f)

pattern CircleTree :: Circle -> Tree
pattern $bCircleTree :: Circle -> Tree
$mCircleTree :: forall r. Tree -> (Circle -> r) -> (Void# -> r) -> r
CircleTree f = Tree (CircleNode f)

pattern PolyLineTree :: PolyLine -> Tree
pattern $bPolyLineTree :: PolyLine -> Tree
$mPolyLineTree :: forall r. Tree -> (PolyLine -> r) -> (Void# -> r) -> r
PolyLineTree f = Tree (PolyLineNode f)

pattern PolygonTree :: Polygon -> Tree
pattern $bPolygonTree :: Polygon -> Tree
$mPolygonTree :: forall r. Tree -> (Polygon -> r) -> (Void# -> r) -> r
PolygonTree f = Tree (PolygonNode f)

pattern EllipseTree :: Ellipse -> Tree
pattern $bEllipseTree :: Ellipse -> Tree
$mEllipseTree :: forall r. Tree -> (Ellipse -> r) -> (Void# -> r) -> r
EllipseTree f = Tree (EllipseNode f)

pattern LineTree :: Line -> Tree
pattern $bLineTree :: Line -> Tree
$mLineTree :: forall r. Tree -> (Line -> r) -> (Void# -> r) -> r
LineTree f = Tree (LineNode f)

pattern RectangleTree :: Rectangle -> Tree
pattern $bRectangleTree :: Rectangle -> Tree
$mRectangleTree :: forall r. Tree -> (Rectangle -> r) -> (Void# -> r) -> r
RectangleTree f = Tree (RectangleNode f)

pattern TextTree :: Maybe TextPath -> Text -> Tree
pattern $bTextTree :: Maybe TextPath -> Text -> Tree
$mTextTree :: forall r.
Tree -> (Maybe TextPath -> Text -> r) -> (Void# -> r) -> r
TextTree p t = Tree (TextNode p t)

pattern ImageTree :: Image -> Tree
pattern $bImageTree :: Image -> Tree
$mImageTree :: forall r. Tree -> (Image -> r) -> (Void# -> r) -> r
ImageTree n = Tree (ImageNode n)

pattern LinearGradientTree :: LinearGradient -> Tree
pattern $bLinearGradientTree :: LinearGradient -> Tree
$mLinearGradientTree :: forall r. Tree -> (LinearGradient -> r) -> (Void# -> r) -> r
LinearGradientTree n = Tree (LinearGradientNode n)

pattern RadialGradientTree :: RadialGradient -> Tree
pattern $bRadialGradientTree :: RadialGradient -> Tree
$mRadialGradientTree :: forall r. Tree -> (RadialGradient -> r) -> (Void# -> r) -> r
RadialGradientTree n = Tree (RadialGradientNode n)

pattern MeshGradientTree :: MeshGradient -> Tree
pattern $bMeshGradientTree :: MeshGradient -> Tree
$mMeshGradientTree :: forall r. Tree -> (MeshGradient -> r) -> (Void# -> r) -> r
MeshGradientTree n = Tree (MeshGradientNode n)

pattern PatternTree :: Pattern -> Tree
pattern $bPatternTree :: Pattern -> Tree
$mPatternTree :: forall r. Tree -> (Pattern -> r) -> (Void# -> r) -> r
PatternTree n = Tree (PatternNode n)

pattern MarkerTree :: Marker -> Tree
pattern $bMarkerTree :: Marker -> Tree
$mMarkerTree :: forall r. Tree -> (Marker -> r) -> (Void# -> r) -> r
MarkerTree n = Tree (MarkerNode n)

pattern MaskTree :: Mask -> Tree
pattern $bMaskTree :: Mask -> Tree
$mMaskTree :: forall r. Tree -> (Mask -> r) -> (Void# -> r) -> r
MaskTree n = Tree (MaskNode n)

pattern ClipPathTree :: ClipPath -> Tree
pattern $bClipPathTree :: ClipPath -> Tree
$mClipPathTree :: forall r. Tree -> (ClipPath -> r) -> (Void# -> r) -> r
ClipPathTree n = Tree (ClipPathNode n)

pattern SvgTree :: Document -> Tree
pattern $bSvgTree :: Document -> Tree
$mSvgTree :: forall r. Tree -> (Document -> r) -> (Void# -> r) -> r
SvgTree n = Tree (SvgNode n)