s/BenchmarkReportJSONWriter.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Mon, 21 Mar 2016 13:15:35 +0100
changeset 314 9ac0be200068
parent 285 0cf54ee76de5
permissions -rw-r--r--
CI: Added CI scripts for Pharo ...to make Jenkins setup easier. To run CalipeL/S tests on Pharo, simply execute: wget -O "ci-pharo-common.sh" https://bitbucket.org/janvrany/jv-calipel/raw/tip/s/pharo/ci/ci-pharo-tests.sh | bash -x To run standard set ob benchmarks on Pharo, run wget -O "ci-pharo-common.sh" https://bitbucket.org/janvrany/jv-calipel/raw/tip/s/pharo/ci/ci-pharo-benchmarks.sh | bash -x

"{ Package: 'jv:calipel/s' }"

"{ NameSpace: Smalltalk }"

Object subclass:#BenchmarkReportJSONWriter
	instanceVariableNames:'stream indent'
	classVariableNames:'Rules EscapeTable'
	poolDictionaries:''
	category:'CalipeL-S-Core-Reports'
!

!BenchmarkReportJSONWriter class methodsFor:'documentation'!

documentation
"
    Simple, portable JSON writer.
    
    [author:]
        Jan Vrany <jan.vrany@fit.cvut.cz> (adaptation for CalipeL)

    [instance variables:]

    [class variables:]

    [see also:]

"
! !

!BenchmarkReportJSONWriter class methodsFor:'initialization'!

initialize
    "Invoked at system start or when the class is dynamically loaded."

    EscapeTable := Dictionary new.
    EscapeTable at:  8 put: '\b'.
    EscapeTable at:  9 put: '\t'.
    EscapeTable at: 10 put: '\n'.
    EscapeTable at: 12 put: '\f'.
    EscapeTable at: 13 put: '\r'.
    EscapeTable at: 34 put: '\"'.
    EscapeTable at: 92 put: '\\'.

    Rules := OrderedCollection new.
    Rules add: [:obj | obj isNil ];             add:#writeNull: .
    Rules add: [:obj | obj isString ];          add:#writeString: .
    Rules add: [:obj | obj isBoolean ];         add:#writeBoolean: .
    Rules add: [:obj | obj isInteger ];         add:#writeInteger: .
    Rules add: [:obj | obj isFloat ];           add:#writeFloat: .
    "CalipeL/S specific mappings"
    Rules add: [:obj | obj isClass ];           add:#writeClass: .

    "Modified: / 12-06-2013 / 13:53:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (comment): / 16-06-2013 / 00:53:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BenchmarkReportJSONWriter class methodsFor:'instance creation'!

new
    "return an initialized instance"

    ^ self basicNew initialize.
!

on: writeStream
	"Initialize on writeStream, which should be a character stream that 
	implements #nextPut:, #nextPutAll:, #space and (optionally) #close."

	^ self new
		on: writeStream;
		yourself
! !

!BenchmarkReportJSONWriter class methodsFor:'convenience'!

toString: object
	^ String streamContents: [ :stream |
			(self on: stream) nextPut: object ]
!

toStringPretty: object
	^ String streamContents: [ :stream |
			(self on: stream)
				prettyPrint: true; 
				nextPut: object ]
! !

!BenchmarkReportJSONWriter methodsFor:'initialize-release'!

close
	stream ifNotNil: [
		stream close.
		stream := nil ]
!

initialize
        super initialize.
        indent := 0

    "Modified: / 12-06-2013 / 14:00:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

on: aWriteStream
	"Initialize on aWriteStream, which should be a character stream that 
	implements #nextPut:, #nextPutAll:, #space and (optionally) #close."

	stream := aWriteStream
! !

!BenchmarkReportJSONWriter methodsFor:'private'!

encode: string

    string do:[:char|
        | code escape |

        code := char codePoint.
        escape := EscapeTable at: code ifAbsent:[nil].
        escape notNil ifTrue:[
            stream nextPutAll: escape
        ] ifFalse:[
            (code < 32 or:[code > 127]) ifTrue:[
                self error: 'Unimplemented \u escaping'.
            ] ifFalse:[
                stream nextPut: char.
            ]
        ]
    ].

    "Created: / 12-06-2013 / 13:42:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BenchmarkReportJSONWriter methodsFor:'stream protocol'!

nextPut: anObject
    self write: anObject

    "Modified: / 12-06-2013 / 11:06:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

nextPutAll: anObject
    self write: anObject

    "Created: / 12-06-2013 / 11:07:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BenchmarkReportJSONWriter methodsFor:'writing'!

write: anObject

    1 to: Rules size by: 2 do:[:i|
        ((Rules at: i) value: anObject) ifTrue:[
            self perform: (Rules at: i + 1) with: anObject.
            ^self.
        ]        
    ].
    anObject isSequenceable ifTrue:[
        self writeArray: anObject.
        ^self
    ].
    anObject isDictionary ifTrue:[
        self writeDictionary: anObject.
        ^self
    ].
    self writeObject: anObject

    "Created: / 12-06-2013 / 11:00:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

writeArray:collection 
    self writeArrayWith:[
        collection 
            do:[:each | self write: each ]
            separatedBy:[ self writeElementSeparator ].
    ]

    "Modified: / 12-06-2013 / 14:02:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

writeArrayWith:block 
    stream nextPut: $[.
    indent := indent + 1.
    block value.
    indent := indent - 1.
    stream nextPut: $]

    "Created: / 12-06-2013 / 14:01:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

writeBoolean: boolean
	boolean printOn: stream
!

writeDictionary:dictionary 
    self writeDictionaryWith:[
        dictionary associations
            do:[:each | self writeKey: each key value: each value ]
            separatedBy:[ self writeElementSeparator ].
    ]

    "Modified: / 12-06-2013 / 14:02:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

writeDictionaryWith:block
    stream nextPut: ${.
    indent := indent + 1.
    block value.
    indent := indent - 1.
    stream nextPut: $}

    "Created: / 12-06-2013 / 14:01:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

writeElementSeparator
    stream nextPut:$,.

    "Modified: / 12-06-2013 / 13:42:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

writeFloat: float
	float printOn: stream
!

writeInteger: integer
	integer printOn: stream
	
!

writeKey: key value: value 
    self write: key.
    stream nextPutAll:': '.
    self write: value

    "Created: / 12-06-2013 / 13:59:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

writeKey: key valueWith: block 
    self write: key.
    stream nextPutAll:': '.
    block value

    "Created: / 12-06-2013 / 14:08:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

writeNull: anObject
    stream nextPutAll: 'null'

    "Created: / 12-06-2013 / 11:09:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

writeObject: anObject
    "Objects are written as dictionaries instvarname -> instvar value"

    | instvars |

    instvars := anObject class allInstVarNames.
    stream nextPut: ${.
    indent := indent + 1.
    instvars withIndexDo:[:nm :i|
        self writeKey: nm value: (anObject instVarAt: i).        
        i ~~ instvars size ifTrue:[
            self writeElementSeparator.
        ]
    ].
    indent := indent - 1.
    stream nextPut: $}

    "Modified: / 12-06-2013 / 13:59:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

writeString: string
    stream nextPut: $".
    self encode: string.
    stream nextPut: $"

    "Modified: / 12-06-2013 / 13:43:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BenchmarkReportJSONWriter methodsFor:'writing - CalipeL-S extras'!

writeClass: aClass
    ^self writeString: aClass name

    "Created: / 12-06-2013 / 13:52:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BenchmarkReportJSONWriter class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
! !


BenchmarkReportJSONWriter initialize!