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

MetacelloAbstractPackageSpec subclass:#MetacelloStXPackageSpec
	instanceVariableNames:'file repositories goferPackage preLoadDoIt postLoadDoIt'
	classVariableNames:''
	poolDictionaries:''
	category:'Metacello-St/X-Specs'
!

Collection subclass:#Prerequisites
	instanceVariableNames:'packageSpec suppressions additions'
	classVariableNames:''
	poolDictionaries:''
	privateIn:MetacelloStXPackageSpec
!


!MetacelloStXPackageSpec methodsFor:'accessing'!

file: aString

	file := aString
!

getFile
	"raw access to iv"
	
	^file
!

getName
    "raw access to iv"

    ^ name
!

getRepositories
    "raw access to iv"

    ^ repositories
!

goferLoaderReference

	^file == nil 
		ifTrue: [ GoferPackageReference name: self name ]
		ifFalse: [ 
			"does Monticello-style #versionInfoFromVersionNamed: matching"
			MetacelloGoferPackage name: self name packageFilename: self file ]
!

goferPackage

	goferPackage == nil 
		ifTrue: [ goferPackage := MetacelloGoferPackage name: self name packageFilename: self file ].
	^goferPackage
!

info
	"test compatibility method"

	^self
!

preLoadDoIt: anObject

	anObject setPreLoadDoItInMetacelloSpec: self
!

repository: aStringOrMetacelloRepositorySpec

	self repositories repository: aStringOrMetacelloRepositorySpec
!

repository: aString username: username password: password

	self repositories repository: aString username: username password: password
!

setPostLoadDoIt: aSymbol

	postLoadDoIt := aSymbol
!

setPreLoadDoIt: aSymbol

	preLoadDoIt := aSymbol
! !

!MetacelloStXPackageSpec methodsFor:'construction'!

file: aString constructor: aVersionConstructor
    aVersionConstructor fileForPackage: aString
!

includes: anObject constructor: aVersionConstructor
    aVersionConstructor includesForPackage: anObject
!

postLoadDoIt: aSymbol constructor: aVersionConstructor
    aVersionConstructor postLoadDoItForPackage: aSymbol
!

preLoadDoIt: aSymbol constructor: aVersionConstructor
    aVersionConstructor preLoadDoItForPackage: aSymbol
!

repositories: aBlock constructor: aVersionConstructor
    aVersionConstructor repositoriesForPackage: aBlock
!

repository: anObject constructor: aVersionConstructor
    aVersionConstructor repositoryForPackage: anObject
!

repository: aString username: username password: password constructor: aVersionConstructor
    aVersionConstructor repositoryForPackage: aString username: username password: password
!

requires: anObject constructor: aVersionConstructor
    aVersionConstructor requiresForPackage: anObject
!

supplyingAnswers: anObject constructor: aVersionConstructor
    aVersionConstructor supplyingAnswersForPackage: anObject
! !

!MetacelloStXPackageSpec methodsFor:'copying'!

postCopy

	super postCopy.
	goferPackage := nil.
	repositories := repositories copy.
! !

!MetacelloStXPackageSpec methodsFor:'development support'!

copySpecTo: aRepositorySpec
	"Copy current mcz file to the repository named in aRepositorySpec"

	self loader copySpec: self from: self repositorySpecs to: aRepositorySpec createRepository
!

forceUpdatePackageSpec: updatedSpecs using: anMCLoader
	
	self updatePackageSpec: updatedSpecs force: true using: anMCLoader
!

goferBranchPackage: branchName message: commitMessage
	"uses gofer to do commit ... non-interactive"

	| latestFile pkgSpec   |
	(file notNil and: [ (self name, '.', branchName) = self file ])
		ifTrue: [ 
			latestFile := self loader latestPackage: self file fromRepository: self repositorySpecs.
			pkgSpec := self copy.
			latestFile ~~ nil
				ifTrue: [ 
					pkgSpec file: latestFile.
					pkgSpec goferCommitPackage: commitMessage.
					^ self ] ].
	self loader goferCommitBranchPackage: branchName using: self repositorySpecs commitMessage: commitMessage
!

goferCommitPackage: commitMessage
	"uses gofer to do commit ... non-interactive"
	
	| latestFile pkgSpec |
	^(file notNil and: [ self name = self file ])
		ifTrue: [
			latestFile := self loader latestPackage: self name fromRepository: self repositorySpecs.
			pkgSpec := self copy.
			pkgSpec file: latestFile.
			pkgSpec goferCommitPackage: commitMessage ]
		ifFalse: [ self loader goferCommitPackageUsing: self repositorySpecs commitMessage: commitMessage ]
