[squeak-dev] (1) Bug fixes, and (2) potential improvements to FileSystem-Git

Tony Garnock-Jones tonyg at leastfixedpoint.com
Mon Nov 9 13:01:29 UTC 2020


Hi Jakob, all,

I have a few bug fixes and potential enhancements to FileSystem-Git
ready, but I can't figure out how to add a new github:// repository to
Monticello. I've made my own fork of Squot at the github end, and now I
just need to add it to my image somehow...

The fixes I have are:

 - repair GitReference class >> validateReferenceName: to follow the
   rules in the git docs

 - repair GitRepository >> collectTagsFromLooseRefs when the repo has
   tags including a '/'

 - remove restriction on GitTag's object field: tags can point at any
   git object, not just commits

The potential enhancements I have are:

 - a GitTreeDiffBuilder class which digs into a bit more detail than
   the existing GitDiffCreator; namely, it classifies changes into:
     GitTreeDiffModeChangedItem
     GitTreeDiffNewItem
     GitTreeDiffRenamedItem
     GitTreeDiffSubmoduleChangedItem
     GitTreeDiffTypeChangedItem
     GitTreeDiffChangedItem
     GitTreeDiffDeletedItem

 - GitTaglikeObject >> contributor, which answers author for commits
   and tagger for tags

 - GitTaglikeObject >> messageSummary, which answers the first line of
   the commit message on the assumption that this contains a summary
   of the whole thing (a common convention)

 - GitTree >> followPath:, for digging into a tree when working in a
   git context and not a simulated-filesystem context

 - GitTreeEntry >> entryCode, answering something analogous to
   GitStorableObject class >> typeCode, but for tree entries

I'd prefer to figure out how to contribute the changes using the
in-image github workflow, but for reference, I've attached fileouts of
the changes.

Regards,
  Tony
-------------- next part --------------
Object subclass: #GitTreeDiffBuilder
	instanceVariableNames: 'old new result path'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GitTreeDiff'!

!GitTreeDiffBuilder methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 15:49'!
addEntry: item
	(result at: path asArray ifAbsentPut: [OrderedCollection new]) add: item! !

!GitTreeDiffBuilder methodsFor: 'as yet unclassified' stamp: 'tonyg 1/29/2020 10:06'!
build
	self visitTreeOld: old new: new.! !

!GitTreeDiffBuilder methodsFor: 'as yet unclassified' stamp: 'tonyg 11/9/2020 12:18'!
entriesByHash: tree
	| d |
	d := Dictionary new.
	tree entries valuesDo: [:v | d at: v entryHash put: v].
	^ d! !

!GitTreeDiffBuilder methodsFor: 'as yet unclassified' stamp: 'tonyg 1/29/2020 10:27'!
initializeOld: oldTree new: newTree 
	old := oldTree.
	new := newTree.
	result := Dictionary new.
	path := OrderedCollection new.! !

!GitTreeDiffBuilder methodsFor: 'as yet unclassified' stamp: 'tonyg 1/29/2020 12:06'!
result
	^ result! !

!GitTreeDiffBuilder methodsFor: 'as yet unclassified' stamp: 'tonyg 11/9/2020 12:20'!
visitOld: oldItem new: newItem
	| oldType newType |
	oldType := oldItem object typeCode.
	newType := newItem object typeCode.
	
	oldType = newType ifFalse: [
		^ self addEntry: (GitTreeDiffTypeChangedItem new oldItem: oldItem; newItem: newItem; yourself)].
	
	oldItem mode = newItem mode ifFalse: [
		self addEntry: (GitTreeDiffModeChangedItem new oldItem: oldItem; newItem: newItem; yourself)].

	oldItem entryHash = newItem entryHash ifFalse: [
		oldType = 'tree' ifTrue: [^ self visitTreeOld: oldItem object new: newItem object].
		oldType = 'blob' ifTrue: [^ self addEntry: (GitTreeDiffChangedItem new oldItem: oldItem; newItem: newItem; yourself)].
		oldType = 'commit' ifTrue: [^ self addEntry: (GitTreeDiffSubmoduleChangedItem new oldItem: oldItem; newItem: newItem; yourself)].
		self error: 'Unsupported item type ', oldType]! !

