-- ------------------------------------------------------------ {- | Module : HXPath Copyright : Copyright (C) 2005 Torbel Kuseler, Uwe Schmidt License : MIT Maintainer : Uwe Schmidt Maintainer : uwe@fh-wedel.de Stability : experimental Portability: portable HXPath - XPath Evaluator of the Haskell XML Toolbox (Arrow version) -} -- ------------------------------------------------------------ module Main where import Text.XML.HXT.Arrow.XmlState.TypeDefs import Text.XML.HXT.Core import Text.XML.HXT.Curl import Text.XML.HXT.XPath import System.Console.GetOpt import System.Environment import System.Exit import System.IO -- ------------------------------------------------------------ -- | -- the main program main :: IO () main = do argv <- getArgs -- get the commandline arguments (al, expr, src) <- cmdlineOpts argv -- and evaluate them, return a key-value list [rc] <- runX (xpath al expr src) -- run the parser arrow exitProg (rc >= c_err) -- set return code and terminate -- ------------------------------------------------------------ exitProg :: Bool -> IO a exitProg True = exitWith (ExitFailure 1) exitProg False = exitWith ExitSuccess -- ------------------------------------------------------------ -- | -- the /real/ main program -- -- runs in the trivial XmlState monad (with user state set to ()) -- so IO and access to global options is possible xpath :: SysConfigList -> String -> String -> IOSArrow b Int xpath cf expr src = configSysVars cf -- set all global config options, the output file and the >>> -- other user options are stored as key-value pairs in the stystem state readDocument [withCurl []] src >>> evalXPathExpr >>> traceMsg 1 "evaluation finished" >>> traceSource >>> traceTree >>> ( formatXPathResult $< getSysVar theIndent ) >>> writeDocument [] "-" >>> getErrStatus where evalXPathExpr :: IOSArrow XmlTree XmlTree evalXPathExpr = traceMsg 1 ("evaluating XPath expression: " ++ expr) >>> replaceChildren ( getXPathTreesInDoc expr >>> filterErrorMsg ) formatXPathResult :: Bool -> IOSArrow XmlTree XmlTree formatXPathResult indent = replaceChildren ( mkelem "xpath-result" [ sattr "expr" expr, sattr "source" src ] [ newline, getChildren >>> (this <+> newline) ] ) where newline | indent = txt "\n" | otherwise = none -- ------------------------------------------------------------ -- -- the options definition part -- see doc for System.Console.GetOpt progName :: String progName = "HXPath" options :: [OptDescr SysConfig] options = generalOptions ++ inputOptions ++ outputOptions usage :: [String] -> IO a usage errl | null errl = do hPutStrLn stdout use exitProg False | otherwise = do hPutStrLn stderr (concat errl ++ "\n" ++ use) exitProg True where header = "HXPath - XPath Evaluator of the Haskell XML Toolbox (Arrow Version)\n" ++ "Usage: " ++ progName ++ " [OPTION...] " use = usageInfo header options cmdlineOpts :: [String] -> IO ([SysConfig], String, String) cmdlineOpts argv = case (getOpt Permute options argv) of (scfg,n,[] ) -> do (ex, sa) <- src n help (getConfigAttr a_help scfg) return (scfg, ex, sa) (_,_,errs) -> usage errs where src [expr, url] = return (expr, url) src [] = usage ["XPath expression and input file/url missing"] src [_] = usage ["input file/url missing"] src _ = usage ["too many arguments"] help "1" = usage [] help _ = return () -- ------------------------------------------------------------