module Graphics.SvgTree.Printer
  ( ppTree,
    ppDocument,
  )
where

import Control.Lens ((^.))
import Data.List
import Graphics.SvgTree.Types hiding (Element)
import Graphics.SvgTree.XmlParser
import Text.XML.Light hiding (showAttr)

ppDocument :: Document -> String
ppDocument :: Document -> String
ppDocument Document
doc =
  [Tree] -> Element -> ShowS
ppElementS_ (Document -> [Tree]
_documentElements Document
doc) (Document -> Element
xmlOfDocument Document
doc) String
""

ppTree :: Tree -> String
ppTree :: Tree -> String
ppTree Tree
t = Tree -> ShowS
ppTreeS Tree
t String
""

ppTreeS :: Tree -> ShowS
ppTreeS :: Tree -> ShowS
ppTreeS Tree
tree =
  case Tree -> Maybe Element
xmlOfTree Tree
tree of
    Just Element
x -> [Tree] -> Element -> ShowS
ppElementS_ (Tree -> [Tree]
treeChildren Tree
tree) Element
x
    Maybe Element
Nothing -> ShowS
forall a. a -> a
id

treeChildren :: Tree -> [Tree]
treeChildren :: Tree -> [Tree]
treeChildren Tree
t = case Tree
t of
  GroupTree Group
g -> Group
g Group -> Getting [Tree] Group [Tree] -> [Tree]
forall s a. s -> Getting a s a -> a
^. Getting [Tree] Group [Tree]
Lens' Group [Tree]
groupChildren
  SymbolTree Group
g -> Group
g Group -> Getting [Tree] Group [Tree] -> [Tree]
forall s a. s -> Getting a s a -> a
^. Getting [Tree] Group [Tree]
Lens' Group [Tree]
groupChildren
  DefinitionTree Group
g -> Group
g Group -> Getting [Tree] Group [Tree] -> [Tree]
forall s a. s -> Getting a s a -> a
^. Getting [Tree] Group [Tree]
Lens' Group [Tree]
groupChildren
  ClipPathTree ClipPath
c -> ClipPath
c ClipPath -> Getting [Tree] ClipPath [Tree] -> [Tree]
forall s a. s -> Getting a s a -> a
^. Getting [Tree] ClipPath [Tree]
Lens' ClipPath [Tree]
clipPathContent
  PatternTree Pattern
p -> Pattern
p Pattern -> Getting [Tree] Pattern [Tree] -> [Tree]
forall s a. s -> Getting a s a -> a
^. Getting [Tree] Pattern [Tree]
Lens' Pattern [Tree]
patternElements
  MarkerTree Marker
m -> Marker
m Marker -> Getting [Tree] Marker [Tree] -> [Tree]
forall s a. s -> Getting a s a -> a
^. Getting [Tree] Marker [Tree]
Lens' Marker [Tree]
markerElements
  MaskTree Mask
m -> Mask
m Mask -> Getting [Tree] Mask [Tree] -> [Tree]
forall s a. s -> Getting a s a -> a
^. Getting [Tree] Mask [Tree]
Lens' Mask [Tree]
maskContent
  Tree
_ -> []

ppElementS_ :: [Tree] -> Element -> ShowS
ppElementS_ :: [Tree] -> Element -> ShowS
ppElementS_ [] Element
e String
xs | Bool -> Bool
not ([Content] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Element -> [Content]
elContent Element
e)) = Element -> String
ppElement Element
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs
ppElementS_ [Tree]
children Element
e String
xs = QName -> [Attr] -> ShowS
tagStart QName
name (Element -> [Attr]
elAttribs Element
e) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
  case [Tree]
children of
    []
      | String
"?" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` QName -> String
qName QName
name -> String -> ShowS
showString String
" ?>" String
xs
      | Bool
otherwise -> String -> ShowS
showString String
" />" String
xs
    [Tree]
_ -> Char -> ShowS
showChar Char
'>' ((Tree -> ShowS) -> String -> [Tree] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tree -> ShowS
ppTreeS (QName -> ShowS
tagEnd QName
name String
xs) [Tree]
children)
  where
    name :: QName
name = Element -> QName
elName Element
e

--------------------------------------------------------------------------------
tagStart :: QName -> [Attr] -> ShowS
tagStart :: QName -> [Attr] -> ShowS
tagStart QName
qn [Attr]
as String
rs = Char
'<' Char -> ShowS
forall a. a -> [a] -> [a]
: QName -> String
showQName QName
qn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
as_str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rs
  where
    as_str :: String
as_str = if [Attr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attr]
as then String
"" else Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: [String] -> String
unwords ((Attr -> String) -> [Attr] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Attr -> String
showAttr [Attr]
as)

showAttr :: Attr -> String
showAttr :: Attr -> String
showAttr (Attr QName
qn String
v) = QName -> String
showQName QName
qn String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'=' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""