module Svgone.Plugin.CollapseGroups (P, PluginOptions (..)) where

import Control.Lens
import Control.Monad
import Data.Maybe
import Graphics.SvgTree
import Svgone.Plugin

data P
type Opts = PluginOptions P

instance Plugin P where
    data PluginOptions P = Opts
    defaultOpts :: PluginOptions P
defaultOpts = PluginOptions P
Opts
    plugin :: Opts -> Document -> Document
    plugin :: PluginOptions P -> Document -> Document
plugin PluginOptions P
Opts = ([Tree] -> Identity [Tree]) -> Document -> Identity Document
Lens' Document [Tree]
documentElements (([Tree] -> Identity [Tree]) -> Document -> Identity Document)
-> ([Tree] -> [Tree]) -> Document -> Document
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [Tree] -> [Tree]
trees
    pluginName :: Text
pluginName = Text
"collapse-groups"

trees :: [Tree] -> [Tree]
trees :: [Tree] -> [Tree]
trees = (Tree -> Tree) -> [Tree] -> [Tree]
forall a b. (a -> b) -> [a] -> [b]
map ((Tree -> Tree) -> [Tree] -> [Tree])
-> (Tree -> Tree) -> [Tree] -> [Tree]
forall a b. (a -> b) -> a -> b
$ TreeBranch -> Tree
branch (TreeBranch -> Tree) -> (Tree -> TreeBranch) -> Tree -> Tree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree -> Getting TreeBranch Tree TreeBranch -> TreeBranch
forall s a. s -> Getting a s a -> a
^. Getting TreeBranch Tree TreeBranch
Lens' Tree TreeBranch
treeBranch)

branch :: TreeBranch -> Tree
branch :: TreeBranch -> Tree
branch TreeBranch
t = case TreeBranch
t of
    GroupNode Group
g -> Tree -> Maybe Tree -> Tree
forall a. a -> Maybe a -> a
fromMaybe (TreeBranch -> Tree
Tree (TreeBranch -> Tree) -> TreeBranch -> Tree
forall a b. (a -> b) -> a -> b
$ Group -> TreeBranch
GroupNode (Group -> TreeBranch) -> Group -> TreeBranch
forall a b. (a -> b) -> a -> b
$ Group
g 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] -> [Tree]) -> Group -> Group
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [Tree] -> [Tree]
trees) do
        [Tree (PathNode Path
p)] <- [Tree] -> Maybe [Tree]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Tree] -> Maybe [Tree]) -> [Tree] -> Maybe [Tree]
forall a b. (a -> b) -> a -> b
$ Group
g Group -> Getting [Tree] Group [Tree] -> [Tree]
forall s a. s -> Getting a s a -> a
^. Getting [Tree] Group [Tree]
Lens' Group [Tree]
groupChildren
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Maybe (Double, Double, Double, Double) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Double, Double, Double, Double) -> Bool)
-> Maybe (Double, Double, Double, Double) -> Bool
forall a b. (a -> b) -> a -> b
$ Group
g Group
-> Getting
     (Maybe (Double, Double, Double, Double))
     Group
     (Maybe (Double, Double, Double, Double))
-> Maybe (Double, Double, Double, Double)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Double, Double, Double, Double))
  Group
  (Maybe (Double, Double, Double, Double))
Lens' Group (Maybe (Double, Double, Double, Double))
groupViewBox
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Group
g Group
-> Getting PreserveAspectRatio Group PreserveAspectRatio
-> PreserveAspectRatio
forall s a. s -> Getting a s a -> a
^. Getting PreserveAspectRatio Group PreserveAspectRatio
Lens' Group PreserveAspectRatio
groupAspectRatio PreserveAspectRatio -> PreserveAspectRatio -> Bool
forall a. Eq a => a -> a -> Bool
== PreserveAspectRatio
forall a. WithDefaultSvg a => a
defaultSvg
        Tree -> Maybe Tree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tree -> Maybe Tree) -> Tree -> Maybe Tree
forall a b. (a -> b) -> a -> b
$ TreeBranch -> Tree
Tree (TreeBranch -> Tree) -> TreeBranch -> Tree
forall a b. (a -> b) -> a -> b
$ Path -> TreeBranch
PathNode Path
p TreeBranch -> (TreeBranch -> TreeBranch) -> TreeBranch
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> Identity DrawAttributes)
-> TreeBranch -> Identity TreeBranch
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> TreeBranch -> Identity TreeBranch)
-> (DrawAttributes -> DrawAttributes) -> TreeBranch -> TreeBranch
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Group
g Group
-> Getting DrawAttributes Group DrawAttributes -> DrawAttributes
forall s a. s -> Getting a s a -> a
^. Getting DrawAttributes Group DrawAttributes
Lens' Group DrawAttributes
groupDrawAttributes) DrawAttributes -> DrawAttributes -> DrawAttributes
forall a. Semigroup a => a -> a -> a
<>)
    TreeBranch
x -> TreeBranch -> Tree
Tree TreeBranch
x