From: PHO <pho@cielonegro.org>
Date: Tue, 9 Mar 2010 07:30:33 +0000 (+0900)
Subject: dtd.xml
X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=hxt-compile.git;a=commitdiff_plain;h=3128cde83c431e117badabba87cbcd9c7de26b52

dtd.xml
---

diff --git a/Main.hs b/Main.hs
index 296b252..15482e2 100644
--- a/Main.hs
+++ b/Main.hs
@@ -8,13 +8,14 @@ import qualified System.IO.UTF8 as Uio
 
 
 main :: IO ()
-main = do let fpath = "examples/utf8.xml"
+main = do let fpath = "examples/dtd.xml"
 
           [hsMod] <- runX ( setErrorMsgHandler False fail
                             >>>
                             constA fpath
                             >>>
                             readFromDocument [ (a_validate        , v_0)
+                                             , (a_canonicalize    , v_0)
                                              , (a_check_namespaces, v_1)
                                              ]
                             >>>
diff --git a/Text/XML/HXT/Compilation.hs b/Text/XML/HXT/Compilation.hs
index c2428de..e8865a1 100644
--- a/Text/XML/HXT/Compilation.hs
+++ b/Text/XML/HXT/Compilation.hs
@@ -30,8 +30,8 @@ wrapIntoModule :: Arrow a => a (Module, ([HsImportDecl], (HsName, (HsQualType, H
 wrapIntoModule = proc (modName, (extImports, (symName, (symType, symExp)))) ->
                  do let hsModule = HsModule undefined modName (Just exports) imports decls
                         exports  = [HsEVar (UnQual symName)]
-                        imports  = [ HsImportDecl undefined (Module "Text.XML.HXT.Arrow") False Nothing Nothing
-                                   , HsImportDecl undefined (Module "Text.XML.HXT.DOM.XmlNode") True (Just (Module "XN")) Nothing
+                        imports  = [ HsImportDecl undefined (Module "Text.XML.HXT.DOM.Interface") False Nothing Nothing
+                                   , HsImportDecl undefined (Module "Text.XML.HXT.DOM.XmlNode"  ) False Nothing Nothing
                                    ] ++ extImports
                         decls    = [ HsTypeSig undefined [symName] symType
                                    , HsFunBind [HsMatch undefined symName [] (HsUnGuardedRhs symExp) []]
diff --git a/Text/XML/HXT/Compilation/XmlTree.hs b/Text/XML/HXT/Compilation/XmlTree.hs
index 7f8d48b..1538329 100644
--- a/Text/XML/HXT/Compilation/XmlTree.hs
+++ b/Text/XML/HXT/Compilation/XmlTree.hs
@@ -32,23 +32,37 @@ compileXNode (XCharRef   n) = xn "mkCharRef"     $: litInt n
 compileXNode (XEntityRef s) = xn "mkEntityRef"   $: litStr s
 compileXNode (XCmt       s) = xn "mkCmt"         $: litStr s
 compileXNode (XCdata     s) = xn "mkCdata"       $: litStr s
-compileXNode (XPi    qn ts) = xn "mkPi"          $: HsParen (compileQName   qn) $: compileXmlTrees ts
-compileXNode (XTag   qn ts) = xn "mkElementNode" $: HsParen (compileQName   qn) $: compileXmlTrees ts
-compileXNode (XDTD   de as) = xn "mkDTDNode"     $: HsParen (compileDTDElem de) $: HsParen (compileAttributes as)
-compileXNode (XAttr     qn) = xn "mkAttrNode"    $: HsParen (compileQName   qn)
+compileXNode (XPi    qn ts) = xn "mkPi"          $: HsParen (compileQName qn) $: compileXmlTrees ts
+compileXNode (XTag   qn ts) = xn "mkElementNode" $: HsParen (compileQName qn) $: compileXmlTrees ts
+compileXNode (XDTD   de as) = xn "mkDTDNode"     $: compileDTDElem de         $: compileAttributes as
+compileXNode (XAttr     qn) = xn "mkAttrNode"    $: HsParen (compileQName qn)
 compileXNode (XError  n  s) = xn "mkError"       $: litInt n $: litStr s
 
 
 compileDTDElem :: DTDElem -> HsExp
-compileDTDElem = error "compileDTDElem: FIXME: not implemented"
+compileDTDElem DOCTYPE  = unq "DOCTYPE"
+compileDTDElem ELEMENT  = unq "ELEMENT"
+compileDTDElem CONTENT  = unq "CONTENT"
+compileDTDElem ATTLIST  = unq "ATTLIST"
+compileDTDElem ENTITY   = unq "ENTITY"
+compileDTDElem PENTITY  = unq "PENTITY"
+compileDTDElem NOTATION = unq "NOTATION"
+compileDTDElem CONDSECT = unq "CONDSECT"
+compileDTDElem NAME     = unq "NAME"
+compileDTDElem PEREF    = unq "PEREF"
 
 
 compileAttributes :: Attributes -> HsExp
-compileAttributes = error "compileAttributes: FIXME: not implemented"
+compileAttributes = HsList . map compileAttr
+    where
+      compileAttr :: (String, String) -> HsExp
+      compileAttr (k, v) = HsTuple [ litStr k, litStr v ]
+
 
 
 xn :: String -> HsExp
-xn = HsVar . Qual (Module "XN") . HsIdent
+--xn = HsVar . Qual (Module "XN") . HsIdent
+xn = unq
 
 unq :: String -> HsExp
 unq = HsVar . UnQual . HsIdent
diff --git a/examples/dtd.xml b/examples/dtd.xml
new file mode 100644
index 0000000..077f5cf
--- /dev/null
+++ b/examples/dtd.xml
@@ -0,0 +1,8 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE foo [
+    <!ELEMENT foo (baz)>
+    <!ELEMENT baz (#PCDATA)>
+]>
+<foo>
+  <bar>baz</bar>
+</foo>
\ No newline at end of file
diff --git a/hxt-compile.cabal b/hxt-compile.cabal
index e93691e..e455302 100644
--- a/hxt-compile.cabal
+++ b/hxt-compile.cabal
@@ -10,6 +10,7 @@ Cabal-Version:       >= 1.2
 Build-Type:          Simple
 
 Extra-Source-Files:
+    examples/dtd.xml
     examples/tiny.xml
     examples/utf8.xml
 
@@ -18,6 +19,7 @@ Library
         base, haskell-src, hxt, utf8-string
     Exposed-Modules:
         Text.XML.HXT.Compilation
+    Other-Modules:
         Text.XML.HXT.Compilation.XmlTree
     Extensions:
         Arrows