SystemOrganization addCategory: #'TextLint-Tests'! SystemOrganization addCategory: #'TextLint-Model'! TestCase subclass: #TLHoweverRuleTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Tests'! !TLHoweverRuleTest methodsFor: 'test' stamp: 'JorgeRessia 4/1/2010 20:55'! testFailure | aRule aWord aDocument anotherWord aSentence words sentences aParagraph paragraphs| aWord := TLWord with: (PPToken on: 'However'). anotherWord := TLWord with: (PPToken on: 'test'). words := OrderedCollection with: aWord with: anotherWord. aSentence := TLSentence withAll: words. sentences := OrderedCollection with: aSentence. aParagraph := TLParagraph withAll: sentences. paragraphs := OrderedCollection with: aParagraph. aDocument := TLDocument withAll: paragraphs. aRule := TLHoweverRule new. aRule runOn: aDocument. self assert: aRule results size = 1. ! ! !TLHoweverRuleTest methodsFor: 'test' stamp: 'JorgeRessia 4/1/2010 20:56'! testSuccess | aRule aWord aDocument anotherWord aSentence words sentences aParagraph paragraphs| aWord := TLWord with: (PPToken on: 'test'). anotherWord := TLWord with: (PPToken on: 'test'). words := OrderedCollection with: aWord with: anotherWord. aSentence := TLSentence withAll: words. sentences := OrderedCollection with: aSentence. aParagraph := TLParagraph withAll: sentences. paragraphs := OrderedCollection with: aParagraph. aDocument := TLDocument withAll: paragraphs. aRule := TLHoweverRule new. aRule runOn: aDocument. self assert: aRule results size = 0. ! ! TestCase subclass: #TLOneOfTheMostRuleTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Tests'! !TLOneOfTheMostRuleTest methodsFor: 'test' stamp: 'JorgeRessia 4/2/2010 08:33'! testFailure | aRule aWord aDocument anotherWord aSentence words sentences aParagraph paragraphs| words := OrderedCollection new. words add: (TLWord with: (PPToken on: 'One')). words add: (TLWord with: (PPToken on: 'of')). words add: (TLWord with: (PPToken on: 'the')). words add: (TLWord with: (PPToken on: 'most')). aSentence := TLSentence withAll: words. sentences := OrderedCollection with: aSentence. aParagraph := TLParagraph withAll: sentences. paragraphs := OrderedCollection with: aParagraph. aDocument := TLDocument withAll: paragraphs. aRule := TLOneOfTheMostRule new. aRule runOn: aDocument. self assert: aRule results size = 1. ! ! !TLOneOfTheMostRuleTest methodsFor: 'test' stamp: 'JorgeRessia 4/2/2010 09:11'! testSuccess | aRule aWord aDocument anotherWord aSentence words sentences aParagraph paragraphs| words := OrderedCollection new. words add: (TLWord with: (PPToken on: 'A')). words add: (TLWord with: (PPToken on: 'of')). words add: (TLWord with: (PPToken on: 'the')). words add: (TLWord with: (PPToken on: 'most')). aSentence := TLSentence withAll: words. sentences := OrderedCollection with: aSentence. aParagraph := TLParagraph withAll: sentences. paragraphs := OrderedCollection with: aParagraph. aDocument := TLDocument withAll: paragraphs. aRule := TLOneOfTheMostRule new. aRule runOn: aDocument. self assert: aRule results size = 0. ! ! TestCase subclass: #TLSentenceTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Tests'! !TLSentenceTest methodsFor: 'test' stamp: 'JorgeRessia 4/2/2010 08:42'! testContainsPhraseAtTheBeginning | aSentence words| words := OrderedCollection new. words add: (TLWord with: (PPToken on: '1')). words add: (TLWord with: (PPToken on: '2')). words add: (TLWord with: (PPToken on: '3')). words add: (TLWord with: (PPToken on: 'xxxx')). aSentence := TLSentence withAll: words. self assert: (aSentence containsPhrase: '1 2 3')! ! !TLSentenceTest methodsFor: 'test' stamp: 'JorgeRessia 4/2/2010 08:57'! testContainsPhraseAtTheEnd | aSentence words| words := OrderedCollection new. words add: (TLWord with: (PPToken on: 'xxxx')). words add: (TLWord with: (PPToken on: '1')). words add: (TLWord with: (PPToken on: '2')). words add: (TLWord with: (PPToken on: '3')). aSentence := TLSentence withAll: words. self assert: (aSentence containsPhrase: '1 2 3')! ! !TLSentenceTest methodsFor: 'test' stamp: 'JorgeRessia 4/2/2010 08:56'! testContainsPhraseAtTheMiddle | aSentence words| words := OrderedCollection new. words add: (TLWord with: (PPToken on: 'xxxx')). words add: (TLWord with: (PPToken on: '1')). words add: (TLWord with: (PPToken on: '2')). words add: (TLWord with: (PPToken on: '3')). words add: (TLWord with: (PPToken on: 'xxxx')). aSentence := TLSentence withAll: words. self assert: (aSentence containsPhrase: '1 2 3')! ! !TLSentenceTest methodsFor: 'test' stamp: 'JorgeRessia 4/2/2010 08:58'! testContainsPhraseInAnyCase | aSentence words| words := OrderedCollection new. words add: (TLWord with: (PPToken on: 'xxxx')). words add: (TLWord with: (PPToken on: 'a')). words add: (TLWord with: (PPToken on: 'b')). words add: (TLWord with: (PPToken on: 'c')). aSentence := TLSentence withAll: words. self assert: (aSentence containsPhrase: 'A B C'). words add: (TLWord with: (PPToken on: 'xxxx')). words add: (TLWord with: (PPToken on: 'a')). words add: (TLWord with: (PPToken on: 'b')). words add: (TLWord with: (PPToken on: 'c')). aSentence := TLSentence withAll: words. self assert: (aSentence containsPhrase: 'a b c'). words add: (TLWord with: (PPToken on: 'xxxx')). words add: (TLWord with: (PPToken on: 'a')). words add: (TLWord with: (PPToken on: 'B')). words add: (TLWord with: (PPToken on: 'c')). aSentence := TLSentence withAll: words. self assert: (aSentence containsPhrase: 'A B c')! ! TestCase subclass: #TLTextLintCheckerTest instanceVariableNames: 'result' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Tests'! !TLTextLintCheckerTest methodsFor: 'mocking' stamp: 'JorgeRessia 3/31/2010 16:58'! checkDocument: aDocument result add: self! ! !TLTextLintCheckerTest methodsFor: 'mocking' stamp: 'JorgeRessia 3/31/2010 17:01'! results ^result ! ! !TLTextLintCheckerTest methodsFor: 'test' stamp: 'JorgeRessia 3/31/2010 16:58'! test | aChecker | result := OrderedCollection new. aChecker := TLTextLintChecker new. aChecker addRule: self. aChecker check: 'test test2.'. self assert: ( aChecker results size = 1 ). self assert: ( aChecker results first = self ) ! ! TestCase subclass: #TLTextLintRuleTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Tests'! !TLTextLintRuleTest methodsFor: 'test' stamp: 'JorgeRessia 4/1/2010 12:10'! test | aRule | aRule := TLTextLintRule new. aRule check: 1. self assert: true.! ! TestCase subclass: #TLTextParserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Tests'! !TLTextParserTest methodsFor: 'test' stamp: 'JorgeRessia 4/1/2010 14:58'! test | aParser aDocument | aParser := TLTextParser new. aDocument := aParser parse: 'text1 text2.'. self deny: aDocument isPetitFailure. self assert: aDocument paragraphs size = 1. self assert: aDocument sentences size = 1. self assert: aDocument words size = 2.! ! TestCase subclass: #TLWordRepetitionRuleTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Tests'! !TLWordRepetitionRuleTest methodsFor: 'test' stamp: 'JorgeRessia 4/1/2010 21:02'! testFailure | aRule aWord aDocument anotherWord aSentence words sentences aParagraph paragraphs| aWord := TLWord with: (PPToken on: 'test'). anotherWord := TLWord with: (PPToken on: 'test'). words := OrderedCollection with: aWord with: anotherWord. aSentence := TLSentence withAll: words. sentences := OrderedCollection with: aSentence. aParagraph := TLParagraph withAll: sentences. paragraphs := OrderedCollection with: aParagraph. aDocument := TLDocument withAll: paragraphs. aRule := TLWordRepetitionRule new. aRule runOn: aDocument. self assert: aRule results size = 1. ! ! !TLWordRepetitionRuleTest methodsFor: 'test' stamp: 'JorgeRessia 4/1/2010 21:22'! testFailureManyWords | aRule aWord aDocument anotherWord aSentence words sentences aParagraph paragraphs| words := OrderedCollection new. words add: (TLWord with: (PPToken on: 'tes')). words add: (TLWord with: (PPToken on: 'test')). words add: (TLWord with: (PPToken on: 'test')). words add: (TLWord with: (PPToken on: 'xxxx')). aSentence := TLSentence withAll: words. sentences := OrderedCollection with: aSentence. aParagraph := TLParagraph withAll: sentences. paragraphs := OrderedCollection with: aParagraph. aDocument := TLDocument withAll: paragraphs. aRule := TLWordRepetitionRule new. aRule runOn: aDocument. self assert: aRule results size = 1. ! ! !TLWordRepetitionRuleTest methodsFor: 'test' stamp: 'JorgeRessia 4/1/2010 21:22'! testFailureThreeInRow | aRule aWord aDocument anotherWord aSentence words sentences aParagraph paragraphs| words := OrderedCollection new. words add: (TLWord with: (PPToken on: 'test')). words add: (TLWord with: (PPToken on: 'test')). words add: (TLWord with: (PPToken on: 'test')). words add: (TLWord with: (PPToken on: 'xxxx')). aSentence := TLSentence withAll: words. sentences := OrderedCollection with: aSentence. aParagraph := TLParagraph withAll: sentences. paragraphs := OrderedCollection with: aParagraph. aDocument := TLDocument withAll: paragraphs. aRule := TLWordRepetitionRule new. aRule runOn: aDocument. self assert: aRule results size = 2. ! ! !TLWordRepetitionRuleTest methodsFor: 'test' stamp: 'JorgeRessia 4/1/2010 21:20'! testSuccess | aRule aWord aDocument anotherWord aSentence words sentences aParagraph paragraphs| aWord := TLWord with: (PPToken on: 'test1'). anotherWord := TLWord with: (PPToken on: 'test'). words := OrderedCollection with: aWord with: anotherWord. aSentence := TLSentence withAll: words. sentences := OrderedCollection with: aSentence. aParagraph := TLParagraph withAll: sentences. paragraphs := OrderedCollection with: aParagraph. aDocument := TLDocument withAll: paragraphs. aRule := TLWordRepetitionRule new. aRule runOn: aDocument. self assert: aRule results size = 0. ! ! PPCompositeParser subclass: #TLTextChecker instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! PPCompositeParser subclass: #TLTextParser instanceVariableNames: 'document paragraph sentence word' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLTextParser methodsFor: 'productions' stamp: 'lr 3/31/2010 11:27'! document ^ (paragraph delimitedBy: #newline asParser token) ==> [ :nodes | TLDocument withAll: (nodes reject: [ :each | each class = PPToken ]) ]! ! !TLTextParser methodsFor: 'productions' stamp: 'lr 3/31/2010 11:31'! paragraph ^ (sentence delimitedBy: $. asParser token) ==> [ :nodes | TLParagraph withAll: (nodes reject: [ :each | each class = PPToken ]) ]! ! !TLTextParser methodsFor: 'productions' stamp: 'lr 3/31/2010 11:29'! sentence ^ word plus ==> [ :nodes | TLSentence withAll: nodes ]! ! !TLTextParser methodsFor: 'accessing' stamp: 'lr 3/31/2010 10:59'! start ^ document end! ! !TLTextParser methodsFor: 'productions' stamp: 'lr 3/31/2010 11:29'! word ^ #word asParser plus token ==> [ :node | TLWord with: node ]! ! Object subclass: #TLDocument instanceVariableNames: 'paragraphs' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLDocument class methodsFor: 'as yet unclassified' stamp: 'lr 3/31/2010 11:15'! withAll: aCollection ^self new initializeWithAll: aCollection! ! !TLDocument methodsFor: 'as yet unclassified' stamp: 'lr 3/31/2010 11:16'! initializeWithAll: aCollection paragraphs := aCollection! ! !TLDocument methodsFor: 'as yet unclassified' stamp: 'lr 3/31/2010 11:22'! paragraphs ^paragraphs ! ! !TLDocument methodsFor: 'as yet unclassified' stamp: 'lr 3/31/2010 11:24'! sentences ^ self paragraphs gather: [ :each | each sentences ]! ! !TLDocument methodsFor: 'as yet unclassified' stamp: 'lr 3/31/2010 11:24'! words ^self sentences gather: [ :each | each words ]! ! Object subclass: #TLHoweverRule instanceVariableNames: 'results' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLHoweverRule methodsFor: 'initializing' stamp: 'JorgeRessia 4/1/2010 15:13'! initialize results := OrderedCollection new.! ! !TLHoweverRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/1/2010 15:14'! results ^results! ! !TLHoweverRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/1/2010 15:12'! runOn: aDocument aDocument sentences do: [:eachSentence | (eachSentence words first text = 'However') ifTrue: [ results add: eachSentence] ] ! ! Object subclass: #TLOneOfTheMostRule instanceVariableNames: 'results' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLOneOfTheMostRule methodsFor: 'initialization' stamp: 'JorgeRessia 4/2/2010 08:23'! initialize results := OrderedCollection new.! ! !TLOneOfTheMostRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/2/2010 08:23'! results ^results! ! !TLOneOfTheMostRule methodsFor: 'running' stamp: 'JorgeRessia 4/2/2010 08:28'! runOn: aDocument aDocument sentences do: [:eachSentence | (eachSentence containsPhrase: 'one of the most') ifTrue: [ results add: eachSentence] ] ! ! Object subclass: #TLParagraph instanceVariableNames: 'sentences' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLParagraph class methodsFor: 'as yet unclassified' stamp: 'lr 3/31/2010 11:16'! withAll: aCollection ^self new initializeWithAll: aCollection! ! !TLParagraph methodsFor: 'as yet unclassified' stamp: 'lr 3/31/2010 11:17'! initializeWithAll: aCollection sentences := aCollection! ! !TLParagraph methodsFor: 'as yet unclassified' stamp: 'lr 3/31/2010 11:32'! sentences ^sentences! ! Object subclass: #TLSentence instanceVariableNames: 'words' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLSentence class methodsFor: 'as yet unclassified' stamp: 'lr 3/31/2010 11:17'! withAll: aCollection ^self new initializeWithAll: aCollection! ! !TLSentence methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/2/2010 08:56'! containsPhrase: aString ^('*', aString, '*') match: self wordsAsString translateToLowercase.! ! !TLSentence methodsFor: 'as yet unclassified' stamp: 'lr 3/31/2010 11:17'! initializeWithAll: aCollection words := aCollection! ! !TLSentence methodsFor: 'accessing' stamp: 'lr 3/31/2010 11:20'! words ^ words! ! !TLSentence methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 4/2/2010 08:45'! wordsAsString ^words inject: ' ' into: [:count :each | count, ' ', each token collection] ! ! Object subclass: #TLTextLintChecker instanceVariableNames: 'rules' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLTextLintChecker methodsFor: 'accessing' stamp: 'JorgeRessia 3/31/2010 16:49'! addRule: aRule rules add: aRule! ! !TLTextLintChecker methodsFor: 'public' stamp: 'JorgeRessia 3/31/2010 16:55'! check: aString | aDocument | aDocument := TLTextParser parse: aString. self checkDocument: aDocument.! ! !TLTextLintChecker methodsFor: 'as yet unclassified' stamp: 'JorgeRessia 3/31/2010 16:56'! checkDocument: aDocument rules do: [ :each | each checkDocument: aDocument]! ! !TLTextLintChecker methodsFor: 'initializing' stamp: 'JorgeRessia 3/31/2010 16:50'! initialize rules := OrderedCollection new! ! !TLTextLintChecker methodsFor: 'accessing' stamp: 'JorgeRessia 4/1/2010 11:29'! results ^rules gather: [ :each | each results ]! ! Object subclass: #TLTextLintRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLTextLintRule methodsFor: 'public' stamp: 'JorgeRessia 4/1/2010 12:10'! check: anObject ! ! Object subclass: #TLWord instanceVariableNames: 'token' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLWord class methodsFor: 'as yet unclassified' stamp: 'lr 3/31/2010 11:18'! with: aToken ^self new initializeWith: aToken! ! !TLWord class methodsFor: 'as yet unclassified' stamp: 'lr 3/31/2010 11:17'! withAll: aCollection ^self new initializeWithAll: aCollection! ! !TLWord methodsFor: 'as yet unclassified' stamp: 'lr 3/31/2010 11:18'! initializeWith: aToken token := aToken! ! !TLWord methodsFor: 'accessing' stamp: 'JorgeRessia 4/1/2010 15:14'! text ^token collection! ! !TLWord methodsFor: 'accessing' stamp: 'lr 3/31/2010 11:21'! token ^ token! ! Object subclass: #TLWordRepetitionRule instanceVariableNames: 'results' classVariableNames: '' poolDictionaries: '' category: 'TextLint-Model'! !TLWordRepetitionRule methodsFor: 'initializing' stamp: 'JorgeRessia 4/1/2010 20:58'! initialize results := OrderedCollection new.! ! !TLWordRepetitionRule methodsFor: 'accessing' stamp: 'JorgeRessia 4/1/2010 20:59'! results ^results! ! !TLWordRepetitionRule methodsFor: 'running' stamp: 'JorgeRessia 4/1/2010 21:09'! runOn: aDocument | words | aDocument sentences do: [:eachSentence | words := eachSentence words asArray. (words size < 2) ifTrue: [^self]. 2 to: words size do: [:index | ((words at: index) text = (words at: index - 1) text) ifTrue: [ results add: eachSentence] ] ] ! !