HXmlParser.hs

-- |
-- HXmlParser - Validating XML Parser of the Haskell XML Toolbox
-- XML well-formed checker and validator.
--
-- Author : .\\artin Schmidt and Uwe Schmidt
--
-- Version : $Id: HXmlParser.hs,v 1.14 2005/04/14 12:52:51 hxml Exp $
--
-- this program may be used as example main program for the
-- Haskell XML Toolbox

module Main
where

import Text.XML.HXT.Parser		-- import all stuff for parsing, validating, and transforming XML

import System.IO			-- import the IO and commandline option stuff
import System.Environment
import System.Console.GetOpt
import System.Exit

import Data.Maybe

-- ------------------------------------------------------------

-- |
-- the main program of the Haskell XML Validating Parser

main :: IO ()
main
    = do
      argv <- getArgs					-- get the commandline arguments
      al   <- cmdlineOpts argv				-- and evaluate them, return a key-value list
      res  <- run' $ parser al emptyRoot		-- build a XML root from the list and start parsing
      exitProg (null res)				-- set return code and terminate

-- ------------------------------------------------------------

exitProg	:: Bool -> IO a
exitProg True	= exitWith (ExitFailure (-1))
exitProg False	= exitWith ExitSuccess

-- ------------------------------------------------------------

-- |
-- the /real/ main program
--
-- get wellformed document, validates document, propagates and check namespaces
-- and controls output

parser	:: Attributes -> XmlStateFilter state
parser al
    = parseDocument al					-- read document
      .>>
      traceMsg 1 "start processing"
      .>>
      liftMf processDocument				-- process document: in this case rather simple, just apply a pure filter
      .>>
      traceMsg 1 "processing finished"
      .>>
      traceSource
      .>>
      traceTree
      .>>
      ( writeDocument []				-- write result, all options already set with parseDocument
	`whenNotM`
	hasAttr "no-output"
      )
      .>>
      checkStatus					-- check status

processDocument	:: XmlFilter
processDocument
    = ( processChildren (deep isXText)			-- process document, just select text when option \"show-text\" is set
	`when`
	hasAttr "show-text"
      )

-- ------------------------------------------------------------
--
-- the options definition part
-- see doc for System.Console.GetOpt

progName	:: String
progName	= "HXmlParser"
    
options 	:: [OptDescr (String, String)]
options
    = generalOptions
      ++
      inputOptions
      ++
      outputOptions
      ++
      [ Option "q"	["no-output"]		(NoArg  ("no-output", "1"))	"no output of resulting document"
      , Option "x"	["show-text"]		(NoArg	("show-text", "1"))	"output only the raw text, remove all markup"
      ]
      ++
      showOptions

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 = "HXmlParser - Validating XML Parser of the Haskell XML Toolbox\n" ++
             "XML well-formed checker and validator.\n\n" ++
             "Usage: " ++ progName ++ " [OPTION...] [URI or FILE]"
    use    = usageInfo header options

cmdlineOpts 	:: [String] -> IO (Attributes)
cmdlineOpts argv
    = case (getOpt Permute options argv) of
      (ol,n,[])
	  -> do
	     sa <- src n
	     help (lookup a_help ol) sa
	     return (ol ++ sa)
      (_,_,errs)
	  -> usage errs
    where
    src []	= return []
    src [uri]	= return [("source", uri)]
    src _	= usage ["only one input uri or file allowed\n"]

    help (Just _) _	= usage []
    help Nothing []	= usage ["no input uri or file given\n"]
    help Nothing _	= return ()

-- ------------------------------------------------------------