{-# LANGUAGE CPP #-}
module Graphics.SvgTree
(
loadSvgFile
, parseSvgFile
, xmlOfDocument
, saveXmlFile
, cssApply
, cssRulesOfText
, applyCSSRules
, resolveUses
, module Graphics.SvgTree.Types
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Lens
import qualified Data.ByteString as B
import Data.List (foldl')
import qualified Data.Map as M
import qualified Data.Text as T
import Text.XML.Light.Input (parseXMLDoc)
import Text.XML.Light.Output (ppcTopElement, prettyConfigPP)
import Graphics.SvgTree.CssParser (cssRulesOfText)
import Graphics.SvgTree.CssTypes
import Graphics.SvgTree.Types
import Graphics.SvgTree.XmlParser
loadSvgFile :: FilePath -> IO (Maybe Document)
loadSvgFile filename =
parseSvgFile filename <$> B.readFile filename
parseSvgFile :: FilePath
-> B.ByteString
-> Maybe Document
parseSvgFile filename fileContent =
parseXMLDoc fileContent >>= unparseDocument filename
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 [] = None
go ([]:_) = None
go context@((t:_):_) = t & drawAttr .~ attr'
where
matchingDeclarations =
findMatchingDeclarations rules context
attr = view drawAttr t
attr' = foldl' cssDeclApplyer attr matchingDeclarations
resolveUses :: Document -> Document
resolveUses doc =
doc { _elements = mapTree fetchUses <$> _elements doc }
where
fetchUses (UseTree useInfo _) = UseTree useInfo $ search useInfo
fetchUses a = a
search nfo = M.lookup (_useName nfo) $ _definitions doc
applyCSSRules :: Document -> Document
applyCSSRules doc = doc
{ _elements = cssApply (_styleRules doc) <$> _elements doc }