-- | pxslcc - compiles PXSL into XML
--
-- CVS: $Id: pxslcc.hs,v 1.9 2003/06/01 21:02:01 thor Exp $ 
--
-- Copyright (C) 2003 Tom Moertel <tom@moertel.com>
-- Licensed under the terms of the GNU General Public License.
-- See the LICENSE file in the project distribution for details.

module Main (main) where

import Data.Maybe (maybe)
import System.IO 
import System.Environment (getArgs)
import System.Console.GetOpt
import Text.ParserCombinators.Parsec

import GetInput
import PxsltElementDefaults
import PxsltFormat
import PxsltMacros
import PxsltParser
import PxsltParserTerms
import PxsltParserTreeTransforms

main :: IO ()
main = do
       rawArgs <- getArgs
       case getOpt Permute opts rawArgs of
           (flags, args, []) -> run args flags
           (_, _, errs)      -> handleArgErrors errs

data Flag = Dump | UseDB String | UseXsltDB | ExportDB | Indent Indenter
          | AddHeader

opts :: [OptDescr Flag]
opts =
    [ o "i" ["indent"] (OptArg mkIndent "NUM")  
                      "Re-indent XML using NUM spaces per nesting level"
    , o "h" ["header"] (NoArg AddHeader)
                  "Insert edit-the-PXSL-instead header into output XML"
    , o "x" ["xslt"] (NoArg UseXsltDB)     "Add XSLT defaults"
    , o "a" ["add"]  (ReqArg UseDB "FILE") "Add the given defaults file"
    , o ""  ["export"] (NoArg ExportDB)
                            "Export (print) all of the active defaults"
    , o ""  ["dump"] (NoArg Dump) "Dump internal parse format (for debugging)"
    
    ]
    where
    o = Option
    mkIndent = Indent . nestingIndenter . maybe 2 read 

run :: [String] -> [Flag] -> IO ()
run args flags = do
    loadedDBs <- mapM loadDB [fileName | UseDB fileName <- flags]
    let indenter  = head [i  | Indent i <- flags++[Indent sourceIndenter]]
    let formatter = case [() | Dump <- flags] of
                    [] -> formatWithIndenter indenter . tightenTree
                    _  -> (++"\n").show
    let combinedDB = mkCombinedDB loadedDBs
    let addHead   = case [() | AddHeader <- flags] of
                    [] -> id
                    _  -> addHeader
    case [() | ExportDB <- flags] of
      [] ->  parseAndPrint addHead (formatter . applyDefaults combinedDB) args
      _  ->  putStr (   "# BEGIN PXSL ELEMENT DEFAULTS DATABASE\n" 
                     ++ showDefaults combinedDB
                     ++ "# END PXSL ELEMENT DEFAULTS DATABASE\n")
    where
    loadDB fn = readFile fn >>= return . readDefaults
    builtinDBs = [xsltDefaults | UseXsltDB <- flags]
    mkCombinedDB dbs = foldl mergeDefaults emptyDefaults (builtinDBs ++ dbs)
    tightenTree = liftTrailingEmpties . cullLiteralDominatedEmpties

handleArgErrors :: [String] -> IO ()
handleArgErrors errs =
    ioError (userError (concat errs ++ usageInfo header opts))
    where
    header = "Usage: pxslcc [OPTION...] [file]"

parseAndPrint :: (String->String) -> (Statement -> String) -> [String] -> IO ()
parseAndPrint headerFn formatFn args = do
    input <- getInputFromArgs args
    case parse pxslParser (fileName args) input of
        Left err -> hPutStrLn stderr (show err)
        Right x  -> putStr . headerFn $
                    concatMap formatFn (applyMacros emptyEnv x)
    where
    fileName args = case args of f:_ -> f; _ -> ""

addHeader :: String -> String
addHeader = unlines . addHeader'  . lines
    where
    addHeader' (pi@('<':'?':_):rest) = pi : header : rest
    addHeader' doc                   = header : doc
    header =    "<!--\n\n"
             ++ "NOTICE:  This XML document was generated from PXSL source.\n"
             ++ "         If you want to edit this file, you should probably\n"
             ++ "         edit the original PXSL source file instead.\n\n"
             ++ "-->\n"