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

import Control.Lens
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{Bool
invisiblePathStroke :: Bool
defaultAttributes :: Bool
invisiblePathStroke :: PluginOptions P -> Bool
defaultAttributes :: PluginOptions P -> Bool
..} =
        Lens' Document [Tree]
documentElements
            forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a b. (a -> b) -> [a] -> [b]
map
                ( TreeBranch -> Tree
Tree
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( \TreeBranch
x ->
                            forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                                TreeBranch
x
                                ( Path -> TreeBranch
PathNode
                                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
                                        forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes
                                        ( forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
invisiblePathStroke DrawAttributes -> DrawAttributes
removeInvisibleStroke
                                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
defaultAttributes forall p. HasDrawAttributes p => p -> p
removeDefaultAttributes
                                        )
                                )
                                forall a b. (a -> b) -> a -> b
$ TreeBranch -> Maybe Path
pathBranch TreeBranch
x
                      )
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. Lens' Tree TreeBranch
treeBranch)
                )
    pluginName :: Text
pluginName = Text
"remove-attributes"

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

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