"{ 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: [ 
			MetacelloValidationNotification
				signal:
					(MetacelloValidationError
						configurationClass: self configurationClass
						reasonCode: #incorrectVersionString
						callSite: #validateVersionString:againstSpec
						explanation:
							'The version declared in the pragma ', versionString printString , ' does not match the version in the spec '
								, versionSpec versionString printString) ].
! !

!MetacelloVersionConstructor class methodsFor:'documentation'!

version_SVN
    ^ '$Id::                                                                                                                        $'
! !