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

import Control.Lens
import Data.Monoid
import Graphics.SvgTree
import Linear.Epsilon
import Svgone.Plugin
import Util

data P
type Opts = PluginOptions P

instance Plugin P where
    data PluginOptions P = Opts
        { PluginOptions P -> Bool
defaultAttributes :: Bool
        , -- | Remove all stroke attributes if the stroke isn't visible.
          PluginOptions P -> Bool
invisiblePathStroke :: Bool
        }
    defaultOpts :: PluginOptions P
defaultOpts = Bool -> Bool -> PluginOptions P
Opts Bool
True Bool
True
    plugin :: Opts -> Document -> Document
    plugin :: PluginOptions P -> Document -> Document
plugin 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) -> [Tree] -> [Tree]
forall a b. (a -> b) -> [a] -> [b]
map
                ( TreeBranch -> Tree
Tree
                    (TreeBranch -> Tree) -> (Tree -> TreeBranch) -> Tree -> Tree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( \TreeBranch
x ->
                            TreeBranch -> (Path -> TreeBranch) -> Maybe Path -> TreeBranch
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                                TreeBranch
x
                                ( Path -> TreeBranch
PathNode
                                    (Path -> TreeBranch) -> (Path -> Path) -> Path -> TreeBranch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Path Path DrawAttributes DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> Path -> Path
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
                                        ASetter Path Path DrawAttributes DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
                                        ( Bool
-> (DrawAttributes -> DrawAttributes)
-> DrawAttributes
-> DrawAttributes
forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
invisiblePathStroke DrawAttributes -> DrawAttributes
removeInvisibleStroke
                                            (DrawAttributes -> DrawAttributes)
-> (DrawAttributes -> DrawAttributes)
-> DrawAttributes
-> DrawAttributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> (DrawAttributes -> DrawAttributes)
-> DrawAttributes
-> DrawAttributes
forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
defaultAttributes DrawAttributes -> DrawAttributes
forall p. HasDrawAttributes p => p -> p
removeDefaultAttributes
                                        )
                                )
                                (Maybe Path -> TreeBranch) -> Maybe Path -> TreeBranch
forall a b. (a -> b) -> a -> b
$ TreeBranch -> Maybe Path
pathBranch TreeBranch
x
                      )
                    (TreeBranch -> TreeBranch)
-> (Tree -> TreeBranch) -> Tree -> TreeBranch
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)
                )
    pluginName :: Text
pluginName = Text
"remove-attributes"

removeDefaultAttributes :: HasDrawAttributes p => p -> p
removeDefaultAttributes :: p -> p
removeDefaultAttributes p
attrs
    | Just Float
x <- p
attrs p -> Getting (Maybe Float) p (Maybe Float) -> Maybe Float
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Float) p (Maybe Float)
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
fillOpacity, Float -> Bool
forall a. Epsilon a => a -> Bool
nearZero (Float -> Bool) -> Float -> Bool
forall a b. (a -> b) -> a -> b
$ Float -> Float
forall a. Num a => a -> a
abs (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1 = p
attrs p -> (p -> p) -> p
forall a b. a -> (a -> b) -> b
& (Maybe Float -> Identity (Maybe Float)) -> p -> Identity p
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
fillOpacity ((Maybe Float -> Identity (Maybe Float)) -> p -> Identity p)
-> Maybe Float -> p -> p
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Float
forall a. Maybe a
Nothing
    | Bool
otherwise = p
attrs

removeInvisibleStroke :: DrawAttributes -> DrawAttributes
removeInvisibleStroke :: DrawAttributes -> DrawAttributes
removeInvisibleStroke DrawAttributes
attrs
    | Last (Just Number
x) <- DrawAttributes
attrs DrawAttributes
-> Getting (Last Number) DrawAttributes (Last Number)
-> Last Number
forall s a. s -> Getting a s a -> a
^. Getting (Last Number) DrawAttributes (Last Number)
forall c. HasDrawAttributes c => Lens' c (Last Number)
strokeWidth, Number -> Bool
nearZeroNumber Number
x = DrawAttributes
remove
    | Just Float
x <- DrawAttributes
attrs DrawAttributes
-> Getting (Maybe Float) DrawAttributes (Maybe Float)
-> Maybe Float
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Float) DrawAttributes (Maybe Float)
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
strokeOpacity, Float -> Bool
forall a. Epsilon a => a -> Bool
nearZero Float
x = DrawAttributes
remove
    | Bool
otherwise = DrawAttributes
attrs
  where
    remove :: DrawAttributes
remove =
        DrawAttributes
attrs
            DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (Last Number -> Identity (Last Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Number)
strokeWidth ((Last Number -> Identity (Last Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Number -> Last Number
forall a. Maybe a -> Last a
Last Maybe Number
forall a. Maybe a
Nothing
            DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (Last Texture -> Identity (Last Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Texture)
strokeColor ((Last Texture -> Identity (Last Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Texture -> Last Texture
forall a. Maybe a -> Last a
Last Maybe Texture
forall a. Maybe a
Nothing
            DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (Maybe Float -> Identity (Maybe Float))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
strokeOpacity ((Maybe Float -> Identity (Maybe Float))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Float -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Float
forall a. Maybe a
Nothing
            DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (Last Cap -> Identity (Last Cap))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Cap)
strokeLineCap ((Last Cap -> Identity (Last Cap))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Cap -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Cap -> Last Cap
forall a. Maybe a -> Last a
Last Maybe Cap
forall a. Maybe a
Nothing
            DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (Last LineJoin -> Identity (Last LineJoin))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last LineJoin)
strokeLineJoin ((Last LineJoin -> Identity (Last LineJoin))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last LineJoin -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe LineJoin -> Last LineJoin
forall a. Maybe a -> Last a
Last Maybe LineJoin
forall a. Maybe a
Nothing
            DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (Last Double -> Identity (Last Double))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Double)
strokeMiterLimit ((Last Double -> Identity (Last Double))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Double -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Double -> Last Double
forall a. Maybe a -> Last a
Last Maybe Double
forall a. Maybe a
Nothing
            DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (Last Number -> Identity (Last Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Number)
strokeOffset ((Last Number -> Identity (Last Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Number -> Last Number
forall a. Maybe a -> Last a
Last Maybe Number
forall a. Maybe a
Nothing
            DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (Last [Number] -> Identity (Last [Number]))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last [Number])
strokeDashArray ((Last [Number] -> Identity (Last [Number]))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last [Number] -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe [Number] -> Last [Number]
forall a. Maybe a -> Last a
Last Maybe [Number]
forall a. Maybe a
Nothing