2ec49b8 · typeable/xsd-parser

git.iko.soy/typeable/xsd-parser

on master help sign in

Parse complex type extension (#5)

2ec49b8Yuras7 years ago

src/Xsd/Parser.hs+63−18

compare with master

unifiedsplit

@@ -195,28 +195,68 @@ parseList c =

195

196parseComplexType :: Cursor -> P Xsd.ComplexType

197parseComplexType c = do

198− attrAxis <- makeElemAxis "attribute"

199− attributes <- mapM parseAttribute (c $/ attrAxis)

200−

201− group <- do

202− sequenceAxis <- makeElemAxis "sequence"

203− choiceAxis <- makeElemAxis "choice"

204− allAxis <- makeElemAxis "all"

205− case (c $/ sequenceAxis, c $/ choiceAxis, c $/ allAxis) of

206− ([], [], []) -> return Nothing

207− ([g], [], []) -> Just <$> parseSequence g

208− ([], [g], []) -> Just <$> parseChoice g

209− ([], [], [g]) -> Just <$> parseAll g

210− _ -> parseError c "Multiple groups"

211−

212 annotations <- parseAnnotations c

198 annotations <- parseAnnotations c

213−

199+ cont <- parseContent c

214 return Xsd.ComplexType

200 return Xsd.ComplexType

215− { Xsd.complexAttributes = attributes

216− , Xsd.complexModelGroup = group

217− , Xsd.complexAnnotations = annotations

201+ { Xsd.complexAnnotations = annotations

202+ , Xsd.complexContent = cont

203+ }

204+

205+parseContent :: Cursor -> P Xsd.Content

206+parseContent c = do

207+ simpleContentAxis <- makeElemAxis "simpleContent"

208+ complexContentAxis <- makeElemAxis "complexContent"

209+ case (c $/ simpleContentAxis, c $/ complexContentAxis) of

210+ ([], []) -> Xsd.ContentPlain <$> parsePlainContent c

211+ ([s], []) -> Xsd.ContentSimple <$> parseSimpleContent s

212+ ([], [s]) -> Xsd.ContentComplex <$> parseComplexContent s

213+ _ -> parseError c

214+ "Expected one of simpleContent, complextContent or model group"

215+

216+parsePlainContent :: Cursor -> P Xsd.PlainContent

217+parsePlainContent c = do

218+ attributes <- parseAttributes c

219+ model <- parseModelGroup c

220+ return Xsd.PlainContent

221+ { Xsd.plainContentModel = model

222+ , Xsd.plainContentAttributes = attributes

223+ }

224+

225+parseSimpleContent :: Cursor -> P Xsd.SimpleContent

226+parseSimpleContent c = parseError c "not implemented"

227+

228+parseComplexContent :: Cursor -> P Xsd.ComplexContent

229+parseComplexContent c = do

230+ restrictionAxis <- makeElemAxis "restriction"

231+ extenstionAxis <- makeElemAxis "extension"

232+ case (c $/ restrictionAxis, c $/ extenstionAxis) of

233+ ([r], []) -> parseError r "not implemented"

234+ ([], [e]) -> Xsd.ComplexContentExtension <$> parseComplexExtension e

235+ _ -> parseError c "Expected one of restriction or extension"

236+

237+parseComplexExtension :: Cursor -> P Xsd.ComplexExtension

238+parseComplexExtension c = do

239+ base <- theAttribute "base" c >>= makeQName c

240+ attributes <- parseAttributes c

241+ model <- parseModelGroup c

242+ return Xsd.ComplexExtension

243+ { Xsd.complexExtensionBase = base

244+ , Xsd.complexExtensionModel = model

245+ , Xsd.complexExtensionAttributes = attributes

218 }

246 }

219

247

248+parseModelGroup :: Cursor -> P (Maybe Xsd.ModelGroup)

249+parseModelGroup c = do

250+ sequenceAxis <- makeElemAxis "sequence"

251+ choiceAxis <- makeElemAxis "choice"

252+ allAxis <- makeElemAxis "all"

253+ case (c $/ sequenceAxis, c $/ choiceAxis, c $/ allAxis) of

254+ ([], [], []) -> return Nothing

255+ ([g], [], []) -> Just <$> parseSequence g

256+ ([], [g], []) -> Just <$> parseChoice g

257+ ([], [], [g]) -> Just <$> parseAll g

258+ _ -> parseError c "Multiple model groups"

259+

220parseSequence :: Cursor -> P Xsd.ModelGroup

260parseSequence :: Cursor -> P Xsd.ModelGroup

221parseSequence c = Xsd.Sequence <$> parseElements c

261parseSequence c = Xsd.Sequence <$> parseElements c

222

262

@@ -232,6 +272,11 @@ parseElements c = do

232 elementAxis <- makeElemAxis "element"

272 elementAxis <- makeElemAxis "element"

233 mapM parseElement (c $/ elementAxis)

273 mapM parseElement (c $/ elementAxis)

234

274

275+parseAttributes :: Cursor -> P [Xsd.Attribute]

276+parseAttributes c = do

277+ attrAxis <- makeElemAxis "attribute"

278+ mapM parseAttribute (c $/ attrAxis)

279+

235parseAttribute :: Cursor -> P Xsd.Attribute

280parseAttribute :: Cursor -> P Xsd.Attribute

236parseAttribute c = do

281parseAttribute c = do

237 name <- theAttribute "name" c >>= makeTargetQName

282 name <- theAttribute "name" c >>= makeTargetQName

src/Xsd/Types.hs+37−3

@@ -9,6 +9,11 @@ module Xsd.Types

9, Restriction(..)

10, Constraint(..)

11, ComplexType(..)

12+, Content(..)

13+, PlainContent(..)

14+, SimpleContent(..)

15+, ComplexContent(..)

16+, ComplexExtension(..)

12, RefOr(..)

17, RefOr(..)

13, Element(..)

18, Element(..)

14, MaxOccurs(..)

19, MaxOccurs(..)

@@ -88,12 +93,40 @@ data SimpleType

88 deriving (Show, Eq)

93 deriving (Show, Eq)

90data ComplexType = ComplexType

95data ComplexType = ComplexType

91− { complexAttributes :: [Attribute]

92− , complexModelGroup :: Maybe ModelGroup

93− , complexAnnotations :: [Annotation]

96+ { complexAnnotations :: [Annotation]

97+ , complexContent :: Content

94 }

98 }

95 deriving (Show, Eq)

99 deriving (Show, Eq)

100

101+data Content

102+ = ContentComplex ComplexContent

103+ | ContentSimple SimpleContent

104+ | ContentPlain PlainContent

105+ deriving (Show, Eq)

106+

107+-- | Represent content of complexType without simpleContent or complexContent

108+data PlainContent = PlainContent

109+ { plainContentModel :: Maybe ModelGroup

110+ , plainContentAttributes :: [Attribute]

111+ }

112+ deriving (Show, Eq)

113+

114+data ComplexContent

115+ = ComplexContentExtension ComplexExtension

116+ | ComplexContentRestriction -- TODO: implement me

117+ deriving (Show, Eq)

118+

119+data ComplexExtension = ComplexExtension

120+ { complexExtensionBase :: QName

121+ , complexExtensionModel :: Maybe ModelGroup

122+ , complexExtensionAttributes :: [Attribute]

123+ }

124+ deriving (Show, Eq)

125+

126+-- TODO: implement me

127+data SimpleContent = SimpleContent

128+ deriving (Show, Eq)

129+

97data ModelGroup

130data ModelGroup

98 = Sequence [Element]

131 = Sequence [Element]

99 | Choice [Element]

132 | Choice [Element]

@@ -115,6 +148,7 @@ data Use

115

148

116data Restriction = Restriction

149data Restriction = Restriction

117 { restrictionBase :: RefOr SimpleType

150 { restrictionBase :: RefOr SimpleType

151+ -- XXX: could restrictionBase be an inline type? Probably not.

118 , restrictionConstraints :: [Constraint]

152 , restrictionConstraints :: [Constraint]

119 }

153 }

120 deriving (Show, Eq)

154 deriving (Show, Eq)

test/Spec.hs+33−3

@@ -198,7 +198,8 @@ spec = do

198 res = Xsd.parse Xsd.defaultConfig doc

199 Right [Xsd.ChildType tpName (Xsd.TypeComplex t)] =

200 fmap Xsd.children res

201− [attr] = Xsd.complexAttributes t

201+ Xsd.ContentPlain plain = Xsd.complexContent t

202+ [attr] = Xsd.plainContentAttributes plain

202 res `shouldSatisfy` isRight

203 res `shouldSatisfy` isRight

203 tpName `shouldBe` Xsd.QName Nothing "person"

204 tpName `shouldBe` Xsd.QName Nothing "person"

204 Xsd.attrName attr `shouldBe` Xsd.QName Nothing "firstName"

205 Xsd.attrName attr `shouldBe` Xsd.QName Nothing "firstName"

@@ -223,7 +224,8 @@ spec = do

223 res = Xsd.parse Xsd.defaultConfig doc

224 res = Xsd.parse Xsd.defaultConfig doc

224 Right [Xsd.ChildType _ (Xsd.TypeComplex t)] =

225 Right [Xsd.ChildType _ (Xsd.TypeComplex t)] =

225 fmap Xsd.children res

226 fmap Xsd.children res

226− [attr] = Xsd.complexAttributes t

227+ Xsd.ContentPlain plain = Xsd.complexContent t

228+ [attr] = Xsd.plainContentAttributes plain

227 Xsd.Inline (Xsd.AtomicType restriction _) = Xsd.attrType attr

229 Xsd.Inline (Xsd.AtomicType restriction _) = Xsd.attrType attr

228 res `shouldSatisfy` isRight

230 res `shouldSatisfy` isRight

229 Xsd.restrictionBase restriction `shouldBe`

231 Xsd.restrictionBase restriction `shouldBe`

@@ -254,11 +256,39 @@ spec = do

254 res = Xsd.parse Xsd.defaultConfig doc

256 res = Xsd.parse Xsd.defaultConfig doc

255 Right [Xsd.ChildType _ (Xsd.TypeComplex t)] =

257 Right [Xsd.ChildType _ (Xsd.TypeComplex t)] =

256 fmap Xsd.children res

258 fmap Xsd.children res

259+ Xsd.ContentPlain plain = Xsd.complexContent t

257− Just (Xsd.Sequence elems) = Xsd.complexModelGroup t

260+ Just (Xsd.Sequence elems) = Xsd.plainContentModel plain

258 res `shouldSatisfy` isRight

261 res `shouldSatisfy` isRight

259 map Xsd.elementName elems `shouldBe`

262 map Xsd.elementName elems `shouldBe`

260 map (Xsd.QName Nothing) ["firstName", "lastName"]

263 map (Xsd.QName Nothing) ["firstName", "lastName"]

261

264

265+ context "when it contains complexContent" $ do

266+ context "when it's an extenstion" $ do

267+ it "succeeds" $ do

268+ let

269+ doc = mkDoc $

270+ mkElem "schema"

271+ (Map.fromList [("xmlns:xs","something")])

272+ [NodeElement $ mkElem "complexType"

273+ (Map.fromList [("name", "person")])

274+ [NodeElement $ mkElem "complexContent" Map.empty

275+ [ NodeElement $ mkElem "extension"

276+ (Map.fromList [("base", "BaseType")])

277+ [ NodeElement $ mkElem "sequence" Map.empty

278+ [ NodeElement $ mkElem "element"

279+ (Map.fromList

280+ [ ("name", "first")

281+ , ("type", "xs:string")])

282+ []

283+ ]]]]]

284+ res = Xsd.parse Xsd.defaultConfig doc

285+ Right [Xsd.ChildType _ (Xsd.TypeComplex t)] =

286+ fmap Xsd.children res

287+ Xsd.ContentComplex (Xsd.ComplexContentExtension e)

288+ = Xsd.complexContent t

289+ res `shouldSatisfy` isRight

290+ Xsd.complexExtensionBase e `shouldBe` Xsd.QName Nothing "BaseType"

291+

262 context "when element is given" $ do

292 context "when element is given" $ do

263 context "when type is inlined" $ do

293 context "when type is inlined" $ do

264 it "succeeds" $ do

294 it "succeeds" $ do