!GitTreeDiffBuilder methodsFor: 'as yet unclassified' stamp: 'tonyg 11/9/2020 12:20'!
visitTreeOld: o new: n
	| oldKeys newKeys oldNameMap newNameMap moved |
	oldKeys := o entries keys asSet.
	newKeys := n entries keys asSet.

	moved := Set new.
	oldNameMap := self entriesByHash: o.
	newNameMap := self entriesByHash: n.
	(oldNameMap keys intersection: newNameMap keys) do: [:nm | | oi ni |
		oi := oldNameMap at: nm.
		ni := newNameMap at: nm.
		oi entryName = ni entryName ifFalse: [
			moved add: nm.
			self withPath: oi fileName do: [
				self addEntry: (GitTreeDiffRenamedItem new oldItem: oi; newItem: ni; yourself)]]].
	 
	(oldKeys difference: newKeys) do: [:k | | e |
		e := o entries at: k.
		(moved includes: e objectName) ifFalse: [
			self withPath: k do: [
				self addEntry: (GitTreeDiffDeletedItem new item: e)]]].
	(newKeys difference: oldKeys) do: [:k | | e |
		e := n entries at: k.
		(moved includes: e objectName) ifFalse: [
			self withPath: k do: [
				self addEntry: (GitTreeDiffNewItem new item: e)]]].

	(oldKeys intersection: newKeys) do: [:k | | oi ni |
		oi := o entries at: k.
		ni := n entries at: k.
		oi = ni ifFalse: [self withPath: k do: [self visitOld: oi new: ni]]].! !

!GitTreeDiffBuilder methodsFor: 'as yet unclassified' stamp: 'tonyg 1/29/2020 10:28'!
withPath: edgeLabel do: aBlock
	| v |
	path add: edgeLabel.
	v := aBlock value.
	path removeLast.
	^ v! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

GitTreeDiffBuilder class
	instanceVariableNames: ''!

!GitTreeDiffBuilder class methodsFor: 'as yet unclassified' stamp: 'tonyg 11/9/2020 12:12'!
diffTrees: oldTree and: newTree
	^ (self new initializeOld: oldTree new: newTree) build; result! !


Object subclass: #GitTreeDiffEntry
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GitTreeDiff'!

!GitTreeDiffEntry methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 14:23'!
accept: aVisitor
	self subclassResponsibility! !

!GitTreeDiffEntry methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 14:45'!
primaryItem
	self subclassResponsibility! !


GitTreeDiffEntry subclass: #GitTreeDiffChangedItem
	instanceVariableNames: 'oldItem newItem diff'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GitTreeDiff'!

!GitTreeDiffChangedItem methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 14:24'!
accept: aVisitor
	^ aVisitor visitTreeDiffChangedItem: self! !

!GitTreeDiffChangedItem methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 14:45'!
primaryItem
	^ self newItem! !


!GitTreeDiffChangedItem methodsFor: 'accessing' stamp: 'tonyg 11/9/2020 12:22'!
computeDiff
	^ [TextDiffBuilder
			from: oldItem object bytes utf8Decoded
			to: newItem object bytes utf8Decoded]
		on: InvalidUTF8 do: [:ex | nil]
! !

!GitTreeDiffChangedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:19'!
diff
	diff ifNil: [diff := self computeDiff].
	^ diff! !

!GitTreeDiffChangedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:09'!
newItem

	^ newItem! !

!GitTreeDiffChangedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:09'!
newItem: anObject

	newItem := anObject.! !

!GitTreeDiffChangedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:09'!
oldItem

	^ oldItem! !

!GitTreeDiffChangedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:09'!
oldItem: anObject

	oldItem := anObject.! !


GitTreeDiffEntry subclass: #GitTreeDiffDeletedItem
	instanceVariableNames: 'item'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GitTreeDiff'!

!GitTreeDiffDeletedItem methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 14:24'!
accept: aVisitor
	^ aVisitor visitTreeDiffDeletedItem: self! !

!GitTreeDiffDeletedItem methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 14:46'!
primaryItem
	^ self item! !


!GitTreeDiffDeletedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:08'!
item

	^ item! !

!GitTreeDiffDeletedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:08'!
item: anObject

	item := anObject.! !


GitTreeDiffEntry subclass: #GitTreeDiffModeChangedItem
	instanceVariableNames: 'oldItem newItem'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GitTreeDiff'!

!GitTreeDiffModeChangedItem methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 14:25'!
accept: aVisitor
	^ aVisitor visitTreeDiffModeChangedItem: self! !

!GitTreeDiffModeChangedItem methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 14:46'!
primaryItem
	^ self newItem! !


!GitTreeDiffModeChangedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:46'!
newItem

	^ newItem! !

!GitTreeDiffModeChangedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:46'!
newItem: anObject

	newItem := anObject.! !

!GitTreeDiffModeChangedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:46'!
oldItem

	^ oldItem! !

!GitTreeDiffModeChangedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:46'!
oldItem: anObject

	oldItem := anObject.! !


GitTreeDiffEntry subclass: #GitTreeDiffNewItem
	instanceVariableNames: 'item'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GitTreeDiff'!

!GitTreeDiffNewItem methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 14:25'!
accept: aVisitor
	^ aVisitor visitTreeDiffNewItem: self! !

!GitTreeDiffNewItem methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 14:46'!
primaryItem
	^ self item! !


!GitTreeDiffNewItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:08'!
item

	^ item! !

!GitTreeDiffNewItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:08'!
item: anObject

	item := anObject.! !


GitTreeDiffEntry subclass: #GitTreeDiffRenamedItem
	instanceVariableNames: 'oldItem newItem'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GitTreeDiff'!

!GitTreeDiffRenamedItem methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 14:25'!
accept: aVisitor
	^ aVisitor visitTreeDiffRenamedItem: self! !

!GitTreeDiffRenamedItem methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 14:46'!
primaryItem
	^ self newItem! !


!GitTreeDiffRenamedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:46'!
newItem

	^ newItem! !

!GitTreeDiffRenamedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:46'!
newItem: anObject

	newItem := anObject.! !

!GitTreeDiffRenamedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:46'!
oldItem

	^ oldItem! !

!GitTreeDiffRenamedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:46'!
oldItem: anObject

	oldItem := anObject.! !


GitTreeDiffEntry subclass: #GitTreeDiffSubmoduleChangedItem
	instanceVariableNames: 'oldItem newItem'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GitTreeDiff'!

!GitTreeDiffSubmoduleChangedItem methodsFor: 'as yet unclassified' stamp: 'tonyg 2/12/2020 12:00'!
accept: aVisitor
	^ aVisitor visitTreeDiffSubmoduleChangedItem: self! !

!GitTreeDiffSubmoduleChangedItem methodsFor: 'as yet unclassified' stamp: 'tonyg 2/12/2020 12:00'!
primaryItem
	^ newItem! !


!GitTreeDiffSubmoduleChangedItem methodsFor: 'accessing' stamp: 'tonyg 2/12/2020 12:00'!
newItem

	^ newItem! !

!GitTreeDiffSubmoduleChangedItem methodsFor: 'accessing' stamp: 'tonyg 2/12/2020 12:00'!
newItem: anObject

	newItem := anObject.! !

!GitTreeDiffSubmoduleChangedItem methodsFor: 'accessing' stamp: 'tonyg 2/12/2020 12:00'!
oldItem

	^ oldItem! !

!GitTreeDiffSubmoduleChangedItem methodsFor: 'accessing' stamp: 'tonyg 2/12/2020 12:00'!
oldItem: anObject

	oldItem := anObject.! !


GitTreeDiffEntry subclass: #GitTreeDiffTypeChangedItem
	instanceVariableNames: 'oldItem newItem'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GitTreeDiff'!

!GitTreeDiffTypeChangedItem methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 14:25'!
accept: aVisitor
	^ aVisitor visitTreeDiffTypeChangedItem: self! !

!GitTreeDiffTypeChangedItem methodsFor: 'as yet unclassified' stamp: 'tonyg 2/11/2020 14:46'!
primaryItem
	^ self newItem! !


!GitTreeDiffTypeChangedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:46'!
newItem

	^ newItem! !

!GitTreeDiffTypeChangedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:46'!
newItem: anObject

	newItem := anObject.! !

!GitTreeDiffTypeChangedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:46'!
oldItem

	^ oldItem! !

!GitTreeDiffTypeChangedItem methodsFor: 'accessing' stamp: 'tonyg 1/29/2020 10:46'!
oldItem: anObject

	oldItem := anObject.! !
-------------- next part --------------
'From Squeak6.0alpha of 9 November 2020 [latest update: #20073] on 9 November 2020 at 1:54:46 pm'!

!GitTaglikeObject methodsFor: '*GitWeb-accessing' stamp: 'tonyg 11/9/2020 12:38'!
contributor
	self subclassResponsibility! !

!GitCommit methodsFor: '*GitWeb-accessing' stamp: 'tonyg 11/9/2020 12:38'!
contributor
	^ self author! !

!GitTag methodsFor: '*GitWeb-accessing' stamp: 'tonyg 11/9/2020 12:38'!
contributor
	^ self tagger! !
-------------- next part --------------
'From Squeak6.0alpha of 9 November 2020 [latest update: #20073] on 9 November 2020 at 1:51:37 pm'!

!GitTag commentStamp: 'tonyg 11/8/2020 22:20' prior: 0!
I have the responsibility of associating a human readable tag (a string) with another object ("usually a commit", according to the git-tag manpage); e.g. 'version 0.5' -> '2341f8c0615bbcc465ac4686025e880786430697'. Since I am a full tag and can hold additional information, the tag ref points to my object name and I in turn point to the tagged object.

Full tags have the advantage of knowing the tagger (and the date of tagging) and can hold a message (e.g. a PGP signature).
I incorporate both possibilities.

