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
R:PluginOptionsP
Opts = Lens' Document [Tree]
documentElements 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 = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ TreeBranch -> Tree
branch forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. Lens' Tree TreeBranch
treeBranch)

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