{--------------------------------------------------------------
-
- 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.4"
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))) [] []