module Graphics.SvgTree
(
loadSvgFile,
parseSvgFile,
parseSvg,
unparse,
xmlOfDocument,
xmlOfTree,
saveXmlFile,
cssApply,
cssRulesOfText,
module Graphics.SvgTree.Types,
)
where
import Control.Lens
import Data.List (foldl')
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Graphics.SvgTree.CssParser (cssRulesOfText)
import Graphics.SvgTree.CssTypes
import Graphics.SvgTree.Types
import Graphics.SvgTree.XmlParser
import Text.XML.Light.Input (parseXMLDoc)
import Text.XML.Light.Output (ppcTopElement, prettyConfigPP)
loadSvgFile :: FilePath -> IO (Maybe Document)
loadSvgFile filename =
parseSvgFile filename <$> T.readFile filename
parseSvgFile ::
FilePath ->
T.Text ->
Maybe Document
parseSvgFile filename fileContent =
parseXMLDoc fileContent >>= unparseDocument filename
parseSvg :: T.Text -> Tree
parseSvg inp =
case parseXMLDoc inp of
Nothing -> error "Invalid XML"
Just xml -> unparse xml
saveXmlFile :: FilePath -> Document -> IO ()
saveXmlFile filePath =
writeFile filePath . ppcTopElement prettyConfigPP . xmlOfDocument
cssDeclApplyer ::
DrawAttributes ->
CssDeclaration ->
DrawAttributes
cssDeclApplyer value (CssDeclaration txt elems) =
case lookup txt cssUpdaters of
Nothing -> value
Just f -> f value elems
where
cssUpdaters =
[ (T.pack $ _attributeName n, u)
| (n, u) <- drawAttributesList
]
cssApply :: [CssRule] -> Tree -> Tree
cssApply rules = zipTree go
where
go [] = defaultSvg
go ([] : _) = defaultSvg
go context@((t : _) : _) = t & drawAttributes .~ attr'
where
matchingDeclarations =
findMatchingDeclarations rules context
attr = view drawAttributes t
attr' = foldl' cssDeclApplyer attr matchingDeclarations