Element classification inference is no longer rewritten by a simpler …

…element later in the document.

More tests and bit of reorganization & commenting.

repository/XML-MA-Generator.package/XOGElementClassification.class/README.md

@@ -0,0 +1 @@
+I unify the information form valueType and type classification.

repository/XML-MA-Generator.package/XOGElementClassification.class/instance/attributesOf.in..st

@@ -0,0 +1,8 @@
+retrieving
+attributesOf: anElementPath in: aMapping
+	^ aMapping associations
+		select: [ :pair | 
+			| path |
+			path := pair key.
+			(path beginsWith: anElementPath)
+				and: [ path size = (anElementPath size + 1) and: [ path last includes: $@ ] ] ]

repository/XML-MA-Generator.package/XOGElementClassification.class/instance/childrenOf.in..st

@@ -0,0 +1,8 @@
+retrieving
+childrenOf: anElementPath in: aMapping
+	^ aMapping associations
+		select: [ :pair | 
+			| path |
+			path := pair key.
+			(path beginsWith: anElementPath)
+				and: [ path size = (anElementPath size + 1) and: [ (path last includes: $@) not ] ] ]

repository/XML-MA-Generator.package/XOGElementClassification.class/instance/classifyElement.withTypes.andValues..st

@@ -0,0 +1,36 @@
+retrieving
+classifyElement: anElementPath withTypes: types andValues: valueTypes
+	| type classification |
+	type := types at: anElementPath.
+	type isList | type isInlined
+		ifTrue: [ ^ nil ].
+	classification := OrderedCollection new.
+	(self attributesOf: anElementPath in: valueTypes)
+		do: [ :pair | 
+			classification
+				add: (pair key last copyUpTo: $[) -> (Array with: #attribute with: pair value) ].
+	(self childrenOf: anElementPath in: valueTypes)
+		do: [ :pair | 
+			| childPath childType childName |
+			childPath := pair key.
+			childName := childPath last.
+			childType := types at: childPath.
+			childType isList
+				ifTrue: [ classification add: childName -> (Array with: #list with: childType childName) ].
+			childType isInlined
+				ifTrue: [ | childAttrs |
+					childAttrs := self attributesOf: childPath in: valueTypes.
+					childAttrs
+						ifEmpty: [ classification
+								add: childName -> (Array with: #inlinedElement with: (valueTypes at: childPath)) ]
+						ifNotEmpty: [ classification
+								add:
+									childName
+										->
+											(Array
+												with: #inlinedAttribute
+												with: (childAttrs first key last copyUpTo: $[)
+												with: (valueTypes at: childAttrs first key)) ] ].
+			childType isComplex
+				ifTrue: [ classification add: childName -> #(complex) ] ].
+	^ classification

repository/XML-MA-Generator.package/XOGElementClassification.class/instance/classifyTypes.andValues..st

@@ -0,0 +1,10 @@
+retrieving
+classifyTypes: aTypesDictionary andValues: aValueTypesDictionary
+	| types valueTypes |
+	types := self convertToPaths: aTypesDictionary.
+	valueTypes := self convertToPaths: aValueTypesDictionary.
+	^ self
+		convertFromPaths:
+			(types keys
+				collect: [ :path | path -> (self classifyElement: path withTypes: types andValues: valueTypes) ])
+				asOrderedDictionary

repository/XML-MA-Generator.package/XOGElementClassification.class/instance/convertFromPaths..st

@@ -0,0 +1,4 @@
+utility
+convertFromPaths: aDictionary
+	^ (aDictionary associations
+		collect: [ :pair | ('/' , (pair key joinUsing: $/)) -> pair value ]) asOrderedDictionary

repository/XML-MA-Generator.package/XOGElementClassification.class/instance/convertToPaths..st

@@ -0,0 +1,5 @@
+utility
+convertToPaths: aDictionary
+	^ (aDictionary associations
+		collect: [ :pair | (pair key allButFirst splitOn: $/) asArray -> pair value ])
+		asOrderedDictionary

repository/XML-MA-Generator.package/XOGElementClassification.class/properties.json

@@ -0,0 +1,11 @@
+{
+	"commentStamp" : "PeterUhnak 7/16/2017 23:27",
+	"super" : "Object",
+	"category" : "XML-MA-Generator-Inference",
+	"classinstvars" : [ ],
+	"pools" : [ ],
+	"classvars" : [ ],
+	"instvars" : [ ],
+	"name" : "XOGElementClassification",
+	"type" : "normal"
+}

repository/XML-MA-Generator.package/XOGElementClassificationTest.class/instance/setUp.st

@@ -0,0 +1,16 @@
+running
+setUp
+	super setUp.
+	classification := XOGElementClassification new.
+	types := {#(complex) -> XOGTypeClassification complex.
+	#(complex list) -> (XOGTypeClassification list childName: 'item').
+	#(complex list item) -> XOGTypeClassification complex.
+	#(complex inlinedAttr) -> XOGTypeClassification inlined.
+	#(complex inlinedElement) -> XOGTypeClassification inlined} asOrderedDictionary.
+	valueTypes := {#(complex) -> #Empty.
+	#(complex inlinedAttr) -> #Empty.
+	#(complex inlinedAttr 'value[@value]') -> #String.
+	#(complex inlinedElement) -> #String.
+	#(complex list) -> #Empty.
+	#(complex list item) -> #Empty.
+	#(complex list item 'name[@name]') -> #String} asOrderedDictionary

repository/XML-MA-Generator.package/XOGElementClassificationTest.class/instance/testClassifyAll.st

@@ -0,0 +1,17 @@
+tests
+testClassifyAll
+	self
+		assert:
+			(classification
+				classifyTypes: (classification convertFromPaths: types)
+				andValues: (classification convertFromPaths: valueTypes))
+		equals:
+			{'/complex'
+				->
+					{'inlinedAttr' -> #(inlinedAttribute 'value' String).
+					'inlinedElement' -> #(inlinedElement String).
+					'list' -> #(list item)} asOrderedCollection.
+			'/complex/list' -> nil.
+			'/complex/list/item' -> {'name' -> #(attribute String)} asOrderedCollection.
+			'/complex/inlinedAttr' -> nil.
+			'/complex/inlinedElement' -> nil} asOrderedDictionary

repository/XML-MA-Generator.package/XOGElementClassificationTest.class/instance/testClassifyElementComplex.st

@@ -0,0 +1,8 @@
+tests
+testClassifyElementComplex
+	self
+		assert: (classification classifyElement: #(complex) withTypes: types andValues: valueTypes) asArray
+		equals:
+			{#inlinedAttr -> #(inlinedAttribute 'value' String).
+			#inlinedElement -> #(inlinedElement String).
+			#list -> #(list item)}

repository/XML-MA-Generator.package/XOGElementClassificationTest.class/instance/testClassifyElementEasyComplex.st

@@ -0,0 +1,9 @@
+tests
+testClassifyElementEasyComplex
+	self
+		assert:
+			(classification
+				classifyElement: #(complex list item)
+				withTypes: types
+				andValues: valueTypes) asArray
+		equals: {'name' -> #(attribute String)}

repository/XML-MA-Generator.package/XOGElementClassificationTest.class/instance/testClassifyElementInlined.st

@@ -0,0 +1,5 @@
+tests - classification
+testClassifyElementInlined
+	self
+		assert: (classification classifyElement: #(complex inlinedElement) withTypes: types andValues: valueTypes)
+		equals: nil

repository/XML-MA-Generator.package/XOGElementClassificationTest.class/instance/testClassifyElementList.st

@@ -0,0 +1,5 @@
+tests - classification
+testClassifyElementList
+	self
+		assert: (classification classifyElement: #(complex list) withTypes: types andValues: valueTypes)
+		equals: nil

repository/XML-MA-Generator.package/XOGElementClassificationTest.class/instance/testConvertFromPaths.st

@@ -0,0 +1,11 @@
+tests - utility
+testConvertFromPaths
+	self
+		assert:
+			(classification
+				convertFromPaths:
+					{#(a) -> nil.
+					#(a b) -> nil} asOrderedDictionary)
+		equals:
+			{'/a' -> nil.
+			'/a/b' -> nil} asOrderedDictionary

repository/XML-MA-Generator.package/XOGElementClassificationTest.class/instance/testConvertToPaths.st

@@ -0,0 +1,11 @@
+tests - utility
+testConvertToPaths
+	self
+		assert:
+			(classification
+				convertToPaths:
+					{'/a' -> nil.
+					'/a/b' -> nil} asOrderedDictionary)
+		equals:
+			{#(a) -> nil.
+			#(a b) -> nil} asOrderedDictionary

repository/XML-MA-Generator.package/XOGElementClassificationTest.class/instance/testRetrieveAttributes.st

@@ -0,0 +1,5 @@
+tests - retrieving
+testRetrieveAttributes
+	self
+		assert: (classification attributesOf: #(complex list item) in: valueTypes)
+		equals: {#(complex list item 'name[@name]') -> #String}

repository/XML-MA-Generator.package/XOGElementClassificationTest.class/instance/testRetrieveChildren.st

@@ -0,0 +1,5 @@
+tests - retrieving
+testRetrieveChildren
+	| children |
+	children := classification childrenOf: #(complex list) in: valueTypes.
+	self assert: children equals: {#(complex list item) -> #Empty}

repository/XML-MA-Generator.package/XOGElementClassificationTest.class/properties.json

@@ -0,0 +1,18 @@
+{
+	"commentStamp" : "",
+	"super" : "XOGTestCase",
+	"category" : "XML-MA-Generator-Tests",
+	"classinstvars" : [ ],
+	"pools" : [ ],
+	"classvars" : [ ],
+	"instvars" : [
+		"generator",
+		"classification",
+		"dom",
+		"element",
+		"types",
+		"valueTypes"
+	],
+	"name" : "XOGElementClassificationTest",
+	"type" : "normal"
+}

repository/XML-MA-Generator.package/XOGStructureGenerator.class/instance/processDocument..st

@@ -1,4 +1,8 @@
 xml processing
 processDocument: aDocument
-	self typeHierarchy: (XOGTypeClassification new hierarchyFor: aDocument).
+	| types valueTypes classification |
+	types := XOGTypeClassification new classificationFor: aDocument.
+	valueTypes := XOGValueTypeInference new inferDocument: aDocument.
+	classification := XOGElementClassification new classifyTypes: types andValues: valueTypes.
+	self typeHierarchy: classification.
 	aDocument allElements do: [ :each | self processElement: each ]

repository/XML-MA-Generator.package/XOGTypeAny.class/README.md

@@ -0,0 +1 @@
+I represent an element whose type hasn't been determined yet.

repository/XML-MA-Generator.package/XOGTypeAny.class/properties.json

@@ -1,5 +1,5 @@
 {
-	"commentStamp" : "",
+	"commentStamp" : "PeterUhnak 7/16/2017 23:27",
 	"super" : "XOGType",
 	"category" : "XML-MA-Generator-Inference",
 	"classinstvars" : [ ],

repository/XML-MA-Generator.package/XOGTypeClassification.class/README.md

@@ -1,4 +1,6 @@
-Rules:
+I classify elements by their relation to their own subelements.
+
+Rules for classification (complex/inlined/list/any), by priority:
 
 A) root is always #complex
 B) #inlined

repository/XML-MA-Generator.package/XOGTypeClassification.class/properties.json

@@ -1,5 +1,5 @@
 {
-	"commentStamp" : "PeterUhnak 2/12/2017 09:05",
+	"commentStamp" : "PeterUhnak 7/16/2017 22:11",
 	"super" : "Object",
 	"category" : "XML-MA-Generator-Inference",
 	"classinstvars" : [ ],

repository/XML-MA-Generator.package/XOGTypeComplex.class/README.md

@@ -0,0 +1 @@
+I represent a complex element that has attributes and various subelements.

repository/XML-MA-Generator.package/XOGTypeComplex.class/properties.json

@@ -1,5 +1,5 @@
 {
-	"commentStamp" : "",
+	"commentStamp" : "PeterUhnak 7/16/2017 23:27",
 	"super" : "XOGType",
 	"category" : "XML-MA-Generator-Inference",
 	"classinstvars" : [ ],

repository/XML-MA-Generator.package/XOGTypeInlined.class/README.md

@@ -0,0 +1 @@
+I represent an element that has only string value and will be inlined as an attribute of the partent #complex type.

repository/XML-MA-Generator.package/XOGTypeInlined.class/properties.json

@@ -1,5 +1,5 @@
 {
-	"commentStamp" : "",
+	"commentStamp" : "PeterUhnak 7/16/2017 23:27",
 	"super" : "XOGType",
 	"category" : "XML-MA-Generator-Inference",
 	"classinstvars" : [ ],

repository/XML-MA-Generator.package/XOGTypeList.class/README.md

@@ -0,0 +1 @@
+I represent a XML element that has no attributes and all its children have the same name (=childName).

repository/XML-MA-Generator.package/XOGTypeList.class/properties.json

@@ -1,5 +1,5 @@
 {
-	"commentStamp" : "",
+	"commentStamp" : "PeterUhnak 7/16/2017 23:26",
 	"super" : "XOGType",
 	"category" : "XML-MA-Generator-Inference",
 	"classinstvars" : [ ],

repository/XML-MA-Generator.package/XOGValueTypeInference.class/instance/mergeTypes..st

@@ -1,9 +1,9 @@
 as yet unclassified
 mergeTypes: aCollection
-	(aCollection includes: #String)
-		ifTrue: [ ^ #String ].
-	(aCollection includes: #Float)
-		ifTrue: [ ^ #Float ].
-	(aCollection allSatisfy: [ :each | each = aCollection first ])
-		ifFalse: [ self error: 'Unforeseen error (obviously)' ].
-	^ aCollection anyOne
+	| types |
+	types := aCollection removeDuplicates.
+	types removeAllSuchThat: [ :each | each = #Empty ].
+	types ifEmpty: [ ^ #Empty ].
+	types size > 1
+		ifTrue: [ self error: 'Unforeseen error (obviously)' ].
+	^ types first

repository/XML-MA-Generator.package/XOGValueTypeInference.class/instance/xPathFor..st

@@ -5,8 +5,7 @@ xPathFor: aNode
 	element := aNode.
 	suffix := ''.
 	aNode isAttribute
-		ifTrue: [ element parent.
-			suffix := '[@' , element name , ']' ].
+		ifTrue: [ suffix := '[@' , element name , ']' ].
 	[ element isDocument ]
 		whileFalse: [ parts addFirst: element name.
 			element := element parent ].