Introduce root command, cleanup old code from context

src/Clap-Core/ClapContext.class.st

@@ -9,14 +9,20 @@ Class {
 	#name : #ClapContext,
 	#superclass : #Object,
 	#instVars : [
-		'commandCandidates',
 		'arguments',
 		'session',
-		'obeyingExits'
+		'obeyingExits',
+		'root'
 	],
 	#category : #'Clap-Core-Activation'
 }
 
+{ #category : #accessing }
+ClapContext class >> defaultRoot [
+	^ ClapRoot new
+	"setup default flags, omnipresent subcommands & basic meanings here"
+]
+
 { #category : #accessing }
 ClapContext class >> pragmaCommands [
 	^ (PragmaCollector filter: [:prg | prg keyword = 'commandline']) reset
@@ -31,17 +37,15 @@ ClapContext class >> pragmaCommands [
 ]
 
 { #category : #'instance creation' }
-ClapContext class >> with: commandCandidate [
+ClapContext class >> with: rootCommand [
 	^ self new
-		candidates: { commandCandidate };
+		root: rootCommand;
 		yourself
 ]
 
 { #category : #'instance creation' }
-ClapContext class >> withAll: commandCandidates [ 
-	^ self new
-		candidates: commandCandidates;
-		yourself
+ClapContext class >> withAll: commandCandidates [
+	^ self with: (self defaultRoot addAll: commandCandidates)
 ]
 
 { #category : #'instance creation' }
@@ -76,31 +80,11 @@ ClapContext >> arguments: aCollection [
 	arguments := aCollection
 ]
 
-{ #category : #'testing - deprecated' }
-ClapContext >> atEnd [
-	^ self arguments atEnd
-]
-
 { #category : #initialization }
 ClapContext >> beObeyingExits [
 	obeyingExits := true
 ]
 
-{ #category : #initialization }
-ClapContext >> candidates: commandSpecifications [
-	commandCandidates := commandSpecifications
-]
-
-{ #category : #activation }
-ClapContext >> detectMatching: matchBlock ifNone: failBlock [
-	commandCandidates do: [ :each |
-		(each matchOn: self arguments readStream)
-			ifMatch: [ :match |
-				^ matchBlock value: match ] ].
-
-	^ failBlock value
-]
-
 { #category : #accessing }
 ClapContext >> documenter [
 	^ ClapDocumenter on: (ClapDocumentationFormatter on: self stdout)
@@ -147,42 +131,49 @@ ClapContext >> hasSessionChanged [
 	^ session ~~ Smalltalk session
 ]
 
+{ #category : #activation }
+ClapContext >> ifMatch: matchBlock ifMismatch: failBlock [
+	^ (self root matchOn: self arguments readStream)
+		ifMatch: matchBlock
+		ifMismatch: failBlock
+
+]
+
 { #category : #initialization }
 ClapContext >> initialize [
-	commandCandidates := 	#().
 	arguments := #().
 	obeyingExits := false
 ]
 
 { #category : #activation }
 ClapContext >> interpret: argumentsSequence [
 	^ self arguments: argumentsSequence;
-		detectMatching: [ :match |
+		ifMatch: [ :match |
 			match value: self.
 			self exitSuccess ]
-		ifNone: [ self noneMatched ]
-]
-
-{ #category : #'accessing - deprecated' }
-ClapContext >> next [
-	^ self arguments next
+		ifMismatch: [ self noneMatched ]
 ]
 
 { #category : #activation }
 ClapContext >> noneMatched [
 	^ self exitFailure: 'Unknown command'
 ]
 
-{ #category : #'accessing - deprecated' }
-ClapContext >> peek [
-	^ self arguments peek
-]
-
 { #category : #activation }
 ClapContext >> rememberSession [
 	session := Smalltalk session
 ]
 
+{ #category : #accessing }
+ClapContext >> root [
+	^ root ifNil: [ root := ClapRoot new ]
+]
+
+{ #category : #initialization }
+ClapContext >> root: aCommand [
+	root := aCommand
+]
+
 { #category : #testing }
 ClapContext >> shouldObeyExit [
 	^ obeyingExits and: [ Smalltalk isInteractive not ]

src/Clap-Core/ClapImplicit.class.st

@@ -46,7 +46,7 @@ ClapImplicit >> parent: aMatch [
 ClapImplicit >> rootMatch [
 	^ parent
 		ifNil: [ self ]
-		ifNotNil: [ parent root ]
+		ifNotNil: [ parent rootMatch ]
 ]
 
 { #category : #accessing }

src/Clap-Core/ClapRoot.class.st

@@ -0,0 +1,20 @@
+"
+I represent a nameless command, serving as the root of the command hierarchy and providing default behavior and error handling.
+My subcommands are effectively the main commands available to the user.
+"
+Class {
+	#name : #ClapRoot,
+	#superclass : #ClapCommand,
+	#category : #'Clap-Core-Specifications'
+}
+
+{ #category : #matching }
+ClapRoot >> matchPremiseOn: aStream [
+	^ self newMatchAt: aStream
+]
+
+{ #category : #matching }
+ClapRoot >> newMatchAt: aStream [
+	^ self matchClass specification: self
+
+]

src/Clap-Tests/ClapHelloWorldTest.class.st

@@ -22,7 +22,9 @@ ClapHelloWorldTest >> testHello [
 
 	match should not be isMismatch.
 	match should not be includesKey: 'shout'.
-	match should not be includesKey: 'who'
+	match should not be includesKey: 'who'.
+	match rootMatch should be: match
+
 ]
 
 { #category : #'tests - matching' }
@@ -33,7 +35,8 @@ ClapHelloWorldTest >> testHelloWorld [
 	match should not be isMismatch.
 	match should not be includesKey: 'shout'.
 	match should be includesKey: 'who'.
-	(match atName: 'who') word should equal: 'world'
+	(match atName: 'who') word should equal: 'world'.
+	(match atName: 'who') rootMatch should be: match
 ]
 
 { #category : #'tests - matching' }
@@ -52,8 +55,8 @@ ClapHelloWorldTest >> testLanguageFlag [
 	(match atName: 'who') word should equal: 'monde'.
 	match should be includesKey: 'lang'.
 	(match atName: 'lang') should be includesKey: 'language'.
-	(match atName: 'lang') value should equal: 'fr'
-
+	(match atName: 'lang') value should equal: 'fr'.
+	((match atName: 'lang') at: lang) rootMatch should be: match.
 ]
 
 { #category : #tests }

src/Clap-Tests/ClapMatchesTest.class.st

@@ -34,6 +34,7 @@ ClapMatchesTest >> testFlagAbsentValue [
 	flagMatch := (match atName: 'this') at: slowFlag.
 	flagMatch should not be isExplicit.
 	flagMatch parent parent should be: match.
+	flagMatch rootMatch should be: match.
 	flagMatch value should be: false.
 
 ]