{--------------------------------------------------------------
-
- The main program of the XQuery interpreter
- Programmer: Leonidas Fegaras (fegaras@cse.uta.edu)
- Date: 12/06/2008
-
---------------------------------------------------------------}

{-# OPTIONS -cpp #-}

module Main where

import System.Environment
#if __GLASGOW_HASKELL__ >= 609
import qualified Control.OldException as C
#else
import qualified Control.Exception as C
#endif
import Text.XML.HXQ.Functions(functions)
import Text.XML.HXQ.Interpreter(evalInput,xqueryE)
import Text.XML.HXQ.XQuery

type E = C.Exception


version = "0.12.0"


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 ("-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 -db in xquery"


main = do senv <- getArgs
          let env = parseEnv senv
              Just system_path = lookup "ghc" env
              Just hxq_path = lookup "hxq" env
              Just dbname = lookup "db" env
              verbose = case lookup "v" env of Nothing -> False; _ -> True
          case lookup "help" env of
            Just _ -> do putStrLn ("HXQ: XQuery Interpreter version "++version++".")
                         putStrLn "Command line options and files:"
                         putStrLn "   xquery-file               evaluate the XQuery in xquery-file using the interpreter"
                         putStrLn "   -db file-path             use the relational database in file-path 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                        verbose 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:  "++(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))
                                       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
                                                             result <- xfileDB file db
                                                             commit db
                                                             putXSeq result
                                         _ -> do query <- readFile file
                                                 (result,_,_) <- xqueryE query [] [] noDBerror verbose
                                                 putXSeq result
                          _ -> case lookup "p" env of
                                 Just query -> do (result,_,_) <- xqueryE query [] [] noDBerror verbose
                                                  putXSeq result
                                 _ -> do putStrLn ("HXQ: XQuery Interpreter version "++version++". Use -help for help.")
                                         case lookup "db" env of
                                           Just filepath
                                               -> do db <- connect filepath
                                                     evalInput (\s vs fs-> C.catch
                                                                          (do (result,nvs,nfs) <- xqueryE s vs fs db verbose
                                                                              putXSeq result
                                                                              commit db
                                                                              return (nvs,nfs))
                                                                          (\e -> do putStrLn (show (e::E)); return (vs,fs))) [] []
                                           _ -> evalInput (\s vs fs-> C.catch
                                                                      (do (result,nvs,nfs) <- xqueryE s vs fs noDBerror verbose
                                                                          putXSeq result
                                                                          return (nvs,nfs))
                                                                      (\e -> do putStrLn (show (e::E)); return (vs,fs))) [] []