"{ Package: 'stx:goodies/metacello' }"

MetacelloAbstractVersionConstructor subclass:#MetacelloVersionConstructor

	instanceVariableNames:'errorMap'

	classVariableNames:''

	poolDictionaries:''

	category:'Metacello-Core-Constructors'

!

!MetacelloVersionConstructor class methodsFor:'instance creation'!

on: aConfig

	^(self new)

		on: aConfig;

		yourself

!

on: aConfig project: aProject

	^(self new)

		on: aConfig project: aProject;

		yourself

! !

!MetacelloVersionConstructor class methodsFor:'deprecated'!

spawnPackageMethodIn: aConfig category: methodCategory named: newSelector sourceVersion: sourceVersionString targetVersion: targetVersionString blessing: blessing

	self deprecated: 'see MetacelloToolBox class>>createDevelopment:for:importFromBaseline:description: for a similar example'.

	^self new

		spawnPackageMethodIn: aConfig 

		category: methodCategory 

		named: newSelector

		sourceVersion: sourceVersionString 

		targetVersion: targetVersionString

		blessing: blessing

!

spawnPackageMethodIn: aConfig named: newSelector sourceVersion: sourceVersionString targetVersion: targetVersionString

	self deprecated: 'see MetacelloToolBox class>>createDevelopment:for:importFromBaseline:description: for a similar example'.

	^self 

		spawnPackageMethodIn: aConfig 

		category: 'versions'

		named: newSelector 

		sourceVersion: sourceVersionString 

		targetVersion: targetVersionString 

		blessing: #development

!

spawnPackageMethodIn: aConfig named: newSelector sourceVersion: sourceVersionString targetVersion: targetVersionString blessing: blessing

	self deprecated: 'see MetacelloToolBox class>>createDevelopment:for:importFromBaseline:description: for a similar example'.

	^self new

		spawnPackageMethodIn: aConfig 

		category: 'versions'

		named: newSelector 

		sourceVersion: sourceVersionString 

		targetVersion: targetVersionString

		blessing: blessing

!

updatePackageMethodIn: aConfig sourceVersion: sourceVersionString

	self deprecated: 'see MetacelloToolBox class>>updateDevelopment:for:updateProjects:description: for a similar example'.

	^self new

		updatePackageMethodIn: aConfig 

		sourceVersion: sourceVersionString

! !

!MetacelloVersionConstructor methodsFor:'accessing'!

errorMap

    errorMap ifNil: [ errorMap := Dictionary new ].

    ^ errorMap

! !

!MetacelloVersionConstructor methodsFor:'deprecated'!