!

packagesNeedSavingVisited: visitedProjects using: repos into: aCollection

	^self loader packagesNeedSavingUsing: repos into: aCollection
!

savePackage
	"Interactive save ... prompted for commit message and package name unless MCVersionNameAndMessageRequest handled"

	| latestFile pkgSpec |
	^(file notNil and: [ self name = self file ])
		ifTrue: [
			latestFile := self loader latestPackage: self name fromRepository: self repositorySpecs.
			pkgSpec := self copy.
			pkgSpec file: latestFile.
			pkgSpec savePackage ]
		ifFalse: [ self loader savePackageUsing: self repositorySpecs ]
!

updateForSpawnMethod: sourceSpec
	"This means that this spec was used in a baseline and will be used in a version .... drop all information that isn't useful"

	| nm fl |
	nm := name.
	fl := file.
	sourceSpec ~~ nil ifTrue: [ fl := sourceSpec file ].
	super updateForSpawnMethod: sourceSpec.
	file := repositories := goferPackage := preLoadDoIt := postLoadDoIt := nil.
	name := nm.
	file := fl.
!

updatePackageRepositories: repositorySpecs

	| resolvedPackageRef |
	Transcript cr; show: '  Looking up version -> ', self file.
	resolvedPackageRef := self loader resolveSpec: self from: repositorySpecs.
	Transcript cr; show: 'Update repositoryGroup -> ', resolvedPackageRef name, ' ' , resolvedPackageRef repository description.
	resolvedPackageRef version workingCopy repositoryGroup addRepository: resolvedPackageRef repository
!

updatePackageRepositoriesFor: aVersionSpec
	"Don't update the repository unless the package is loaded in the image"
	
	self workingCopy == nil ifTrue: [ ^self ].
	self updatePackageRepositories: self repositorySpecs, aVersionSpec repositorySpecs.	
!

