Text/XML/HXT/Compilation/XmlTree.hs

   1 module Text.XML.HXT.Compilation.XmlTree
   2     ( compileXmlTree
   3     )
   4     where
   5
   6 import           Language.Haskell.Syntax
   7 import           Text.XML.HXT.DOM.QualifiedName
   8 import           Text.XML.HXT.DOM.XmlNode
   9 import           Text.XML.HXT.DOM.TypeDefs
  10
  11
  12 compileXmlTrees :: XmlTrees -> HsExp
  13 compileXmlTrees = HsList . map compileXmlTree
  14
  15
  16 compileXmlTree :: XmlTree -> HsExp
  17 compileXmlTree t
  18     = let node     = compileXNode (getNode t)
  19           children = HsList (map compileXmlTree (getChildren t))
  20       in
  21         xn "mkTree" $: node $: children
  22
  23
  24 compileXNode :: XNode -> HsExp
  25 compileXNode (XText      s) = xn "mkText"        $: litStr s
  26 compileXNode (XCharRef   n) = xn "mkCharRef"     $: litInt n
  27 compileXNode (XEntityRef s) = xn "mkEntityRef"   $: litStr s
  28 compileXNode (XCmt       s) = xn "mkCmt"         $: litStr s
  29 compileXNode (XCdata     s) = xn "mkCdata"       $: litStr s
  30 compileXNode (XPi    qn ts) = xn "mkPi"          $: compileQName   qn $: compileXmlTrees ts
  31 compileXNode (XTag   qn ts) = xn "mkElementNode" $: compileQName   qn $: compileXmlTrees ts
  32 compileXNode (XDTD   de as) = xn "mkDTDNode"     $: compileDTDElem de $: compileAttributes as
  33 compileXNode (XAttr     qn) = xn "mkAttrNode"    $: compileQName   qn
  34 compileXNode (XError  n  s) = xn "mkError"       $: litInt n          $: litStr s
  35
  36
  37 compileDTDElem :: DTDElem -> HsExp
  38 compileDTDElem = error "compileDTDElem: FIXME: not implemented"
  39
  40
  41 compileAttributes :: Attributes -> HsExp
  42 compileAttributes = error "compileAttributes: FIXME: not implemented"
  43
  44
  45 xn :: String -> HsExp
  46 xn = HsVar . Qual (Module "XN") . HsIdent
  47
  48
  49 litStr :: String -> HsExp
  50 litStr = HsLit . HsString
  51
  52
  53 litInt :: Integral a => a -> HsExp
  54 litInt = HsLit . HsInt . toInteger
  55
  56
  57 infixl $:
  58 ($:) :: HsExp -> HsExp -> HsExp
  59 ($:) = HsApp
  60
  61
  62 compileQName :: QName -> HsExp
  63 compileQName (QN prefix local ns)
  64     = xn "mkQName" $: litStr prefix $: litStr local $: litStr ns