module XQueryInterpreter where
import List(sortBy)
import XMLParse(parseDocument)
import System.Console.Readline
import XQueryParser
import XTree
import XQueryOptimizer
import XQueryCompiler
systemFunctions :: [(String,Int,[XSeq]->XSeq)]
systemFunctions = $(iFunctions)
pathFunctions :: [(String,Tag->XTree->XSeq)]
pathFunctions = $(pFunctions)
type Environment = [(String,XSeq)]
type Functions = [(String,[String],Ast)]
undefv1 = error "Undefined XQuery context (.)"
undefv2 = error "Undefined position()"
undefv3 = error "Undefined last()"
applyPredicates :: [Ast] -> XSeq -> Bool -> Environment -> Functions -> XSeq
applyPredicates [] xs _ _ _ = xs
applyPredicates ((Aint n):preds) xs _ env fncs
= applyPredicates preds [xs !! (n1)] True env fncs
applyPredicates (pred:preds) xs True env fncs
| maxPosition pathPosition pred > 0
= applyPredicates (pred:preds) (take (maxPosition pathPosition pred) xs) False env fncs
applyPredicates (pred:preds) xs _ env fncs
| containsLast pred
= let last = length xs
in applyPredicates preds
(foldir (\x i r -> if case eval pred x i last "" env fncs of
[XInt k] -> k == i
b -> conditionTest b
then x:r else r) [] xs 1) True env fncs
applyPredicates (pred:preds) xs _ env fncs
= applyPredicates preds
(foldir (\x i r -> if case eval pred x i undefv3 "" env fncs of
[XInt k] -> k == i
b -> conditionTest b
then x:r else r) [] xs 1) True env fncs
eval :: Ast -> XTree -> Int -> Int -> String -> Environment -> Functions -> XSeq
eval e context position last effective_axis env fncs
= case e of
Avar "." -> [ context ]
Avar v -> findV v env
Aint n -> [ XInt n ]
Afloat n -> [ XFloat n ]
Astring s -> [ XText s ]
Ast "doc" [Aint n] -> findV ("_doc"++(show n)) env
Ast "context" [v,Astring dp,body]
-> foldr (\x r -> (eval body x position last dp env fncs)++r)
[] (eval v context position last effective_axis env fncs)
Ast "call" [Avar "position"] -> [XInt position]
Ast "call" [Avar "last"] -> [XInt last]
Ast "step" [Ast "child_step" [tag, Avar "."]]
| effective_axis /= ""
-> eval (Ast "step" [Ast effective_axis [tag, Avar "."]]) context position last "" env fncs
Ast "step" ((Ast "descendant_any" (body:tags)):predicates)
-> let ts = map (\(Avar tag) -> tag) tags
in foldr (\x r -> (applyPredicates predicates (descendant_any_with_tagged_children ts x) True env fncs)++r)
[] (eval body context position last effective_axis env fncs)
Ast "step" ((Ast path_step [Astring tag,body]):predicates)
| memV path_step pathFunctions
-> foldr (\x r -> (applyPredicates predicates ((findV path_step pathFunctions) tag x) True env fncs)++r)
[] (eval body context position last effective_axis env fncs)
Ast "step" [exp]
-> eval exp context position last effective_axis env fncs
Ast "step" (exp:predicates)
-> applyPredicates predicates (eval exp context position last effective_axis env fncs) True env fncs
Ast "predicate" [condition,body]
-> applyPredicates [condition] (eval body context position last effective_axis env fncs) True env fncs
Ast "call" ((Avar fname):args)
-> case filter (\(n,_,_) -> n == fname || ("fn:"++n) == fname) systemFunctions of
[(_,len,f)] -> if (length args) == len
then f (map (\x -> eval x context position last effective_axis env fncs) args)
else error ("Wrong number of arguments in system call: "++fname)
_ -> case filter (\(n,_,_) -> n == fname) fncs of
(_,params,body):_ -> if (length params) == (length args)
then eval body context undefv2 undefv3 ""
((zipWith (\p a -> (p,eval a context position last effective_axis env fncs))
params args)++env) fncs
else error ("Wrong number of arguments in function call: "++fname)
_ -> error ("Undefined function: "++fname)
Ast "construction" [Astring tag,Ast "attributes" [],body]
-> [ XElem tag [] 0 (eval body context position last effective_axis env fncs) ]
Ast "construction" [tag,Ast "attributes" al,body]
-> let alc = map (\(Ast "pair" [a,v])
-> let ac = eval a context position last effective_axis env fncs
vc = eval v context position last effective_axis env fncs
in (qName ac,showXS (text vc))) al
ct = eval tag context position last effective_axis env fncs
bc = eval body context position last effective_axis env fncs
in [ XElem (qName ct) alc 0 bc ]
Ast "let" [Avar var,source,body]
-> eval body context position last effective_axis
((var,eval source context position last effective_axis env fncs):env) fncs
Ast "for" [Avar var,Avar "$",source,body]
-> foldr (\a r -> (eval body a undefv2 undefv3 "" ((var,[a]):env) fncs)++r)
[] (eval source context position last effective_axis env fncs)
Ast "for" [Avar var,Avar ivar,source,body]
-> let p = maxPosition (Avar ivar) body
ns = if p > 0
then Ast "step" [source,Ast "call" [Avar "<=",Ast "step" [pathPosition],Aint p]]
else source
in foldir (\a i r -> (eval body a i undefv3 "" ((var,[a]):(ivar,[XInt i]):env) fncs)++r)
[] (eval ns context position last effective_axis env fncs) 1
Ast "sortTuple" (exp:orderBys)
-> [ XElem "" [] 0 (foldl (\r a -> r++[XElem "" [] 0 (text (eval a context position last effective_axis env fncs))])
[XElem "" [] 0 (eval exp context position last effective_axis env fncs)] orderBys) ]
Ast "sort" (exp:ordList)
-> let ce = map (\(XElem _ _ _ xs) -> map (\(XElem _ _ _ ys) -> ys) xs)
(eval exp context position last effective_axis env fncs)
ordering = foldr (\(Avar ord) r (x:xs) (y:ys)
-> case compareXSeqs (ord == "ascending") x y of
EQ -> r xs ys
o -> o)
(\xs ys -> EQ) ordList
in concatMap head (sortBy (\(_:xs) (_:ys) -> ordering xs ys) ce)
_ -> error ("Illegal XQuery: "++(show e))
evalInput :: (String -> Environment -> Functions -> IO(Environment,Functions)) -> Environment -> Functions -> IO ()
evalInput eval vs fs
= do let oneline prompt = do line <- readline prompt
case line of
Nothing -> return "quit"
Just t -> if t == ""
then oneline prompt
else return t
readlines x = do line <- oneline ": "
if last line == '}'
then return (x++" "++(init line))
else if line == "quit"
then return line
else readlines (x++" "++line)
line <- oneline "> "
stmt <- if head line == '{'
then if last line == '}'
then return (init (tail line))
else readlines (tail line)
else return line
if stmt == "quit"
then putStrLn "Bye!"
else do addHistory stmt
(nvs,nfs) <- eval (map (\c -> if c=='\"' then '\'' else c) stmt) vs fs
evalInput eval nvs nfs
xqueryE :: String -> Environment -> Functions -> IO (XSeq,Environment,Functions)
xqueryE query variables functions
= let asts = parse (scan query)
fncs = foldr (\e r -> case e of
Ast "function" ((Avar f):b:args) -> (f,map (\(Avar v) -> v) args,optimize b):r
_ -> r) functions asts
vars = foldl (\r e -> case e of
Ast "variable" [Avar v,u] -> (v,eval (optimize u) undefv1 undefv2 undefv3 "" r fncs):r
_ -> r) variables asts
exprp e = case e of Ast f _ | elem f ["function","variable"] -> True; _ -> False
(ast,_,ns) = getDocs (concatenateAll (dropWhile exprp asts)) 0
in do env <- foldr (\(n,s) r -> case s of
Astring file -> do doc <- readFile file
env <- r
return (("_doc"++(show n),[materialize (parseDocument doc)]):env)
Aint m -> do env <- r
return (("_doc"++(show n),findV ("_doc"++(show m)) env):env))
(return []) ns
return (eval (optimize ast) undefv1 undefv2 undefv3 "" (env++vars) fncs,vars,fncs)
xquery :: String -> IO XSeq
xquery query = do (u,_,_) <- xqueryE query [] []; return u
xfile :: String -> IO XSeq
xfile file = do query <- readFile file
xquery query