updatePackageSpec: updatedSpecs force: force using: anMCLoader
	"Add pkg copy to updatedSpecs if the file in current image is different from the receiver's file"

	| viName |
	(force not and: [ self getFile == nil ])
		ifTrue: [ ^ self ].	"no file explicitly specified in this spec"
	(viName := self workingCopyNameFor: anMCLoader) == nil
		ifTrue: [ ^ self ].	"no working copy"
	viName ~= self file
		ifTrue: [ 
			| spec |
			spec := self copy.
			spec file: viName.
			updatedSpecs at: spec name put: spec ]
		ifFalse: [ updatedSpecs at: self name put: #uptodate ]
!

updatePackageSpec: updatedSpecs using: anMCLoader
	"Add pkg copy to updatedSpecs if the file in current image is different from the receiver's file"
	
	self updatePackageSpec: updatedSpecs force: false using: anMCLoader
! !

!MetacelloStXPackageSpec methodsFor:'loading'!

ensureLoadUsing: mcLoader
	self explicitLoadUsing: mcLoader ensureSpecLoader
!

ensureLoadedForDevelopmentUsing: mcLoader
	"noop"
	
	^true
!

explicitLoadUsing: mcLoader

	| wc fetchingSpecLoader |
	((wc := self workingCopy) ~~ nil and: [ wc needsSaving ]) 
		ifTrue: [ 
			(MetacelloSkipDirtyPackageLoad signal: self)
				ifTrue:  [
					Transcript cr; show: 'Skipping load of modified package: ', self file.
					^self]
				ifFalse: [Transcript cr; show: 'Load over modified package: ', self file] ].
	"fetch and explicitly load it"
	fetchingSpecLoader := mcLoader fetchingSpecLoader.
	fetchingSpecLoader
		explicitLoadPackageSpecs: (Array with: self) 
		repositories: (fetchingSpecLoader repositoriesFrom: self repositorySpecs).
!

fetch

	self fetchUsing: self loader
!

fetchPackage: aLoaderPolicy

	self fetchUsing: 
		(self loader
			loaderPolicy: aLoaderPolicy;
			yourself)
!

fetchUsing: mcLoader

	| fetchingSpecLoader |
	fetchingSpecLoader := mcLoader fetchingSpecLoader.
	fetchingSpecLoader
		linearLoadPackageSpecs: (Array with: self) 
		repositories: (fetchingSpecLoader repositoriesFrom: self repositorySpecs).
!

load

	self explicitLoadUsing: self loader
!

loadUsing: mcLoader

	self loader doingLoads: [ self explicitLoadUsing: mcLoader ]
!

loadUsing: aLoader gofer: gofer

	^aLoader linearLoadPackageSpec: self gofer: gofer
!

packageSpecsInLoadOrder

	^{ self. }
!

postLoadDoIt: anObject

	anObject setPostLoadDoItInMetacelloSpec: self
!

repositoryDescriptions
    ^ self repositorySpecs collect: [ :repoSpec | repoSpec description ]
!

repositorySpecs

	^self repositories map values 
! !

!MetacelloStXPackageSpec methodsFor:'merging'!

mergeMap

	| map |
	map := super mergeMap.
	map at: #file put: file.
	map at: #repositories put: self repositories.
	map at: #preLoadDoIt put: preLoadDoIt.
	map at: #postLoadDoIt put: postLoadDoIt.
	^map
!

mergeSpec: anotherSpec

	| newSpec map anotherPackages anotherRepositories |
	newSpec := super mergeSpec: anotherSpec.
	map := anotherSpec mergeMap.
	(anotherRepositories := map at: #repositories) notEmpty
		ifTrue: [ 
			newSpec 
				repositories: (self repositories isEmpty
					ifTrue: [ anotherRepositories ]
					ifFalse: [ self repositories mergeSpec: anotherRepositories ]) ].
	^newSpec
!

nonOverridable

	^super nonOverridable, #( repositories)
! !

!MetacelloStXPackageSpec methodsFor:'printing'!

configMethodBodyOn: aStream hasName: hasName indent: indent

	| hasFile hasRepositories hasPreLoadDoIt hasPostLoadDoIt hasRequiresOrIncludesOrAnswers |
	hasFile := file ~~ nil.
	hasRepositories := self repositorySpecs size > 0.
	hasPreLoadDoIt := self getPreLoadDoIt ~~ nil.
	hasPostLoadDoIt := self getPostLoadDoIt ~~ nil.
	hasRequiresOrIncludesOrAnswers := (self requires isEmpty and: [ self includes isEmpty and: [self answers isEmpty ]]) not.
	hasRequiresOrIncludesOrAnswers
		ifTrue: [ 
			self 
				configMethodBodyOn: aStream 
				hasName: hasName 
				cascading: hasFile | hasRepositories | hasPreLoadDoIt | hasPostLoadDoIt
				indent: indent ].
	self 
		configMethodOn: aStream 
		for: file 
		selector: 'file: ' 
		cascading: hasName | hasRepositories | hasPreLoadDoIt | hasPostLoadDoIt | hasRequiresOrIncludesOrAnswers 
		cascade: hasRepositories | hasPreLoadDoIt | hasPostLoadDoIt 
		indent: indent.
	hasRepositories
		ifTrue: [ 
			(self repositorySpecs size > 1)
				ifTrue: [ 
					hasName | hasFile | hasPreLoadDoIt | hasPostLoadDoIt | hasRequiresOrIncludesOrAnswers
						ifTrue: [ 
							aStream cr;
							tab: indent. ].
					aStream 
						nextPutAll: 'repositories: ['; 
						cr;
						tab: indent + 1;
						nextPutAll: 'spec'; 
						cr.
					self repositories configMethodCascadeOn: aStream indent: indent + 1.
					aStream nextPutAll: ' ]' ]
				ifFalse: [ 
					hasName | hasFile | hasPreLoadDoIt | hasPostLoadDoIt | hasRequiresOrIncludesOrAnswers
						ifTrue: [ aStream cr; tab: indent ].
					self repositories configMethodCascadeOn: aStream indent: indent ].
			hasPreLoadDoIt | hasPostLoadDoIt ifTrue: [ aStream nextPut: $; ] ].
	self 
		configMethodOn: aStream 
		for: self getPreLoadDoIt 
		selector: 'preLoadDoIt: '
		cascading: hasName | hasFile | hasRepositories | hasPostLoadDoIt | hasRequiresOrIncludesOrAnswers 
		cascade: hasPostLoadDoIt 
		indent: indent.
	self 
		configMethodOn: aStream 
		for: self getPostLoadDoIt 
		selector: 'postLoadDoIt: ' 
		cascading: hasName | hasFile | hasRepositories | hasPreLoadDoIt | hasRequiresOrIncludesOrAnswers 
		cascade: false 
		indent: indent.
	aStream nextPut: $.
!

configMethodCascadeOn: aStream member: aMember last: lastCascade indent: indent

	aMember methodUpdateSelector  == #remove:
		ifTrue: [ aStream  nextPutAll: 'removePackage: ', self name printString ]
		ifFalse: [ self configShortCutMethodBodyOn: aStream member: aMember indent: indent ].
	lastCascade
		ifTrue: [ aStream nextPut: $. ]
		ifFalse: [ aStream nextPut: $;; cr ]
!

configMethodOn: aStream indent: indent

	| hasRepositories hasPreLoadDoIt hasPostLoadDoIt hasRequiresOrIncludesOrAnswers hasFile |
	hasFile := file ~~ nil.
	hasRepositories := self repositorySpecs size > 0.
	hasPreLoadDoIt := self getPreLoadDoIt ~~ nil.
	hasPostLoadDoIt := self getPostLoadDoIt ~~ nil.
	hasRequiresOrIncludesOrAnswers := (self requires isEmpty and: [ self includes isEmpty and: [self answers isEmpty ]]) not.
	aStream tab: indent; nextPutAll: 'spec '.
	hasFile | hasRepositories | hasPreLoadDoIt | hasPostLoadDoIt | hasRequiresOrIncludesOrAnswers
		ifTrue: [
			aStream cr; tab: indent + 1; nextPutAll: 'name: ', self name printString; nextPut: $;.
			self configMethodBodyOn: aStream hasName: true indent: indent + 1 ]
		ifFalse: [
			aStream nextPutAll: 'name: ', self name printString ]
!

configShortCutMethodBodyOn: aStream member: aMember indent: indent

	| hasFile hasRepositories hasPreLoadDoIt hasPostLoadDoIt hasRequiresOrIncludesOrAnswers |
	hasFile := file ~~ nil.
	hasRepositories := self repositorySpecs size > 0.
	hasPreLoadDoIt := self getPreLoadDoIt ~~ nil.
	hasPostLoadDoIt := self getPostLoadDoIt ~~ nil.
	hasRequiresOrIncludesOrAnswers := (self requires isEmpty and: [ self includes isEmpty and: [self answers isEmpty ]]) not.
	hasRepositories | hasPreLoadDoIt | hasPostLoadDoIt | hasRequiresOrIncludesOrAnswers
		ifTrue: [
			aStream 
				nextPutAll: 'package: ', self name printString, ' ';
				nextPutAll: aMember methodUpdateSelector asString, ' ['; cr.
			aStream tab: indent + 1; nextPutAll: 'spec '.
			self configMethodBodyOn: aStream hasName: false indent: indent + 2.
			aStream nextPutAll: ' ]'.
			^self ].
	aStream nextPutAll: 'package: ', self name printString.
	hasFile
		ifTrue: [ aStream nextPutAll: ' with: ', file printString ]
! !

!MetacelloStXPackageSpec methodsFor:'private'!

extractNameFromFile

	file == nil ifTrue: [ ^nil ].
	^(self loader nameComponentsFrom: self file) first
!

includesForPackageOrdering

	^self includes
!

resolveToPackagesIn: aVersionSpec visited: visited

	^{ self }
!

setRequires: aCollection

    self breakPoint: #jv.

    requires := aCollection

    "Created: / 05-09-2012 / 19:47:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MetacelloStXPackageSpec methodsFor:'querying'!

file

	file == nil ifTrue: [ ^self name ].
	^file
!

getPostLoadDoIt

	^postLoadDoIt
!

getPreLoadDoIt

	^preLoadDoIt
!

isPackageLoaded

	^self isPackageLoaded: self loader
!

isPackageLoaded: aLoader

	^(self workingCopyNameFor: aLoader) ~~ nil
!

name

	name == nil ifTrue: [ name := self extractNameFromFile ].
	^name
!

postLoadDoIt

	^postLoadDoIt
!

preLoadDoIt

	^preLoadDoIt
!

repositories

	repositories == nil ifTrue: [ repositories := self project repositoriesSpec ].
	^ repositories
!

repositories: anObject
	repositories := anObject
!

repository
    self deprecated: 'Use repositories or repositorySpecs'.
    self repositorySpecs isEmpty
        ifTrue: [ ^ nil ].
    ^ self repositorySpecs first
!

requires

    requires == nil ifTrue: [ 
        requires := Prerequisites for: self. 
    ].
    ^requires

    "Created: / 05-09-2012 / 19:47:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MetacelloStXPackageSpec methodsFor:'testing'!

compareCurrentVersion: anOperator targetVersionStatus: statusIgnored using: anMCLoader

	self 
		currentPackageLoaded: [:bool | ^bool ] 
		comparing: anOperator 
		notLoaded: [:ignored | ^false ]
		using: anMCLoader
!

compareRelativeCurrentVersion: anOperator targetVersionStatus: statusIgnored using: anMCLoader

	^self compareCurrentVersion: anOperator targetVersionStatus: statusIgnored using: anMCLoader
!

compareWorkingCopyNamed: wcName using: comarisonOperator
	| fileRef wcRef |
	fileRef := GoferResolvedReference name: self file.
	wcRef := GoferResolvedReference name: wcName.
	^ wcRef compare: fileRef using: comarisonOperator
!

currentPackageLoaded: loadedBlock comparing: comarisonOperator notLoaded: notLoadedBlock using: anMCLoader
	"Use currentVersionInfoFor: because it involves the loader and returns versionInfo for a planned load 
	 (atomic loaders) or currently loaded package"

	| wcName vis |
	vis := anMCLoader ancestorsFor: self.
	vis notNil
		ifTrue: [ 
			| fileRef wcRef |
			self getFile == nil
				ifTrue: [ ^ loadedBlock value: false ].
			vis
				do: [ :vi | 
					wcName := vi name.
					fileRef := GoferResolvedReference name: self file.
					wcRef := GoferResolvedReference name: wcName.
					(wcRef compare: fileRef using: comarisonOperator)
						ifTrue: [ ^ loadedBlock value: true ] ].
			^ loadedBlock value: false ].
	^ notLoadedBlock value: true
!

currentPackageLoaded: loadedBlock notLoaded: notLoadedBlock using: anMCLoader
	"Use currentVersionInfoFor: because it involves the loader and returns versionInfo for a planned load 
	 (atomic loaders) or currently loaded package"

	| wcName vis |
	vis := anMCLoader ancestorsFor: self.
	vis notNil
		ifTrue: [ 
			self getFile == nil
				ifTrue: [ ^ loadedBlock value: #() value: self file ].
			^ loadedBlock value: vis value: self file ].
	^ notLoadedBlock value
!

hasRepository
    ^ self repositorySpecs notEmpty
! !

!MetacelloStXPackageSpec methodsFor:'visiting'!

projectDo: projectBlock packageDo: packageBlock groupDo: groupBlock

	packageBlock value: self
!

visitingWithPackages: packages

	packages at: self name put: self
! !

!MetacelloStXPackageSpec::Prerequisites class methodsFor:'instance creation'!

for: spec
    ^self new initializeFor: spec

    "Created: / 05-09-2012 / 19:49:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MetacelloStXPackageSpec::Prerequisites methodsFor:'adding & removing'!

add:anObject
    "add the argument, anObject to the receiver.
     If the receiver is ordered, the position of the new element is undefined
     (i.e. don't depend on where it will be put).
     An error is raised here - it is to be implemented by a concrete subclass."

    ^ self shouldImplement
!

addFirst:anObject
    "add the argument, anObject to the receiver.
     If the receiver is ordered, the new element will be added at the beginning.
     An error is raised here - it is to be implemented by a concrete subclass."

    ^ self shouldImplement
!

remove:anObject ifAbsent:exceptionBlock
    "search for the first element, which is equal to anObject;
     if found, remove and return it.
     If not found, return the the value of the exceptionBlock.
     Uses equality compare (=) to search for the occurrence.
     An error is raised here - it is to be implemented by a concrete subclass."

    ^ self shouldImplement
!

removeIdentical:anObject ifAbsent:exceptionBlock
    "search for the first element, which is identical to anObject;
     if found, remove and return it.
     If not found, return the the value of the exceptionBlock.
     Uses identity compare (==) to search for the occurrence.
     An error is raised here - it is to be implemented by a concrete subclass."

    ^ self shouldImplement
!

removeLast
    "remove the last element from the receiver.
     Return the removed element.
     An error is raised here - it is to be implemented by a concrete subclass."

    ^ self shouldImplement
! !

!MetacelloStXPackageSpec::Prerequisites methodsFor:'enumerating'!

do:aBlock
    "evaluate the argument, aBlock for each element"

    | def |

    def := ProjectDefinition definitionClassForPackage: packageSpec name.
    def preRequisites do:[:each|
        aBlock value: each
    ]

    "Modified: / 05-09-2012 / 19:53:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

reverseDo:aBlock
    "evaluate the argument, aBlock for each element in reverse order."

    ^ self do: aBlock

    "Modified: / 05-09-2012 / 19:51:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MetacelloStXPackageSpec::Prerequisites methodsFor:'growing'!

grow:howBig
    "change the receivers size"

    ^ self shouldImplement
! !

!MetacelloStXPackageSpec::Prerequisites methodsFor:'initialization'!

initializeFor: aMetacelloStXPackageSpec
    packageSpec := aMetacelloStXPackageSpec

    "Created: / 05-09-2012 / 19:48:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MetacelloStXPackageSpec class methodsFor:'documentation'!

version_SVN
    ^ '$Id::                                                                                                                        $'
! !