{------------------------------------------------------------------------------------- - - The XQuery Compiler and Interpreter - Programmer: Leonidas Fegaras - Email: fegaras@cse.uta.edu - Web: http://lambda.uta.edu/ - Creation: 03/22/08, last update: 01/07/10 - - Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved. - This material is provided as is, with absolutely no warranty expressed or implied. - Any use is at your own risk. Permission is hereby granted to use or copy this program - for any purpose, provided the above notices are retained on all copies. - --------------------------------------------------------------------------------------} {-# OPTIONS_HADDOCK prune #-} {-# OPTIONS -cpp #-} -- | HXQ is a fast and space-efficient compiler from XQuery (the standard -- query language for XML) to embedded Haskell code. The translation is -- based on Haskell templates. It also provides an interpreter for -- evaluating ad-hoc XQueries read from input or from files -- and optional database connectivity using HDBC. -- For more information, look at . module Text.XML.HXQ.XQuery ( -- * The XML Data Representation Prefix, URI, LocalName, QName(..), Attributes, XTree(..), XSeq, TVar, TQualifier, Type(..), putXSeq, -- * The XQuery Compiler xq, xe, qx, -- * The XQuery Interpreter xquery, eval, -- * The XQuery Command Line Interpreter commandLineInterpreter, -- * Validation using XML Schema validateFile, -- * The XQuery Compiler with Database Connectivity xqdb, -- * The XQuery Interpreter with Database Connectivity xqueryDB, -- * Shredding and Publishing XML Documents Using a Relational Database Path, Table(..), genSchema, shred, shredC, isSchema, printSchema, createIndex, -- * Other Database Functions connect, disconnect, commit, rollback, prepareSQL, executeSQL ) where import HXML(Name,AttList) import Text.XML.HXQ.XTree import Text.XML.HXQ.OptionalDB import XMLParse import Text.XML.HXQ.Compiler import Text.XML.HXQ.Interpreter import Text.XML.HXQ.Types import Text.XML.HXQ.Functions(systemFunctions,pathFunctions) import List(sort) import System.CPUTime(getCPUTime) #if _BASE_3_ import qualified Control.Exception as C(try,catch,Exception) type E = C.Exception #else import qualified Control.Exception as C(try,catch,SomeException) type E = C.SomeException #endif version = "0.19.0" -- | The XQuery interpreter as an XQuery function. eval :: XSeq -> IO XSeq eval x = case x of [ XText q ] -> xquery q _ -> error $ "The eval argument must be a string: " ++ show x parseEnv :: [String] -> [(String,String)] parseEnv [] = [("o","Temp.hs")] parseEnv ("-help":xs) = ("help",""):(parseEnv xs) parseEnv ("-c":file:xs) = ("c",file):(parseEnv xs) parseEnv ("-o":file:xs) = ("o",file):(parseEnv xs) parseEnv ("-db":file:xs) = ("db",file):(parseEnv xs) parseEnv ("-v":xs) = ("v",""):(parseEnv xs) parseEnv ("-tp":xs) = ("tp",""):(parseEnv xs) parseEnv ("-t":xs) = ("t",""):(parseEnv xs) parseEnv ("-p":query:file:xs) = ("p","doc('"++file++"')"++query):(parseEnv xs) parseEnv (('-':x):_) = error ("Unrecognized option -"++x++". Use -help.") parseEnv (file:xs) = ("r",file):(parseEnv xs) noDBError = error "Missing Database Connection; use the option -db in xquery" -- | The XQuery command line interpreter used by the main program (@xquery@). -- The program arguments may contain the following command line options: -- -- [@xquery-file@] Evaluate the XQuery code in @xquery-file@ using the interpreter -- -- [@-db database-name@] Use the relational schema @database-name@ during querying -- -- [@-c xquery-file@] Compile the XQuery code in @xquery-file@ into Haskell code -- -- [@-o haskell-file@] Set the Haskell file for @-c@ (default is @Temp.hs@) -- -- [@-p XPath-query xml-file@] Interpret the XPath query against the @xml-file@ -- -- [@-v@] Print verbose information (the AST and the optimized plan) -- -- [@-t@] Print timing information -- -- [@-tp@] Print typing information (experimental) -- -- Without an @xquery-file@, it reads and evaluates the input using the HXQ interpreter. -- The input may be a single XQuery or a @declare variable@ or a @declare function@ expression. -- To write an XQuery in multiple lines, wrap it in @{ }@. commandLineInterpreter :: [String] -- ^ program arguments -> IO () commandLineInterpreter arguments = let env = parseEnv arguments verbose = case lookup "v" env of Nothing -> False; _ -> True timing = case lookup "t" env of Nothing -> False; _ -> True typecheck = case lookup "tp" env of Nothing -> False; _ -> True putTime t = if timing then putStrLn $ "Evaluation time: "++show (div t (10^9))++" milliseconds" else return () in case lookup "help" env of Just _ -> do putStrLn ("HXQ: XQuery Interpreter version "++version) putStrLn "The documentation is availabe at http://lambda.uta.edu/HXQ/" putStrLn "Command line options and files:" putStrLn " xquery-file evaluate the XQuery in xquery-file using the interpreter" putStrLn " -db database use the relational database during querying" putStrLn " -c xquery-file compile the XQuery in xquery-file into Haskell code" putStrLn " -o haskell-file set the Haskell file for -c (default is Temp.hs)" putStrLn " -p XPath-query xml-file interpret the XPath query against the xml-file" putStrLn " -v print verbose information (AST and optimized plan)" putStrLn " -t print timing information" putStrLn " -tp print typing information" putStrLn "Without an xquery-file, it reads and evaluates the input using the HXQ interpreter." putStrLn " The input may be an XQuery or a 'declare variable' or a 'declare function'." putStrLn " To write an XQuery in multiple lines, wrap it in {}." putStrLn $ "Functions (name/arity): " ++ (unwords $ sort $ map (\(f,c,_,_,_) -> f++"/"++show c) systemFunctions) putStrLn $ "Path Steps: " ++ (unwords $ map fst pathFunctions) putStrLn $ "Build-in Types: xs:anyAtomicType " ++ (unwords $ map fst buildInTypes) _ -> case lookup "c" env of Just file -> do query <- readFile file let qf = foldr (\c r -> if c=='\"' then '\\':c:r else c:r) "" (foldr1 (\a r -> a++" "++r) (lines query)) db = case lookup "db" env of Just filepath -> filepath; _ -> "" pr = "{-# LANGUAGE TemplateHaskell #-}\nmodule Main where\nimport Text.XML.HXQ.XQuery\n\nmain = do " ++ (if db=="" then "res <- " else "db <- connect \""++db++"\"\n res <- ") ++ (if db=="" then "$(xq \"" else "$(xqdb \"") ++ qf ++ "\")"++(if db=="" then "" else " db")++"\n putXSeq res\n" Just ofile = lookup "o" env writeFile ofile pr _ -> case lookup "r" env of Just file -> case lookup "db" env of Just filepath -> do db <- connect filepath t1 <- getCPUTime query <- readFile file (result,_,_,_,_) <- xqueryE query [] [] initialNS [] db verbose typecheck putXSeq result t2 <- getCPUTime putTime (t2-t1) commit db _ -> do query <- readFile file t1 <- getCPUTime (result,_,_,_,_) <- xqueryE query [] [] initialNS [] noDBError verbose typecheck putXSeq result t2 <- getCPUTime putTime (t2-t1) _ -> case lookup "p" env of Just query -> do t1 <- getCPUTime (result,_,_,_,_) <- xqueryE query [] [] initialNS [] noDBError verbose typecheck putXSeq result t2 <- getCPUTime putTime (t2-t1) _ -> do putStrLn ("HXQ: XQuery Interpreter version "++version++". Use -help for help.") case lookup "db" env of Just filepath -> do db <- connect filepath evalInput (\s es fs ns vs -> C.catch (do t1 <- getCPUTime (result,nes,nfs,nns,nvs) <- xqueryE s es fs ns vs db verbose typecheck putXSeq result t2 <- getCPUTime putTime (t2-t1) commit db return (nes,nfs,nns,nvs)) (\e -> do putStrLn (show (e::E)) return (es,fs,ns,vs))) [] [] initialNS [] "> " [] return () _ -> do evalInput (\s es fs ns vs -> C.catch (do t1 <- getCPUTime (result,nes,nfs,nns,nvs) <- xqueryE s es fs ns vs noDBError verbose typecheck putXSeq result t2 <- getCPUTime putTime (t2-t1) return (nes,nfs,nns,nvs)) (\e -> do putStrLn (show (e::E)) return (es,fs,ns,vs))) [] [] initialNS [] "> " [] return ()