module Text.XML.ToJSON.Builder
(
Element(..)
, emptyElement
, addChild'
, addValue'
, addAttr'
, addAttrs'
, Stack
, popStack
, closeStack
, Builder
, runBuilder
, beginElement
, endElement
, modifyTopElement
, addChild
, addValue
, addAttr
, addAttrs
) where
import Data.Text (Text)
import Control.Monad.Trans.State
data Element = Element
{ elAttrs :: [(Text, Text)]
, elValues :: [Text]
, elChildren :: [(Text, Element)]
} deriving (Show)
emptyElement :: Element
emptyElement = Element [] [] []
addChild' :: (Text, Element) -> Element -> Element
addChild' item o = o { elChildren = item : elChildren o }
addValue' :: Text -> Element -> Element
addValue' v o = o { elValues = v : elValues o }
addAttr' :: (Text, Text) -> Element -> Element
addAttr' attr o = o { elAttrs = attr : elAttrs o }
addAttrs' :: [(Text, Text)] -> Element -> Element
addAttrs' as o = o { elAttrs = as ++ elAttrs o }
type Stack = [(Text, Element)]
popStack :: Stack -> Stack
popStack ((k,v) : (name,elm) : tl) = (name, addChild' (k,v) elm) : tl
popStack _ = error "popStack: can't pop root elmect."
closeStack :: Stack -> Element
closeStack [] = error "closeStack: empty stack."
closeStack [(_, elm)] = elm
closeStack st = closeStack (popStack st)
type Builder = State Stack ()
runBuilder :: Builder -> Element
runBuilder b = closeStack $ execState b [("", emptyElement)]
beginElement :: Text -> Builder
beginElement name =
modify ( (name, emptyElement) : )
endElement :: Builder
endElement =
modify popStack
modifyTopElement :: (Element -> Element) -> Builder
modifyTopElement f =
modify $ \st ->
case st of
((k, v) : tl) -> (k, f v) : tl
_ -> fail "modifyTopElement: impossible: empty stack."
addValue :: Text -> Builder
addValue = modifyTopElement . addValue'
addAttr :: (Text, Text) -> Builder
addAttr = modifyTopElement . addAttr'
addAttrs :: [(Text, Text)] -> Builder
addAttrs = modifyTopElement . addAttrs'
addChild :: (Text, Element) -> Builder
addChild = modifyTopElement . addChild'