Tomsovi

Object subclass: #DMEntityBuilder
    instanceVariableNames: 'umlBuilder'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'DecisionMaker-EntityBuilder'

DMEntityBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/5/2010 17:41'
entityClasses
    ^ umlBuilder classes 
            select: [ :c | c hasStereotypeNamed: 'entity' ].

DMEntityBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/4/2010 22:05'
umlBuilder
    umlBuilder ifNil: [ umlBuilder := XMIUMLBuilder new ].
    ^ umlBuilder

DMEntityBuilder methodsFor: 'accessing' stamp: 'JanTomsa 4/4/2010 22:03'
umlBuilder: anObject
    umlBuilder := anObject

DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/4/2010 23:43'
CRUDClassName: anUMLClass withPrefix: aPrefix
    ^(aPrefix, anUMLClass elementName), 'CRUD'.

DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/6/2010 00:12'
buildCRUDClass: anUMLClass withPrefix: aPrefix
    | CRUDClass CR modelClassName editorClassName textsClassName |
    CR := Character cr asString.
    modelClassName := (self modelClassName: anUMLClass withPrefix: aPrefix ).
    editorClassName := (self editorClassName: anUMLClass withPrefix: aPrefix ).
    textsClassName  := (self textsClassName: anUMLClass withPrefix: aPrefix ).
    CRUDClass := UMLClass new: (self CRUDClassName: anUMLClass withPrefix: aPrefix).
    CRUDClass forcedGeneral: 'WAComponent'.
    "==================== Attributes =================="
    CRUDClass addAttribute: ( (UMLAttribute new: 'listComponent')
                                        type: 'WATableReport';
                                        yourself
    ).
    "==================== Operations =================="
    CRUDClass addOperation: ( (UMLOperation new: 'children')
                                type: 'Array';
                                behavior: '^Array with: listComponent';
                                yourself
    ).
    "--------------------- CRUD ---------------------"
    CRUDClass addOperation: ( (UMLOperation new: 'add')
            type: 'void';
            behavior: '| editor instance answer |', CR,
                        'instance := ', modelClassName, ' new.',CR,
                        'editor := ', editorClassName, ' on: instance.',CR,
                        'answer := self call: editor.',CR,
                        'answer ifTrue: [ ',modelClassName,' instances add: instance ]'
            yourself
    ).
    CRUDClass addOperation: ( (UMLOperation new: 'edit')
            type: 'void';
            addParameter: ( (UMLParameter new: 'anInstance') type: modelClassName );
            behavior: '| editor |', CR,
                        'editor := ', editorClassName, ' on: anInstance.',CR,
                        'self call: editor.';
            yourself
    ).
    CRUDClass addOperation: ( (UMLOperation new: 'delete')
            type: 'void';
            addParameter: ( (UMLParameter new: 'anInstance') type: modelClassName );
            behavior: modelClassName, ' instances remove: anInstance.';
            yourself
    ).
    "--------------------- columns ---------------------"
    ((anUMLClass attributes )
        select: [ :a | 
                  (a stereotypes select: [ :as | 
                                           as elementName = 'column' 
                                         ] ) size = 1 
                ])
        do: [ :a |
            CRUDClass addOperation: ((UMLOperation new: (a elementName, 'ReportColumn'))
                                                type: 'void';
                                                behavior: '^WAReportColumn new',CR,
                '        title: (',textsClassName,' labelFor: #',a elementName,');',CR,
                '        selector: #',a elementName,';',CR,
                '        clickBlock: [ :each | self edit: each ];',CR,
                '        yourself .';
                yourself )
        ].
    "------------------ action column ------------------"
    CRUDClass addOperation: ( (UMLOperation new: ('actionReportColumn'))
        type: 'void';
        behavior: '^WAReportColumn new',CR,
            '    title: DMTexts ACTIONS;',CR,
            '    valueBlock: [ :anInstance :html |',CR,
            '        html anchor ',CR,
            '        onClick: (''return confirm('''''',
            DMTexts CONFIRMQUESTION, '''''')'');',CR,
            '        callback: [ self delete: anInstance  ];',CR,
            '        with: DMTexts DELETE',CR,
            '    ];',CR,
            'yourself .';
        yourself ).
    "----------------- initialization ------------------"
    CRUDClass addOperation: ( (UMLOperation new: 'initialize')
            type: 'void';
            behavior: '| columns |',CR,
                        'super initialize.',CR,
                        'columns := OrderedCollection new.',CR,
                        (((CRUDClass operations collect: [ :o | o elementName ]) 
                            select: [ :o | o endsWith: 'ReportColumn' ])
                            inject: '' into: [ :x :y | x,' columns add: self ',y,'.',CR]
                        ),
                        'listComponent := WATableReport new',CR,
                        '    columns: columns;',CR,
                        '    rowPeriod: 1;',CR,
                        '    yourself.';
            yourself
    ).
    "-------------------- rendering --------------------"
    CRUDClass addOperation: ( (UMLOperation new: 'renderContentOn')
            type: 'void';
            addParameter: ( (UMLParameter new: 'canvas') type: 'WARenderer' );
            behavior: 'canvas heading with: (', textsClassName,
                           ' labelFor: #Instances); level: 3.',CR,
                        'listComponent rows: ', modelClassName,
                           ' instances asSortedCollection.',CR,
                        'canvas render: listComponent.',CR,
                        'canvas anchor callback: [ self add ]; with: DMTexts NEW.';
            yourself
    ).
    ^CRUDClass

DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/5/2010 18:22'
buildEditorClass: anUMLClass withPrefix: aPrefix
    | editorClass CR modelClassName editorClassName textsClassName editorType |
    CR := Character cr asString.
    modelClassName := (self modelClassName: anUMLClass withPrefix: aPrefix ).
    editorClassName := (self editorClassName: anUMLClass withPrefix: aPrefix ).
    textsClassName  := (self textsClassName: anUMLClass withPrefix: aPrefix ).
    editorClass := UMLClass new: editorClassName.
    editorClass forcedGeneral: 'WAComponent'.
    "==================== Attributes =================="
    editorClass addAttribute: ( (UMLAttribute new: 'model')
                                        type: modelClassName;
                                        yourself
    ).
    "==================== Operations =================="
    "--------------------- columns ---------------------"
    ((anUMLClass attributes )
        select: [ :a | (a stereotypes select: [ :as | as elementName = 'column' ] ) size = 1 ])
        do: [ :a |
            editorType := a taggedValueAt: 'editor' ifAbsent: 'textInput'.
            editorClass addOperation: ( (UMLOperation new: 'render',(a elementName) capitalized,'On')
                                                            type: 'void';
                addParameter: ( (UMLParameter new: 'canvas') type: 'WARenderer'     );
                behavior: '| tagID |',CR,
                            'canvas div: [',CR,
                            '    canvas label',CR,
                            '        for: (tagID := canvas nextId);',CR,
                            '        with: (',textsClassName,' labelFor: #',a elementName,').',CR,
                            (self editorSourceCode: (a elementName) editorType: editorType),
                            '].';
                yourself )
        ].
    "----------------- initialization ------------------"
    editorClass addOperation: ( (UMLOperation new: 'initialize')
            type: 'void';
            addParameter: ( (UMLParameter new: 'anInstance') type: modelClassName );
            behavior: 'self initialize.',CR,
                        'model := anInstance.';
            yourself
    ).
    "-------------------- rendering --------------------"
    editorClass addOperation: ( (UMLOperation new: 'renderButtonsOn')
            type: 'void';
            addParameter: ( (UMLParameter new: 'canvas') type: 'WARenderer' );
            behavior: 'canvas div: [',CR,
                        '    canvas span: [',CR,
                        '        canvas cancelButton callback: [self answer: false];',CR,
                                ' with: DMTexts CANCEL.',CR,
                        '    ].',CR,
                        '    canvas span: [',CR,
                        '        canvas submitButton callback: [self answer: true];',CR,
                                ' with: DMTexts SAVE.',CR,
                        '    ].',CR,
                        '].';
            yourself
    ).
    editorClass addOperation: ( (UMLOperation new: 'renderContentOn')
            type: 'void';
            addParameter: ( (UMLParameter new: 'canvas') type: 'WARenderer' );
            behavior: 'canvas form',CR,
                        '    class: ''dmEditor'';',CR,
                        '    with: [',CR,
                        '        self',CR,
                        (((editorClass operations collect: [ :o | o elementName ]) 
                            select: [ :o | o beginsWith: 'render' ])
                            inject: '' into: [ :x :y | x,'            ',y,': canvas;',CR]
                        ),
                        '            yourself.',CR,
                        '].';
            yourself
    ).
    "-------------------- constructor --------------------"
    editorClass addOperation: ( (UMLOperation new: 'on')
            type: modelClassName;
            isStatic: true;
            addParameter: ( (UMLParameter new: 'anInstance') type: modelClassName );
            behavior: '^self basicNew',CR,
                        '    initialize: anInstance;',CR,
                        '    yourself.';
            yourself
    ).
    ^editorClass

DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/5/2010 22:02'
buildModelClass: anUMLClass withPrefix: aPrefix
    | modelClass |
    modelClass := UMLClass new: (self modelClassName: anUMLClass withPrefix: aPrefix).
    "==================== Attributes =================="
    anUMLClass attributes do: [ :att |
        modelClass addAttribute: ( (UMLAttribute new: (att elementName))
                                            description: att description;
                                            id: att id;
                                            alias: att alias;
                                            initialValue: att initialValue;
                                            scope: att scope;
                                            type: att type;
                                            yourself
                                        ).
    ].
    "-------------------- accessors -------------------"
    anUMLClass attributes do: [ :att |
        att elementName ifNotNil: [
        "---- getter ----"
            modelClass addOperation: ( (UMLOperation new: (att elementName))
                                            type: att type;
                                            behavior: '^',att elementName ;
                                            yourself ).
            "---- setter ----"
            modelClass addOperation: ( (UMLOperation new: (att elementName))
                                            type: 'void';
                                            addParameter: ((UMLParameter new: 'anObject')
                                                                    type: att type);
                                            behavior: att elementName,' := anObject';
                                            yourself )
        ]
    ].
    "==================== Operations =================="
    anUMLClass operations do: [ :op |
        modelClass addOperation: ( (UMLOperation new: (op elementName))
                                            description: op description;
                                            id: op id;
                                            alias: op alias;
                                            type: op type;
                                            isStatic: op isStatic;
                                            behavior: op behavior;
                                            addParameters: ( 
                                                    op parameters collect: [ :p | 
                                                        (UMLParameter new: p elementName)
                                                            type: p type;
                                                            kind: p kind;
                                                            yourself
                                                    ] 
                                            );
                                            yourself )
    ].
    modelClass addAttribute: ( (UMLAttribute new: 'instances')
                                        isStatic: true;
                                        type: anUMLClass elementName,'[]';
                                        scope: 'Private';
                                        yourself ).
    modelClass addOperation: ( (UMLOperation new: 'instances')
                                        isStatic: true;
                                        type: anUMLClass elementName,'[]';
                                        behavior: 'instances ifNil: [ instances := IdentitySet new ].  ^instances');
                                        yourself.
    "-------------------- comparator -------------------"
    modelClass addOperation: ( (UMLOperation new: '<=')
                                        type: 'Boolean';
                                        addParameter: ((UMLParameter new: 'anObject')
                                                                type: modelClass elementName);
                                        behavior: '^self ',(anUMLClass attributes first elementName),
                                                        '<= anObject ',
                                                        (anUMLClass attributes first elementName));
                                        yourself.
    ^modelClass

DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/5/2010 18:53'
buildTextsClass: anUMLClass withPrefix: aPrefix
    | textsClass CR modelClassName editorClassName textsClassName 
        instanceCZ instanceEN instancesCZ instancesEN |
    CR := Character cr asString.
    modelClassName := (self modelClassName: anUMLClass withPrefix: aPrefix ).
    editorClassName := (self editorClassName: anUMLClass withPrefix: aPrefix ).
    textsClassName  := (self textsClassName: anUMLClass withPrefix: aPrefix ).
    textsClass := UMLClass new: textsClassName.
    "==================== Attributes =================="
    textsClass addAttribute: ( (UMLAttribute new: 'labels')
                                        type: 'Dictionary';
                                        isStatic: true;
                                        yourself
    ).
    "==================== Operations =================="
    textsClass addOperation: ( (UMLOperation new: 'labelFor')
            type: 'String';
            isStatic: true;
            addParameter: ( (UMLParameter new: 'aSymbol') type: 'Symbol' );
            behavior: '^self labelFor: aSymbol inLanguage: (DMTexts defaultLanguage).';
            yourself
    ).
 
    textsClass addOperation: ( (UMLOperation new: 'labelFor_inLanguage')
            type: 'String';
            isStatic: true;
            addParameter: ( (UMLParameter new: 'aSymbol') type: 'Symbol' );
            addParameter: ( (UMLParameter new: 'language') type: 'Symbol' );
            behavior: '^(self labels at: language) at: aSymbol.';
            yourself
    ).
 
    instanceCZ := anUMLClass taggedValueAt: 'label_cz_singular' 
                    ifAbsent: (anUMLClass class name asString).
    instancesCZ := anUMLClass taggedValueAt: 'label_cz_plural' 
                    ifAbsent: (anUMLClass class name asString),'s'.
    instanceEN := anUMLClass taggedValueAt: 'label_en_singular' 
                    ifAbsent: (anUMLClass class name asString).
    instancesEN := anUMLClass taggedValueAt: 'label_en_plural' 
                    ifAbsent: (anUMLClass class name asString),'s'.
    textsClass addOperation: ( (UMLOperation new: 'labels')
            type: 'Dictionary';
            isStatic: true;
            behavior: '| labelsCzech labelsEnglish |',CR,
                        'labels ifNil: [',CR,
                        '    labelsCzech := Dictionary new.',CR,
                        '    labelsEnglish := Dictionary new.',CR,
                        '    labelsCzech add: #Instance->''',instanceCZ,'''.',CR,
                        '    labelsCzech add: #Instances->''',instancesCZ,'''.',CR,
                        '    labelsEnglish add: #Instance->''',instanceEN,'''.',CR,
                        '    labelsEnglish add: #Instances->''',instancesEN,'''.',CR,
                        (((anUMLClass attributes )
                            select: [ :a | a hasStereotypeNamed: 'column' ])
                                inject: '' into: [ :a :b | 
                                    a,
                                    'labelsCzech add: #',b elementName,'->''',
                                        (b taggedValueAt: 'label_cz' ifAbsent: b elementName),'''.',CR,
                                    'labelsEnglish add: #',b elementName,'->''',
                                        (b taggedValueAt: 'label_en' ifAbsent: b elementName),'''.',CR
                                ]
                        ),
                        '    labels := Dictionary new.',CR,
                        '    labels add: #czech->labelsCzech.',CR,
                        '    labels add: #english->labelsEnglish.',CR,
                        '].',CR,
                        '^labels';
            yourself
    ).
    ^textsClass

DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/4/2010 23:42'
editorClassName: anUMLClass withPrefix: aPrefix
    ^(aPrefix, anUMLClass elementName), 'Editor'.

DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/5/2010 21:57'
editorSourceCode: elementName editorType: editorType
    | CR sourceCode |
    CR := Character cr asString.
    (editorType ='textArea')
    ifTrue: [
        sourceCode := '    canvas textArea',CR,
            '        id: tagID;',CR,
            '        value: model ',elementName,';',CR,
            '        callback: [ :value | model ',elementName,': value ]',CR.
    ]
    ifFalse: [
        (editorType ='select')
        ifTrue: [
            sourceCode := '    canvas select',CR,
                '        id: tagID;',CR,
                '        selected: model ',elementName,';',CR,
                '        list: model ',elementName,'List;',CR,
                '        callback: [ :value | model ',elementName,': value ].',CR.
        ]
        ifFalse: [
            (editorType ='dateTimeSelector')
            ifTrue: [
                sourceCode := '    canvas span',CR,
                    '        id: tagID;',CR,
                    '        with: [ canvas render: dateTimeSelector ].',CR.
            ]
            ifFalse: [
                sourceCode := '    canvas textInput',CR,
                    '        value: model ',elementName,';',CR,
                    '        callback: [:value | model ',elementName,': value]',CR.
            ]
        ]
    ].
    ^sourceCode.

DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/4/2010 23:40'
modelClassName: anUMLClass withPrefix: aPrefix
    ^(aPrefix, anUMLClass elementName).

DMEntityBuilder methodsFor: 'builders' stamp: 'JanTomsa 4/4/2010 23:43'
textsClassName: anUMLClass withPrefix: aPrefix
    ^(aPrefix, anUMLClass elementName), 'Texts'.

DMEntityBuilder methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/4/2010 22:08'
initFromFileNamed: aFileName
    self umlBuilder initFromFileNamed: aFileName.
    self umlBuilder buildRootPackages.

DMEntityBuilder methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/4/2010 23:01'
transformClass: anUMLClass withPrefix: aPrefix
    | xformedClasses |
    xformedClasses := Dictionary new.
    xformedClasses add: #model->(self buildModelClass: anUMLClass withPrefix: aPrefix).
    xformedClasses add: #CRUD->(self buildCRUDClass: anUMLClass withPrefix: aPrefix).
    xformedClasses add: #editor->(self buildEditorClass: anUMLClass withPrefix: aPrefix).
    xformedClasses add: #texts->(self buildTextsClass: anUMLClass withPrefix: aPrefix).
    ^xformedClasses.

DMEntityBuilder methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/5/2010 17:47'
transformEntityClassesWithPrefix: aPrefix
    | xformedEntities |
    xformedEntities := Dictionary new.
    self entityClasses do: 
        [ :ec | 
            xformedEntities add: (ec elementName)->(self transformClass: ec withPrefix: aPrefix).
        ].
    ^xformedEntities.

DMEntityBuilder methodsFor: 'as yet unclassified' stamp: 'JanTomsa 4/5/2010 17:53'
transformEntityClassesWithPrefixPlain: aPrefix
    | xformedEntities plainList |
    xformedEntities := self transformEntityClassesWithPrefix: aPrefix.
    plainList := OrderedCollection new.
    xformedEntities do: [ :xe |
        xe do: [ :xed |
            plainList add: xed
        ]
    ].
    ^plainList.