├── .project ├── src ├── .properties ├── Clap-Core │ ├── package.st │ ├── Symbol.extension.st │ ├── ClapMatchedValidation.class.st │ ├── ClapRoot.class.st │ ├── ClapWordMatch.class.st │ ├── ClapLeftoversValidation.class.st │ ├── ManifestClapCore.class.st │ ├── ClapNamedMatch.class.st │ ├── ClapPluggableStdio.class.st │ ├── ClapNestedPositionalValidation.class.st │ ├── ClapValidationDiagnostic.class.st │ ├── ClapValidation.class.st │ ├── ClapImplicit.class.st │ ├── ClapValidationErrorPrinter.class.st │ ├── ClapMismatch.class.st │ ├── ClapPositional.class.st │ ├── ClapValidationReport.class.st │ ├── ClapSubExpression.class.st │ ├── ClapExplicit.class.st │ ├── ClapFlag.class.st │ ├── ClapDocumentationFormatter.class.st │ ├── ClapParameterized.class.st │ ├── ClapExpression.class.st │ ├── ClapApplication.class.st │ ├── ClapDocumenter.class.st │ ├── ClapCompositeMatch.class.st │ ├── ClapCommandSpec.class.st │ ├── ClapParameter.class.st │ └── ClapContext.class.st ├── Clap-Tests │ ├── package.st │ ├── ClapTestRunnerTest.class.st │ ├── ClapPositionalTest.class.st │ ├── ClapPharoCommandsTest.class.st │ ├── ClapCodeEvaluatorTest.class.st │ ├── ClapApplicationTest.class.st │ ├── ClapParameterizedTest.class.st │ ├── ClapDocumentationTest.class.st │ ├── ClapParameterTest.class.st │ ├── ClapMeaningsTest.class.st │ ├── ClapFlagTest.class.st │ ├── ClapValidationTest.class.st │ ├── ClapHelloTest.class.st │ ├── ClapHelloWorldTest.class.st │ ├── ClapPharoVersionTest.class.st │ ├── ClapCommandSpecTest.class.st │ ├── ClapContextTest.class.st │ ├── ClapMatchesTest.class.st │ └── ClapCommandTest.class.st ├── Clap-Examples │ ├── package.st │ ├── ClapGitAddCommandExample.class.st │ └── ClapCommandLineExamples.class.st ├── BaselineOfClap │ ├── package.st │ └── BaselineOfClap.class.st ├── Clap-Okay-Tests │ ├── package.st │ └── ClapArgumentValidationTest.class.st ├── Clap-CommandLine │ ├── package.st │ └── ClapCommandLineHandler.class.st ├── Clap-Commands-Pharo │ ├── package.st │ ├── ClapPharoApplication.class.st │ ├── ClapImage.class.st │ ├── ClapCodeEvaluator.class.st │ ├── ClapMetacello.class.st │ ├── ClapTestRunner.class.st │ └── ClapPharoVersion.class.st └── Clap-Examples-Booklet │ ├── package.st │ └── ClapBookletMonthsCommand.class.st ├── demos ├── clap.gif ├── record.sh ├── demo-setup.sh ├── Makefile └── clap.cast ├── clap.load.st ├── .gitignore ├── .travis.yml ├── .smalltalk.ston └── README.md /.project: -------------------------------------------------------------------------------- 1 | { 2 | 'srcDirectory' : 'src' 3 | } -------------------------------------------------------------------------------- /src/.properties: -------------------------------------------------------------------------------- 1 | { 2 | #format : #tonel 3 | } -------------------------------------------------------------------------------- /src/Clap-Core/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'Clap-Core' } 2 | -------------------------------------------------------------------------------- /src/Clap-Tests/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'Clap-Tests' } 2 | -------------------------------------------------------------------------------- /src/Clap-Examples/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'Clap-Examples' } 2 | -------------------------------------------------------------------------------- /src/BaselineOfClap/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'BaselineOfClap' } 2 | -------------------------------------------------------------------------------- /src/Clap-Okay-Tests/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #'Clap-Okay-Tests' } 2 | -------------------------------------------------------------------------------- /src/Clap-CommandLine/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #'Clap-CommandLine' } 2 | -------------------------------------------------------------------------------- /src/Clap-Commands-Pharo/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'Clap-Commands-Pharo' } 2 | -------------------------------------------------------------------------------- /src/Clap-Examples-Booklet/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #'Clap-Examples-Booklet' } 2 | -------------------------------------------------------------------------------- /demos/clap.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pharo-contributions/clap-st/HEAD/demos/clap.gif -------------------------------------------------------------------------------- /demos/record.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env zsh 2 | 3 | asciinema rec \ 4 | --title 'Clap: command line arguments parsing in Pharo' \ 5 | --idle-time-limit 4 \ 6 | --overwrite "${1:-wip.cast}" 7 | -------------------------------------------------------------------------------- /clap.load.st: -------------------------------------------------------------------------------- 1 | "-*- mode: smalltalk; -*-" 2 | Metacello new baseline: #Clap; 3 | repository: 'gitlocal://.'; 4 | onLock: [:ex :old :new | ex honor]; 5 | ignoreImage; load: 'development-full'. 6 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapTestRunnerTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapTestRunnerTest', 3 | #superclass : 'ClapPharoCommandsTest', 4 | #category : 'Clap-Tests-Commands', 5 | #package : 'Clap-Tests', 6 | #tag : 'Commands' 7 | } 8 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # any local load script for fari.sh 2 | *local.st 3 | 4 | # general Pharo stuff 5 | *.changes 6 | *.image 7 | *.sources 8 | pharo 9 | pharo-ui 10 | pharo-vm/ 11 | github-cache/ 12 | pharo-local/ 13 | 14 | # other noise 15 | .DS_Store 16 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: smalltalk 2 | sudo: true 3 | 4 | os: 5 | - osx 6 | - linux 7 | 8 | smalltalk: 9 | - Pharo64-alpha 10 | - Pharo64-stable 11 | - Pharo32-stable 12 | 13 | matrix: 14 | fast_finish: true 15 | allow_failures: 16 | - smalltalk: Pharo64-alpha 17 | os: linux 18 | -------------------------------------------------------------------------------- /src/Clap-Core/Symbol.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : 'Symbol' } 2 | 3 | { #category : '*Clap-Core' } 4 | Symbol >> asClapIdentifier [ 5 | ^ self 6 | ] 7 | 8 | { #category : '*Clap-Core' } 9 | Symbol >> identifiesClapParameter: aClapParameter [ 10 | ^ self = aClapParameter identifier 11 | ] 12 | -------------------------------------------------------------------------------- /.smalltalk.ston: -------------------------------------------------------------------------------- 1 | SmalltalkCISpec { 2 | #name : 'Clap', 3 | #loading : [ 4 | SCIMetacelloLoadSpec { 5 | #baseline : 'Clap', 6 | #directory : 'src', 7 | #ignoreImage : true, 8 | #platforms : [ #pharo ] 9 | } 10 | ], 11 | #testing : { 12 | #packages : [ 'Clap-*' ], 13 | #coverage : { 14 | #packages : [ 'Clap-*' ] 15 | } 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /demos/demo-setup.sh: -------------------------------------------------------------------------------- 1 | # -*- mode: sh; -*- 2 | 3 | alias clap='~/bin/pharo-vms/64/pharo clap.00d2cc5.image clap' 4 | 5 | function :D { 6 | print 7 | print "\e[37m Clap, the command-line argument parser for Pharo\e[0m" 8 | print "\e[34m https://github.com/cdlm/clap-st\e[0m" 9 | exit 10 | clear 11 | } 12 | -------------------------------------------------------------------------------- /demos/Makefile: -------------------------------------------------------------------------------- 1 | # first record a screencast with demos/record.sh 2 | 3 | export GIFSICLE_OPTS = --colors 256 --resize-method mix --resize-colors 256 --optimize=3 4 | 5 | %.gif: %.cast 6 | asciicast2gif -t solarized-dark "$<" "$@" 7 | 8 | %.mp4: %.gif 9 | rm -f "$@" 10 | ffmpeg -i "$<" \ 11 | -c:v libx265 -r 60 -an -preset slower -crf 25 \ 12 | -tag:v hvc1 \ 13 | -movflags faststart \ 14 | -pix_fmt yuv420p \ 15 | -vf "scale=trunc(iw/2)*2:trunc(ih/2)*2" \ 16 | "$@" 17 | -------------------------------------------------------------------------------- /src/Clap-Examples/ClapGitAddCommandExample.class.st: -------------------------------------------------------------------------------- 1 | " 2 | This an example of a subcommand that can be used to define the behaviour of a subcommand, do business validations. 3 | " 4 | Class { 5 | #name : 'ClapGitAddCommandExample', 6 | #superclass : 'ClapApplication', 7 | #category : 'Clap-Examples', 8 | #package : 'Clap-Examples' 9 | } 10 | 11 | { #category : 'execution' } 12 | ClapGitAddCommandExample >> execute [ 13 | 14 | self outputStreamDo: [ :str | str nextPutAll: 'Running git add ...' ] 15 | ] 16 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapMatchedValidation.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I validate a Clap context by checking that it has matched. 3 | " 4 | Class { 5 | #name : 'ClapMatchedValidation', 6 | #superclass : 'ClapValidation', 7 | #category : 'Clap-Core-Validation', 8 | #package : 'Clap-Core', 9 | #tag : 'Validation' 10 | } 11 | 12 | { #category : 'accessing' } 13 | ClapMatchedValidation >> description [ 14 | ^ 'Unmatched arguments' 15 | ] 16 | 17 | { #category : 'validation' } 18 | ClapMatchedValidation >> failureDescriptionFor: anObject [ 19 | ^ 'Not matched!' 20 | ] 21 | 22 | { #category : 'testing' } 23 | ClapMatchedValidation >> matches: aClapContext [ 24 | ^ aClapContext 25 | ifMatch: [ true ] 26 | ifMismatch: [ false ] 27 | ] 28 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapRoot.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent a nameless command, serving as the root of the command hierarchy and providing default behavior and error handling. 3 | My subcommands are effectively the main commands available to the user. 4 | " 5 | Class { 6 | #name : 'ClapRoot', 7 | #superclass : 'ClapCommandSpec', 8 | #category : 'Clap-Core-Specification', 9 | #package : 'Clap-Core', 10 | #tag : 'Specification' 11 | } 12 | 13 | { #category : 'matching - testing' } 14 | ClapRoot >> canMatchWith: word [ 15 | ^ true 16 | ] 17 | 18 | { #category : 'testing' } 19 | ClapRoot >> isCommand [ 20 | "A clap root is not a true command but the entry point for Clap commands" 21 | 22 | ^ false 23 | ] 24 | 25 | { #category : 'accessing' } 26 | ClapRoot >> matchClass [ 27 | ^ ClapCompositeMatch 28 | ] 29 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapPositionalTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapPositionalTest', 3 | #superclass : 'ClapParameterTest', 4 | #category : 'Clap-Tests-Unit', 5 | #package : 'Clap-Tests', 6 | #tag : 'Unit' 7 | } 8 | 9 | { #category : 'accessing' } 10 | ClapPositionalTest >> classToTest [ 11 | ^ ClapPositional 12 | ] 13 | 14 | { #category : 'tests' } 15 | ClapPositionalTest >> testMatches [ 16 | | subject argv ctx match | 17 | subject := self namedSubject. 18 | argv := { 'bar'. #remainder } readStream. 19 | ctx := ClapContext new. 20 | 21 | match := subject matchOn: argv in: ctx. 22 | 23 | self deny: match isMismatch. 24 | self assert: match specification identicalTo: subject. 25 | self assert: match parent identicalTo: ctx. 26 | self assert: match word equals: 'bar'. 27 | self assert: argv next equals: #remainder 28 | ] 29 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapPharoCommandsTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapPharoCommandsTest', 3 | #superclass : 'TestCase', 4 | #instVars : [ 5 | 'context' 6 | ], 7 | #category : 'Clap-Tests-Commands', 8 | #package : 'Clap-Tests', 9 | #tag : 'Commands' 10 | } 11 | 12 | { #category : 'testing' } 13 | ClapPharoCommandsTest class >> isAbstract [ 14 | ^ self = ClapPharoCommandsTest 15 | ] 16 | 17 | { #category : 'testing' } 18 | ClapPharoCommandsTest class >> shouldInheritSelectors [ 19 | ^ true 20 | ] 21 | 22 | { #category : 'asserting' } 23 | ClapPharoCommandsTest >> assertSuccess [ 24 | self assert: context exitStatus equals: 0 25 | ] 26 | 27 | { #category : 'tests - fixture' } 28 | ClapPharoCommandsTest >> lineEnding [ 29 | ^ OSPlatform current lineEnding 30 | ] 31 | 32 | { #category : 'accessing' } 33 | ClapPharoCommandsTest >> outputString [ 34 | ^ context stdio stdout contents utf8Decoded 35 | ] 36 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapWordMatch.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a leaf match, covering a single word of the argument sequence. 3 | " 4 | Class { 5 | #name : 'ClapWordMatch', 6 | #superclass : 'ClapExplicit', 7 | #instVars : [ 8 | 'word' 9 | ], 10 | #category : 'Clap-Core-Activation', 11 | #package : 'Clap-Core', 12 | #tag : 'Activation' 13 | } 14 | 15 | { #category : 'matching' } 16 | ClapWordMatch >> completeMatchOn: aStream [ 17 | word := aStream next. 18 | startIndex := aStream position 19 | ] 20 | 21 | { #category : 'testing' } 22 | ClapWordMatch >> isValid: aValidation [ 23 | 24 | ^ aValidation isValidWordMatch: self 25 | ] 26 | 27 | { #category : 'accessing' } 28 | ClapWordMatch >> stop [ 29 | ^ self start 30 | ] 31 | 32 | { #category : 'accessing' } 33 | ClapWordMatch >> value [ 34 | ^ self word 35 | "^ self value: nil" 36 | ] 37 | 38 | { #category : 'accessing' } 39 | ClapWordMatch >> word [ 40 | ^ word 41 | ] 42 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapLeftoversValidation.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I validate a Clap context by checking that it has matched completely, i.e. no word remains unmatched by a parameter. 3 | " 4 | Class { 5 | #name : 'ClapLeftoversValidation', 6 | #superclass : 'ClapValidation', 7 | #category : 'Clap-Core-Validation', 8 | #package : 'Clap-Core', 9 | #tag : 'Validation' 10 | } 11 | 12 | { #category : 'validation' } 13 | ClapLeftoversValidation >> description [ 14 | ^ 'Unrecognized arguments' 15 | ] 16 | 17 | { #category : 'validation' } 18 | ClapLeftoversValidation >> failureDescriptionFor: anObject [ 19 | ^ String streamContents: [ :str | 20 | str nextPutAll: 'Unrecognized arguments: '. 21 | anObject context leftovers 22 | do: [ :each | str nextPutAll: each ] 23 | separatedBy: [ str nextPutAll: ', ' ] ] 24 | ] 25 | 26 | { #category : 'validation' } 27 | ClapLeftoversValidation >> matches: aClapExpression [ 28 | ^ aClapExpression context leftovers isEmpty 29 | ] 30 | -------------------------------------------------------------------------------- /src/Clap-Commands-Pharo/ClapPharoApplication.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am an abstract class providing some support to Pharo commands available from command-line. 3 | " 4 | Class { 5 | #name : 'ClapPharoApplication', 6 | #superclass : 'ClapApplication', 7 | #category : 'Clap-Commands-Pharo', 8 | #package : 'Clap-Commands-Pharo' 9 | } 10 | 11 | { #category : 'execution' } 12 | ClapPharoApplication >> execute [ 13 | 14 | self prepareImage 15 | ] 16 | 17 | { #category : 'execution' } 18 | ClapPharoApplication >> prepareImage [ 19 | self positional: #rename ifPresent: [ :rename | 20 | | imageFile | 21 | imageFile := rename value asFileReference. 22 | self flag: 'check if it already exists & not same as current'. 23 | Smalltalk image 24 | changeImagePathTo: imageFile; 25 | closeSourceFiles; 26 | openSourceFiles ] 27 | ] 28 | 29 | { #category : 'execution' } 30 | ClapPharoApplication >> shouldSave [ 31 | ^ (self hasFlag: #save) 32 | or: [ (self hasFlag: #noSave) not ] 33 | ] 34 | -------------------------------------------------------------------------------- /src/Clap-CommandLine/ClapCommandLineHandler.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I hook Clap into the existing command-line handlers system. 3 | " 4 | Class { 5 | #name : #ClapCommandLineHandler, 6 | #superclass : #CommandLineHandler, 7 | #category : #'Clap-CommandLine' 8 | } 9 | 10 | { #category : #accessing } 11 | ClapCommandLineHandler class >> commandName [ 12 | ^ 'clap' 13 | ] 14 | 15 | { #category : #activation } 16 | ClapCommandLineHandler >> activate [ 17 | [ 18 | ClapContext withPragmaCommands 19 | beObeyingExits; 20 | setStdio: Stdio; 21 | arguments: self arguments; 22 | executeToExit: [ :exit | self handleExit: exit ] 23 | ] 24 | forkAt: Processor userSchedulingPriority 25 | named: 'Clap commandline handler process' 26 | ] 27 | 28 | { #category : #activation } 29 | ClapCommandLineHandler >> handleExit: exit [ 30 | Smalltalk isInteractive 31 | ifFalse: [ ^ exit pass ]. 32 | 33 | exit isSuccess 34 | ifFalse: [ ^ exit resignalAs: (Error new messageText: exit messageText) ] 35 | ] 36 | -------------------------------------------------------------------------------- /src/Clap-Core/ManifestClapCore.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Clap is a parser for command-line arguments. 3 | 4 | The general process in Clap has three steps: 5 | 6 | 1. We start from a static specification of a command, its parameters, and their behavior. 7 | 8 | The command specification is recursively composed from instances of ClapCommand (a named command or sub-command with flags and positional parameters), ClapFlag (a keyword representing an option or naming a parameter) and ClapPositional (a value passed in sequence). 9 | 10 | 2. At invocation time, we build a context to match the specification against an actual sequence of arguments coming from the shell. 11 | 12 | 3. The resulting context is an activation of the command, which can be evaluated. 13 | 14 | The activation is a structured record of the parameters that matched the invocation and how; at its root, the context provides access to external resources such as the standard I/O streams. 15 | 16 | " 17 | Class { 18 | #name : 'ManifestClapCore', 19 | #superclass : 'PackageManifest', 20 | #category : 'Clap-Core-Manifest', 21 | #package : 'Clap-Core', 22 | #tag : 'Manifest' 23 | } 24 | -------------------------------------------------------------------------------- /src/Clap-Okay-Tests/ClapArgumentValidationTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #ClapArgumentValidationTest, 3 | #superclass : #TestCase, 4 | #category : #'Clap-Okay-Tests' 5 | } 6 | 7 | { #category : #tests } 8 | ClapArgumentValidationTest >> testFailValidationWhenMissingMandatoryArgument [ 9 | | flag match report | 10 | flag := (ClapFlag id: #lang) 11 | add: (ClapPositional id: #langCode); 12 | validations: [ :arg | { 13 | Okay if: [ :it | (it at: #langCode) isExplicit ] 14 | } collect: [ :each | each validate: arg ] ]. 15 | 16 | match := flag match: #('--lang'). 17 | report := ClapValidationReport success. 18 | match validateOn: report. 19 | 20 | self assert: report isFailure 21 | ] 22 | 23 | { #category : #tests } 24 | ClapArgumentValidationTest >> testPassValidationWithMandatoryArgument [ 25 | | flag match report | 26 | flag := (ClapFlag id: #lang) 27 | add: (ClapPositional id: #langCode); 28 | validations: [ :arg | { 29 | Okay if: [ :it | (it at: #langCode) isExplicit ] 30 | } collect: [ :each | each validate: arg ] ]. 31 | 32 | match := flag match: #('--lang' 'eo'). 33 | report := ClapValidationReport success. 34 | match validateOn: report. 35 | 36 | self assert: report isSuccess 37 | ] 38 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapNamedMatch.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a match for a named composite parameter; I cover at least one word (corresponding to one of my specification's aliases). 3 | " 4 | Class { 5 | #name : 'ClapNamedMatch', 6 | #superclass : 'ClapCompositeMatch', 7 | #instVars : [ 8 | 'keyword' 9 | ], 10 | #category : 'Clap-Core-Activation', 11 | #package : 'Clap-Core', 12 | #tag : 'Activation' 13 | } 14 | 15 | { #category : 'accessing' } 16 | ClapNamedMatch >> child [ 17 | "Warning: onyl use this method if you are sure there is at least one child. 18 | This method is used to get a positional value" 19 | 20 | ^ children first 21 | ] 22 | 23 | { #category : 'matching' } 24 | ClapNamedMatch >> completeMatchOn: aStream [ 25 | keyword := aStream next. 26 | startIndex := aStream position. 27 | self matchChildrenOn: aStream 28 | ] 29 | 30 | { #category : 'testing' } 31 | ClapNamedMatch >> isFullMatch [ 32 | 33 | ^ (self specification isFlag and: [ self specification hasPositional ]) 34 | ifTrue: [ children size = self specification positionals size ] 35 | ifFalse: [ true ] 36 | ] 37 | 38 | { #category : 'testing' } 39 | ClapNamedMatch >> isValid: aValidation [ 40 | 41 | ^ aValidation isValidNamedMatch: self 42 | ] 43 | 44 | { #category : 'matching' } 45 | ClapNamedMatch >> word [ 46 | ^ keyword 47 | ] 48 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapCodeEvaluatorTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapCodeEvaluatorTest', 3 | #superclass : 'ClapPharoCommandsTest', 4 | #category : 'Clap-Tests-Commands', 5 | #package : 'Clap-Tests', 6 | #tag : 'Commands' 7 | } 8 | 9 | { #category : 'tests' } 10 | ClapCodeEvaluatorTest >> testEvaluateAliasMultipleArguments [ 11 | context := ClapCodeEvaluator evaluate activateWith: #('eval' 12 | '''(2+3)''' 'class' 'printString' ', String space ,' '(2+3)' 'class' 'printString'). 13 | 14 | self assertSuccess. 15 | self 16 | assert: self outputString 17 | equals: '''ByteString SmallInteger''' , self lineEnding 18 | ] 19 | 20 | { #category : 'tests' } 21 | ClapCodeEvaluatorTest >> testEvaluateAliasSingleArgument [ 22 | context := ClapCodeEvaluator evaluate activateWith: #('eval' '1 class'). 23 | 24 | self assertSuccess. 25 | self 26 | assert: self outputString 27 | equals: 'SmallInteger' , self lineEnding 28 | ] 29 | 30 | { #category : 'tests' } 31 | ClapCodeEvaluatorTest >> testEvaluatePipeIn [ 32 | context := (ClapCodeEvaluator evaluate activationWith: #('evaluate')) 33 | setStdio: (ClapPluggableStdio onByteArraysWithInput: 'Object class class class class'); 34 | execute. 35 | 36 | self assertSuccess. 37 | self 38 | assert: self outputString 39 | equals: 'Metaclass' , self lineEnding 40 | ] 41 | -------------------------------------------------------------------------------- /src/BaselineOfClap/BaselineOfClap.class.st: -------------------------------------------------------------------------------- 1 | " 2 | This is the baseline for Clap - the Pharo command line handler 3 | " 4 | Class { 5 | #name : 'BaselineOfClap', 6 | #superclass : 'BaselineOf', 7 | #category : 'BaselineOfClap', 8 | #package : 'BaselineOfClap' 9 | } 10 | 11 | { #category : 'baselines' } 12 | BaselineOfClap >> baseline: spec [ 13 | 14 | spec for: #common do: [ spec 15 | baseline: 'Okay' with: [ spec repository: 'github://cdlm/okay-st' ]; 16 | 17 | package: 'Clap-Core'; 18 | package: 'Clap-CommandLine' with: [ spec requires: #('Clap-Core') ]; 19 | package: 'Clap-Commands-Pharo' with: [ spec requires: #('Clap-CommandLine') ]; 20 | package: 'Clap-Examples' with: [ spec requires: #('Clap-CommandLine') ]; 21 | package: 'Clap-Examples-Booklet' with: [ spec requires: #('Clap-CommandLine') ]; 22 | package: 'Clap-Tests' with: [ spec requires: #('Clap-Core' 'Clap-Examples') ]; 23 | package: 'Clap-Okay-Tests' with: [ spec requires: #('Clap-Core' 'Okay') ]; 24 | 25 | group: 'default' with: #(core development); 26 | group: 'core' with: #('Clap-Core' 'Clap-CommandLine'); 27 | group: 'pharo' with: #('Clap-Commands-Pharo'); 28 | group: 'examples' with: #('Clap-Examples'); 29 | group: 'tests' with: #('Clap-Tests'); 30 | group: 'development' with: #(core pharo examples tests); 31 | group: 'development-full' with: #(development 'Clap-Examples-Booklet' 'Clap-Okay-Tests') ] 32 | ] 33 | -------------------------------------------------------------------------------- /src/Clap-Commands-Pharo/ClapImage.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I provide commands related to the image: cleanup and save. 3 | " 4 | Class { 5 | #name : 'ClapImage', 6 | #superclass : 'ClapApplication', 7 | #category : 'Clap-Commands-Pharo', 8 | #package : 'Clap-Commands-Pharo' 9 | } 10 | 11 | { #category : 'command line - subcommands' } 12 | ClapImage class >> cleanupCommand [ 13 | 14 | ^ (ClapCommandSpec id: 'cleanup') 15 | description: 'Clean caches & other temporary data from the image '; 16 | commandClass: self; 17 | addFlag: #aggressive description: 'Also delete resources, change sets, etc'; 18 | addFlag: #release description: 'Prepare for release (implies --aggressive)'; 19 | addFlag: #production description: 'Unload tests, examples, etc, for production (implies --release)'; 20 | yourself 21 | ] 22 | 23 | { #category : 'command line' } 24 | ClapImage class >> image [ 25 | 26 | ^ (ClapCommandSpec id: #image) 27 | description: 'Manage image/changes files'; 28 | commandClass: self; 29 | add: self saveCommand; 30 | add: self cleanupCommand; 31 | yourself 32 | ] 33 | 34 | { #category : 'command line - subcommands' } 35 | ClapImage class >> saveCommand [ 36 | 37 | ^ (ClapCommandSpec id: #save) 38 | description: 'Save the image/changes file under a new name'; 39 | commandClass: self; 40 | addFlag: #rename; 41 | addFlag: #backup; 42 | addPositional: #NAME; 43 | yourself 44 | ] 45 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapPluggableStdio.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a utility for replacing the normal Stdio during tests and maybe for activating Clap commands from a workspace. 3 | " 4 | Class { 5 | #name : 'ClapPluggableStdio', 6 | #superclass : 'Object', 7 | #instVars : [ 8 | 'in', 9 | 'out', 10 | 'err' 11 | ], 12 | #category : 'Clap-Core-Activation', 13 | #package : 'Clap-Core', 14 | #tag : 'Activation' 15 | } 16 | 17 | { #category : 'instance creation' } 18 | ClapPluggableStdio class >> onByteArrays [ 19 | ^ self onByteArraysWithInputBytes: #[] 20 | ] 21 | 22 | { #category : 'instance creation' } 23 | ClapPluggableStdio class >> onByteArraysWithInput: aString [ 24 | ^ self onByteArraysWithInputBytes: aString utf8Encoded 25 | ] 26 | 27 | { #category : 'instance creation' } 28 | ClapPluggableStdio class >> onByteArraysWithInputBytes: aByteArray [ 29 | ^ self new 30 | initializeInput: aByteArray readStream 31 | output: #[] writeStream 32 | error: #[] writeStream 33 | ] 34 | 35 | { #category : 'initialization' } 36 | ClapPluggableStdio >> initializeInput: inputStream output: outputStream error: errorStream [ 37 | in := inputStream. 38 | out := outputStream. 39 | err := errorStream 40 | ] 41 | 42 | { #category : 'accessing' } 43 | ClapPluggableStdio >> stderr [ 44 | ^ err 45 | ] 46 | 47 | { #category : 'accessing' } 48 | ClapPluggableStdio >> stdin [ 49 | ^ in 50 | ] 51 | 52 | { #category : 'accessing' } 53 | ClapPluggableStdio >> stdout [ 54 | ^ out 55 | ] 56 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapNestedPositionalValidation.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I validate that a nested positional, i.e. a positional preceded by a flag is correct: 3 | - there is no positional found in the command line but a default value was specified, 4 | - or there is a positional found after the flag. 5 | " 6 | Class { 7 | #name : 'ClapNestedPositionalValidation', 8 | #superclass : 'ClapValidation', 9 | #instVars : [ 10 | 'missing' 11 | ], 12 | #category : 'Clap-Core-Validation', 13 | #package : 'Clap-Core', 14 | #tag : 'Validation' 15 | } 16 | 17 | { #category : 'accessing' } 18 | ClapNestedPositionalValidation >> description [ 19 | ^ 'Missing positional value for ', (', ' join: self missingValueIdentifiers) 20 | ] 21 | 22 | { #category : 'validation' } 23 | ClapNestedPositionalValidation >> failureDescriptionFor: anObject [ 24 | ^ self description 25 | ] 26 | 27 | { #category : 'initialization' } 28 | ClapNestedPositionalValidation >> initialize [ 29 | 30 | missing := OrderedCollection new. 31 | ] 32 | 33 | { #category : 'validation' } 34 | ClapNestedPositionalValidation >> isValidNamedMatch: aClapNamedMatch [ 35 | 36 | | isValid | 37 | isValid := aClapNamedMatch isFullMatch. 38 | isValid ifFalse: [ missing add: aClapNamedMatch ]. 39 | ^ isValid 40 | ] 41 | 42 | { #category : 'accessing' } 43 | ClapNestedPositionalValidation >> missingValueIdentifiers [ 44 | 45 | ^ missing flatCollect: [ :match | 46 | match specification positionals collect: [ :positional | positional identifier ] ] 47 | ] 48 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapValidationDiagnostic.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am the result of applying a validation to a given subject. 3 | If the subject does not pass my criterium, I can provide a helpful description why. 4 | " 5 | Class { 6 | #name : 'ClapValidationDiagnostic', 7 | #superclass : 'Object', 8 | #instVars : [ 9 | 'validation', 10 | 'subject', 11 | 'success' 12 | ], 13 | #category : 'Clap-Core-Validation', 14 | #package : 'Clap-Core', 15 | #tag : 'Validation' 16 | } 17 | 18 | { #category : 'instance creation' } 19 | ClapValidationDiagnostic class >> of: aValidation subject: anExpression [ 20 | ^ self new 21 | validation: aValidation subject: anExpression; 22 | yourself 23 | ] 24 | 25 | { #category : 'accessing' } 26 | ClapValidationDiagnostic >> description [ 27 | ^ validation failureDescriptionFor: subject 28 | ] 29 | 30 | { #category : 'testing' } 31 | ClapValidationDiagnostic >> isFailure [ 32 | ^ success not 33 | ] 34 | 35 | { #category : 'testing' } 36 | ClapValidationDiagnostic >> isSuccess [ 37 | ^ success 38 | ] 39 | 40 | { #category : 'printing' } 41 | ClapValidationDiagnostic >> printOn: aStream [ 42 | aStream nextPutAll: self description 43 | ] 44 | 45 | { #category : 'accessing' } 46 | ClapValidationDiagnostic >> validation [ 47 | ^ validation 48 | ] 49 | 50 | { #category : 'initialization' } 51 | ClapValidationDiagnostic >> validation: aValidation subject: anExpression [ 52 | validation := aValidation. 53 | subject := anExpression. 54 | success := validation matches: subject 55 | ] 56 | -------------------------------------------------------------------------------- /src/Clap-Commands-Pharo/ClapCodeEvaluator.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I evaluate code passed via standard input or as arguments from the command line. 3 | " 4 | Class { 5 | #name : 'ClapCodeEvaluator', 6 | #superclass : 'ClapPharoApplication', 7 | #category : 'Clap-Commands-Pharo', 8 | #package : 'Clap-Commands-Pharo' 9 | } 10 | 11 | { #category : 'command line' } 12 | ClapCodeEvaluator class >> evaluate [ 13 | 14 | ^ (ClapCommandSpec id: #evaluate) 15 | aliases: #('eval'); 16 | commandClass: self; 17 | description: 'Print the result of a Pharo expression'; 18 | addHelp; 19 | addFlag: #save description: 'Save the image after evaluation'; 20 | addFlag: #keepAlive description: 'Keep image running'; 21 | addPositional: #EXPR spec: [ :positional | 22 | positional 23 | description: 'The expression to evaluate, joining successive arguments with spaces (if omitted, read the expression from stdin)'; 24 | multiple: true; 25 | defaultValue: [ :match | "in the absence of an explicit argument, read from standard input" 26 | Array with: match context stdin upToEnd ] ]; 27 | yourself 28 | ] 29 | 30 | { #category : 'execution' } 31 | ClapCodeEvaluator >> execute [ 32 | | result | 33 | result := Smalltalk compiler evaluate: self source. 34 | 35 | self context hasSessionChanged "we might be waking up after a #save:andQuit:" 36 | ifFalse: [ self outputStreamDo: [ :out | out print: result; lf ] ] 37 | ] 38 | 39 | { #category : 'accessing' } 40 | ClapCodeEvaluator >> source [ 41 | ^ String space join: (self positional: #EXPR) 42 | ] 43 | -------------------------------------------------------------------------------- /src/Clap-Commands-Pharo/ClapMetacello.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I allow to load code with Metacello from command line. 3 | " 4 | Class { 5 | #name : 'ClapMetacello', 6 | #superclass : 'ClapPharoApplication', 7 | #category : 'Clap-Commands-Pharo', 8 | #package : 'Clap-Commands-Pharo' 9 | } 10 | 11 | { #category : 'command line' } 12 | ClapMetacello class >> metacello [ 13 | 14 | ^ (ClapCommandSpec id: #metacello) 15 | description: 'Load code using Metacello'; 16 | commandClass: self; 17 | addHelp; 18 | add: ClapCommandSpec forHelp; 19 | addPositional: #REPOSITORY description: 'URL of the repository to load code from'; 20 | addPositional: #NAME description: 'Name of the project to load'; 21 | addFlagWithPositional: #groups description: 'Names of groups to load, comma-separated'; 22 | addFlagWithPositional: #version description: 'Version to load (only valid for configurations)'; 23 | yourself 24 | ] 25 | 26 | { #category : 'baselines' } 27 | ClapMetacello >> baselineName [ 28 | ^ self positional: #NAME 29 | ] 30 | 31 | { #category : 'execution' } 32 | ClapMetacello >> execute [ 33 | self outputStreamDo: [ :out | 34 | out 35 | print: self repositoryUrl; 36 | print: self baselineName; 37 | newLine ] 38 | ] 39 | 40 | { #category : 'accessing' } 41 | ClapMetacello >> groups [ 42 | ^ $, split: (self positional: #version) 43 | ] 44 | 45 | { #category : 'accessing' } 46 | ClapMetacello >> repositoryUrl [ 47 | ^ self positional: #REPOSITORY 48 | ] 49 | 50 | { #category : 'accessing' } 51 | ClapMetacello >> version [ 52 | ^ self positional: #groups 53 | ] 54 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapValidation.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent a validation criterium that various subjects might have to pass at a later point. 3 | My subclasses implement specific validations for Clap parameters. 4 | " 5 | Class { 6 | #name : 'ClapValidation', 7 | #superclass : 'Object', 8 | #category : 'Clap-Core-Validation', 9 | #package : 'Clap-Core', 10 | #tag : 'Validation' 11 | } 12 | 13 | { #category : 'accessing' } 14 | ClapValidation >> description [ 15 | ^ self subclassResponsibility 16 | ] 17 | 18 | { #category : 'accessing' } 19 | ClapValidation >> failureDescriptionFor: anObject [ 20 | self subclassResponsibility 21 | ] 22 | 23 | { #category : 'validation' } 24 | ClapValidation >> isValidCompositeMatch: aClapCompositeMatch [ 25 | ^ true 26 | ] 27 | 28 | { #category : 'validation' } 29 | ClapValidation >> isValidContext: aClapContext [ 30 | ^ true 31 | ] 32 | 33 | { #category : 'validation' } 34 | ClapValidation >> isValidImplicit: aClapImplicit [ 35 | ^ true 36 | ] 37 | 38 | { #category : 'validation' } 39 | ClapValidation >> isValidMismatch: aClapMisatch [ 40 | ^ false 41 | ] 42 | 43 | { #category : 'validation' } 44 | ClapValidation >> isValidNamedMatch: aClapNamedMatch [ 45 | ^ true 46 | ] 47 | 48 | { #category : 'validation' } 49 | ClapValidation >> isValidWordMatch: aClapWordMatch [ 50 | ^ true 51 | ] 52 | 53 | { #category : 'validation' } 54 | ClapValidation >> matches: aClapExpression [ 55 | 56 | ^ aClapExpression isValid: self 57 | ] 58 | 59 | { #category : 'validation' } 60 | ClapValidation >> validate: anObject [ 61 | ^ ClapValidationDiagnostic of: self subject: anObject 62 | ] 63 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapImplicit.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent the non-occurrence of a parameter in the argument sequence. 3 | 4 | My instances are only created on demand in response to a query for a parameter that was not recognized in the argument sequence, i.e. it was omitted. 5 | When evaluated with #value or #value:, my meaning is given by the implicit meaning block of my specification. 6 | " 7 | Class { 8 | #name : 'ClapImplicit', 9 | #superclass : 'ClapSubExpression', 10 | #category : 'Clap-Core-Activation', 11 | #package : 'Clap-Core', 12 | #tag : 'Activation' 13 | } 14 | 15 | { #category : 'instance creation' } 16 | ClapImplicit class >> of: aParameter in: parentMatch [ 17 | ^ (self specification: aParameter) 18 | parent: parentMatch; 19 | yourself 20 | ] 21 | 22 | { #category : 'enumerating' } 23 | ClapImplicit >> allOccurrences [ 24 | ^ Array with: self 25 | ] 26 | 27 | { #category : 'enumerating' } 28 | ClapImplicit >> allOccurrencesCollect: aBlock [ 29 | ^ Array with: (aBlock value: self) 30 | ] 31 | 32 | { #category : 'enumerating' } 33 | ClapImplicit >> allOccurrencesDo: aBlock [ 34 | aBlock value: self 35 | ] 36 | 37 | { #category : 'testing' } 38 | ClapImplicit >> isExplicit [ 39 | ^ false 40 | ] 41 | 42 | { #category : 'testing' } 43 | ClapImplicit >> isValid [ 44 | self flag: 'could be false if resulted from wrong access...'. 45 | ^ true 46 | ] 47 | 48 | { #category : 'testing' } 49 | ClapImplicit >> isValid: aValidation [ 50 | 51 | ^ aValidation isValidImplicit: self 52 | ] 53 | 54 | { #category : 'evaluating' } 55 | ClapImplicit >> value: arg [ 56 | ^ specification valueForImplicit: self with: arg 57 | ] 58 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapValidationErrorPrinter.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I pretty print an informative message explaining errors found according to the command specification. 3 | " 4 | Class { 5 | #name : 'ClapValidationErrorPrinter', 6 | #superclass : 'Object', 7 | #instVars : [ 8 | 'report', 9 | 'writeStream' 10 | ], 11 | #category : 'Clap-Core-Validation', 12 | #package : 'Clap-Core', 13 | #tag : 'Validation' 14 | } 15 | 16 | { #category : 'initialization' } 17 | ClapValidationErrorPrinter class >> on: aClapValidationReport [ 18 | 19 | ^ self new 20 | validationReport: aClapValidationReport; 21 | yourself 22 | ] 23 | 24 | { #category : 'printing' } 25 | ClapValidationErrorPrinter >> printCommandHelp [ 26 | 27 | (ClapDocumenter on: writeStream) 28 | explain: report commandSpecification 29 | ] 30 | 31 | { #category : 'printing' } 32 | ClapValidationErrorPrinter >> printDelimiterLine [ 33 | 34 | writeStream 35 | << '--------------------'; 36 | cr 37 | ] 38 | 39 | { #category : 'printing' } 40 | ClapValidationErrorPrinter >> printOn: aStream [ 41 | 42 | report isSuccess ifTrue: [ ^ '' ]. 43 | 44 | writeStream := aStream. 45 | report problems do: [ :problem | 46 | aStream 47 | nextPutAll: 'Error: '; 48 | nextPutAll: problem description; 49 | cr ]. 50 | self printDelimiterLine. 51 | self printCommandHelp 52 | ] 53 | 54 | { #category : 'printing' } 55 | ClapValidationErrorPrinter >> printString [ 56 | 57 | ^ String streamContents: [ :stream | self printOn: stream ] 58 | ] 59 | 60 | { #category : 'initialization' } 61 | ClapValidationErrorPrinter >> validationReport: aClapValidationReport [ 62 | 63 | report := aClapValidationReport 64 | ] 65 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapApplicationTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapApplicationTest', 3 | #superclass : 'TestCase', 4 | #instVars : [ 5 | 'context' 6 | ], 7 | #category : 'Clap-Tests-Integration', 8 | #package : 'Clap-Tests', 9 | #tag : 'Integration' 10 | } 11 | 12 | { #category : 'tests' } 13 | ClapApplicationTest >> assertStdOutIncludes: aString [ 14 | 15 | self 16 | assert: (self stdoutString includesSubstring: aString) 17 | description: (aString surroundedBy: '"') , ' not found in ', (self stdoutString surroundedBy: '"') 18 | 19 | ] 20 | 21 | { #category : 'helpers' } 22 | ClapApplicationTest >> stdoutString [ 23 | 24 | ^ context binaryStdout contents utf8Decoded 25 | ] 26 | 27 | { #category : 'tests' } 28 | ClapApplicationTest >> testCanGetFlags [ 29 | 30 | | command | 31 | context := ClapCommandLineExamples hello activateWith: #('hello' 'world' '--shout' '--language' 'fr'). 32 | command := context command. 33 | 34 | self 35 | assertCollection: command flags 36 | hasSameElements: #('shout' 'language') 37 | ] 38 | 39 | { #category : 'tests' } 40 | ClapApplicationTest >> testCanPrintHelp [ 41 | 42 | context := ClapCommandLineExamples git activateWith: #(). 43 | context command printHelp. 44 | 45 | self assertStdOutIncludes: 'Usage: git'. 46 | self assertStdOutIncludes: 'The stupid content tracker'. 47 | ] 48 | 49 | { #category : 'tests' } 50 | ClapApplicationTest >> testCanPrintHelpWhenSubcommand [ 51 | 52 | context := ClapCommandLineExamples git activateWith: #('git' 'add'). 53 | context command printHelp. 54 | 55 | self assertStdOutIncludes: 'Usage: git add'. 56 | self assertStdOutIncludes: 'Add file contents to the index' 57 | ] 58 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapMismatch.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a failed match of my specification at a given word of the arguments sequence. 3 | " 4 | Class { 5 | #name : 'ClapMismatch', 6 | #superclass : 'ClapWordMatch', 7 | #category : 'Clap-Core-Activation', 8 | #package : 'Clap-Core', 9 | #tag : 'Activation' 10 | } 11 | 12 | { #category : 'accessing' } 13 | ClapMismatch >> at: identifierOrSpec [ 14 | ^ specification at: identifierOrSpec 15 | ifPresent: [ :spec | ClapImplicit of: spec in: self ] 16 | ] 17 | 18 | { #category : 'matching' } 19 | ClapMismatch >> completeMatchOn: aStream [ 20 | word := aStream peek. 21 | startIndex := aStream position + 1. 22 | ] 23 | 24 | { #category : 'testing' } 25 | ClapMismatch >> ifMatch: matchingBlock ifMismatch: mismatchBlock [ 26 | ^ mismatchBlock cull: self 27 | ] 28 | 29 | { #category : 'testing' } 30 | ClapMismatch >> isValid [ 31 | ^ false 32 | ] 33 | 34 | { #category : 'testing' } 35 | ClapMismatch >> isValid: aValidation [ 36 | 37 | ^ aValidation isValidMismatch: self 38 | ] 39 | 40 | { #category : 'printing' } 41 | ClapMismatch >> printDetailsOn: aStream [ 42 | aStream 43 | print: specification; 44 | nextPutAll: ' mismatched'. 45 | word 46 | ifNil: [ aStream nextPutAll: ' (nothing to match)' ] 47 | ifNotNil: [ 48 | aStream 49 | nextPutAll: ' word '''; 50 | nextPutAll: word; 51 | nextPutAll: '''' ] 52 | ] 53 | 54 | { #category : 'adding' } 55 | ClapMismatch >> recordIn: parentMatch [ 56 | "this match failed, so do nothing" 57 | ] 58 | 59 | { #category : 'accessing' } 60 | ClapMismatch >> subcommands [ 61 | 62 | ^ #() 63 | ] 64 | 65 | { #category : 'accessing' } 66 | ClapMismatch >> value [ 67 | ^ self 68 | ] 69 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapParameterizedTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapParameterizedTest', 3 | #superclass : 'ClapParameterTest', 4 | #category : 'Clap-Tests-Unit', 5 | #package : 'Clap-Tests', 6 | #tag : 'Unit' 7 | } 8 | 9 | { #category : 'testing' } 10 | ClapParameterizedTest class >> isAbstract [ 11 | ^ self = ClapParameterizedTest 12 | ] 13 | 14 | { #category : 'tests' } 15 | ClapParameterizedTest >> testAddPositional [ 16 | | subject pos | 17 | subject := self namedSubject. 18 | pos := (ClapPositional id: #myPositional) 19 | canonicalName: 'ARG'; 20 | yourself. 21 | subject add: pos. 22 | 23 | self assert: (subject at: #myPositional) identicalTo: pos. 24 | self assert: (subject positionals includes: pos). 25 | ] 26 | 27 | { #category : 'tests' } 28 | ClapParameterizedTest >> testAddPositionals [ 29 | | subject pos1 pos2 | 30 | subject := self namedSubject. 31 | pos1 := (ClapPositional id: #positional1) 32 | canonicalName: 'ARG1'; 33 | yourself. 34 | pos2 := (ClapPositional id: #positional2) 35 | canonicalName: 'ARG2'; 36 | yourself. 37 | subject addAll: { pos1 . pos2 }. 38 | 39 | self assert: (subject at: #positional1) identicalTo: pos1. 40 | self assert: (subject at: #positional2) identicalTo: pos2. 41 | self assert: (subject positionals includes: pos1). 42 | self assert: (subject positionals includes: pos2). 43 | 44 | ] 45 | 46 | { #category : 'tests' } 47 | ClapParameterizedTest >> testIdentifierConflict [ 48 | | subject first second | 49 | subject := self namedSubject. 50 | first := ClapPositional id: #theSame. 51 | second := ClapPositional id: #theSame. 52 | subject add: first. 53 | 54 | self 55 | should: [ subject add: second ] 56 | raise: Error 57 | ] 58 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapPositional.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent a free-form parameter which is passed as a single shell word and recognized based on its position in the input. 3 | 4 | " 5 | Class { 6 | #name : 'ClapPositional', 7 | #superclass : 'ClapParameter', 8 | #category : 'Clap-Core-Specification', 9 | #package : 'Clap-Core', 10 | #tag : 'Specification' 11 | } 12 | 13 | { #category : 'evaluating' } 14 | ClapPositional class >> basicMeaning [ 15 | ^ [ :match | match word ] 16 | ] 17 | 18 | { #category : 'computing' } 19 | ClapPositional class >> idFrom: aFlagId [ 20 | 21 | ^ aFlagId , '-value' 22 | ] 23 | 24 | { #category : 'adding' } 25 | ClapPositional >> addTo: parentParameter [ 26 | ^ parentParameter addPositional: self 27 | ] 28 | 29 | { #category : 'matching - testing' } 30 | ClapPositional >> canMatchWith: word [ 31 | ^ (word beginsWith: '-') not 32 | ] 33 | 34 | { #category : 'api' } 35 | ClapPositional >> defaultValue: aBlock [ 36 | self implicitMeaning: aBlock 37 | ] 38 | 39 | { #category : 'accessing' } 40 | ClapPositional >> flagId [ 41 | 42 | "positional of a flag has an id like xxx-value" 43 | ^ self identifier copyUpToLast: $- 44 | ] 45 | 46 | { #category : 'testing' } 47 | ClapPositional >> isPositional [ 48 | 49 | ^ true 50 | ] 51 | 52 | { #category : 'accessing' } 53 | ClapPositional >> matchClass [ 54 | ^ ClapWordMatch 55 | ] 56 | 57 | { #category : 'types' } 58 | ClapPositional >> symbol [ 59 | "tell that I must be converted as a symbol" 60 | 61 | self flag: 'TODO: convert as symbol' 62 | ] 63 | 64 | { #category : 'documenting' } 65 | ClapPositional >> synopsisOn: aStream [ 66 | ^ aStream 67 | nextPut: $<; 68 | nextPutAll: self canonicalName; 69 | nextPut: $> 70 | ] 71 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapDocumentationTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapDocumentationTest', 3 | #superclass : 'TestCase', 4 | #category : 'Clap-Tests-Unit', 5 | #package : 'Clap-Tests', 6 | #tag : 'Unit' 7 | } 8 | 9 | { #category : 'tests' } 10 | ClapDocumentationTest >> testFlagWithPositionalShouldPrintBothFlagAndPositional [ 11 | | command doc lines | 12 | command := (ClapCommandSpec id: #testCommand) 13 | description: 'Test command for flags with positional'; 14 | add: ClapFlag forHelp; 15 | add: 16 | ((ClapFlag id: #language) 17 | description: 'Select language of greeting'; 18 | add: ((ClapPositional id: #langCode) 19 | meaning: [ :pos | pos word asSymbol ]; 20 | implicitMeaning: [ :arg :app | app defaultLanguage ]); 21 | yourself); 22 | yourself. 23 | 24 | doc := ClapDocumenter stringFrom: [ :documenter | documenter explain: command ]. 25 | lines := doc lines. 26 | 27 | self assert: (lines third includesSubstring: '[--language ]'). 28 | self assert: (lines seventh includesSubstring: '--language '). 29 | 30 | ] 31 | 32 | { #category : 'tests' } 33 | ClapDocumentationTest >> testHelloShortUsage [ 34 | | command doc lines | 35 | command := ClapCommandLineExamples hello. 36 | 37 | doc := ClapDocumenter stringFrom: [ :documenter | documenter explain: command ]. 38 | lines := doc lines. 39 | 40 | self assert: (doc endsWith: OSPlatform current lineEnding). 41 | self assert: lines first equals: 'Provides greetings'. 42 | self assert: lines second isEmpty. 43 | self assert: (lines third beginsWith: 'Usage: hello'). 44 | self assert: (lines third includesSubstring: '[--language ]'). 45 | self assert: (lines third endsWith: '[]'). 46 | ] 47 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapValidationReport.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I aggregate multiple validation diagnostics together. 3 | " 4 | Class { 5 | #name : 'ClapValidationReport', 6 | #superclass : 'Object', 7 | #instVars : [ 8 | 'problems', 9 | 'context' 10 | ], 11 | #category : 'Clap-Core-Validation', 12 | #package : 'Clap-Core', 13 | #tag : 'Validation' 14 | } 15 | 16 | { #category : 'instance creation' } 17 | ClapValidationReport class >> on: aClapContext [ 18 | 19 | ^ self new 20 | context: aClapContext; 21 | yourself 22 | ] 23 | 24 | { #category : 'controlling' } 25 | ClapValidationReport >> add: aDiagnostic [ 26 | aDiagnostic isFailure ifTrue: [ problems add: aDiagnostic ]. 27 | ] 28 | 29 | { #category : 'controlling' } 30 | ClapValidationReport >> addAll: diagnostics [ 31 | diagnostics do: [ :each | self add: each ] 32 | ] 33 | 34 | { #category : 'accessing' } 35 | ClapValidationReport >> commandSpecification [ 36 | ^ context lastSubcommand specification 37 | ] 38 | 39 | { #category : 'initialization' } 40 | ClapValidationReport >> context: aClapContext [ 41 | 42 | context := aClapContext 43 | ] 44 | 45 | { #category : 'initialization' } 46 | ClapValidationReport >> initialize [ 47 | problems := OrderedCollection new 48 | ] 49 | 50 | { #category : 'testing' } 51 | ClapValidationReport >> isFailure [ 52 | ^ self isSuccess not 53 | ] 54 | 55 | { #category : 'testing' } 56 | ClapValidationReport >> isSuccess [ 57 | ^ problems isEmpty 58 | ] 59 | 60 | { #category : 'printing' } 61 | ClapValidationReport >> printOn: aStream [ 62 | problems do: [ :each | 63 | aStream 64 | nextPutAll: each printString; 65 | cr ] 66 | ] 67 | 68 | { #category : 'accessing' } 69 | ClapValidationReport >> problems [ 70 | 71 | ^ problems 72 | ] 73 | -------------------------------------------------------------------------------- /src/Clap-Examples-Booklet/ClapBookletMonthsCommand.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #ClapBookletMonthsCommand, 3 | #superclass : #Object, 4 | #category : #'Clap-Examples-Booklet' 5 | } 6 | 7 | { #category : #'command line' } 8 | ClapBookletMonthsCommand class >> commandSpecification [ 9 | 10 | ^ (ClapCommand id: #months) 11 | add: ((ClapPositional id: #start) 12 | meaning: [ :m | m word asNumber ]; 13 | implicitMeaning: [ 1 ]); 14 | add: ((ClapPositional id: #end) 15 | meaning: [ :m | m word asNumber ]; 16 | implicitMeaning: [ 12 ]); 17 | meaning: [ :commandMatch | | out start end | 18 | out := commandMatch context stdout. 19 | start := (commandMatch at: #start) value. 20 | end := (commandMatch at: #end) value. 21 | (start to: end) 22 | do: [ :each | out << each asString ] 23 | separatedBy: [ out space ]. 24 | out newLine ] 25 | ] 26 | 27 | { #category : #'command line' } 28 | ClapBookletMonthsCommand class >> seqSpecification [ 29 | 30 | ^ (ClapCommand id: #'months-seq') 31 | add: ((ClapPositional id: #bound) 32 | multiple: true; 33 | meaning: [ :m | m word asNumber ]); 34 | meaning: [ :commandMatch | | out bounds start step end | 35 | out := commandMatch context stdout. 36 | bounds := (commandMatch occurrencesOf: #bound) collect: #value. 37 | end := bounds size >= 1 38 | ifTrue: [ bounds last ] ifFalse: [ 12 ]. 39 | start := bounds size >= 2 40 | ifTrue: [ bounds first ] ifFalse: [ 1 ]. 41 | step := bounds size >= 3 42 | ifTrue: [ bounds second ] ifFalse: [ 1 ]. 43 | (start to: end by: step) 44 | do: [ :each | out << each asString ] 45 | separatedBy: [ out space ]. 46 | out newLine ] 47 | 48 | ] 49 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapSubExpression.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a node in the match tree. 3 | My parent is either the match I'm a child of, or the context for the whole command invocation. 4 | " 5 | Class { 6 | #name : 'ClapSubExpression', 7 | #superclass : 'ClapExpression', 8 | #instVars : [ 9 | 'parent' 10 | ], 11 | #category : 'Clap-Core-Activation', 12 | #package : 'Clap-Core', 13 | #tag : 'Activation' 14 | } 15 | 16 | { #category : 'testing' } 17 | ClapSubExpression class >> isAbstract [ 18 | ^ self == ClapSubExpression 19 | ] 20 | 21 | { #category : 'instance creation' } 22 | ClapSubExpression class >> of: aSpecification in: aMatch [ 23 | 24 | ^ (self specification: aSpecification) 25 | parent: aMatch; 26 | yourself 27 | ] 28 | 29 | { #category : 'enumerating' } 30 | ClapSubExpression >> allOccurrences [ 31 | ^ self parent 32 | occurrencesOf: self specification 33 | ] 34 | 35 | { #category : 'enumerating' } 36 | ClapSubExpression >> allOccurrencesCollect: aBlock [ 37 | ^ self parent 38 | occurrencesOf: self specification 39 | collect: aBlock 40 | ] 41 | 42 | { #category : 'enumerating' } 43 | ClapSubExpression >> allOccurrencesDo: aBlock [ 44 | ^ self parent 45 | occurrencesOf: self specification 46 | do: aBlock 47 | ] 48 | 49 | { #category : 'accessing' } 50 | ClapSubExpression >> context [ 51 | ^ parent context 52 | ] 53 | 54 | { #category : 'testing' } 55 | ClapSubExpression >> ifMatch: matchBlock ifMismatch: mismatchBlock [ 56 | ^ matchBlock cull: self 57 | ] 58 | 59 | { #category : 'testing' } 60 | ClapSubExpression >> isExplicit [ 61 | ^ self subclassResponsibility 62 | ] 63 | 64 | { #category : 'accessing' } 65 | ClapSubExpression >> parent [ 66 | ^ parent 67 | ] 68 | 69 | { #category : 'accessing' } 70 | ClapSubExpression >> parent: aMatch [ 71 | parent := aMatch 72 | ] 73 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapParameterTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapParameterTest', 3 | #superclass : 'TestCase', 4 | #category : 'Clap-Tests-Unit', 5 | #package : 'Clap-Tests', 6 | #tag : 'Unit' 7 | } 8 | 9 | { #category : 'testing' } 10 | ClapParameterTest class >> isAbstract [ 11 | ^ self = ClapParameterTest 12 | ] 13 | 14 | { #category : 'testing' } 15 | ClapParameterTest class >> shouldInheritSelectors [ 16 | ^ true 17 | ] 18 | 19 | { #category : 'accessing' } 20 | ClapParameterTest >> classToTest [ 21 | ^ self subclassResponsibility 22 | ] 23 | 24 | { #category : 'tests - fixture' } 25 | ClapParameterTest >> namedSubject [ 26 | ^ self classToTest id: self subjectName asSymbol 27 | ] 28 | 29 | { #category : 'tests - fixture' } 30 | ClapParameterTest >> subjectName [ 31 | ^ 'foo' 32 | ] 33 | 34 | { #category : 'tests' } 35 | ClapParameterTest >> testCanonicalName [ 36 | self 37 | assert: self namedSubject canonicalName 38 | equals: self subjectName asString 39 | ] 40 | 41 | { #category : 'tests' } 42 | ClapParameterTest >> testIdentifierDerivedFromCanonicalName [ 43 | self 44 | assert: self namedSubject identifier 45 | equals: self subjectName asSymbol 46 | ] 47 | 48 | { #category : 'tests' } 49 | ClapParameterTest >> testMismatchesAtEnd [ 50 | | subject argv ctx match | 51 | subject := self namedSubject. 52 | argv := #() readStream. 53 | ctx := Object new. 54 | 55 | match := subject matchOn: argv in: ctx. 56 | 57 | self assert: match isMismatch. 58 | self assert: match specification identicalTo: subject. 59 | self assert: match parent identicalTo: ctx 60 | ] 61 | 62 | { #category : 'tests' } 63 | ClapParameterTest >> testSubjectIdentifier [ 64 | | subject | 65 | subject := self classToTest id: #subjectId. 66 | subject canonicalName: self subjectName. 67 | 68 | self 69 | assert: subject identifier 70 | equals: #subjectId. 71 | self 72 | assert: subject canonicalName 73 | equals: self subjectName 74 | ] 75 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapExplicit.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent an explicit match over words in the argument sequence, which constitutes an explicit occurrence of my specification. 3 | 4 | My instances have a value, given by the meaning block of my specification. 5 | " 6 | Class { 7 | #name : 'ClapExplicit', 8 | #superclass : 'ClapSubExpression', 9 | #instVars : [ 10 | 'startIndex' 11 | ], 12 | #category : 'Clap-Core-Activation', 13 | #package : 'Clap-Core', 14 | #tag : 'Activation' 15 | } 16 | 17 | { #category : 'testing' } 18 | ClapExplicit class >> isAbstract [ 19 | ^ self == ClapExplicit 20 | ] 21 | 22 | { #category : 'matching' } 23 | ClapExplicit >> completeMatchOn: aStream [ 24 | self subclassResponsibility 25 | ] 26 | 27 | { #category : 'testing' } 28 | ClapExplicit >> isExplicit [ 29 | ^ true 30 | ] 31 | 32 | { #category : 'printing' } 33 | ClapExplicit >> printOn: aStream [ 34 | super printOn: aStream. 35 | aStream 36 | nextPut: $(; 37 | nextPutAll: (String space join: self words); 38 | nextPut: $) 39 | ] 40 | 41 | { #category : 'adding' } 42 | ClapExplicit >> recordIn: parentMatch [ 43 | self parent: parentMatch. 44 | self parent addChild: self 45 | ] 46 | 47 | { #category : 'accessing' } 48 | ClapExplicit >> span [ 49 | ^ self start to: self stop 50 | ] 51 | 52 | { #category : 'accessing' } 53 | ClapExplicit >> start [ 54 | ^ startIndex 55 | ] 56 | 57 | { #category : 'accessing' } 58 | ClapExplicit >> stop [ 59 | ^ self subclassResponsibility 60 | ] 61 | 62 | { #category : 'evaluating' } 63 | ClapExplicit >> words [ 64 | 65 | ^ self context arguments 66 | ifEmpty: [ #() ] 67 | ifNotEmpty:[ :args | 68 | args 69 | collect: [ :str | str asByteArray utf8Decoded ] 70 | from: self start 71 | to: self stop ] 72 | ] 73 | 74 | { #category : 'evaluating' } 75 | ClapExplicit >> wordsDo: aBlock [ 76 | ^ self context arguments 77 | from: self start 78 | to: self stop 79 | do: [ :str | aBlock value: str asByteArray utf8Decoded ] 80 | ] 81 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapMeaningsTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapMeaningsTest', 3 | #superclass : 'TestCase', 4 | #category : 'Clap-Tests-Integration', 5 | #package : 'Clap-Tests', 6 | #tag : 'Integration' 7 | } 8 | 9 | { #category : 'tests' } 10 | ClapMeaningsTest >> testArgFlagBasicMeaning [ 11 | | flag match | 12 | flag := (ClapFlag id: #foo) 13 | add: (ClapPositional id: #bar); 14 | yourself. 15 | 16 | match := flag match: #('--foo' 'whatever'). 17 | 18 | self assert: match isMatch. 19 | self assert: (flag match: #()) isMismatch 20 | ] 21 | 22 | { #category : 'tests' } 23 | ClapMeaningsTest >> testArgFlagCollectionMeaning [ 24 | | flag match | 25 | flag := (ClapFlag id: #foo) 26 | add: ((ClapPositional id: #bar) implicitMeaning: [ #nobar ]); 27 | add: ((ClapPositional id: #baz) implicitMeaning: [ #nobaz ]); 28 | meaningCollection. 29 | match := flag match: #('--foo' 'whatever 1' 'whatever 2'). 30 | self assert: match value asArray equals: #('whatever 1' 'whatever 2'). 31 | match := flag match: #('--foo' 'whatever'). 32 | self assert: match value asArray equals: #('whatever' nobaz). 33 | match := flag match: #('--foo'). 34 | self assert: match value asArray equals: #(nobar nobaz) 35 | ] 36 | 37 | { #category : 'tests' } 38 | ClapMeaningsTest >> testArgFlagScalarMeaning [ 39 | | flag match | 40 | flag := (ClapFlag id: #foo) 41 | add: ((ClapPositional id: #bar) implicitMeaning: [ 'oops' ]); 42 | meaningScalar. 43 | match := flag match: #('--foo' 'whatever'). 44 | self assert: match value equals: 'whatever'. 45 | match := flag match: #('--foo'). 46 | self assert: match value equals: 'oops'. 47 | match := flag match: #(). "might be wrong, since this is really a mismatch" 48 | self assert: match isMismatch. 49 | ] 50 | 51 | { #category : 'tests' } 52 | ClapMeaningsTest >> testSimpleFlagBasicMeaning [ 53 | | flag match | 54 | flag := ClapFlag id: #foo. 55 | 56 | match := flag match: #('--foo'). 57 | 58 | self assert: match isMatch. 59 | self deny: (flag match: #()) isMatch 60 | ] 61 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapFlagTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapFlagTest', 3 | #superclass : 'ClapParameterizedTest', 4 | #category : 'Clap-Tests-Unit', 5 | #package : 'Clap-Tests', 6 | #tag : 'Unit' 7 | } 8 | 9 | { #category : 'accessing' } 10 | ClapFlagTest >> classToTest [ 11 | ^ ClapFlag 12 | ] 13 | 14 | { #category : 'tests' } 15 | ClapFlagTest >> testMatchesLongForm [ 16 | | subject argv flagName match | 17 | subject := self namedSubject. 18 | flagName := '--' , self subjectName. 19 | argv := { flagName. #remainder } readStream. 20 | 21 | match := subject matchOn: argv in: ClapContext new. 22 | 23 | self deny: match isMismatch. 24 | self 25 | assert: match specification 26 | identicalTo: subject. 27 | self assert: match word equals: '--foo'. 28 | self assert: argv next equals: #remainder 29 | ] 30 | 31 | { #category : 'tests' } 32 | ClapFlagTest >> testMatchesShortForm [ 33 | | subject argv flagName match | 34 | subject := self namedSubject. 35 | flagName := '-' , (self subjectName first: 1). 36 | argv := { flagName. #remainder } readStream. 37 | 38 | match := subject matchOn: argv in: ClapContext new. 39 | 40 | self deny: match isMismatch. 41 | self 42 | assert: match specification 43 | identicalTo: subject. 44 | self assert: match word equals: flagName. 45 | self assert: argv next equals: #remainder 46 | ] 47 | 48 | { #category : 'tests' } 49 | ClapFlagTest >> testMismatchesWrongLongForm [ 50 | | subject argv badFlag match | 51 | subject := self namedSubject. 52 | badFlag := '--' , self subjectName , 'NOT'. 53 | argv := { badFlag } readStream. 54 | 55 | match := subject matchOn: argv in: Object new. 56 | 57 | self assert: match isMismatch. 58 | self 59 | assert: match specification 60 | identicalTo: subject. 61 | self assert: match word equals: badFlag. 62 | self assert: argv next identicalTo: badFlag 63 | ] 64 | 65 | { #category : 'tests' } 66 | ClapFlagTest >> testMismatchesWrongShortForm [ 67 | | subject argv badFlag match | 68 | subject := self namedSubject. 69 | badFlag := '-' , (self subjectName first: 1) asUppercase. 70 | argv := { badFlag } readStream. 71 | 72 | match := subject matchOn: argv in: Object new. 73 | 74 | self assert: match isMismatch. 75 | self 76 | assert: match specification 77 | identicalTo: subject. 78 | self assert: match word equals: badFlag. 79 | self assert: argv next identicalTo: badFlag 80 | ] 81 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapValidationTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapValidationTest', 3 | #superclass : 'TestCase', 4 | #category : 'Clap-Tests-Unit', 5 | #package : 'Clap-Tests', 6 | #tag : 'Unit' 7 | } 8 | 9 | { #category : 'tests' } 10 | ClapValidationTest >> testErrorReportingWhenMissingNestedPositional [ 11 | 12 | | spec context match validationReport errorString | 13 | spec := ClapCommandSpec id: #hello. 14 | spec addFlagWithPositional: #foo description: 'some foo'. 15 | spec addFlagWithPositional: #bar description: 'some bar'. 16 | context := ClapContext specification: spec. 17 | match := context 18 | arguments: #( 'hello' '--foo' '--bar' ); 19 | match. 20 | validationReport := context allValidations. 21 | 22 | errorString := (ClapValidationErrorPrinter on: validationReport) printString. 23 | self assert: (errorString includesSubstring: 'Usage: hello [--foo ] [--bar ]'). 24 | self assert: (errorString includesSubstring: 'Missing positional value for foo-value'). 25 | self assert: (errorString includesSubstring: 'Missing positional value for bar-value'). 26 | ] 27 | 28 | { #category : 'tests' } 29 | ClapValidationTest >> testErrorReportingWhenNotMatched [ 30 | 31 | | match context validationReport errorString | 32 | context := ClapCommandLineExamples hello activateWith: #('hello' 'world' '--helpe'). 33 | match := context match. 34 | validationReport := context allValidations. 35 | 36 | self assert: match isMatch. 37 | self deny: validationReport isSuccess. 38 | errorString := (ClapValidationErrorPrinter on: validationReport) printString. 39 | self assert: (errorString includesSubstring: 'Usage: hello [--help]'). 40 | self assert: (errorString includesSubstring: 'Unrecognized arguments: --helpe') 41 | ] 42 | 43 | { #category : 'tests' } 44 | ClapValidationTest >> testNoErrorReportingWhenNestedPositionalNotInArguments [ 45 | 46 | | spec context match validationReport errorString | 47 | spec := ClapCommandSpec id: #hello. 48 | spec addFlagWithPositional: #foo description: 'some foo'. 49 | context := ClapContext specification: spec. 50 | match := context 51 | arguments: #( 'hello' ); 52 | match. 53 | validationReport := context allValidations. 54 | 55 | errorString := (ClapValidationErrorPrinter on: validationReport) printString. 56 | self assert: validationReport isSuccess. 57 | self assert: errorString equals: '' 58 | ] 59 | -------------------------------------------------------------------------------- /src/Clap-Commands-Pharo/ClapTestRunner.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I run unit tests found in specified packages, and display their results to standard output. 3 | " 4 | Class { 5 | #name : 'ClapTestRunner', 6 | #superclass : 'ClapPharoApplication', 7 | #instVars : [ 8 | 'suite' 9 | ], 10 | #category : 'Clap-Commands-Pharo', 11 | #package : 'Clap-Commands-Pharo' 12 | } 13 | 14 | { #category : 'command line' } 15 | ClapTestRunner class >> test [ 16 | 17 | ^ (ClapCommandSpec id: #test) 18 | commandClass: self; 19 | add: ClapFlag forHelp; 20 | addFlag: #xml description: 'Output results in JUnit-compatible XML format'; 21 | addFlag: #tap description: 'Output results in Test-Anything Protocol format'; 22 | add: ((ClapPositional id: #PKG) 23 | description: 'Run tests from packages matching this pattern'; 24 | multiple: true; 25 | meaning: [ :match | match word asRegex ]); 26 | meaning: [ :args | 27 | args at: #helpFlag ifPresent: [ :help | 28 | help value; exitSuccess ]. 29 | args validateAll. 30 | 31 | (self with: args) execute ] 32 | ] 33 | 34 | { #category : 'private' } 35 | ClapTestRunner >> buildSuite [ 36 | | packageSuites | 37 | packageSuites := self packages 38 | collect: [ :each | SUnitSuiteBuilder new visit: each ] 39 | thenReject: [ :each | each tests isEmpty ]. 40 | suite := (TestSuite named: packageSuites size printString , ' packages') 41 | addTests: packageSuites 42 | ] 43 | 44 | { #category : 'execution' } 45 | ClapTestRunner >> execute [ 46 | | result | 47 | self outputStreamDo: [ :out | 48 | self suite 49 | when: TestAnnouncement 50 | do: [ :ann | out nextPutAll: ann test name; lf ] 51 | for: self; 52 | when: TestCaseAnnouncement 53 | do: [ :ann | out space; space; nextPutAll: ann testSelector; lf ] 54 | for: self. 55 | result := [ self suite run ] 56 | ensure: [ self suite unsubscribe: TestAnnouncement ]. 57 | out print: result; lf 58 | ]. 59 | 60 | self context exitSuccess 61 | ] 62 | 63 | { #category : 'accessing' } 64 | ClapTestRunner >> packagePatterns [ 65 | ^ self positional: #PKG 66 | ] 67 | 68 | { #category : 'accessing' } 69 | ClapTestRunner >> packages [ 70 | ^ self packagePatterns 71 | flatCollect: [ :regex | 72 | self packageOrganizer packages 73 | select: [ :package | regex matches: package name ]] 74 | as: Set 75 | ] 76 | 77 | { #category : 'accessing' } 78 | ClapTestRunner >> suite [ 79 | suite ifNil: [ self buildSuite ]. 80 | ^ suite 81 | ] 82 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapHelloTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapHelloTest', 3 | #superclass : 'ClapPharoCommandsTest', 4 | #category : 'Clap-Tests-Commands', 5 | #package : 'Clap-Tests', 6 | #tag : 'Commands' 7 | } 8 | 9 | { #category : 'tests' } 10 | ClapHelloTest >> testHello [ 11 | context := ClapCommandLineExamples hello activateWith: #('hello'). 12 | 13 | self assertSuccess. 14 | self 15 | assert: self outputString 16 | equals: 'hello, world.' , self lineEnding 17 | ] 18 | 19 | { #category : 'tests' } 20 | ClapHelloTest >> testHelloBothShoutingAndWhispering [ 21 | context := ClapCommandLineExamples hello activateWith: #('hello' '--shout' '--whisper'). 22 | 23 | self skip: 'should probably fail or obey the latest flag' 24 | ] 25 | 26 | { #category : 'tests' } 27 | ClapHelloTest >> testHelloFrench [ 28 | context := ClapCommandLineExamples hello activateWith: #('hello' '--language' 'fr'). 29 | 30 | self assertSuccess. 31 | self 32 | assert: self outputString 33 | equals: 'bonjour, tout le monde.' , self lineEnding 34 | ] 35 | 36 | { #category : 'tests' } 37 | ClapHelloTest >> testHelloShoutingLong [ 38 | context := ClapCommandLineExamples hello activateWith: #('hello' '--shout'). 39 | 40 | self assertSuccess. 41 | self 42 | assert: self outputString 43 | equals: 'HELLO, WORLD!' , self lineEnding 44 | ] 45 | 46 | { #category : 'tests' } 47 | ClapHelloTest >> testHelloShoutingShort [ 48 | context := ClapCommandLineExamples hello activateWith: #('hello' '-s'). 49 | 50 | self assertSuccess. 51 | self 52 | assert: self outputString 53 | equals: 'HELLO, WORLD!' , self lineEnding 54 | ] 55 | 56 | { #category : 'tests' } 57 | ClapHelloTest >> testHelloSomeone [ 58 | context := ClapCommandLineExamples hello activateWith: #('hello' 'someone'). 59 | 60 | self assertSuccess. 61 | self 62 | assert: self outputString 63 | equals: 'hello, someone.' , self lineEnding 64 | ] 65 | 66 | { #category : 'tests' } 67 | ClapHelloTest >> testHelloWhisperingLong [ 68 | context := ClapCommandLineExamples hello activateWith: #('hello' '--whisper'). 69 | 70 | self assertSuccess. 71 | self 72 | assert: self outputString 73 | equals: '(hello, world)' , self lineEnding 74 | ] 75 | 76 | { #category : 'tests' } 77 | ClapHelloTest >> testHelloWhisperingShort [ 78 | context := ClapCommandLineExamples hello activateWith: #('hello' '-w'). 79 | 80 | self assertSuccess. 81 | self 82 | assert: self outputString 83 | equals: '(hello, world)' , self lineEnding 84 | ] 85 | -------------------------------------------------------------------------------- /src/Clap-Commands-Pharo/ClapPharoVersion.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I report release and version information about the image and VM, in various formats. 3 | " 4 | Class { 5 | #name : 'ClapPharoVersion', 6 | #superclass : 'ClapPharoApplication', 7 | #category : 'Clap-Commands-Pharo', 8 | #package : 'Clap-Commands-Pharo' 9 | } 10 | 11 | { #category : 'command line' } 12 | ClapPharoVersion class >> version [ 13 | 14 | 15 | ^ (ClapCommandSpec id: #version) 16 | description: 'Displays version information, in various formats'; 17 | commandClass: self; 18 | addHelp; 19 | addFlag: #full description: 'Full image version (default format)'; 20 | addFlag: #release description: 'Major.minor alpha/stable'; 21 | addFlag: #numeric description: '5-digit sequential integration number'; 22 | addFlag: #hash description: 'Integration commit hash'; 23 | addFlag: #vm description: 'VM build and version'; 24 | addFlag: #license description: 'Licensing and copyright'; 25 | yourself 26 | ] 27 | 28 | { #category : 'execution' } 29 | ClapPharoVersion >> execute [ 30 | self showVersionsNamed: self formats 31 | ] 32 | 33 | { #category : 'accessing' } 34 | ClapPharoVersion >> formatSelectorFor: formatName [ 35 | ^ formatName asSymbol , #VersionString 36 | ] 37 | 38 | { #category : 'accessing' } 39 | ClapPharoVersion >> formatStringFor: formatName [ 40 | ^ self perform: (self formatSelectorFor: formatName) 41 | ] 42 | 43 | { #category : 'accessing' } 44 | ClapPharoVersion >> formats [ 45 | ^ self flags ifEmpty: [ #(full) ] 46 | ] 47 | 48 | { #category : 'version strings' } 49 | ClapPharoVersion >> fullVersionString [ 50 | ^ SystemVersion current imageVersionString 51 | ] 52 | 53 | { #category : 'version strings' } 54 | ClapPharoVersion >> hashVersionString [ 55 | ^ SystemVersion current commitHash 56 | ] 57 | 58 | { #category : 'version strings' } 59 | ClapPharoVersion >> licenseVersionString [ 60 | ^ Smalltalk licenseString 61 | ] 62 | 63 | { #category : 'version strings' } 64 | ClapPharoVersion >> numericVersionString [ 65 | ^ SystemVersion current highestUpdate printString 66 | ] 67 | 68 | { #category : 'version strings' } 69 | ClapPharoVersion >> releaseVersionString [ 70 | ^ SystemVersion current shortVersionString 71 | ] 72 | 73 | { #category : 'printing' } 74 | ClapPharoVersion >> showVersionsNamed: formatNames [ 75 | | out | 76 | out := self context stdout. 77 | formatNames do: [ :each | 78 | out nextPutAll: (self formatStringFor: each); lf ]. 79 | out flush 80 | ] 81 | 82 | { #category : 'version strings' } 83 | ClapPharoVersion >> vmVersionString [ 84 | ^ Smalltalk vm version 85 | ] 86 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapFlag.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent a flag (also called option). 3 | 4 | A flag is recognized by its form, starting with dashes (e.g. `--foo` in long form or `-f` in short form). Often, flags are optional and take a boolean meaning representing their presence or absence, but they can also be used as named parameters or to accept complex values in the form of positionals. 5 | " 6 | Class { 7 | #name : 'ClapFlag', 8 | #superclass : 'ClapParameterized', 9 | #category : 'Clap-Core-Specification', 10 | #package : 'Clap-Core', 11 | #tag : 'Specification' 12 | } 13 | 14 | { #category : 'evaluating' } 15 | ClapFlag class >> basicMeaning [ 16 | ^ [ :match | 17 | match isExplicit and: [ match isMatch ] ] 18 | ] 19 | 20 | { #category : 'predefined flags' } 21 | ClapFlag class >> forHelp [ 22 | ^ (self id: #help) 23 | description: 'Prints this documentation'; 24 | canonicalName: 'help' 25 | ] 26 | 27 | { #category : 'adding' } 28 | ClapFlag >> addPositional: aPositional [ 29 | super addPositional: aPositional. 30 | implicitMeaningBlock := aPositional implicitMeaning. 31 | ] 32 | 33 | { #category : 'adding' } 34 | ClapFlag >> addTo: parentParameter [ 35 | ^ parentParameter addFlag: self 36 | ] 37 | 38 | { #category : 'matching - testing' } 39 | ClapFlag >> canMatchWith: word [ 40 | ^ word = self shortForm 41 | or: [ word = self longForm ] 42 | ] 43 | 44 | { #category : 'testing' } 45 | ClapFlag >> isFlag [ 46 | 47 | ^ true 48 | ] 49 | 50 | { #category : 'accessing' } 51 | ClapFlag >> longForm [ 52 | ^ '--' , self canonicalName 53 | ] 54 | 55 | { #category : 'initialization' } 56 | ClapFlag >> meaningCollection [ 57 | self meaning: [ :match | match positionalValues ] 58 | ] 59 | 60 | { #category : 'initialization' } 61 | ClapFlag >> meaningScalar [ 62 | "Should only be allowed when there's a single positional" 63 | self meaning: [ :match | (match at: self positionals first) value ] 64 | ] 65 | 66 | { #category : 'accessing' } 67 | ClapFlag >> positionalIdentifier [ 68 | ^ ClapPositional idFrom: self identifier 69 | ] 70 | 71 | { #category : 'accessing' } 72 | ClapFlag >> shortForm [ 73 | ^ '-' , self shortName 74 | ] 75 | 76 | { #category : 'accessing' } 77 | ClapFlag >> shortName [ 78 | ^ self canonicalName copyFrom: 1 to: 1 79 | ] 80 | 81 | { #category : 'documenting' } 82 | ClapFlag >> synopsisOn: aStream [ 83 | aStream 84 | nextPutAll: '--'; 85 | nextPutAll: self canonicalName. 86 | 87 | self positionals 88 | ifNotEmpty: [ 89 | aStream 90 | nextPutAll: ' <'; 91 | nextPutAll: (Character space join: (self positionals collect: #canonicalName)); 92 | nextPut: $> ] 93 | ] 94 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapDocumentationFormatter.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I wrap a stream and generate documentation in a concrete format. 3 | 4 | The intent is that sister classes will implement various concrete formats (HTML, Man page, LaTeX, colored terminal output…) 5 | " 6 | Class { 7 | #name : 'ClapDocumentationFormatter', 8 | #superclass : 'Object', 9 | #instVars : [ 10 | 'stream' 11 | ], 12 | #category : 'Clap-Core-Documentation', 13 | #package : 'Clap-Core', 14 | #tag : 'Documentation' 15 | } 16 | 17 | { #category : 'instance creation' } 18 | ClapDocumentationFormatter class >> on: aCharacterWriteStream [ 19 | ^ self new 20 | stream: aCharacterWriteStream; 21 | yourself 22 | ] 23 | 24 | { #category : 'accessing' } 25 | ClapDocumentationFormatter >> columnIndent [ 26 | ^ 16 27 | ] 28 | 29 | { #category : 'accessing' } 30 | ClapDocumentationFormatter >> columnSeparation [ 31 | ^ 3 32 | ] 33 | 34 | { #category : 'accessing' } 35 | ClapDocumentationFormatter >> contents [ 36 | ^ stream contents 37 | ] 38 | 39 | { #category : 'flushing' } 40 | ClapDocumentationFormatter >> flush [ 41 | stream flush 42 | ] 43 | 44 | { #category : 'accessing' } 45 | ClapDocumentationFormatter >> listIndent [ 46 | ^ 4 47 | ] 48 | 49 | { #category : 'formattting' } 50 | ClapDocumentationFormatter >> newLine [ 51 | ^ stream newLine 52 | ] 53 | 54 | { #category : 'formattting' } 55 | ClapDocumentationFormatter >> section: titleString with: contentsBlock [ 56 | | contents | 57 | contents := self class new. 58 | contentsBlock value: contents. 59 | 60 | contents isEmpty ifFalse: [ 61 | stream 62 | nextPutAll: titleString; nextPut: $:; 63 | newLine; 64 | nextPutAll: contents contents ] 65 | ] 66 | 67 | { #category : 'accessing' } 68 | ClapDocumentationFormatter >> space [ 69 | ^ stream space 70 | ] 71 | 72 | { #category : 'formattting' } 73 | ClapDocumentationFormatter >> space: anInteger [ 74 | anInteger timesRepeat: [ stream space ] 75 | ] 76 | 77 | { #category : 'initialization' } 78 | ClapDocumentationFormatter >> stream: aStream [ 79 | stream := (aStream respondsTo: #newLine) 80 | ifTrue: [ aStream ] 81 | ifFalse: [ ZnNewLineWriterStream on: aStream ] 82 | ] 83 | 84 | { #category : 'formattting' } 85 | ClapDocumentationFormatter >> tabularize: associations [ 86 | associations do: [ :each | 87 | | keyWidth | 88 | keyWidth := each key size + self listIndent. 89 | self space: self listIndent. 90 | stream nextPutAll: each key. 91 | keyWidth + self columnSeparation > self columnIndent 92 | ifTrue: [ self newLine; space: self columnIndent ] 93 | ifFalse: [ self space: self columnIndent - keyWidth ]. 94 | stream nextPutAll: each value. 95 | self newLine ] 96 | ] 97 | 98 | { #category : 'formattting' } 99 | ClapDocumentationFormatter >> text: aString [ 100 | stream nextPutAll: aString 101 | ] 102 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapHelloWorldTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapHelloWorldTest', 3 | #superclass : 'TestCase', 4 | #instVars : [ 5 | 'hello' 6 | ], 7 | #category : 'Clap-Tests-Integration', 8 | #package : 'Clap-Tests', 9 | #tag : 'Integration' 10 | } 11 | 12 | { #category : 'running' } 13 | ClapHelloWorldTest >> setUp [ 14 | super setUp. 15 | hello := (ClapCommandSpec id: #hello) 16 | add: (ClapFlag id: #shout); 17 | add: (ClapPositional id: #who) 18 | ] 19 | 20 | { #category : 'tests - matching' } 21 | ClapHelloWorldTest >> testHello [ 22 | | match | 23 | match := hello match: #('hello'). 24 | 25 | self deny: match isMismatch. 26 | self deny: (match includesMatchOf: #shout). 27 | self deny: (match includesMatchOf: #who) 28 | ] 29 | 30 | { #category : 'tests - matching' } 31 | ClapHelloWorldTest >> testHelloWorld [ 32 | | match | 33 | match := hello match: #('hello' 'world'). 34 | 35 | self deny: match isMismatch. 36 | self deny: (match includesMatchOf: #shout). 37 | self assert: (match includesMatchOf: #who). 38 | self 39 | assert: (match at: #who) word 40 | equals: 'world'. 41 | self 42 | assert: (match at: #who) parent 43 | identicalTo: match 44 | ] 45 | 46 | { #category : 'tests - matching' } 47 | ClapHelloWorldTest >> testLanguageFlag [ 48 | | match lang | 49 | lang := ClapPositional id: #language. 50 | hello add: ((ClapFlag id: #lang) 51 | add: lang; 52 | meaning: [ :flag | (flag at: lang) value]). 53 | 54 | match := hello match: #('hello' 'monde' '--lang' 'fr' '--shout'). 55 | 56 | self deny: match isMismatch. 57 | self assert: (match includesMatchOf: #shout). 58 | self assert: (match includesMatchOf: #who). 59 | self 60 | assert: (match at: #who) word 61 | equals: 'monde'. 62 | self assert: (match includesMatchOf: #lang). 63 | self assert: ((match at: #lang) includesMatchOf: #language). 64 | self 65 | assert: (match at: #lang) value 66 | equals: 'fr'. 67 | self flag: 'needs a context'. "((match atName: 'lang') at: lang) context should be: match." 68 | ] 69 | 70 | { #category : 'tests - matching' } 71 | ClapHelloWorldTest >> testShouting [ 72 | | match | 73 | match := hello match: #('hello' '--shout'). 74 | 75 | self deny: match isMismatch. 76 | self assert: (match includesMatchOf: #shout). 77 | self deny: (match includesMatchOf: #who) 78 | ] 79 | 80 | { #category : 'tests - matching' } 81 | ClapHelloWorldTest >> testShoutingAfterthought [ 82 | | match | 83 | match := hello match: #('hello' 'world' '-s'). 84 | 85 | self deny: match isMismatch. 86 | self assert: (match includesMatchOf: #shout). 87 | self assert: (match includesMatchOf: #who) 88 | ] 89 | 90 | { #category : 'tests - matching' } 91 | ClapHelloWorldTest >> testShoutingWorld [ 92 | | match | 93 | match := hello match: #('hello' '--shout' 'world'). 94 | 95 | self deny: match isMismatch. 96 | self assert: (match includesMatchOf: #shout). 97 | self assert: (match includesMatchOf: #who) 98 | ] 99 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapPharoVersionTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapPharoVersionTest', 3 | #superclass : 'ClapPharoCommandsTest', 4 | #category : 'Clap-Tests-Commands', 5 | #package : 'Clap-Tests', 6 | #tag : 'Commands' 7 | } 8 | 9 | { #category : 'tests' } 10 | ClapPharoVersionTest >> testDefaultFormat [ 11 | context := ClapPharoVersion version activateWith: #('version'). 12 | 13 | self assertSuccess. 14 | self 15 | assert: self outputString 16 | equals: SystemVersion current imageVersionString , self lineEnding 17 | ] 18 | 19 | { #category : 'tests' } 20 | ClapPharoVersionTest >> testFullFormat [ 21 | context := ClapPharoVersion version activateWith: #('version' '--full'). 22 | 23 | self assertSuccess. 24 | self 25 | assert: self outputString 26 | equals: SystemVersion current imageVersionString , self lineEnding 27 | ] 28 | 29 | { #category : 'tests' } 30 | ClapPharoVersionTest >> testHashFormat [ 31 | context := ClapPharoVersion version activateWith: #('version' '--hash'). 32 | 33 | self assertSuccess. 34 | self 35 | assert: self outputString 36 | equals: SystemVersion current commitHash , self lineEnding 37 | ] 38 | 39 | { #category : 'tests' } 40 | ClapPharoVersionTest >> testHelpFlag [ 41 | context := ClapPharoVersion version activateWith: #('version' '--help'). 42 | 43 | self assertSuccess. 44 | self 45 | assert: self outputString lines first 46 | equals: 'Displays version information, in various formats' 47 | ] 48 | 49 | { #category : 'tests' } 50 | ClapPharoVersionTest >> testLicenseFormat [ 51 | context := ClapPharoVersion version activateWith: #('version' '--license'). 52 | 53 | self assertSuccess. 54 | self 55 | assert: self outputString trim 56 | equals: (Smalltalk licenseString withLineEndings: self lineEnding) 57 | ] 58 | 59 | { #category : 'tests' } 60 | ClapPharoVersionTest >> testMultipleFormats [ 61 | | lines | 62 | context := ClapPharoVersion version activateWith: #('version' '--hash' '--release' '--numeric'). 63 | 64 | self assertSuccess. 65 | lines := self outputString lines. 66 | self 67 | assert: (lines at: 1) 68 | equals: SystemVersion current commitHash. 69 | self 70 | assert: (lines at: 2) 71 | equals: SystemVersion current shortVersionString. 72 | self 73 | assert: (lines at: 3) 74 | equals: SystemVersion current highestUpdate printString 75 | ] 76 | 77 | { #category : 'tests' } 78 | ClapPharoVersionTest >> testNumericFormat [ 79 | context := ClapPharoVersion version activateWith: #('version' '--numeric'). 80 | 81 | self assertSuccess. 82 | self 83 | assert: self outputString 84 | equals: SystemVersion current highestUpdate printString , self lineEnding 85 | ] 86 | 87 | { #category : 'tests' } 88 | ClapPharoVersionTest >> testReleaseFormat [ 89 | context := ClapPharoVersion version activateWith: #('version' '--release'). 90 | 91 | self assertSuccess. 92 | self 93 | assert: self outputString 94 | equals: SystemVersion current shortVersionString , self lineEnding 95 | ] 96 | 97 | { #category : 'tests' } 98 | ClapPharoVersionTest >> testVmFormat [ 99 | context := ClapPharoVersion version activateWith: #('version' '--vm'). 100 | 101 | self assertSuccess. 102 | self 103 | assert: self outputString 104 | equals: (Smalltalk vm version withLineEndings: self lineEnding) 105 | ] 106 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapParameterized.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am an abstract class specifying a parameter with nested positional parameters. 3 | " 4 | Class { 5 | #name : 'ClapParameterized', 6 | #superclass : 'ClapParameter', 7 | #instVars : [ 8 | 'parameters', 9 | 'positionals', 10 | 'aliases' 11 | ], 12 | #category : 'Clap-Core-Specification', 13 | #package : 'Clap-Core', 14 | #tag : 'Specification' 15 | } 16 | 17 | { #category : 'testing' } 18 | ClapParameterized class >> isAbstract [ 19 | ^ self == ClapParameterized 20 | ] 21 | 22 | { #category : 'adding' } 23 | ClapParameterized >> add: aParameter [ 24 | parameters 25 | at: aParameter identifier 26 | ifPresent: [ :param | self signalIdentifierConflictOf: aParameter with: param ] 27 | ifAbsentPut: aParameter. 28 | ^ aParameter addTo: self 29 | ] 30 | 31 | { #category : 'adding' } 32 | ClapParameterized >> addAll: someParameters [ 33 | someParameters do: [ :each | self add: each ] 34 | ] 35 | 36 | { #category : 'adding' } 37 | ClapParameterized >> addPositional: aPositional [ 38 | positionals add: aPositional 39 | ] 40 | 41 | { #category : 'accessing' } 42 | ClapParameterized >> aliases [ 43 | ^ aliases 44 | ] 45 | 46 | { #category : 'initialization' } 47 | ClapParameterized >> aliases: aCollection [ 48 | aliases := aCollection 49 | ] 50 | 51 | { #category : 'accessing' } 52 | ClapParameterized >> at: identifierOrSpec [ 53 | ^ parameters at: identifierOrSpec asClapIdentifier 54 | ] 55 | 56 | { #category : 'accessing' } 57 | ClapParameterized >> at: identifierOrSpec ifAbsent: absentBlock [ 58 | ^ parameters at: identifierOrSpec asClapIdentifier 59 | ifAbsent: absentBlock 60 | ] 61 | 62 | { #category : 'accessing' } 63 | ClapParameterized >> at: identifierOrSpec ifPresent: presentBlock [ 64 | ^ parameters 65 | at: identifierOrSpec asClapIdentifier 66 | ifPresent: presentBlock 67 | ] 68 | 69 | { #category : 'accessing' } 70 | ClapParameterized >> at: identifierOrSpec ifPresent: presentBlock ifAbsent: absentBlock [ 71 | ^ parameters 72 | at: identifierOrSpec asClapIdentifier 73 | ifPresent: presentBlock 74 | ifAbsent: absentBlock 75 | ] 76 | 77 | { #category : 'testing' } 78 | ClapParameterized >> hasAlias: aString [ 79 | ^ aString = self canonicalName or: [ self aliases includes: aString ] 80 | 81 | ] 82 | 83 | { #category : 'testing' } 84 | ClapParameterized >> hasPositional [ 85 | 86 | ^ self positionals notEmpty 87 | ] 88 | 89 | { #category : 'initialization' } 90 | ClapParameterized >> initialize [ 91 | super initialize. 92 | parameters := OrderedDictionary new. 93 | positionals := OrderedCollection new. 94 | aliases := #() 95 | ] 96 | 97 | { #category : 'accessing' } 98 | ClapParameterized >> matchClass [ 99 | ^ ClapNamedMatch 100 | ] 101 | 102 | { #category : 'enumerating' } 103 | ClapParameterized >> parametersDo: aBlock [ 104 | positionals do: aBlock 105 | ] 106 | 107 | { #category : 'enumerating' } 108 | ClapParameterized >> parametersSelect: selectBlock thenDo: doBlock [ 109 | self parametersDo: [ :each | 110 | (selectBlock value: each) 111 | ifTrue: [ doBlock value: each ] 112 | ] 113 | ] 114 | 115 | { #category : 'accessing' } 116 | ClapParameterized >> positionals [ 117 | ^ positionals 118 | ] 119 | 120 | { #category : 'private' } 121 | ClapParameterized >> signalIdentifierConflictOf: newParameter with: currentParameter [ 122 | Error signal: 'Identifier conflict (' , newParameter identifier , ')' 123 | ] 124 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapExpression.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a concrete manifestation (a match) of my specification (a ClapParameter) in the context of a specific command-line invocation. 3 | 4 | " 5 | Class { 6 | #name : 'ClapExpression', 7 | #superclass : 'Object', 8 | #instVars : [ 9 | 'specification' 10 | ], 11 | #category : 'Clap-Core-Activation', 12 | #package : 'Clap-Core', 13 | #tag : 'Activation' 14 | } 15 | 16 | { #category : 'testing' } 17 | ClapExpression class >> isAbstract [ 18 | ^ self == ClapExpression 19 | ] 20 | 21 | { #category : 'instance creation' } 22 | ClapExpression class >> specification: aParameter [ 23 | ^ self new 24 | specification: aParameter; 25 | yourself 26 | ] 27 | 28 | { #category : 'validation' } 29 | ClapExpression >> allValidations [ 30 | ^ self context allValidations 31 | ] 32 | 33 | { #category : 'accessing' } 34 | ClapExpression >> context [ 35 | ^ self subclassResponsibility 36 | ] 37 | 38 | { #category : 'evaluating' } 39 | ClapExpression >> exitSuccess [ 40 | ^ self context exitSuccess 41 | ] 42 | 43 | { #category : 'testing' } 44 | ClapExpression >> ifMatch: aBlock [ 45 | ^ self 46 | ifMatch: aBlock 47 | ifMismatch: [ self ] 48 | ] 49 | 50 | { #category : 'testing' } 51 | ClapExpression >> ifMatch: matchBlock ifMismatch: mismatchBlock [ 52 | ^ self subclassResponsibility 53 | ] 54 | 55 | { #category : 'testing' } 56 | ClapExpression >> ifMismatch: aBlock [ 57 | ^ self 58 | ifMatch: [ self ] 59 | ifMismatch: aBlock 60 | ] 61 | 62 | { #category : 'testing' } 63 | ClapExpression >> isClapContext [ 64 | 65 | ^ false 66 | ] 67 | 68 | { #category : 'testing' } 69 | ClapExpression >> isFullMatch [ 70 | 71 | "This method is used to test if flags with positionals are a full match, 72 | i.e. a matched flag has no positional or its positionals are matched. 73 | See `ClapNamedMatch >> #isFullMatch` " 74 | ^ true 75 | ] 76 | 77 | { #category : 'testing' } 78 | ClapExpression >> isMatch [ 79 | ^ self 80 | ifMatch: [ true ] 81 | ifMismatch: [ false ] 82 | ] 83 | 84 | { #category : 'testing' } 85 | ClapExpression >> isMatchOf: identifierOrSpec [ 86 | ^ identifierOrSpec identifiesClapParameter: self specification 87 | ] 88 | 89 | { #category : 'testing' } 90 | ClapExpression >> isMismatch [ 91 | ^ self 92 | ifMatch: [ false ] 93 | ifMismatch: [ true ] 94 | ] 95 | 96 | { #category : 'testing' } 97 | ClapExpression >> isValid [ 98 | "Semantic validation, post-parse" 99 | self flag: 'obsolete?'. 100 | ^ self allValidations isSuccess 101 | ] 102 | 103 | { #category : 'validation' } 104 | ClapExpression >> isValid: aValidation [ 105 | 106 | self subclassResponsibility 107 | ] 108 | 109 | { #category : 'accessing' } 110 | ClapExpression >> specification [ 111 | ^ specification 112 | ] 113 | 114 | { #category : 'initialization' } 115 | ClapExpression >> specification: anArgumentSpec [ 116 | specification := anArgumentSpec 117 | ] 118 | 119 | { #category : 'validation' } 120 | ClapExpression >> validate: aClapValidationClass on: aReport [ 121 | "Recursively validate the receiver and any subexpressions, enriching aReport" 122 | 123 | self specification 124 | validate: aClapValidationClass on: aReport match: self 125 | ] 126 | 127 | { #category : 'validation' } 128 | ClapExpression >> validateAll [ 129 | "Validate the activation as a whole, or report and exit." 130 | self context validateAll 131 | ] 132 | 133 | { #category : 'validation' } 134 | ClapExpression >> validateOn: aReport [ 135 | "Recursively validate the receiver and any subexpressions, enriching aReport" 136 | 137 | self specification 138 | validate: self on: aReport 139 | ] 140 | 141 | { #category : 'evaluating' } 142 | ClapExpression >> value [ 143 | 144 | ^ self value: nil 145 | ] 146 | 147 | { #category : 'evaluating' } 148 | ClapExpression >> value: arg [ 149 | ^ specification valueFor: self with: arg 150 | ] 151 | -------------------------------------------------------------------------------- /src/Clap-Core/ClapApplication.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I define basic boilerplate for delegating commandline behavior to the instance side, passing the arguments match. 3 | 4 | Declare the main commandline in a class-side method, concluding the main meaning block as follows: 5 | 6 | somethingCommandline 7 | 8 | ^ (ClapCommand withName: 'something') 9 | ""... description, parameters, etc"" 10 | meaning: [ :args | 11 | ""... preliminary checks"" 12 | (self with: args) execute ] 13 | " 14 | Class { 15 | #name : 'ClapApplication', 16 | #superclass : 'Object', 17 | #instVars : [ 18 | 'context' 19 | ], 20 | #category : 'Clap-Core-Specification', 21 | #package : 'Clap-Core', 22 | #tag : 'Specification' 23 | } 24 | 25 | { #category : 'instance creation' } 26 | ClapApplication class >> with: aClapContext [ 27 | ^ self new 28 | setContext: aClapContext; 29 | yourself 30 | ] 31 | 32 | { #category : 'accessing' } 33 | ClapApplication >> commandSpecIdentifiers [ 34 | ^ self commandSpecs collect: [ :spec | spec identifier ] 35 | ] 36 | 37 | { #category : 'accessing' } 38 | ClapApplication >> commandSpecs [ 39 | 40 | ^ self context commandMatches collect: [ :match | 41 | match specification ] 42 | ] 43 | 44 | { #category : 'accessing' } 45 | ClapApplication >> context [ 46 | ^ context 47 | ] 48 | 49 | { #category : 'private' } 50 | ClapApplication >> defaultValueFor: aFlagIdentifier [ 51 | 52 | ^ self context 53 | defaultValueFor: aFlagIdentifier asSymbol 54 | in: self 55 | noneBlock: [ NotFound signal: 'Cannot find ' , aFlagIdentifier asSymbol, '!' ] 56 | ] 57 | 58 | { #category : 'execution' } 59 | ClapApplication >> execute [ 60 | self subclassResponsibility 61 | ] 62 | 63 | { #category : 'execution' } 64 | ClapApplication >> executeOrPrintHelp [ 65 | (self hasFlag: #help) 66 | ifTrue: [ self printHelp. self exitSuccess ] 67 | ifFalse: [ self execute ] 68 | ] 69 | 70 | { #category : 'execution' } 71 | ClapApplication >> exitSuccess [ 72 | ^ self context exitSuccess 73 | ] 74 | 75 | { #category : 'accessing' } 76 | ClapApplication >> flags [ 77 | ^ self context flags 78 | collect: [ :match | match specification identifier ] 79 | ] 80 | 81 | { #category : 'testing' } 82 | ClapApplication >> hasFlag: anIdentifier [ 83 | 84 | ^ self context hasFlag: anIdentifier asSymbol 85 | ] 86 | 87 | { #category : 'execution' } 88 | ClapApplication >> outputStreamDo: aBlock [ 89 | aBlock value: self context stdout 90 | ] 91 | 92 | { #category : 'accessing' } 93 | ClapApplication >> positional: aFlagIdentifier [ 94 | "Get the value of a positional with given identifier" 95 | 96 | ^ [ self rawPositional: aFlagIdentifier ] 97 | on: NotFound 98 | do: [ self defaultValueFor: aFlagIdentifier ] 99 | ] 100 | 101 | { #category : 'accessing' } 102 | ClapApplication >> positional: anIdentifier ifPresent: aBlock [ 103 | "Execute aBlock if a positional with the identifier is found. The positional valu will be passed as first argument of the block" 104 | 105 | [ aBlock value: (self positional: anIdentifier) ] 106 | on: NotFound 107 | do: [ "ignore" ] 108 | ] 109 | 110 | { #category : 'execution' } 111 | ClapApplication >> printHelp [ 112 | (ClapDocumenter on: (ZnCharacterWriteStream on: self context stdout)) 113 | explainContext: self context 114 | 115 | ] 116 | 117 | { #category : 'private' } 118 | ClapApplication >> rawPositional: anIdentifier [ 119 | "We get positionals but a NotFound error can be signaled." 120 | 121 | | matches values | 122 | matches := self context positional: anIdentifier asSymbol. 123 | values := matches collect: [ :match | 124 | match specification isFlag 125 | ifTrue: [ match child value ] 126 | ifFalse: [ match value ] ]. 127 | 128 | ^ matches first specification isMultiple 129 | ifTrue: [ values ] 130 | ifFalse: [ values first ] 131 | ] 132 | 133 | { #category : 'accessing' } 134 | ClapApplication >> setContext: aClapContext [ 135 | context := aClapContext 136 | ] 137 | -------------------------------------------------------------------------------- /src/Clap-Tests/ClapCommandSpecTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'ClapCommandSpecTest', 3 | #superclass : 'ClapParameterizedTest', 4 | #category : 'Clap-Tests-Unit', 5 | #package : 'Clap-Tests', 6 | #tag : 'Unit' 7 | } 8 | 9 | { #category : 'accessing' } 10 | ClapCommandSpecTest >> classToTest [ 11 | ^ ClapCommandSpec 12 | ] 13 | 14 | { #category : 'tests' } 15 | ClapCommandSpecTest >> testAddFlag [ 16 | | subject flag | 17 | subject := self namedSubject. 18 | flag := ClapFlag id: #flag. 19 | subject add: flag. 20 | 21 | self assert: (subject flags includes: flag) 22 | ] 23 | 24 | { #category : 'tests' } 25 | ClapCommandSpecTest >> testAddSubcommand [ 26 | | subject cmd | 27 | subject := self namedSubject. 28 | cmd := ClapCommandSpec id: #cmd. 29 | subject add: cmd. 30 | 31 | self assert: (subject subcommands includes: cmd) 32 | ] 33 | 34 | { #category : 'tests' } 35 | ClapCommandSpecTest >> testMatches [ 36 | | subject arg argv ctx match | 37 | subject := self namedSubject. 38 | arg := self subjectName copy. 39 | argv := { arg. #remainder } readStream. 40 | ctx := ClapContext new. 41 | 42 | match := subject matchOn: argv in: ctx. 43 | 44 | self deny: match isMismatch. 45 | self assert: match specification identicalTo: subject. 46 | self assert: match parent identicalTo: ctx. 47 | self assert: match word equals: arg. 48 | self assert: argv next equals: #remainder 49 | ] 50 | 51 | { #category : 'tests' } 52 | ClapCommandSpecTest >> testMatchesWithSingleFlag [ 53 | | subject argv args match | 54 | subject := self namedSubject. 55 | subject add: (ClapFlag id: #bar). 56 | args := { self subjectName . '--bar' . #remainder }. 57 | argv := args readStream. 58 | 59 | match := subject matchOn: argv in: (subject activationWith: args). 60 | 61 | self deny: match isMismatch. 62 | self assert: (match includesMatchOf: #bar). 63 | self assert: argv next equals: #remainder 64 | ] 65 | 66 | { #category : 'tests' } 67 | ClapCommandSpecTest >> testMatchesWithSinglePositional [ 68 | | subject args argv match | 69 | subject := self namedSubject. 70 | subject add: (ClapPositional id: #bar). 71 | args := { self subjectName copy. 'valueforbar'. #remainder }. 72 | argv := args readStream. 73 | 74 | match := subject matchOn: argv in: (subject activationWith: args). 75 | 76 | self deny: match isMismatch. 77 | self assert: match word equals: self subjectName. 78 | self assert: (match includesMatchOf: #bar). 79 | self 80 | assert: (match at: #bar) word 81 | equals: 'valueforbar'. 82 | self assert: argv next equals: #remainder 83 | ] 84 | 85 | { #category : 'tests' } 86 | ClapCommandSpecTest >> testMatchesWithSingleSubcommand [ 87 | | subject args argv match | 88 | subject := self namedSubject. 89 | subject add: (ClapCommandSpec id: #bar). 90 | args := { self subjectName. 'bar'. #remainder }. 91 | argv := args readStream. 92 | 93 | match := subject matchOn: argv in: (subject activationWith: args). 94 | 95 | self deny: match isMismatch. 96 | self assert: (match includesMatchOf: #bar). 97 | self assert: argv next equals: #remainder 98 | ] 99 | 100 | { #category : 'tests' } 101 | ClapCommandSpecTest >> testMatchingStopsAtWrongFlag [ 102 | | subject args argv badFlag match | 103 | subject := self namedSubject. 104 | subject add: (ClapFlag id: #bar). 105 | badFlag := '--notbar'. 106 | args := { self subjectName. badFlag }. 107 | argv := args readStream. 108 | 109 | match := subject matchOn: argv in: (subject activationWith: args). 110 | 111 | self assert: match isMatch. 112 | self assert: argv next identicalTo: badFlag 113 | ] 114 | 115 | { #category : 'tests' } 116 | ClapCommandSpecTest >> testMismatchesDifferentAlias [ 117 | | subject argv badCommand match | 118 | subject := self namedSubject. 119 | badCommand := self subjectName , 'NOT'. 120 | argv := { badCommand } readStream. 121 | 122 | match := subject matchOn: argv in: Object new. 123 | 124 | self assert: match isMismatch. 125 | self assert: argv next identicalTo: badCommand 126 | ] 127 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # CLAP — Command line argument parser for Pharo 2 | [![Build Status][travis-status]][travis] 3 | [![Coverage Status][coveralls-status]][coveralls] 4 | 5 | Named after and inspired by [clap-rs](https://github.com/kbknapp/clap-rs), but 6 | this is an independent implementation. 7 | 8 |

9 | Terminal screencast demo 10 |

11 | 12 | CLAP project is after major refactoring (due to needs raised by [PharoLauncher CLI](https://github.com/pharo-project/pharo-launcher/tree/feature/cmd-line/src/PharoLauncher-CLI)) and should be more stable now. It means main pieces are 13 | there but some features are still missing and eventually may force changes in the design in rare cases. 14 | 15 | ### Loading instructions 16 | 17 | Pharo image already contains stable version of CLAP, but you can load latest version of project by: 18 | 19 | ```smalltalk 20 | Metacello new 21 | baseline: 'Clap'; 22 | repository: 'github://pharo-contributions/clap-st/src'; 23 | load. 24 | ``` 25 | 26 | #### starting from the shell 27 | 28 | ```shell 29 | git clone https://github.com/pharo-contributions/clap-st.git 30 | cd clap-st 31 | curl https://get.pharo.org/64/ | bash 32 | ``` 33 | 34 | …and then, in the image just downloaded, open a workspace and evaluate: 35 | 36 | ```smalltalk 37 | Metacello new 38 | baseline: 'Clap'; 39 | repository: 'gitlocal://./src'; 40 | load. 41 | ``` 42 | 43 | Shameless plug: I work with [Fari](https://people.untyped.org/fari.sh) and 44 | [direnv](https://direnv.net) to automate building and launching the development image: 45 | 46 | ```shell 47 | # setup $PHARO 48 | fari build 49 | fari run 50 | ``` 51 | 52 | ### Defining and invoking commands 53 | 54 | Commands and subcommands (their specification) are instances of `#ClapCommandSpec`. To make a command 55 | accessible from the command line, return it from a class-side factory method 56 | with the `` pragma. Such class-side method should be defined on user-defined subclass of `ClapApplication`. For instance, here's how we declare the 57 | traditional *hello, world!* example, with the actual behavior delegated the 58 | instance-side method `ClapCommandLineExamples >> sayHello`: 59 | 60 | ```smalltalk 61 | hello 62 | "The usual Hello-World example, demonstrating a Clap command with a couple features." 63 |