git.iko.soy/typeable/xsd-parser
on master help sign in
src/Xsd/Parser.hs+72−27
since splitsnapshots
unifiedsplit
@@ -160,18 +160,19 @@ parseSimpleType c = do
160 unionAxis <- makeElemAxis "union"
160 unionAxis <- makeElemAxis "union"
161 case (c $/ restrictionAxis, c $/ listAxis, c $/ unionAxis) of
161 case (c $/ restrictionAxis, c $/ listAxis, c $/ unionAxis) of
162 ([e], [], []) -> Xsd.AtomicType
162 ([e], [], []) -> Xsd.AtomicType
163− <$> parseRestriction e
163+ <$> parseSimpleRestriction e
164 <*> parseAnnotations c
164 <*> parseAnnotations c
165 ([], [l], []) -> Xsd.ListType
165 ([], [l], []) -> Xsd.ListType
166 <$> parseList l
166 <$> parseList l
167 <*> parseAnnotations c
167 <*> parseAnnotations c
168− -- TODO implement me
168+ ([], [], [u]) -> Xsd.UnionType
169− ([], [], [_]) -> parseError c "Not implemented: union"
169+ <$> parseUnion u
170+ <*> parseAnnotations c
170 _ -> parseError c "Expected exactly of of restriction, list or union"
171 _ -> parseError c "Expected exactly of of restriction, list or union"
171
172
172-- | Restriction for simple type
173-- | Restriction for simple type
173−parseRestriction :: Cursor -> P Xsd.Restriction
174+parseSimpleRestriction :: Cursor -> P Xsd.SimpleRestriction
174−parseRestriction c = do
175+parseSimpleRestriction c = do
175 -- XXX: generalaze RefOr parsing
176 -- XXX: generalaze RefOr parsing
176 tp <- case anAttribute "base" c of
177 tp <- case anAttribute "base" c of
177 Nothing -> do
178 Nothing -> do
@@ -184,9 +185,9 @@ parseRestriction c = do
184
185
185 constraints <- parseConstrains c
186 constraints <- parseConstrains c
186
187
187− return Xsd.Restriction
188+ return Xsd.SimpleRestriction
188− { Xsd.restrictionBase = tp
189+ { Xsd.simpleRestrictionBase = tp
189− , Xsd.restrictionConstraints = constraints
190+ , Xsd.simpleRestrictionConstraints = constraints
190 }
191 }
191
192
192parseConstrains :: Cursor -> P [Xsd.Constraint]
193parseConstrains :: Cursor -> P [Xsd.Constraint]
@@ -207,6 +208,15 @@ parseList c =
207 _ -> parseError c "Multiple types"
208 _ -> parseError c "Multiple types"
208 Just t -> Xsd.Ref <$> makeQName c t
209 Just t -> Xsd.Ref <$> makeQName c t
209
210
211+parseUnion :: Cursor -> P [Xsd.RefOr Xsd.SimpleType]
212+parseUnion c =
213+ case anAttribute "memberTypes" c of
214+ Just list ->
215+ mapM (fmap Xsd.Ref . makeQName c) (Text.splitOn " " list)
216+ Nothing -> do
217+ simpleTypeAxis <- makeElemAxis "simpleType"
218+ mapM (fmap Xsd.Inline . parseSimpleType) (c $/ simpleTypeAxis)
219+
210parseComplexType :: Cursor -> P Xsd.ComplexType
220parseComplexType :: Cursor -> P Xsd.ComplexType
211parseComplexType c = do
221parseComplexType c = do
212 annotations <- parseAnnotations c
222 annotations <- parseAnnotations c
@@ -237,14 +247,29 @@ parsePlainContent c = do
237 }
247 }
238
248
239parseSimpleContent :: Cursor -> P Xsd.SimpleContent
249parseSimpleContent :: Cursor -> P Xsd.SimpleContent
240−parseSimpleContent c = parseError c "not implemented"
250+parseSimpleContent c = do
251+ restrictionAxis <- makeElemAxis "restriction"
252+ extenstionAxis <- makeElemAxis "extension"
253+ case (c $/ restrictionAxis, c $/ extenstionAxis) of
254+ ([r], []) -> Xsd.SimpleContentRestriction <$> parseSimpleRestriction r
255+ ([], [e]) -> Xsd.SimpleContentExtension <$> parseSimpleExtension e
256+ _ -> parseError c "Expected one of restriction or extension"
257+
258+parseSimpleExtension :: Cursor -> P Xsd.SimpleExtension
259+parseSimpleExtension c = handleNamespaces c $ do
260+ base <- theAttribute "base" c >>= makeQName c
261+ attributes <- parseAttributes c
262+ return Xsd.SimpleExtension
263+ { Xsd.simpleExtensionBase = base
264+ , Xsd.simpleExtensionAttributes = attributes
265+ }
241
266
242parseComplexContent :: Cursor -> P Xsd.ComplexContent
267parseComplexContent :: Cursor -> P Xsd.ComplexContent
243parseComplexContent c = do
268parseComplexContent c = do
244 restrictionAxis <- makeElemAxis "restriction"
269 restrictionAxis <- makeElemAxis "restriction"
245 extenstionAxis <- makeElemAxis "extension"
270 extenstionAxis <- makeElemAxis "extension"
246 case (c $/ restrictionAxis, c $/ extenstionAxis) of
271 case (c $/ restrictionAxis, c $/ extenstionAxis) of
247− ([r], []) -> parseError r "not implemented"
272+ ([r], []) -> Xsd.ComplexContentRestriction <$> parseComplexRestriction r
248 ([], [e]) -> Xsd.ComplexContentExtension <$> parseComplexExtension e
273 ([], [e]) -> Xsd.ComplexContentExtension <$> parseComplexExtension e
249 _ -> parseError c "Expected one of restriction or extension"
274 _ -> parseError c "Expected one of restriction or extension"
250
275
@@ -259,6 +284,17 @@ parseComplexExtension c = handleNamespaces c $ do
259 , Xsd.complexExtensionAttributes = attributes
284 , Xsd.complexExtensionAttributes = attributes
260 }
285 }
261
286
287+parseComplexRestriction :: Cursor -> P Xsd.ComplexRestriction
288+parseComplexRestriction c = handleNamespaces c $ do
289+ base <- theAttribute "base" c >>= makeQName c
290+ attributes <- parseAttributes c
291+ model <- parseModelGroup c
292+ return Xsd.ComplexRestriction
293+ { Xsd.complexRestrictionBase = base
294+ , Xsd.complexRestrictionModel = model
295+ , Xsd.complexRestrictionAttributes = attributes
296+ }
297+
262parseModelGroup :: Cursor -> P (Maybe Xsd.ModelGroup)
298parseModelGroup :: Cursor -> P (Maybe Xsd.ModelGroup)
263parseModelGroup c = do
299parseModelGroup c = do
264 sequenceAxis <- makeElemAxis "sequence"
300 sequenceAxis <- makeElemAxis "sequence"
@@ -293,24 +329,33 @@ parseAttributes c = do
293
329
294parseAttribute :: Cursor -> P Xsd.Attribute
330parseAttribute :: Cursor -> P Xsd.Attribute
295parseAttribute c = do
331parseAttribute c = do
296− name <- theAttribute "name" c >>= makeTargetQName
297 use <- parseUseAttribute c
332 use <- parseUseAttribute c
298−
333+ case (anAttribute "name" c, anAttribute "ref" c) of
299− -- XXX: generalaze RefOr parsing
334+ (Just n, Nothing) -> do
335+ name <- makeTargetQName n
300− tp <- case anAttribute "type" c of
336+ tp <- case anAttribute "type" c of
301− Nothing -> do
337+ Nothing -> do
302− simpleTypeAxis <- makeElemAxis "simpleType"
338+ simpleTypeAxis <- makeElemAxis "simpleType"
303− case c $/ simpleTypeAxis of
339+ case c $/ simpleTypeAxis of
304− [s] -> Xsd.Inline <$> parseSimpleType s
340+ [s] -> Xsd.Inline <$> parseSimpleType s
305− [] -> parseError c "Attribute should have type"
341+ [] -> return (Xsd.Ref anySimpleType)
306− _ -> parseError c "Multiple simple types"
342+ _ -> parseError c "Multiple simple types"
307− Just t -> Xsd.Ref <$> makeQName c t
343+ Just t -> Xsd.Ref <$> makeQName c t
308−
344+ return $ Xsd.InlineAttribute $ Xsd.AttributeInline
309− return Xsd.Attribute
345+ { Xsd.attributeInlineName = name
310− { Xsd.attrName = name
346+ , Xsd.attributeInlineUse = use
311− , Xsd.attrUse = use
347+ , Xsd.attributeInlineType = tp
312− , Xsd.attrType = tp
348+ }
349+ (Nothing, Just r) -> do
350+ ref <- makeQName c r
351+ return $ Xsd.RefAttribute $ Xsd.AttributeRef
352+ { Xsd.attributeRefRef = ref
353+ , Xsd.attributeRefUse = use
313− }
354+ }
355+ _ -> parseError c "Should be either name or ref"
356+ where
357+ anySimpleType =
358+ Xsd.QName (Just (Xsd.Namespace Xsd.schemaNamespace)) "anySimpleType"
314
359
315parseUseAttribute :: Cursor -> P Xsd.Use
360parseUseAttribute :: Cursor -> P Xsd.Use
316parseUseAttribute c = case anAttribute "use" c of
361parseUseAttribute c = case anAttribute "use" c of
src/Xsd/Types.hs+43−14
@@ -6,19 +6,23 @@ module Xsd.Types
6, Child(..)
6, Child(..)
7, Type(..)
7, Type(..)
8, SimpleType(..)
8, SimpleType(..)
9−, Restriction(..)
10, Constraint(..)
9, Constraint(..)
11, ComplexType(..)
10, ComplexType(..)
12, Content(..)
11, Content(..)
13, PlainContent(..)
12, PlainContent(..)
14, SimpleContent(..)
13, SimpleContent(..)
14+, SimpleExtension(..)
15+, SimpleRestriction(..)
15, ComplexContent(..)
16, ComplexContent(..)
16, ComplexExtension(..)
17, ComplexExtension(..)
18+, ComplexRestriction(..)
17, RefOr(..)
19, RefOr(..)
18, refOr
20, refOr
19, Element(..)
21, Element(..)
20, MaxOccurs(..)
22, MaxOccurs(..)
21, Attribute(..)
23, Attribute(..)
24+, AttributeRef(..)
25+, AttributeInline(..)
22, Annotation(..)
26, Annotation(..)
23, Use(..)
27, Use(..)
24, ModelGroup(..)
28, ModelGroup(..)
@@ -89,9 +93,9 @@ data Include = Include
89 deriving (Show, Eq)
93 deriving (Show, Eq)
90
94
91data SimpleType
95data SimpleType
92− = AtomicType Restriction [Annotation]
96+ = AtomicType SimpleRestriction [Annotation]
93 | ListType (RefOr SimpleType) [Annotation]
97 | ListType (RefOr SimpleType) [Annotation]
94− -- TODO: also union
98+ | UnionType [RefOr SimpleType] [Annotation]
95 deriving (Show, Eq)
99 deriving (Show, Eq)
96
100
97data ComplexType = ComplexType
101data ComplexType = ComplexType
@@ -115,7 +119,7 @@ data PlainContent = PlainContent
115
119
116data ComplexContent
120data ComplexContent
117 = ComplexContentExtension ComplexExtension
121 = ComplexContentExtension ComplexExtension
118− | ComplexContentRestriction -- TODO: implement me
122+ | ComplexContentRestriction ComplexRestriction
119 deriving (Show, Eq)
123 deriving (Show, Eq)
120
124
121data ComplexExtension = ComplexExtension
125data ComplexExtension = ComplexExtension
@@ -125,8 +129,16 @@ data ComplexExtension = ComplexExtension
125 }
129 }
126 deriving (Show, Eq)
130 deriving (Show, Eq)
127
131
128−-- TODO: implement me
132+data ComplexRestriction = ComplexRestriction
133+ { complexRestrictionBase :: QName
134+ , complexRestrictionModel :: Maybe ModelGroup
135+ , complexRestrictionAttributes :: [Attribute]
136+ }
137+ deriving (Show, Eq)
138+
129−data SimpleContent = SimpleContent
139+data SimpleContent
140+ = SimpleContentExtension SimpleExtension
141+ | SimpleContentRestriction SimpleRestriction
130 deriving (Show, Eq)
142 deriving (Show, Eq)
131
143
132data ModelGroup
144data ModelGroup
@@ -135,10 +147,21 @@ data ModelGroup
135 | All [RefOr Element]
147 | All [RefOr Element]
136 deriving (Show, Eq)
148 deriving (Show, Eq)
137
149
138−data Attribute = Attribute
150+data Attribute
139− { attrName :: QName
151+ = RefAttribute AttributeRef
152+ | InlineAttribute AttributeInline
153+ deriving (Show, Eq)
154+
155+data AttributeInline = AttributeInline
156+ { attributeInlineName :: QName
140− , attrType :: RefOr SimpleType
157+ , attributeInlineType :: RefOr SimpleType
141− , attrUse :: Use
158+ , attributeInlineUse :: Use
159+ }
160+ deriving (Show, Eq)
161+
162+data AttributeRef = AttributeRef
163+ { attributeRefRef :: QName
164+ , attributeRefUse :: Use
142 }
165 }
143 deriving (Show, Eq)
166 deriving (Show, Eq)
144
167
@@ -148,10 +171,16 @@ data Use
148 | Required
171 | Required
149 deriving (Show, Eq)
172 deriving (Show, Eq)
150
173
151−data Restriction = Restriction
174+data SimpleRestriction = SimpleRestriction
152− { restrictionBase :: RefOr SimpleType
175+ { simpleRestrictionBase :: RefOr SimpleType
153− -- XXX: could restrictionBase be an inline type? Probably not.
176+ -- XXX: could simpleRestrictionBase be an inline type? Probably not.
154− , restrictionConstraints :: [Constraint]
177+ , simpleRestrictionConstraints :: [Constraint]
178+ }
179+ deriving (Show, Eq)
180+
181+data SimpleExtension = SimpleExtension
182+ { simpleExtensionBase :: QName
183+ , simpleExtensionAttributes :: [Attribute]
155 }
184 }
156 deriving (Show, Eq)
185 deriving (Show, Eq)
157
186
test/Spec.hs+11−10
@@ -91,7 +91,7 @@ spec = do
91 Xsd.AtomicType restriction _ = t
91 Xsd.AtomicType restriction _ = t
92 res `shouldSatisfy` isRight
92 res `shouldSatisfy` isRight
93 tpName `shouldBe` (Xsd.QName Nothing "str")
93 tpName `shouldBe` (Xsd.QName Nothing "str")
94− Xsd.restrictionBase restriction `shouldBe`
94+ Xsd.simpleRestrictionBase restriction `shouldBe`
95 Xsd.Ref (Xsd.QName (Just (Xsd.Namespace "something")) "string")
95 Xsd.Ref (Xsd.QName (Just (Xsd.Namespace "something")) "string")
96
96
97 context "when restriction contains enumerations" $ do
97 context "when restriction contains enumerations" $ do
@@ -115,7 +115,7 @@ spec = do
115 Xsd.AtomicType restriction _ = t
115 Xsd.AtomicType restriction _ = t
116 res `shouldSatisfy` isRight
116 res `shouldSatisfy` isRight
117 tpName `shouldBe` (Xsd.QName Nothing "str")
117 tpName `shouldBe` (Xsd.QName Nothing "str")
118− Xsd.restrictionConstraints restriction `shouldBe`
118+ Xsd.simpleRestrictionConstraints restriction `shouldBe`
119 [ Xsd.Enumeration "value1"
119 [ Xsd.Enumeration "value1"
120 , Xsd.Enumeration "value2"
120 , Xsd.Enumeration "value2"
121 ]
121 ]
@@ -138,10 +138,10 @@ spec = do
138 fmap Xsd.children res
138 fmap Xsd.children res
139 Xsd.AtomicType restriction' _ = t
139 Xsd.AtomicType restriction' _ = t
140 Xsd.Inline (Xsd.AtomicType restriction _) =
140 Xsd.Inline (Xsd.AtomicType restriction _) =
141− Xsd.restrictionBase restriction'
141+ Xsd.simpleRestrictionBase restriction'
142 res `shouldSatisfy` isRight
142 res `shouldSatisfy` isRight
143 tpName `shouldBe` (Xsd.QName Nothing "str")
143 tpName `shouldBe` (Xsd.QName Nothing "str")
144− Xsd.restrictionBase restriction `shouldBe`
144+ Xsd.simpleRestrictionBase restriction `shouldBe`
145 Xsd.Ref (Xsd.QName (Just (Xsd.Namespace "something")) "string")
145 Xsd.Ref (Xsd.QName (Just (Xsd.Namespace "something")) "string")
146
146
147 context "when base refers to an unbound prefix" $ do
147 context "when base refers to an unbound prefix" $ do
@@ -200,11 +200,11 @@ spec = do
200 Right [Xsd.ChildType tpName (Xsd.TypeComplex t)] =
200 Right [Xsd.ChildType tpName (Xsd.TypeComplex t)] =
201 fmap Xsd.children res
201 fmap Xsd.children res
202 Xsd.ContentPlain plain = Xsd.complexContent t
202 Xsd.ContentPlain plain = Xsd.complexContent t
203− [attr] = Xsd.plainContentAttributes plain
203+ [Xsd.InlineAttribute attr] = Xsd.plainContentAttributes plain
204 res `shouldSatisfy` isRight
204 res `shouldSatisfy` isRight
205 tpName `shouldBe` Xsd.QName Nothing "person"
205 tpName `shouldBe` Xsd.QName Nothing "person"
206− Xsd.attrName attr `shouldBe` Xsd.QName Nothing "firstName"
206+ Xsd.attributeInlineName attr `shouldBe` Xsd.QName Nothing "firstName"
207− Xsd.attrType attr `shouldBe`
207+ Xsd.attributeInlineType attr `shouldBe`
208 Xsd.Ref (Xsd.QName (Just (Xsd.Namespace "something")) "string")
208 Xsd.Ref (Xsd.QName (Just (Xsd.Namespace "something")) "string")
209
209
210 context "when attribute type is inlined" $ do
210 context "when attribute type is inlined" $ do
@@ -226,10 +226,11 @@ spec = do
226 Right [Xsd.ChildType _ (Xsd.TypeComplex t)] =
226 Right [Xsd.ChildType _ (Xsd.TypeComplex t)] =
227 fmap Xsd.children res
227 fmap Xsd.children res
228 Xsd.ContentPlain plain = Xsd.complexContent t
228 Xsd.ContentPlain plain = Xsd.complexContent t
229− [attr] = Xsd.plainContentAttributes plain
229+ [Xsd.InlineAttribute attr] = Xsd.plainContentAttributes plain
230− Xsd.Inline (Xsd.AtomicType restriction _) = Xsd.attrType attr
230+ Xsd.Inline (Xsd.AtomicType restriction _) =
231+ Xsd.attributeInlineType attr
231 res `shouldSatisfy` isRight
232 res `shouldSatisfy` isRight
232− Xsd.restrictionBase restriction `shouldBe`
233+ Xsd.simpleRestrictionBase restriction `shouldBe`
233 Xsd.Ref (Xsd.QName (Just (Xsd.Namespace "something")) "string")
234 Xsd.Ref (Xsd.QName (Just (Xsd.Namespace "something")) "string")
234
235
235 context "when it contains a sequence" $ do
236 context "when it contains a sequence" $ do
xsd-parser.cabal+1−1
@@ -24,7 +24,7 @@ library
24 , Xsd.Parser
24 , Xsd.Parser
25
25
26 -- Other library packages from which modules are imported.
26 -- Other library packages from which modules are imported.
27− build-depends: base ^>=4.12.0.0
27+ build-depends: base >=4.12 && < 5
28 , bytestring
28 , bytestring
29 , containers
29 , containers
30 , lens >= 4.13
30 , lens >= 4.13
xsts-test/Main.hs+61−23
@@ -19,9 +19,10 @@ import Text.XML.Cursor
19import qualified Xsd
19import qualified Xsd
20
20
21data Stat = Stat
21data Stat = Stat
22− { statTestSet :: Text
23− , statTotal :: Int
22+ { statTotal :: Int
24 , statSucceeded :: Int
23 , statSucceeded :: Int
24+ , statValidFailed :: Int
25+ , statInvalidSucceeded :: Int
25 }
26 }
26 deriving (Show)
27 deriving (Show)
27
28
@@ -34,27 +35,29 @@ okRef :: IORef Int
34okRef = unsafePerformIO (newIORef 0)
35okRef = unsafePerformIO (newIORef 0)
35
36
36{-# NOINLINE statsRef #-}
37{-# NOINLINE statsRef #-}
37−statsRef :: IORef [Stat]
38+statsRef :: IORef [(Text, Stat)]
38statsRef = unsafePerformIO (newIORef [])
39statsRef = unsafePerformIO (newIORef [])
39
40
40−dumpResults :: [Stat] -> IO ()
41+dumpResults :: [(Text, Stat)] -> IO ()
41dumpResults stats = IO.withFile "xsts.md" IO.WriteMode $ \h -> do
42dumpResults stats = IO.withFile "xsts.md" IO.WriteMode $ \h -> do
42 IO.hPutStrLn h "This table is generated automatically by `xsts` test."
43 IO.hPutStrLn h "This table is generated automatically by `xsts` test."
43 IO.hPutStrLn h "It contains number of xsd files successfully parsed."
44 IO.hPutStrLn h "It contains number of xsd files successfully parsed."
44 IO.hPutStrLn h "Note that we don't currently attempt to validate xml files"
45 IO.hPutStrLn h "Note that we don't currently attempt to validate xml files"
45 IO.hPutStrLn h "against the schemata."
46 IO.hPutStrLn h "against the schemata."
46 IO.hPutStrLn h ""
47 IO.hPutStrLn h ""
47− IO.hPutStrLn h "Test set | Total tests | Passed tests"
48+ IO.hPutStrLn h "Test set | Total tests | Passed tests | Invalid passed | Valid failed"
48− IO.hPutStrLn h "--- | --- | ---"
49+ IO.hPutStrLn h "--- | --- | --- | --- | ---"
49− forM_ stats $ \s -> do
50+ forM_ stats $ \(name, s) -> do
50 IO.hPutStrLn h $ mconcat
51 IO.hPutStrLn h $ mconcat
51− [ Text.unpack (statTestSet s), " | "
52+ [ Text.unpack name, " | "
52 , show (statTotal s), " | "
53 , show (statTotal s), " | "
53− , show (statSucceeded s)
54+ , show (statSucceeded s), " | "
55+ , show (statInvalidSucceeded s), " | "
56+ , show (statValidFailed s)
54 ]
57 ]
55
58
56expectedFailures :: Int
59expectedFailures :: Int
57−expectedFailures = 4066
60+expectedFailures = 3513
58
61
59main :: IO ()
62main :: IO ()
60main = do
63main = do
@@ -90,24 +93,59 @@ runTestSet path = do
90 results <- mapM (runTestGroup dir) (c $/ laxElement "testGroup")
93 results <- mapM (runTestGroup dir) (c $/ laxElement "testGroup")
91 let
94 let
92 stat = Stat
95 stat = Stat
93− { statTestSet = name
96+ { statTotal = (sum . map statTotal) results
94− , statTotal = (sum . map fst) results
97+ , statSucceeded = (sum . map statSucceeded) results
95− , statSucceeded = (sum . map snd) results
98+ , statValidFailed = (sum . map statValidFailed) results
99+ , statInvalidSucceeded = (sum . map statInvalidSucceeded) results
96 }
100 }
97− modifyIORef' statsRef (stat :)
101+ modifyIORef' statsRef ((name, stat) :)
98 where
102 where
99 dir = takeDirectory path
103 dir = takeDirectory path
100
104
101−runTestGroup :: FilePath -> Cursor -> IO (Int, Int)
105+runTestGroup :: FilePath -> Cursor -> IO Stat
102runTestGroup dir c = do
106runTestGroup dir c = do
103 name <- theAttribute c "name"
107 name <- theAttribute c "name"
104 results <- mapM (runSchemaTest dir name) (aChild c "schemaTest")
108 results <- mapM (runSchemaTest dir name) (aChild c "schemaTest")
105 case join results of
109 case join results of
106− Nothing -> return (0, 0)
110+ Nothing -> return Stat
111+ { statTotal = 0
112+ , statSucceeded = 0
113+ , statValidFailed = 0
114+ , statInvalidSucceeded = 0
115+ }
116+ Just ValidSucceeded -> return Stat
117+ { statTotal = 1
118+ , statSucceeded = 1
119+ , statValidFailed = 0
120+ , statInvalidSucceeded = 0
121+ }
122+ Just ValidFailed -> return Stat
123+ { statTotal = 1
124+ , statSucceeded = 0
125+ , statValidFailed = 1
126+ , statInvalidSucceeded = 0
127+ }
107− Just True -> return (1, 1)
128+ Just InvalidSucceeded -> return Stat
129+ { statTotal = 1
130+ , statSucceeded = 0
131+ , statValidFailed = 0
132+ , statInvalidSucceeded = 1
133+ }
108− Just False -> return (1, 0)
134+ Just InvalidFailed -> return Stat
135+ { statTotal = 1
136+ , statSucceeded = 1
137+ , statValidFailed = 0
138+ , statInvalidSucceeded = 0
139+ }
140+
141+data Result
142+ = InvalidFailed
143+ | InvalidSucceeded
144+ | ValidFailed
145+ | ValidSucceeded
146+ deriving (Show)
109
147
110−runSchemaTest :: FilePath -> Text -> Cursor -> IO (Maybe Bool)
148+runSchemaTest :: FilePath -> Text -> Cursor -> IO (Maybe Result)
111runSchemaTest dir groupName c = do
149runSchemaTest dir groupName c = do
112 path <- do
150 path <- do
113 c' <- theChild c "schemaDocument"
151 c' <- theChild c "schemaDocument"
@@ -126,21 +164,21 @@ runSchemaTest dir groupName c = do
126 case (res, valid) of
164 case (res, valid) of
127 (Left _, False) -> do
165 (Left _, False) -> do
128 modifyIORef' okRef succ
166 modifyIORef' okRef succ
129− return (Just True)
167+ return (Just InvalidFailed)
130 (Right _, True) -> do
168 (Right _, True) -> do
131 modifyIORef' okRef succ
169 modifyIORef' okRef succ
132− return (Just True)
170+ return (Just ValidSucceeded)
133 (Right _, False) -> do
171 (Right _, False) -> do
134 modifyIORef' errRef succ
172 modifyIORef' errRef succ
135 putStrLn $ "invalid xsd passed: " <> Text.unpack groupName
173 putStrLn $ "invalid xsd passed: " <> Text.unpack groupName
136 <> " (" <> dir </> Text.unpack path <> ")"
174 <> " (" <> dir </> Text.unpack path <> ")"
137− return (Just False)
175+ return (Just InvalidSucceeded)
138 (Left err, True) -> do
176 (Left err, True) -> do
139 modifyIORef' errRef succ
177 modifyIORef' errRef succ
140 putStrLn $ "valid xsd didn't pass: " <> Text.unpack groupName
178 putStrLn $ "valid xsd didn't pass: " <> Text.unpack groupName
141 <> " (" <> dir </> Text.unpack path <> ")"
179 <> " (" <> dir </> Text.unpack path <> ")"
142 <> ": " <> show (err :: SomeException)
180 <> ": " <> show (err :: SomeException)
143− return (Just False)
181+ return (Just ValidFailed)
144
182
145anAttribute :: Cursor -> Text -> Maybe Text
183anAttribute :: Cursor -> Text -> Maybe Text
146anAttribute c name = case c $| laxAttribute name of
184anAttribute c name = case c $| laxAttribute name of
xsts.md+95−95
@@ -3,98 +3,98 @@ It contains number of xsd files successfully parsed.
3Note that we don't currently attempt to validate xml files
3Note that we don't currently attempt to validate xml files
4against the schemata.
4against the schemata.
5
5
6−Test set | Total tests | Passed tests
6+Test set | Total tests | Passed tests | Invalid passed | Valid failed
7−--- | --- | ---
7+--- | --- | --- | --- | ---
8−yearMonthDuration | 25 | 9
8+yearMonthDuration | 25 | 13 | 12 | 0
9−XSImportReference | 1 | 0
9+XSImportReference | 1 | 0 | 1 | 0
10−XPathDefaultNSonKeyKeyRefUnique | 13 | 11
10+XPathDefaultNSonKeyKeyRefUnique | 13 | 13 | 0 | 0
11−XML11Support | 11 | 11
11+XML11Support | 11 | 11 | 0 | 0
12−wildcard | 17 | 15
12+wildcard | 17 | 15 | 2 | 0
13−VC | 6 | 5
13+VC | 6 | 6 | 0 | 0
14−unsignedIntegers | 8 | 8
14+unsignedIntegers | 8 | 8 | 0 | 0
15−UnitsLength | 8 | 7
15+UnitsLength | 8 | 6 | 2 | 0
16−union | 19 | 6
16+union | 19 | 14 | 5 | 0
17−CTA | 6 | 4
17+CTA | 6 | 6 | 0 | 0
18−TypeAlternativeTests | 23 | 9
18+TypeAlternativeTests | 23 | 16 | 7 | 0
19−time | 1 | 1
19+time | 1 | 1 | 0 | 0
20−TargetNS | 2 | 1
20+TargetNS | 2 | 2 | 0 | 0
21−substitutionGroup | 5 | 3
21+substitutionGroup | 5 | 3 | 2 | 0
22−rf-whiteSpace | 2 | 2
22+rf-whiteSpace | 2 | 2 | 0 | 0
23−RestrictionOfComplexTypes | 13 | 11
23+RestrictionOfComplexTypes | 13 | 9 | 4 | 0
24−RegularExpression | 8 | 8
24+RegularExpression | 8 | 8 | 0 | 0
25−PopenContent | 24 | 13
25+PopenContent | 24 | 16 | 8 | 0
26−list | 2 | 1
26+list | 2 | 1 | 1 | 0
27−IdentityConstraint | 12 | 7
27+IdentityConstraint | 12 | 6 | 6 | 0
28−ID_IDREF | 77 | 44
28+ID_IDREF | 77 | 57 | 20 | 0
29−gMonth | 1 | 0
29+gMonth | 1 | 0 | 1 | 0
30−gDay | 1 | 1
30+gDay | 1 | 1 | 0 | 0
31−gMonthDay | 1 | 1
31+gMonthDay | 1 | 1 | 0 | 0
32−gYear | 1 | 1
32+gYear | 1 | 1 | 0 | 0
33−gYearMonth | 1 | 1
33+gYearMonth | 1 | 1 | 0 | 0
34−float | 2 | 2
34+float | 2 | 2 | 0 | 0
35−explicitTimezone | 18 | 10
35+explicitTimezone | 18 | 14 | 4 | 0
36−EDCWildcard | 2 | 2
36+EDCWildcard | 2 | 2 | 0 | 0
37−double | 2 | 2
37+double | 2 | 2 | 0 | 0
38−DefaultFixed | 5 | 5
38+DefaultFixed | 5 | 5 | 0 | 0
39−defaultAttributesApply | 17 | 14
39+defaultAttributesApply | 17 | 14 | 3 | 0
40−dayTimeDuration | 24 | 8
40+dayTimeDuration | 24 | 12 | 12 | 0
41−dateTimeStamp | 28 | 9
41+dateTimeStamp | 28 | 11 | 17 | 0
42−date | 1 | 1
42+date | 1 | 1 | 0 | 0
43−CyclicDependencies_Redefine_Include_Import_Override | 5 | 0
43+CyclicDependencies_Redefine_Include_Import_Override | 5 | 0 | 5 | 0
44−constraintsOnAttribute | 16 | 9
44+constraintsOnAttribute | 16 | 6 | 10 | 0
45−ConditionalInclusion | 3 | 2
45+ConditionalInclusion | 3 | 2 | 1 | 0
46−assertion | 51 | 42
46+assertion | 51 | 50 | 1 | 0
47−Assert | 35 | 25
47+Assert | 35 | 35 | 0 | 0
48−anyAttribute | 9 | 7
48+anyAttribute | 9 | 7 | 2 | 0
49−allGroup | 9 | 8
49+allGroup | 9 | 7 | 2 | 0
50−IRI | 1 | 0
50+IRI | 1 | 1 | 0 | 0
51−substitution-groups | 6 | 6
51+substitution-groups | 6 | 6 | 0 | 0
52−Zone | 9 | 5
52+Zone | 9 | 5 | 4 | 0
53−Zone | 20 | 16
53+Zone | 20 | 15 | 5 | 0
54−XmlVersions | 13 | 13
54+XmlVersions | 13 | 13 | 0 | 0
55−Wild | 84 | 57
55+Wild | 84 | 63 | 21 | 0
56−VC | 24 | 9
56+VC | 24 | 19 | 4 | 1
57−TargetNS | 4 | 0
57+TargetNS | 4 | 2 | 2 | 0
58−Subsgroup | 6 | 3
58+Subsgroup | 6 | 3 | 3 | 0
59−Simple | 58 | 31
59+Simple | 58 | 17 | 41 | 0
60−Override | 30 | 21
60+Override | 30 | 21 | 9 | 0
61−Open | 51 | 34
61+Open | 51 | 37 | 14 | 0
62−Missing | 6 | 5
62+Missing | 6 | 4 | 2 | 0
63−Id | 32 | 15
63+Id | 32 | 30 | 2 | 0
64−CTA | 44 | 15
64+CTA | 44 | 33 | 11 | 0
65−Complex | 25 | 11
65+Complex | 25 | 19 | 6 | 0
66−Assert | 34 | 12
66+Assert | 34 | 34 | 0 | 0
67−All | 62 | 27
67+All | 62 | 26 | 34 | 2
68−BoeingXSDTestCases | 6 | 6
68+BoeingXSDTestCases | 6 | 6 | 0 | 0
69−MS-Wildcards2006-07-15 | 315 | 212
69+MS-Wildcards2006-07-15 | 315 | 218 | 97 | 0
70−MS-SimpleType2006-07-15 | 333 | 169
70+MS-SimpleType2006-07-15 | 333 | 210 | 123 | 0
71−MS-Schema2006-07-15 | 124 | 55
71+MS-Schema2006-07-15 | 124 | 56 | 61 | 7
72−MS-Regex2006-07-15 | 2590 | 1988
72+MS-Regex2006-07-15 | 2590 | 1988 | 602 | 0
73−MS-Particles2006-07-15 | 855 | 511
73+MS-Particles2006-07-15 | 855 | 561 | 293 | 1
74−MS-Notations2006-07-15 | 116 | 40
74+MS-Notations2006-07-15 | 116 | 38 | 78 | 0
75−MS-ModelGroups2006-07-15 | 391 | 222
75+MS-ModelGroups2006-07-15 | 391 | 215 | 176 | 0
76−MS-IdentityConstraint2006-07-15 | 844 | 571
76+MS-IdentityConstraint2006-07-15 | 844 | 621 | 223 | 0
77−MS-Group2006-07-15 | 218 | 122
77+MS-Group2006-07-15 | 218 | 138 | 80 | 0
78−MS-Errata102006-07-15 | 19 | 17
78+MS-Errata102006-07-15 | 19 | 15 | 4 | 0
79−MS-Element2006-07-15 | 355 | 198
79+MS-Element2006-07-15 | 355 | 263 | 92 | 0
80−MS-DataTypes2006-07-15 | 2247 | 1482
80+MS-DataTypes2006-07-15 | 2247 | 1491 | 752 | 4
81−MS-ComplexType2006-07-15 | 550 | 303
81+MS-ComplexType2006-07-15 | 550 | 311 | 239 | 0
82−MS-Attribute2006-07-15 | 279 | 138
82+MS-Attribute2006-07-15 | 279 | 165 | 114 | 0
83−MS-AttributeGroup2006-07-15 | 114 | 64
83+MS-AttributeGroup2006-07-15 | 114 | 63 | 51 | 0
84−MS-Annotations2006-07-15 | 80 | 51
84+MS-Annotations2006-07-15 | 80 | 51 | 27 | 2
85−MS-Additional2006-07-15 | 253 | 165
85+MS-Additional2006-07-15 | 253 | 202 | 45 | 6
86−Wildcard | 26 | 22
86+Wildcard | 26 | 22 | 4 | 0
87−Schema | 6 | 6
87+Schema | 6 | 6 | 0 | 0
88−SType | 138 | 123
88+SType | 138 | 131 | 7 | 0
89−Notation | 13 | 8
89+Notation | 13 | 8 | 5 | 0
90−MGroupDef | 19 | 8
90+MGroupDef | 19 | 8 | 11 | 0
91−MGroup | 40 | 24
91+MGroup | 40 | 24 | 16 | 0
92−IdConstrDefs | 27 | 19
92+IdConstrDefs | 27 | 21 | 6 | 0
93−ElemDecl | 227 | 155
93+ElemDecl | 227 | 171 | 56 | 0
94−CType | 31 | 15
94+CType | 31 | 25 | 6 | 0
95−AttrUse | 4 | 1
95+AttrUse | 4 | 3 | 1 | 0
96−AttrDecl | 83 | 78
96+AttrDecl | 83 | 78 | 5 | 0
97−AGroupDef | 13 | 6
97+AGroupDef | 13 | 6 | 7 | 0
98−suntest | 52 | 22
98+suntest | 52 | 30 | 22 | 0
99−NIST2004-01-14 | 3953 | 3873
99+NIST2004-01-14 | 3953 | 3953 | 0 | 0
100−introspection | 1 | 0
100+introspection | 1 | 0 | 0 | 1