-Alternatively, you can download and install all required packages one-by-one: -First download HXQ version 0.18.0 and untar +An alternative way of installing HXQ is to download and install all required packages one-by-one: +First download HXQ version 0.18.1 and untar it (using tar xfz on Linux/Mac or 7z x on Windows). Then, you execute the following commands inside the HXQ directory: @@ -261,4 +261,4 @@
-
Last modified: 09/29/09 by Leonidas Fegaras +Last modified: 10/08/09 by Leonidas Fegaras diff --git a/src/Text/XML/HXQ/Compiler.hs b/src/Text/XML/HXQ/Compiler.hs --- a/src/Text/XML/HXQ/Compiler.hs +++ b/src/Text/XML/HXQ/Compiler.hs @@ -132,7 +132,7 @@ makeAttribute :: XSeq -> XSeq -> NS -> [(QName,String)] makeAttribute [XText s] vc ns - = if vc==[XNull] then [] else [(attributeTag s ns,showXS vc)] + = if vc==[XNull] then [] else [(attributeTag s ns,showsXS vc "")] makeAttribute e _ _ = error ("Invalid attribute name: "++show e) @@ -290,7 +290,7 @@ Ast "attribute_construction" [name,value] -> let nm = compile name context position last ns effective_axis vs = compile value context position last ns effective_axis - in [| [ XAttr (attributeTag $nm $ns) (showXS $vs) ] |] + in [| [ XAttr (attributeTag $nm $ns) (showsXS $vs "") ] |] Ast "let" [Avar var,source,body] -> do s <- compile source context position last ns effective_axis b <- compile body context position last ns effective_axis @@ -498,7 +498,7 @@ vs = compileM value context position last ns effective_axis in [| do n <- $ns v <- $vs - return $! [ XAttr (attributeTag n $ns) (showXS v) ] |] + return $! [ XAttr (attributeTag n $ns) (showsXS v "") ] |] Ast "let" [Avar var,source,body] -> [| $(compileM source context position last ns effective_axis) >>= $(lamE [varP (mkName var)] (compileM body context position last ns effective_axis)) |] diff --git a/src/Text/XML/HXQ/Functions.hs b/src/Text/XML/HXQ/Functions.hs --- a/src/Text/XML/HXQ/Functions.hs +++ b/src/Text/XML/HXQ/Functions.hs @@ -756,8 +756,8 @@ \[] -> error "XQuery error" , \[] -> [| error "XQuery error" |] ), ( "error", 2, [TAny,TAny,TAny], - \[xs,ys] -> error (showXS xs++": "++show ys), - \[xs,ys] -> [| error (showXS $xs++": "++show $ys) |] ), + \[xs,ys] -> error (showsXS xs (": "++show ys)), + \[xs,ys] -> [| error (showsXS $xs (": "++show $ys)) |] ), ( "last", 0, [tInt], \[] -> error "the 'last()' call must be handled separately", \[] -> error "the 'last()' call must be handled separately" ), diff --git a/src/Text/XML/HXQ/Interpreter.hs b/src/Text/XML/HXQ/Interpreter.hs --- a/src/Text/XML/HXQ/Interpreter.hs +++ b/src/Text/XML/HXQ/Interpreter.hs @@ -162,7 +162,7 @@ -> let nms = eval name context position last effective_axis env fncs ns vs = eval value context position last effective_axis env fncs ns in case nms of - [XText s] -> [ XAttr (attributeTag s ns) (showXS vs) ] + [XText s] -> [ XAttr (attributeTag s ns) (showsXS vs "") ] _ -> error ("Illegal attribute: "++show e) Ast "let" [Avar var,source,body] -> let es = eval source context position last effective_axis env fncs ns diff --git a/src/Text/XML/HXQ/XTree.hs b/src/Text/XML/HXQ/XTree.hs --- a/src/Text/XML/HXQ/XTree.hs +++ b/src/Text/XML/HXQ/XTree.hs @@ -50,7 +50,7 @@ instance Show QName where show (QName "" _ ln) = ln - show (QName ns _ ln) = ns++":"++ln + show (QName ns _ ln) = ns++(':':ln) -- | XML attributes are bindings from qualified names to values @@ -104,47 +104,63 @@ _ -> False) -showAL :: Attributes -> String -showAL = foldr (\(a,v) r -> case (a,v) of - (QName _ _ ('_':_),_) -> r - _ -> " "++show a++"=\""++v++"\""++r) [] +showsAL :: Attributes -> String -> String +showsAL al acc + = foldr (\(a,v) r -> case (a,v) of + (QName _ _ ('_':_),_) -> r + _ -> ' ':shows a ('=':shows v r)) acc al -showXT :: XTree -> Bool -> String -showXT e pad +showsXT :: XTree -> String -> Bool -> String +showsXT e acc pad = case e of - XElem tag _ _ _ xs | tag == documentRootTag -> showXS xs - XElem tag al _ _ [] -> "<"++show tag++showAL al++"/>" - XElem _ _ _ _ _ | emptyElem e -> "" - XElem tag al _ _ xs | all emptyElem xs -> "<"++show tag++showAL al++"/>" - XElem tag al _ _ xs -> "<"++show tag++showAL al++">"++showXS xs++"" - XAttr tag val -> p++show tag++"=\""++val++"\"" - XText text -> p++text - XInt n -> p++show n - XFloat n -> p++show n - XBool v -> p++if v then "true" else "false" - XComment s -> "" - XPI n s -> "" + XElem tag _ _ _ xs + | tag == documentRootTag + -> showsXS xs acc + XElem tag al _ _ [] + -> '<':shows tag (showsAL al ('/':'>':acc)) + XElem _ _ _ _ _ + | emptyElem e + -> acc + XElem tag al _ _ xs + | all emptyElem xs + -> '<':shows tag (showsAL al ('/':'>':acc)) + XElem tag al _ _ xs + -> '<':shows tag (showsAL al ('>':showsXS xs ('<':'/':shows tag ('>':acc)))) + XAttr tag val + -> p (shows tag ('=':shows val acc)) + XText text + -> p (text++acc) + XInt n + -> p (shows n acc) + XFloat n + -> p (shows n acc) + XBool v + -> p (if v then "true"++acc else "false"++acc) + XComment s + -> ""++acc + XPI n s + -> "':acc))) XError s -> error s - XNull -> "?" - XType tp -> show tp - _ -> "" - where p = if pad then " " else "" + XNull -> '?':acc + XType tp -> shows tp acc + _ -> acc + where p acc = if pad then ' ':acc else acc -showXS :: XSeq -> String -showXS [] = "" -showXS (x:xs) = showXT x False ++ sXS xs - where sXS (XNoPad:x:xs) = (showXT x False) ++ sXS xs - sXS (x:xs) = (showXT x True) ++ sXS xs - sXS _ = "" +showsXS :: XSeq -> String -> String +showsXS [] acc = acc +showsXS (x:xs) acc = showsXT x (sXS xs acc) False + where sXS (XNoPad:x:xs) acc = showsXT x (sXS xs acc) False + sXS (x:xs) acc = showsXT x (sXS xs acc) True + sXS _ acc = acc instance Show XTree where - show t = showXT t False + show t = showsXT t "" False -- | Print the XQuery result (which is a sequence of XML fragments) without buffering. putXSeq :: XSeq -> IO () -putXSeq xs = hSetBuffering stdout NoBuffering >> putStrLn (showXS xs) +putXSeq xs = hSetBuffering stdout NoBuffering >> putStrLn (showsXS xs "") {--------------------------- XQuery Types ---------------------------------------} @@ -174,31 +190,35 @@ deriving Eq -showType :: Type -> Int -> String -showType t prec +showsType :: Type -> Int -> String -> String +showsType t prec acc = case t of - TVariable s -> '#':show s - TBase s -> show s - TItem s -> s++"()" - TNamed s -> show s - TEmpty -> "()" - TAny -> "xs:any" - TElement n TAny -> "element "++n - TAttribute a TAny -> "attribute "++a + TVariable s -> '#':shows s acc + TBase s -> shows s acc + TItem s -> s++('(':')':acc) + TNamed s -> shows s acc + TEmpty -> '(':')':acc + TAny -> "xs:any"++acc + TElement n TAny -> "element "++n++acc + TAttribute a TAny -> "attribute "++a++acc TElement n t - -> "element "++n++" { "++showType t 3++" }" + -> "element "++n++" { "++showsType t 3 (" }"++acc) TAttribute a t - -> "attribute "++a++" { "++showType t 3++" }" - TSequence t1 t2 -> paren 3 prec (showType t1 3++", "++showType t2 3) - TInterleaving t1 t2 -> paren 3 prec (showType t1 2++" & "++showType t2 2) - TChoice t1 t2 -> paren 2 prec (showType t1 2++" | "++showType t2 2) - TQualified t c -> paren 4 prec (showType t 4++[c]) + -> "attribute "++a++" { "++showsType t 3 (" }"++acc) + TSequence t1 t2 + -> paren 3 prec (showsType t1 3 (", "++showsType t2 3 acc)) + TInterleaving t1 t2 + -> paren 3 prec (showsType t1 2 (" & "++showsType t2 2 acc)) + TChoice t1 t2 + -> paren 2 prec (showsType t1 2 (" | "++showsType t2 2 acc)) + TQualified t c + -> paren 4 prec (showsType t 4 (c:acc)) where paren p1 p2 s | p1