HXQ 0.18.0 → 0.18.1
raw patch · 8 files changed
+121/−85 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- HXQ.cabal +2/−2
- Main.hs +11/−5
- db.html +1/−1
- index.html +4/−4
- src/Text/XML/HXQ/Compiler.hs +3/−3
- src/Text/XML/HXQ/Functions.hs +2/−2
- src/Text/XML/HXQ/Interpreter.hs +1/−1
- src/Text/XML/HXQ/XTree.hs +97/−67
HXQ.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: >= 1.2 Name: HXQ-Version: 0.18.0+Version: 0.18.1 Synopsis: A Compiler from XQuery to Haskell Description: HXQ is a fast and space-efficient compiler from XQuery (the standard@@ -76,7 +76,7 @@ Text.XML.HXQ.Optimizer, Text.XML.HXQ.OptionalDB, Text.XML.HXQ.Parser hs-source-dirs: . src src/hxml-0.2 Build-Depends: base >= 3 && < 5, haskell98, array, regex-base, regex-compat, template-haskell, mtl, haskeline, HTTP- ghc-options: -funfolding-use-threshold=16+ ghc-options: -O2 -funfolding-use-threshold=16 if flag(mysql) Other-Modules: Text.XML.HXQ.DB, Connect Build-Depends: HDBC, HDBC-odbc
Main.hs view
@@ -2,7 +2,7 @@ - - The main program of the XQuery interpreter - Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)-- Date: 06/17/2009+- Date: 10/08/2009 - ---------------------------------------------------------------} @@ -13,17 +13,23 @@ import List(sort) import System.Environment import System.CPUTime-import qualified Control.Exception as C import Text.XML.HXQ.XQuery import Text.XML.HXQ.Functions import Text.XML.HXQ.XTree import Text.XML.HXQ.Types import Text.XML.HXQ.Interpreter(evalInput,xqueryE,xfileDB)+#if __GLASGOW_HASKELL__ >= 609+import qualified Control.OldException as C+#else+import qualified Control.Exception as C+#endif +type E = C.Exception -version = "0.18.0" +version = "0.18.1" + parseEnv :: [String] -> [(String,String)] parseEnv [] = [("o","Temp.hs")] parseEnv ("-help":xs) = ("help",""):(parseEnv xs)@@ -110,7 +116,7 @@ putTime (t2-t1) commit db return (nes,nfs,nns,nvs))- (\e -> do putStrLn (show (e::C.SomeException))+ (\e -> do putStrLn (show (e::E)) return (es,fs,ns,vs))) [] [] initialNS [] "> " [] return () _ -> do evalInput (\s es fs ns vs -> C.catch@@ -120,6 +126,6 @@ t2 <- getCPUTime putTime (t2-t1) return (nes,nfs,nns,nvs))- (\e -> do putStrLn (show (e::C.SomeException))+ (\e -> do putStrLn (show (e::E)) return (es,fs,ns,vs))) [] [] initialNS [] "> " [] return ()
db.html view
@@ -7,7 +7,7 @@ <body> <center> <h1>HXQ with Database Connectivity</h1>-<h3>Download <a href="/HXQ-0.18.0.tar.gz">HXQ-0.18.0.tar.gz</a></h3>+<h3>Download <a href="/HXQ-0.18.1.tar.gz">HXQ-0.18.1.tar.gz</a></h3> </center> <p> <h2>Installation Instructions (HXQ with database connectivity)</h2>
index.html view
@@ -7,7 +7,7 @@ <body> <center> <h1>HXQ: A Compiler from XQuery to Haskell</h1>-<h3>Download <a href="/HXQ-0.18.0.tar.gz">HXQ-0.18.0.tar.gz</a></h3>+<h3>Download <a href="/HXQ-0.18.1.tar.gz">HXQ-0.18.1.tar.gz</a></h3> </center> <p> <h2>Description</h2>@@ -109,8 +109,8 @@ </pre> which will automatically download and install all required packages. <p>-Alternatively, you can download and install all required packages one-by-one:-First download <a href="/HXQ-0.18.0.tar.gz">HXQ version 0.18.0</a> and untar+An alternative way of installing HXQ is to download and install all required packages one-by-one:+First download <a href="/HXQ-0.18.1.tar.gz">HXQ version 0.18.1</a> and untar it (using <tt>tar xfz</tt> on Linux/Mac or <a href="http://www.7-zip.org/">7z x</a> on Windows). Then, you execute the following commands inside the HXQ directory:@@ -261,4 +261,4 @@ <p> <hr> <p>-<address>Last modified: 09/29/09 by <a href="http://lambda.uta.edu/">Leonidas Fegaras</a></address>+<address>Last modified: 10/08/09 by <a href="http://lambda.uta.edu/">Leonidas Fegaras</a></address>
src/Text/XML/HXQ/Compiler.hs view
@@ -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)) |]
src/Text/XML/HXQ/Functions.hs view
@@ -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" ),
src/Text/XML/HXQ/Interpreter.hs view
@@ -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
src/Text/XML/HXQ/XTree.hs view
@@ -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++"</"++show tag++">"- 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 -> "<!--"++s++"-->"- XPI n s -> "<?"++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+ -> "<!--"++s++"-->"++acc+ XPI n s+ -> "<?"++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<p2 = "("++s++")" | otherwise = s instance Show Type where- show t = showType t 4+ show t = showsType t 4 "" -- | XML Schema bindings@@ -222,27 +242,31 @@ tag :: String -> NS -> QName tag s ns- = case span (/= ':') s of- (_,"") -> QName "" (defaultElementNS ns) s- (s1,_:s2) -> case lookup s1 (prefixes ns) of- Just u -> QName s1 u s2- Nothing -> error ("Undeclared element namespace: "++s1)+ = if elem ':' s+ then case span (/= ':') s of+ (s1,_:s2) -> case lookup s1 (prefixes ns) of+ Just u -> QName s1 u s2+ Nothing -> error ("Undeclared element namespace: "++s1)+ else QName "" (defaultElementNS ns) s + attributeTag s ns- = case span (/= ':') s of- (_,"") -> QName "" "" s- (s1,_:s2) -> case lookup s1 (prefixes ns) of- Just u -> QName s1 u s2- Nothing -> error ("Undeclared attribute namespace: "++s1)+ = if elem ':' s+ then case span (/= ':') s of+ (s1,_:s2) -> case lookup s1 (prefixes ns) of+ Just u -> QName s1 u s2+ Nothing -> error ("Undeclared attribute namespace: "++s1)+ else QName "" "" s functionTag :: String -> NS -> QName functionTag s ns- = case span (/= ':') s of- (_,"") -> QName "" (defaultFunctionNS ns) s- (s1,_:s2) -> case lookup s1 (prefixes ns) of- Just u -> QName s1 u s2- Nothing -> error ("Undeclared function namespace: "++s1)+ = if elem ':' s+ then case span (/= ':') s of+ (s1,_:s2) -> case lookup s1 (prefixes ns) of+ Just u -> QName s1 u s2+ Nothing -> error ("Undeclared function namespace: "++s1)+ else QName "" (defaultFunctionNS ns) s attributes :: AttList -> NS -> Attributes@@ -308,7 +332,10 @@ materializeWithoutParent :: Int -> Stream -> NS -> XTree materializeWithoutParent level stream ns = XElem documentRootTag [] 1 noParentError- ((\(x,_,_)->x) (mdl stream 2 level [] ns))+ (if level<=1+ then [head (filter (\x -> case x of XElem _ _ _ _ _ -> True; _ -> False)+ ((\(x,_,_)->x) (ml "" stream 2 ns)))]+ else ((\(x,_,_)->x) (mdl stream 2 level [] ns))) where md s@(x@(StartEvent n atts):xs) i level ls ns | level == 0 = let f [] i ns = m s i ns@@ -360,7 +387,10 @@ materializeWithParent :: Int -> Stream -> NS -> XTree materializeWithParent level stream ns = root where root = XElem documentRootTag [] 1 (XError "Trying to access the root parent")- ((\(x,_,_)->x) (mdl stream 2 level root [] ns))+ (if level<=1+ then [head (filter (\x -> case x of XElem _ _ _ _ _ -> True; _ -> False)+ ((\(x,_,_)->x) (ml "" stream 2 root ns)))]+ else ((\(x,_,_)->x) (mdl stream 2 level root [] ns))) md s@(x@(StartEvent n atts):xs) i level p ls ns | level == 0 = let f [] i p ns = m s i p ns@@ -409,7 +439,7 @@ -- It looks at the first maxStreamingUnitSize events in the stream to determine--- the minimum nesting depth. If this minimum depth is greater than 0, then+-- the minimum nesting depth. If this minimum depth is greater than 1, then -- the stream will be chopped into a list of XML elements at this depth level, -- where each XML element corresponds to at most maxStreamingUnitSize events. -- Otherwise, the cache requirenments would be the size of the largest root child@@ -421,7 +451,7 @@ ((StartEvent n _):xs) -> ((docLevel xs $! i-1) $! level+1) minLevel ((EndEvent n):xs)- -> ((docLevel xs $! i-1) $! level-1) $! min minLevel (level-1)+ -> ((docLevel xs $! i-1) $! level-1) $! min minLevel $! (level-1) (_:xs) -> (docLevel xs $! i-1) level minLevel _ -> 0