module Graphics.SvgTree.Types.Fold where

import           Control.Lens           ((%~), (&), (^.))
import qualified Data.Foldable          as F
import           Data.List              (inits)
import           Graphics.SvgTree.Types.Internal
import           Graphics.SvgTree.Types.Hashable

-- | Insert element in the first sublist in the list of list.
appNode :: [[a]] -> a -> [[a]]
appNode :: [[a]] -> a -> [[a]]
appNode [] a
e           = [[a
e]]
appNode ([a]
curr:[[a]]
above) a
e = (a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
curr) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
above

-- | Map a tree while propagating context information.
-- The function passed in parameter receives a list
-- representing the path used to go arrive to the
-- current node.
zipTree :: ([[Tree]] -> Tree) -> Tree -> Tree
zipTree :: ([[Tree]] -> Tree) -> Tree -> Tree
zipTree [[Tree]] -> Tree
f = [[Tree]] -> Tree -> Tree
dig [] where
  dig :: [[Tree]] -> Tree -> Tree
dig [[Tree]]
prev 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 -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    UseNode Use
_ Maybe Tree
Nothing -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    UseNode Use
nfo (Just Tree
u) ->
      [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev (Tree -> [[Tree]]) -> Tree -> [[Tree]]
forall a b. (a -> b) -> a -> b
$ Use -> Maybe Tree -> Tree
UseTree Use
nfo (Tree -> Maybe Tree
forall a. a -> Maybe a
Just (Tree -> Maybe Tree) -> Tree -> Maybe Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> Tree
dig ([] [Tree] -> [[Tree]] -> [[Tree]]
forall a. a -> [a] -> [a]
: [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e) Tree
u)
    GroupNode Group
g ->
      [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev (Tree -> [[Tree]]) -> Tree -> [[Tree]]
forall a b. (a -> b) -> a -> b
$ Group -> Tree
GroupTree (Group -> Tree) -> Group -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Group -> Group
zipGroup ([[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e) Group
g
    SymbolNode Group
g ->
      [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev (Tree -> [[Tree]]) -> Tree -> [[Tree]]
forall a b. (a -> b) -> a -> b
$ Group -> Tree
SymbolTree (Group -> Tree) -> Group -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Group -> Group
zipGroup ([[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e) Group
g
    DefinitionNode Group
g ->
      [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev (Tree -> [[Tree]]) -> Tree -> [[Tree]]
forall a b. (a -> b) -> a -> b
$ Group -> Tree
DefinitionTree (Group -> Tree) -> Group -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Group -> Group
zipGroup ([[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e) Group
g
    FilterNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    PathNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    CircleNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    PolyLineNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    PolygonNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    EllipseNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    LineNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    RectangleNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    TextNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    ImageNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    MeshGradientNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    LinearGradientNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    RadialGradientNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    PatternNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    MarkerNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    MaskNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    ClipPathNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e
    SvgNode{} -> [[Tree]] -> Tree
f ([[Tree]] -> Tree) -> [[Tree]] -> Tree
forall a b. (a -> b) -> a -> b
$ [[Tree]] -> Tree -> [[Tree]]
forall a. [[a]] -> a -> [[a]]
appNode [[Tree]]
prev Tree
e

  zipGroup :: [[Tree]] -> Group -> Group
zipGroup [[Tree]]
prev Group
g = Group
g { _groupChildren :: [Tree]
_groupChildren = [Tree]
updatedChildren }
    where
      groupChild :: [Tree]
groupChild = Group -> [Tree]
_groupChildren Group
g
      updatedChildren :: [Tree]
updatedChildren =
        [[[Tree]] -> Tree -> Tree
dig ([Tree]
c[Tree] -> [[Tree]] -> [[Tree]]
forall a. a -> [a] -> [a]
:[[Tree]]
prev) Tree
child
            | (Tree
child, [Tree]
c) <- [Tree] -> [[Tree]] -> [(Tree, [Tree])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Tree]
groupChild ([[Tree]] -> [(Tree, [Tree])]) -> [[Tree]] -> [(Tree, [Tree])]
forall a b. (a -> b) -> a -> b
$ [Tree] -> [[Tree]]
forall a. [a] -> [[a]]
inits [Tree]
groupChild]

-- | Fold all nodes of a SVG tree.
foldTree :: (a -> Tree -> a) -> a -> Tree -> a
foldTree :: (a -> Tree -> a) -> a -> Tree -> a
foldTree a -> Tree -> a
f = a -> Tree -> a
go where
  go :: a -> Tree -> a
go a
acc Tree
e = case Tree
e of
    DefinitionTree Group
g   -> Group -> a
foldGroup Group
g
    GroupTree Group
g        -> Group -> a
foldGroup Group
g
    SymbolTree Group
g       -> Group -> a
foldGroup Group
g
    Tree
_                  -> a -> Tree -> a
f a
acc Tree
e
    where
      foldGroup :: Group -> a
foldGroup Group
g =
        let subAcc :: a
subAcc = (a -> Tree -> a) -> a -> [Tree] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' a -> Tree -> a
go a
acc ([Tree] -> a) -> [Tree] -> a
forall a b. (a -> b) -> a -> b
$ Group -> [Tree]
_groupChildren Group
g in
        a -> Tree -> a
f a
subAcc Tree
e

-- | Helper function mapping every tree element.
mapTree :: (Tree -> Tree) -> Tree -> Tree
mapTree :: (Tree -> Tree) -> Tree -> Tree
mapTree Tree -> Tree
f = Tree -> Tree
worker where
  worker :: Tree -> Tree
worker Tree
t = Tree -> Tree
f (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$ Tree
t Tree -> (Tree -> Tree) -> Tree
forall a b. a -> (a -> b) -> b
& (TreeBranch -> Identity TreeBranch) -> Tree -> Identity Tree
Lens' Tree TreeBranch
treeBranch ((TreeBranch -> Identity TreeBranch) -> Tree -> Identity Tree)
-> (TreeBranch -> TreeBranch) -> Tree -> Tree
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TreeBranch -> TreeBranch
go
  go :: TreeBranch -> TreeBranch
go TreeBranch
e = case TreeBranch
e of
    TreeBranch
NoNode -> TreeBranch
e
    UseNode{}    -> TreeBranch
e
    GroupNode Group
g  -> Group -> TreeBranch
GroupNode (Group -> TreeBranch) -> Group -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Group -> Group
mapGroup Group
g
    SymbolNode Group
g ->
      Group -> TreeBranch
SymbolNode (Group -> TreeBranch) -> Group -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Group -> Group
mapGroup Group
g
    DefinitionNode Group
g ->
      Group -> TreeBranch
DefinitionNode (Group -> TreeBranch) -> Group -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Group -> Group
mapGroup Group
g
    FilterNode{} -> TreeBranch
e
    PathNode{} -> TreeBranch
e
    CircleNode{} -> TreeBranch
e
    PolyLineNode{} -> TreeBranch
e
    PolygonNode{} -> TreeBranch
e
    EllipseNode{} -> TreeBranch
e
    LineNode{} -> TreeBranch
e
    RectangleNode{} -> TreeBranch
e
    TextNode{} -> TreeBranch
e
    ImageNode{} -> TreeBranch
e
    LinearGradientNode{} -> TreeBranch
e
    RadialGradientNode{} -> TreeBranch
e
    MeshGradientNode{} -> TreeBranch
e
    PatternNode{} -> TreeBranch
e
    MarkerNode{} -> TreeBranch
e
    MaskNode{} -> TreeBranch
e
    ClipPathNode{} -> TreeBranch
e
    SvgNode{} -> TreeBranch
e

  mapGroup :: Group -> Group
mapGroup Group
g =
      Group
g { _groupChildren :: [Tree]
_groupChildren = (Tree -> Tree) -> [Tree] -> [Tree]
forall a b. (a -> b) -> [a] -> [b]
map Tree -> Tree
worker ([Tree] -> [Tree]) -> [Tree] -> [Tree]
forall a b. (a -> b) -> a -> b
$ Group -> [Tree]
_groupChildren Group
g }

mapBranch :: (TreeBranch -> TreeBranch) -> Tree -> Tree
mapBranch :: (TreeBranch -> TreeBranch) -> Tree -> Tree
mapBranch TreeBranch -> TreeBranch
f = (Tree -> Tree) -> Tree -> Tree
mapTree ((TreeBranch -> Identity TreeBranch) -> Tree -> Identity Tree
Lens' Tree TreeBranch
treeBranch ((TreeBranch -> Identity TreeBranch) -> Tree -> Identity Tree)
-> (TreeBranch -> TreeBranch) -> Tree -> Tree
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TreeBranch -> TreeBranch
f)