module Svgone where

import Data.Text (Text)
import qualified Data.Text.IO as T
import Graphics.SvgTree (Document, parseSvgFile, saveXmlFile)
import Svgone.Plugin
import qualified Svgone.Plugin.CollapseGroups as CollapseGroups
import qualified Svgone.Plugin.MergePaths as MergePaths
import qualified Svgone.Plugin.RemoveAttributes as RemoveAttributes

data SomePlugin where
    SomePlugin :: Plugin a => PluginOptions a -> SomePlugin

runFile ::
    -- | Operations to perform, left to right.
    [SomePlugin] ->
    -- | Input file.
    FilePath ->
    -- | Output file
    FilePath ->
    IO ()
runFile :: [SomePlugin] -> FilePath -> FilePath -> IO ()
runFile [SomePlugin]
ps FilePath
in' FilePath
out = do
    Text
t <- FilePath -> IO Text
T.readFile FilePath
in'
    [SomePlugin] -> FilePath -> Text -> FilePath -> IO ()
run [SomePlugin]
ps FilePath
in' Text
t FilePath
out

run ::
    -- | Operations to perform, left to right.
    [SomePlugin] ->
    -- | Source path/URL of the document, used to resolve relative links.
    FilePath ->
    -- | Contents
    Text ->
    -- | Output file
    FilePath ->
    IO ()
run :: [SomePlugin] -> FilePath -> Text -> FilePath -> IO ()
run [SomePlugin]
ps FilePath
in' Text
t FilePath
out = do
    Just Document
d <- Maybe Document -> IO (Maybe Document)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Document -> IO (Maybe Document))
-> Maybe Document -> IO (Maybe Document)
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Maybe Document
parseSvgFile FilePath
in' Text
t
    let d' :: Document
d' = [SomePlugin] -> Document -> Document
runDoc [SomePlugin]
ps Document
d
    FilePath -> Document -> IO ()
saveXmlFile FilePath
out Document
d'

runDoc :: [SomePlugin] -> Document -> Document
runDoc :: [SomePlugin] -> Document -> Document
runDoc = ((SomePlugin -> (Document -> Document) -> Document -> Document)
 -> (Document -> Document) -> [SomePlugin] -> Document -> Document)
-> (Document -> Document)
-> (SomePlugin -> (Document -> Document) -> Document -> Document)
-> [SomePlugin]
-> Document
-> Document
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SomePlugin -> (Document -> Document) -> Document -> Document)
-> (Document -> Document) -> [SomePlugin] -> Document -> Document
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Document -> Document
forall a. a -> a
id \(SomePlugin PluginOptions a
opts) -> ((Document -> Document)
-> (Document -> Document) -> Document -> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PluginOptions a -> Document -> Document
forall a. Plugin a => PluginOptions a -> Document -> Document
plugin PluginOptions a
opts)

allPluginsWithDefaults :: [SomePlugin]
allPluginsWithDefaults :: [SomePlugin]
allPluginsWithDefaults =
    [ PluginOptions P -> SomePlugin
forall a. Plugin a => PluginOptions a -> SomePlugin
SomePlugin (PluginOptions P -> SomePlugin) -> PluginOptions P -> SomePlugin
forall a b. (a -> b) -> a -> b
$ Plugin P => PluginOptions P
forall a. Plugin a => PluginOptions a
defaultOpts @CollapseGroups.P
    , PluginOptions P -> SomePlugin
forall a. Plugin a => PluginOptions a -> SomePlugin
SomePlugin (PluginOptions P -> SomePlugin) -> PluginOptions P -> SomePlugin
forall a b. (a -> b) -> a -> b
$ Plugin P => PluginOptions P
forall a. Plugin a => PluginOptions a
defaultOpts @RemoveAttributes.P
    , PluginOptions P -> SomePlugin
forall a. Plugin a => PluginOptions a -> SomePlugin
SomePlugin (PluginOptions P -> SomePlugin) -> PluginOptions P -> SomePlugin
forall a b. (a -> b) -> a -> b
$ Plugin P => PluginOptions P
forall a. Plugin a => PluginOptions a
defaultOpts @MergePaths.P
    ]