prepareForMethodUpdate: aConfig sourceVersion: sourceVersionString forceUpdate: forceUpdate generating: generateBlock

	| pragmaDict versionSpecs pragmaMap updatedPackageSpecs updatedPackageSpecsMap reversed pragmaColl seenUpdatedPackageSpecs |

	self deprecated: 'see MetacelloToolBox for replacement methods'.

	self configuration: aConfig.

	versionSpecs := Dictionary new.

	pragmaMap := Dictionary new.

	pragmaDict := self extractAllVersionPragmas.

	pragmaColl := pragmaDict at: sourceVersionString ifAbsent: [ ^ self ].

	pragmaColl

		do: [ :pragma | 

			| specs versionSpec |

			specs := Dictionary new.

			self evaluatePragma: pragma.

			self attributeMap

				keysAndValuesDo: [ :attribute :blockList | 

					versionSpec := self project versionSpec.

					versionSpec versionString: sourceVersionString.

					specs at: attribute put: versionSpec.

					blockList do: [ :block | self with: versionSpec during: block ] ].

			versionSpecs

				at: pragma selector

				put:

					{specs.

					(self attributeOrder).

					nil}.

			pragmaMap at: pragma selector put: pragma.

			self reset ].

	versionSpecs

		keysAndValuesDo: [ :selector :ar | 

			updatedPackageSpecsMap := Dictionary new.

			seenUpdatedPackageSpecs := Dictionary new.

			ar at: 3 put: updatedPackageSpecsMap.

			reversed := aConfig project attributes reverse.

			reversed

				do: [ :attribute | 

					| vs |

					(vs := (ar at: 1) at: attribute ifAbsent: [  ]) ~~ nil

						ifTrue: [ 

							updatedPackageSpecs := forceUpdate

								ifTrue: [ vs forceUpdatedPackageSpecs ]

								ifFalse: [ vs updatedPackageSpecs ].

							updatedPackageSpecs associations

								do: [ :assoc | 

									| filename |

									(filename := seenUpdatedPackageSpecs at: assoc key ifAbsent: [  ]) == nil

										ifTrue: [ 

											assoc value == #uptodate

												ifTrue: [ 

													"#uptodate means that the spec is up-to-date and we mark it as

										 seen so that the spec is not update for a 'later' spec"

													seenUpdatedPackageSpecs at: assoc key put: #uptodate ]

												ifFalse: [ seenUpdatedPackageSpecs at: assoc key put: assoc value file ] ]

										ifFalse: [ 

											"if the spec was already seen as up-to-date or the file is the same as 

								 the one already seen don't propogate the file"

											(filename == #uptodate or: [ assoc value == #uptodate or: [ filename = assoc value file ] ])

												ifTrue: [ updatedPackageSpecs removeKey: assoc key ] ] ].

							updatedPackageSpecsMap at: attribute put: updatedPackageSpecs ] ].	"clear out #uptodate markers"

			updatedPackageSpecsMap

				valuesDo: [ :d | 

					d associations

						do: [ :assoc | 

							assoc value == #uptodate

								ifTrue: [ d removeKey: assoc key ] ] ].	"remove shadowed packages"

			1 to: reversed size do: [ :index | 

				| attribute d |

				attribute := reversed at: index.

				((d := updatedPackageSpecsMap at: attribute ifAbsent: [  ]) ~~ nil and: [ d keys size > 0 ])

					ifTrue: [ 

						index + 1 to: reversed size do: [ :shadowIndex | 

							d

								keysDo: [ :key | 

									| dict |

									(dict := updatedPackageSpecsMap at: (reversed at: shadowIndex) ifAbsent: [  ]) ~~ nil

										ifTrue: [ dict removeKey: key ifAbsent: [  ] ] ] ] ] ].

			updatedPackageSpecsMap keys

				do: [ :key | 

					| d |

					d := updatedPackageSpecsMap at: key.

					d isEmpty

						ifTrue: [ updatedPackageSpecsMap removeKey: key ] ].	"ready to generate source for method"

			generateBlock

				value: selector

				value: pragmaMap

				value: ar

				value: updatedPackageSpecsMap ]

!

spawnPackageMethodIn: aConfig category: methodCategory named: newSelector sourceVersion: sourceVersionString targetVersion: targetVersionString blessing: blessing

	self deprecated: 'see MetacelloToolBox class>>createBaseline:for:from:description: for replacement method'.

	self 

		prepareForMethodUpdate: aConfig 

		sourceVersion: sourceVersionString 

		forceUpdate: blessing ~~ #baseline

		generating: [:selector :pragmaMap :ar :updatedPackageSpecsMap | | strm |

			strm := WriteStream on: String new.

			strm 

				nextPutAll: newSelector asString, ' spec'; cr;

				tab; nextPutAll: 

						'<version: ', 

						targetVersionString printString, 

						' imports: #(', sourceVersionString printString, 

						')>';cr.

			(ar at: 2) do: [:attribute | | vs d |

				vs := (ar at: 1) at: attribute.

				(d := updatedPackageSpecsMap at: attribute ifAbsent: []) ~~ nil

					ifTrue: [ 

						vs packagesSpec list do: [:member | | x |

							x := d at: member spec name ifAbsent: [].

						 	member spec updateForSpawnMethod: x ]]

					ifFalse: [

						vs packagesSpec list do: [:member |

							member spec updateForSpawnMethod: member spec copy ]].

				strm cr; tab; nextPutAll: 'spec for: ', attribute printString, ' do: ['; cr.

				attribute == #common

					ifTrue: [

						vs 

							author: MetacelloPlatform current authorName;

							timestamp: MetacelloPlatform current timestamp.

						blessing ~~ nil

							ifTrue: [ vs blessing: blessing ]].

				vs configSpawnMethodOn: strm indent: 2.

				strm nextPutAll: '].'].

				(aConfig class	

					compile: strm contents

					classified: methodCategory) == nil 

						ifTrue: [ self error: 'Error compiling the method' ]].

	^true

!

updatePackageMethodIn: aConfig sourceVersion: sourceVersionString

	self deprecated: 'see MetacelloToolBox class>>updateDevelopment:for:updateProjects:description: for replacement method'.

	self 

		prepareForMethodUpdate: aConfig 

		sourceVersion: sourceVersionString 

		forceUpdate: false

		generating: [:selector :pragmaMap :ar :updatedPackageSpecsMap | | strm pragma |

			updatedPackageSpecsMap isEmpty ifTrue: [ ^false ].

			strm := WriteStream on: String new.

			strm 

				nextPutAll: selector asString, ' spec'; cr;

				tab; nextPutAll: '<version: ', sourceVersionString printString.

			pragma := pragmaMap at: selector.

			pragma numArgs = 2

				ifTrue: [

					strm nextPutAll: ' imports: #('.

					(pragma argumentAt: 2) do: [:versionString |

						strm nextPutAll: versionString printString; space ]].

			strm nextPutAll: ')>';cr.

			(ar at: 2) do: [:attribute | | vs d |

				vs := (ar at: 1) at: attribute.

				(d := updatedPackageSpecsMap at: attribute ifAbsent: []) ~~ nil

					ifTrue: [ 

						vs packagesSpec list do: [:member | 

							member spec file ~~ nil

								ifTrue: [ | x |

									(((x := d at: member spec name ifAbsent: []) ~~ nil) and: [ x ~~ #uptodate ])

						 				ifTrue: [ member spec file: x file ]]]].

				strm cr; tab; nextPutAll: 'spec for: ', attribute printString, ' do: ['; cr.

				attribute == #common

					ifTrue: [ 

						vs 

							author: MetacelloPlatform current authorName;

							timestamp: MetacelloPlatform current timestamp ].

				vs configMethodOn: strm indent: 2.

				strm nextPutAll: '].'].

			(aConfig class	

					compile: strm contents

					classified: (aConfig class whichCategoryIncludesSelector: pragma selector)) == nil

						ifTrue: [ self error: 'Error compiling the method' ]].

	^true

! !

!MetacelloVersionConstructor methodsFor:'initialization'!

calculate: aConfig project: aProject

    | versionMap symbolicVersionMap executionBlock pragmaDict |

    self setProject: aProject.

    self configuration: aConfig.

    versionMap := Dictionary new.

    symbolicVersionMap := Dictionary new.

    executionBlock := self specResolverBlock.

    self collectAllVersionsFromVersionPragmasInto: versionMap using: executionBlock.

    pragmaDict := self extractVersionImportPragmas.

    self verifyVersionImportPragmas: pragmaDict definedIn: versionMap.

    self collectAllVersionsFromVersionImportPragmasInto: versionMap using: executionBlock satisfiedPragmas: pragmaDict.

    self collectAllSymbolicVersionsFromVersionPragmasInto: symbolicVersionMap using: self symbolicVersionResolverBlock.

    self project map: versionMap.

    self project errorMap: self errorMap.

    self project symbolicVersionMap: symbolicVersionMap.

    self project configuration: aConfig.	"now that we have a nearly complete project, we can collect the defaultSymbolicVersions, which expect the project to be fully constructed"

    self

        collectDefaultSymbolicVersionsFromVersionPragmasFrom: self extractDefaultSymbolicVersionPragmas

        into: symbolicVersionMap

        using: self defaultSymbolicVersionResolverBlock.	"Pick up defaults from MetacelloBaseConfiguration"

    self

        collectDefaultSymbolicVersionsFromVersionPragmasFrom: self extractCommonDefaultSymbolicVersionPragmas

        into: symbolicVersionMap

        using: self commonDefaultSymbolicVersionResolverBlock.	"now resolive symbolicVersions defined as symbolicVersions"

    symbolicVersionMap copy

        keysAndValuesDo: [ :symbolic :original | 

            | versionString visited |

            versionString := original.

            visited := Set new.

            [ 

            visited add: versionString.

            versionString isSymbol and: [ versionString ~~ #'notDefined' ] ]

                whileTrue: [ 

                    versionString := symbolicVersionMap

                        at: versionString

                        ifAbsent: [ self error: 'Cannot resolve symbolic version ' , original printString ].

                    (visited includes: versionString)

                        ifTrue: [ self error: 'Loop detected resolving symbolic version ' , original printString ] ].

            symbolicVersionMap at: symbolic put: versionString ]

!

on: aConfig

	| cacheKey |

	cacheKey := aConfig class.

	project := MetacelloPlatform current

		stackCacheFor: #versionConstructor

		at: cacheKey

		doing: [ :cache | 

			self calculate: aConfig project: nil.

			cache at: cacheKey put:  self project ].

	self setProject: project.

!

on: aConfig project: aProject

    | cacheKey cachedProject |

    cacheKey := aConfig class.

    cachedProject := MetacelloPlatform current

        stackCacheFor: #'versionConstructor'

        at: cacheKey

        doing: [ :cache | 

            self calculate: aConfig project: aProject.

            cache at: cacheKey put: self project.

            ^ self ].

    aProject map: cachedProject map.

    aProject errorMap: cachedProject errorMap.

    aProject symbolicVersionMap: cachedProject symbolicVersionMap.

    aProject configuration: aConfig.

    self setProject: aProject

! !

!MetacelloVersionConstructor methodsFor:'private'!

collectAllSymbolicVersionsFromVersionPragmasInto: symbolicVersionMap using: executionBlock

	| defined versionPragmaDict versionString |

	versionPragmaDict := self extractSymbolicVersionPragmas.

	versionPragmaDict

		keysAndValuesDo: [ :versionSymbol :pragmaColl | 

			defined := false.

			pragmaColl

				do: [ :pragma | 

					defined := true.

					versionString := executionBlock value: versionSymbol value: pragma ].

			defined

				ifTrue: [ 

					versionString == nil

						ifFalse: [ symbolicVersionMap at: versionSymbol put: versionString ]].

			self reset ]

!

collectAllVersionsFromVersionImportPragmasInto: versionMap using: executionBlock satisfiedPragmas: pragmaDict

    | defined done completed |

    done := false.

    completed := IdentitySet new.

    [ done ]

        whileFalse: [ 

            done := true.

            pragmaDict

                keysAndValuesDo: [ :versionString :pragmaColl | 

                    | versionSpec |

                    versionSpec := nil.

                    defined := false.

                    [ 

                    pragmaColl

                        do: [ :pragma | 

                            (completed includes: pragma)

                                ifFalse: [ 

                                    done := false.

                                    (pragma argumentAt: 2)

                                        do: [ :importedVersion | 

                                            | version |

                                            (version := versionMap at: importedVersion ifAbsent: [  ]) ~~ nil

                                                ifTrue: [ 

                                                    defined := true.

                                                    completed add: pragma.

                                                    versionSpec == nil

                                                        ifTrue: [ versionSpec := version spec copy ]

                                                        ifFalse: [ versionSpec := versionSpec mergeSpec: version spec copy ].

                                                    versionSpec versionString: versionString.

                                                    executionBlock value: versionSpec value: pragma ] ] ] ] ]

                        on: Error

                        do: [ :ex | 

                            (MetacelloErrorInProjectConstructionNotification versionString: versionSpec versionString exception: ex)

                                ifTrue: [ ^ ex pass ]

                                ifFalse: [ 

                                    self errorMap at: versionSpec versionString put: ex.

                                    done := true.

                                    defined := false ] ].

                    defined

                        ifTrue: [ 

                            | version importedVersions |

                            importedVersions := OrderedCollection new.

                            version := versionSpec createVersion.

                            pragmaColl do: [ :pragma | importedVersions addAll: (pragma argumentAt: 2) ].

                            version importedVersions: importedVersions.

                            self validateVersionString: versionString againstSpec: versionSpec.

                            versionMap at: versionSpec versionString put: version ].

                    self reset ] ]

!

collectAllVersionsFromVersionPragmasInto: versionMap using: executionBlock

    | defined versionPragmaDict |

    versionPragmaDict := self extractVersionPragmas.

    versionPragmaDict

        keysAndValuesDo: [ :versionString :pragmaColl | 

            | versionSpec |

            versionSpec := self project versionSpec.

            versionSpec versionString: versionString.

            defined := false.

            [ 

            pragmaColl

                do: [ :pragma | 

                    executionBlock value: versionSpec value: pragma.

                    defined := true ] ]

                on: Error

                do: [ :ex | 

                    (MetacelloErrorInProjectConstructionNotification versionString: versionSpec versionString exception: ex)

                        ifTrue: [ ^ ex pass ]

                        ifFalse: [ 

                            self errorMap at: versionSpec versionString put: ex.

                            defined := false ] ].

            defined

                ifTrue: [ 

                    self validateVersionString: versionString againstSpec: versionSpec.

                    versionMap at: versionSpec versionString put: versionSpec createVersion ].

            self reset ]

!

collectDefaultSymbolicVersionsFromVersionPragmasFrom: versionPragmaDict into: symbolicVersionMap using: executionBlock

	| defined versionString |

	versionPragmaDict

		keysAndValuesDo: [ :versionSymbol :pragmaColl | 

			defined := false.

			symbolicVersionMap

				at: versionSymbol

				ifAbsent: [ 

					"process the defaultSymbolicVersion only if the symbolicVersion is not defined yet"

					pragmaColl

						do: [ :pragma | 

							defined := true.

							versionString := executionBlock value: versionSymbol value: pragma ].

					defined

						ifTrue: [ 

							versionString == nil

								ifFalse: [ symbolicVersionMap at: versionSymbol put: versionString ] ].

					self reset ] ]

!

commonDefaultSymbolicVersionResolverBlock

	^ self defaultSymbolicVersionResolverBlock: (ConfigurationOf new project: self project)

!

defaultSymbolicVersionResolverBlock

	^ self defaultSymbolicVersionResolverBlock: self configuration

!

defaultSymbolicVersionResolverBlock: receiver

	^ [ :symbolicVrsn :pragma | 

	| result |

	result := nil.

	(pragma argumentAt: 1) = symbolicVrsn

		ifTrue: [ 

			self symbolicVersion: symbolicVrsn.

			result := [ receiver perform: pragma selector ] on: MetacelloVersionDoesNotExistError do: [ :ex | ex return: nil ] ].

	result ]

!

specResolverBlock

	^ [ :versionSpec :pragma | 

	(pragma argumentAt: 1) = versionSpec versionString

		ifTrue: [ 

			self evaluatePragma: pragma.

			self project attributes

				do: [ :attribute | 

					| blockList |

					(blockList := self attributeMap at: attribute ifAbsent: [  ]) ~~ nil

						ifTrue: [ blockList do: [ :block | self with: versionSpec during: block ] ] ] ] ]

!

symbolicVersionResolverBlock

	^ [ :symbolicVrsn :pragma | 

	| result |

	result := nil.

	(pragma argumentAt: 1) = symbolicVrsn

		ifTrue: [ 

			self symbolicVersion: symbolicVrsn.

			self evaluatePragma: pragma.

			self project attributes

				do: [ :attribute | 

					| versionString |

					versionString := self attributeMap at: attribute ifAbsent: [  ].

					versionString ~~ nil

						ifTrue: [ result := versionString ] ] ].

	result ]

!

verifyVersionImportPragmas: pragmaDict definedIn: versionMap

    pragmaDict copy

        keysAndValuesDo: [ :versionString :pragmaColl | 

            [ 

            pragmaColl

                do: [ :pragma | 

                    (pragma argumentAt: 2)

                        do: [ :importedVersion | 

                            versionMap

                                at: importedVersion

                                ifAbsent: [ 

                                    pragmaDict

                                        at: importedVersion

                                        ifAbsent: [ 

                                            ^ self

                                                error:

                                                    'The imported version:' , importedVersion printString , ' for version: ' , versionString

                                                        , ' referenced from the method: ' , pragma selector printString

                                                        , ' in configuration ' , configuration class printString

                                                        , ' has not been defined.' ] ] ] ] ]

                on: Error

                do: [ :ex | 

                    (MetacelloErrorInProjectConstructionNotification versionString: versionString exception: ex)

                        ifTrue: [ ^ ex pass ]

                        ifFalse: [ 

                            pragmaDict removeKey: versionString.

                            self errorMap at: versionString put: ex ] ] ]

! !

!MetacelloVersionConstructor methodsFor:'validation'!

validateVersionString: versionString againstSpec: versionSpec

	versionString = versionSpec versionString

		ifFalse: [