Instance Variables:
	message (inherited)	<String>
		arbitrary message (e.g. comment or PGP signature)
	tagger	<GitStamp>
		Who created the tag.
	object	<GitStorableObject>
		The object referenced by the tag name.
	name	<String>
		The human readable tag (or tag name) that describes the referenced object.!

!GitTag methodsFor: 'public-accessing' stamp: 'tonyg 11/8/2020 22:21'!
asCommit
	^ self object asCommit! !

!GitTag methodsFor: 'public-accessing' stamp: 'tonyg 11/8/2020 22:22'!
object: aGitStorableObject
	object := aGitStorableObject! !
-------------- next part --------------
'From Squeak6.0alpha of 9 November 2020 [latest update: #20073] on 9 November 2020 at 1:54:50 pm'!

!GitTree methodsFor: '*GitWeb-accessing' stamp: 'tonyg 11/9/2020 10:06'!
followPath: aCollectionOfStrings
	| object |
	object := self.
	[aCollectionOfStrings do: [:n |
		object typeCode = 'tree' ifTrue: [object := object at: n]]]
		on: KeyNotFound do: [:ex | ^nil].
	^ object! !
-------------- next part --------------
'From Squeak6.0alpha of 9 November 2020 [latest update: #20073] on 9 November 2020 at 1:54:49 pm'!

!GitTaglikeObject methodsFor: '*GitWeb-accessing' stamp: 'tonyg 11/9/2020 09:33'!
messageSummary
	"On the assumption that the first line of the message is the summary:"
	message linesDo: [:line | line ifNotEmpty: [^line]].
	^ ''! !
-------------- next part --------------
'From Squeak6.0alpha of 9 November 2020 [latest update: #20073] on 9 November 2020 at 1:51:42 pm'!

!GitTreeEntry methodsFor: 'public-accessing' stamp: 'tonyg 11/9/2020 10:40'!
entryCode
	^ mode caseOf: {
		[#dirMode] -> ['tree'].
		[#fileMode] -> ['blob'].
		[#executableFileMode] -> ['blob'].
		[#symlinkMode] -> ['symlink'].
		[#submoduleMode] -> ['submodule'].
	} otherwise: [self error: 'Unknown mode: ', mode]! !
-------------- next part --------------
'From Squeak6.0alpha of 9 November 2020 [latest update: #20073] on 9 November 2020 at 1:51:28 pm'!

!GitRepository methodsFor: 'private' stamp: 'tonyg 11/7/2020 22:37'!
collectTagsFromLooseRefs
	| tags tagsDir |
	self privateDeprecatedUseUnitOfWork.
	tags := Dictionary new.

	tagsDir := self tagsDir.
	tagsDir allFiles do: [ :ref |
		ref readStreamDo: [ :stream |
			tags 
				at: (ref relativeTo: tagsDir) asReference asString
				put: (self objectNamed: (stream next: 40) asString) ] ].
		
	^ tags! !
-------------- next part --------------
'From Squeak6.0alpha of 9 November 2020 [latest update: #20073] on 9 November 2020 at 1:50:51 pm'!

!GitReference class methodsFor: 'instance creation' stamp: 'tonyg 11/8/2020 21:36'!
validateReferenceName: aName
	"See https://git-scm.com/docs/git-check-ref-format, which includes 10 rules for refnames."

	| tokens illegalCharacters |

	"Rules 4, 5 and 10, but does not enforce the subrule about control characters in rule 4"
	illegalCharacters := '[?~^\*:	 '.
	(aName includesAnyOf: illegalCharacters) ifTrue: [
		GitInvalidReferenceName signal: 'A reference name can not include whitespace or any of the following characters: ' , illegalCharacters.].

	"Not explicitly numbered, but implicit in rule 2"
	aName isEmpty ifTrue: [GitInvalidReferenceName signal: 'A reference name can not be empty'].

	"Rule 3"
	(aName includesSubstring: '..') ifTrue: [GitInvalidReferenceName signal: 'A reference name can not include the string ''..'''].

	"Rule 8"
	(aName includesSubstring: '@{') ifTrue: [GitInvalidReferenceName signal: 'A reference name can not include the string ''@{'''].

	"Rule 6"
	(aName includesSubstring: '//') ifTrue: [GitInvalidReferenceName signal: 'A reference name can not include two consecutive slashes'].
	(aName first = $/ or: [aName last = $/]) ifTrue: [GitInvalidReferenceName signal: 'A reference name can not start or end with a slash'].

	"Rule 9"
	(aName = '@') ifTrue: [GitInvalidReferenceName signal: '''@'' is not a valid reference name'].
	
	"Rule 1"
	tokens := aName findTokens: '/'.
	(tokens anySatisfy: [:t | (t first = $.) or: [t endsWith: '.lock']]) ifTrue: [
		GitInvalidReferenceName signal: 'A reference component can not start with a dot or end with .lock'].! !


More information about the Squeak-dev mailing list