1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
-- |
-- HRelaxNG - Relax NG Validator of the Haskell XML Toolbox.
-- RELAX NG is a simpler schema language for XML.
--
-- Author : Torben Kuseler
--
-- This program may be used as example main program for the
-- Relax NG Validator.
--
module Main
where
import System.IO
import System.Environment
import System.Console.GetOpt
import System.Exit
import Text.XML.HXT.Core
import Text.XML.HXT.RelaxNG
-- ------------------------------------------------------------
main :: IO ()
main
= do
argv <- getArgs -- get the commandline arguments
(al, xml, schema) <- cmdlineOpts argv -- and evaluate them, return a key-value list
[rc] <- runX (relax al xml schema) -- run the Relax NG validator
exitProg (rc >= c_err) -- set return code and terminate
relax :: SysConfigList -> String -> String -> IOSArrow b Int
relax al xml schema
= configSysVars al
>>>
readDocument [withRelaxNG schema] xml
>>>
writeDocument [] "-"
>>>
getErrStatus
exitProg :: Bool -> IO a
exitProg True = exitWith (ExitFailure (-1))
exitProg False = exitWith ExitSuccess
-- ------------------------------------------------------------
--
-- the options definition part
-- see doc for System.Console.GetOpt
progName :: String
progName = "HRelaxNGValidator"
options :: [OptDescr SysConfig]
options
= generalOptions
++
inputOptions
++
relaxOptions
++
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 = "HRelaxNGValidator - Relax NG schema validator of the " ++
"Haskell XML Toolbox with Arrow Interface\n\n" ++
"Usage: " ++ progName ++ " [OPTION...] (XML file URI/FILE) (Relax NG Schema URI/FILE)"
use = usageInfo header options
cmdlineOpts :: [String] -> IO (SysConfigList, String, String)
cmdlineOpts argv
= case (getOpt Permute options argv) of
(ol,n,[])
-> do
(xml, schema) <- src n
help (getConfigAttr a_help ol)
return (ol, xml, schema)
(_,_,errs)
-> usage errs
where
src [xml, schema] = return (xml, schema)
src [] = usage ["XML file and Relax NG schema input file/url missing"]
src [_] = usage ["Relax NG schema input file/url missing"]
src _ = usage ["too many arguments"]
help "1" = usage []
help _ = return ()
-- ------------------------------------------------------------
|
