HXQ-0.8: HXQ.hs
{--------------------------------------------------------------
-
- The main program of the XQuery Compiler
- **** UNSTABLE *****
- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)
- Date: 05/02/2008
-
---------------------------------------------------------------}
module Main where
import GHC
import DynFlags
import Packages
import PackageConfig
import System.IO
import XML.HXQ.XQuery
import System.Environment
import qualified Control.Exception
import XML.HXQ.Compiler(functions)
import XML.HXQ.Interpreter(evalInput)
version = "0.8"
default_system_path = "/usr/local/lib/ghc-6.8.2"
default_hxq_path = "./"
parseEnv :: [String] -> [(String,String)]
parseEnv [] = [("hxq",default_hxq_path),("ghc",default_system_path),("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 ("-p":query:file:xs) = ("p","doc('"++file++"')"++query):(parseEnv xs)
parseEnv ("-h":path:xs) = ("hxq",path):(parseEnv xs)
parseEnv ("-l":path:xs) = ("ghc",path):(parseEnv xs)
parseEnv (('-':x):_) = error ("Unrecognized option -"++x++". Use -help.")
parseEnv (file:xs) = ("r",file):(parseEnv xs)
main = do putStrLn ("HXQ: XQuery Compiler version "++version)
senv <- getArgs
let env = parseEnv senv
Just system_path = lookup "ghc" env
Just hxq_path = lookup "hxq" env
case lookup "help" env of
Just _ -> do putStrLn "Command line options and files:"
putStrLn "xquery-file compile and run the XQuery in xquery-file"
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 compile and run the XPath query against the xml-file"
putStrLn ("-h path set the HXQ installation directory (default is "++default_hxq_path++")")
putStrLn ("-l path set the GHC installation directory (default is "++default_system_path++")")
putStrLn ("Functions: "++(foldr (\(f,_,_) r -> f++" "++r) "" functions))
_ -> case lookup "c" env of
Just file -> do query <- readFile file
let qf = map (\c -> if c=='\"' then '\'' else c)
(foldr1 (\a r -> a++" "++r) (lines query))
pr = "{-# OPTIONS_GHC -fth #-}\nmodule Main where\nimport XML.HXQ.XQuery\n\nmain = do res <- $(xq \""
++ qf ++ "\")\n putXSeq res\n"
Just ofile = lookup "o" env
writeFile ofile pr
_ -> do session <- newSession (Just system_path)
dflags0 <- getSessionDynFlags session
(dflags1,b) <- parseDynamicFlags dflags0 ["-fglasgow-exts", "-O2", "-fth", "-fobject-code",
--"-package HXQ", "-package ghc"]
"-i"++hxq_path++"XML/HXQ/:"++hxq_path++"hxml-0.2"]
(dflags2, _) <- initPackages dflags1
setSessionDynFlags session dflags2
--load session LoadAllTargets
let preludeModule = mkModule (stringToPackageId "base") (mkModuleName "Prelude")
--xqueryModule = mkModule (stringToPackageId "HXQ") (mkModuleName "XQuery")
setContext session [] [preludeModule]
t <- guessTarget (hxq_path++"Main.hs") Nothing
addTarget session t
f <- getSessionDynFlags session
sf <- defaultCleanupHandler f (load session LoadAllTargets)
--ff <- load session (LoadDependenciesOf (mkModuleName "XQuery"))
case lookup "r" env of
Just file -> do q <- readFile file
let qf = map (\c -> if c=='\"' then '\'' else c)
(foldr1 (\a r -> a++" "++r) (lines q))
query = "do result <- $(XQuery.xq \""++qf++"\"); XQuery.putXSeq result"
_ <- runStmt session query SingleStep
return ()
_ -> case lookup "p" env of
Just query -> do _ <- runStmt session ("do result <- $(XML.HXQ.XQuery.xq \""++query
++"\"); XML.HXQ.XQuery.putXSeq result") SingleStep
return ()
_ -> do putStrLn "To write an XQuery in multiple lines, wrap it in {}"
evalInput (\s vs fs -> let query = "do result <- $(XML.HXQ.XQuery.xq \""++s++"\");"
++"XML.HXQ.XQuery.putXSeq result"
in Control.Exception.catch (do runStmt session query SingleStep; return (vs,fs))
(\e -> do putStrLn (show e); return (vs,fs))) [] []