git.iko.soy/typeable/xsd-parser
on master help sign in
Parse enumerations (#4)
commit1f31ce44898694f80262a35af3a6f3a24accb5ac authorYuras <shumovichy@gmail.com> dateFri 7 Feb 2020, 11:50 (7 years ago) parent9fadbc0
3 files changed+37−2
compare with master
unifiedsplit
src/Xsd/Parser.hs+9−1 src/Xsd/Types.hs+1 test/Spec.hs+27−1
src/Xsd/Parser.hs+9−1
@@ -168,11 +168,19 @@ parseRestriction c = do
168168 _ -> parseError c "Multiple types"
169169 Just t -> Xsd.Ref <$> makeQName c t
170170
171+ constraints <- parseConstrains c
172+
171173 return Xsd.Restriction
172174 { Xsd.restrictionBase = tp
173− , Xsd.restrictionConstraints = [] -- TODO: implement me
175+ , Xsd.restrictionConstraints = constraints
174176 }
175177
178+parseConstrains :: Cursor -> P [Xsd.Constraint]
179+parseConstrains c = do
180+ enumerationAxis <- makeElemAxis "enumeration"
181+ forM (c $/ enumerationAxis) $ \e -> do
182+ Xsd.Enumeration <$> theAttribute "value" e
183+
176184parseList :: Cursor -> P (Xsd.RefOr Xsd.SimpleType)
177185parseList c =
178186 -- XXX: generalaze RefOr parsing
src/Xsd/Types.hs+1
@@ -7,6 +7,7 @@ module Xsd.Types
77, Type(..)
88, SimpleType(..)
99, Restriction(..)
10+, Constraint(..)
1011, ComplexType(..)
1112, RefOr(..)
1213, Element(..)
test/Spec.hs+27−1
@@ -93,6 +93,32 @@ spec = do
9393 Xsd.restrictionBase restriction `shouldBe`
9494 Xsd.Ref (Xsd.QName (Just (Xsd.Namespace "something")) "string")
9595
96+ context "when restriction contains enumerations" $ do
97+ it "parses them" $ do
98+ let
99+ doc = mkDoc $
100+ mkElem "schema"
101+ (Map.fromList [("xmlns:xs","something")])
102+ [NodeElement $ mkElem "simpleType"
103+ (Map.fromList [("name", "str")])
104+ [NodeElement $ mkElem "restriction"
105+ (Map.fromList [("base", "xs:string")])
106+ [ NodeElement $ mkElem "enumeration"
107+ (Map.fromList [("value", "value1")]) []
108+ , NodeElement $ mkElem "enumeration"
109+ (Map.fromList [("value", "value2")]) []
110+ ]]]
111+ res = Xsd.parse Xsd.defaultConfig doc
112+ Right [Xsd.ChildType tpName (Xsd.TypeSimple t)] =
113+ fmap Xsd.children res
114+ Xsd.AtomicType restriction _ = t
115+ res `shouldSatisfy` isRight
116+ tpName `shouldBe` (Xsd.QName Nothing "str")
117+ Xsd.restrictionConstraints restriction `shouldBe`
118+ [ Xsd.Enumeration "value1"
119+ , Xsd.Enumeration "value2"
120+ ]
121+
96122 context "when restrication base is inlined" $ do
97123 it "parses it" $ do
98124 let
@@ -117,7 +143,7 @@ spec = do
117143 Xsd.restrictionBase restriction `shouldBe`
118144 Xsd.Ref (Xsd.QName (Just (Xsd.Namespace "something")) "string")
119145
120− context "when base is refers to an unbound prefix" $ do
146+ context "when base refers to an unbound prefix" $ do
121147 it "fails" $ do
122148 let
123149 doc = mkDoc $