This is part IIb of our tutorial on yUML Class Diagram DSL in plain english like these (see part IIa):

Customer is a User
Customer has 1-2 Address
Customer is defined by First Name, Last Name, Email
Customer has Order(s)
Order has LineItem(s) (at least 1)
Order uses 1 PaymentMethod
PaymentMethod can be Credit, Cash, Check
Product is defined by Description, Weight / getPricePerWeight, getWeight
Product is used by LineItem(s)

Before tackling our class diagram DSL rules, let’s revise our use case diagram rules first. There were 5 rules, 4 use case specific rules and one note rule:

actor-rule: [some [ [copy Actor to 'is thru 'is 'a 'Actor (append output rejoin ["[" Actor "]"])]
    | [copy Actor to 'is thru 'is 'a copy Actor2 to end (append output rejoin ["[" Actor "]^[" Actor2 "]"])]
 ]
]

extend-rule: [some [copy UseCase2 to 'Extend thru 'Extend copy UseCase1 to end (append output rejoin ["(" UseCase1 ")(" UseCase1 ")"])]
]  

use-rule: [some [copy Actor to 'Manage thru 'Manage copy UseCase to end (append output rejoin ["[" Actor "]-(" "Manage " UseCase ")"])]
]

  note-rule: [(color: "beige") some [
    'note [
            copy note-string to 'fond thru 'fond copy color to end
            (append output rejoin ["note: " note-string "{" "bg:" color "}"])
            |
            copy note-string to  end  (append output rejoin ["note: " note-string "{" "bg:" color "}"])              

      ]
    ]
    |           copy note-string to 'fond thru 'fond copy color to end
            (append output rejoin ["note: " note-string "{" "bg:" color "}"])
            |
            copy note-string to  end  (append output rejoin ["note: " note-string "{" "bg:" color "}"])
  ]

that we combine to form the whole yUml use-case rules:

specific-rules: [actor-rule | extend-rule | include-rule | use-rule]
yuml-rule: [[specific-rules] | note-rule ]

Let’s test the rules interactively by copying the above instructions in Rebol’s console and add these ones:

output: copy ""
test: [blogger is a user]
parse test yuml-rule

This should give true in Console’s Screen (parse has succeeded):

>> output: copy ""
== ""
>> test: [blogger is a user]
== [blogger is a user]
>> parse test yuml-rule
== true
>>

We’ll follow the same principle for the yUML Class Diagram rules except that specific-rules will be

specific-rules: [
inheritance-rule |
composition-rule |
definition-rule |
association-rule]

We can now start to write our rules for the class diagrams:

1°) let’s start with our first Inheritance Rule ([Customer is a User]):

output: copy ""
test: [Customer is a User]

inheritance-rule: [some [ [copy Class to 'is thru 'is 'a copy Base-Class to end (append output rejoin ["[" Class "]^[" Base-Class "]"])]
 ]
]

specific-rules: [inheritance-rule]
yuml-rule: [[specific-rules] | note-rule ]
parse test specific-rules
probe output

This gives a success:

"[Customer]^[User]"

2°) let’s parse Composition Rule (like [Customer has 1-2 Address]):

output: copy ""
test: [Customer has 1-2 Address]

Oops Rebol doesn’t accept the “1-2″ syntax:

>> output: copy ""
== ""
>> test: [Customer has 1-2 Address]
** Syntax Error: Invalid date -- 1-2
** Near: (line 1) test: [Customer has 1-2 Address]
>>

So let’s change the syntax temporarily to

test: [Customer has 1 to 2 Address]

Now let’s try to write the composition rule for this test:

composition-rule: ['Class 'has thru 'has copy m to 'to copy n to end]

We have a problem with the rule above because n would then contain “2 Adress” instead of “2″. The solution would be to write the rule like this:

composition-rule: [set class1 word! 'has set m integer! 'to set n integer! set class2 word!]

So that we can now test it:

output: copy ""
test: [Customer has 1 to 2 Address]
composition-rule: [set class1 word! 'has set m integer! 'to set n integer! set class2 word! (append output rejoin ["[" Class1 "]++" m "-" n "[" Class2 "]"])]
specific-rules: [composition-rule]
yuml-rule: [[specific-rules] | note-rule ]
parse test specific-rules
probe output

This is a success:

>> parse test specific-rules
== true
>> probe output
"[Customer]++1-2[Address]"
== "[Customer]++1-2[Address]"

I think you understand the test protocol, so let’s speed up with the next ones.

3°) Testing definition rule (like [Customer is defined by First Name / Last Name / Email]):

output: copy ""
test: [Customer is defined by First Name / Last Name / Email]

definition-rule: [some [
    set class word! (append output join class "|") 'is 'defined 'by [
     some [ copy attribute to "/" (append output join attribute ";") thru "/" | copy to end (append output attribute)] ]
 ]
]

specific-rules: [definition-rule]
yuml-rule: [[specific-rules] | note-rule ]
parse test specific-rules
probe output

This one failed on attributes as we only got the class name:

>> parse test specific-rules
== false
>> probe output
"Customer|"
== "Customer|"

The problem is this:

>> parse [a / b] ['a '/ 'b]
** Syntax Error: Invalid word-lit -- '
** Near: (line 1) parse [a / b] ['a '/ 'b]
>>

I was not astute enough to have solved this by myself, happily Sunanda saved my day

REBOL’s interpreter has some limitations on what you can happily write on the command line. You can’t get a lit-word by writing ‘/ — it throws an error because REBOL knows that / is the op! for division:

‘/
** Syntax Error: Invalid word-lit — ‘

But you can create ‘/ as a lit-word, starting with a string:

to-lit-word “/”
== ‘/

A solution to your code issue:

parse [a / b] compose ['a (to-lit-word "/") 'b]
=== true

* compose [...] — means we’ll selectively evaluate part of the block before the parse
* (…) — is the part that is selectively evaluated, thus creating the desired ‘/ lit-word

After some troubles, here’s the solution I got for this case:

attribute: copy []
class: copy []
fs: to-lit-word "/"
output: copy ""

definition-rule:  [
    some [set class word! (append output join class "|") 'is 'defined 'by [
        some [copy attribute to fs thru fs (append output join attribute ";")]
    ]
    copy attribute to end (append output attribute)]
]

parse [Customer is defined by First Name / Last Name / Email] definition-rule
print output

which is finally a success:

>> parse [Customer is defined by First Name / Last Name / Email] definitio
n-rule
== true
>> print output
Customer|FirstName;LastName;Email
>>

4°) Let’s now tackle Composition Rule 2 for [Customer has Order(s)]:

output: copy ""

composition-rule2:  [set class1 word! 'has set class2 word! (cardinality: "*") copy rest to end (if none? rest [cardinality: "1"])
(append output rejoin ["[" Class1 "]++1-0.." cardinality "[" Class2 "]"])
]

We can test the singular case:

>> output: copy ""
== ""
>> parse [Customer has Order] composition-rule2
== true
>> print output
[Customer]++1-0..1[Order]
>>

and then the plural case:

>> output: copy ""
== ""
>> parse [Customer has Order(s)] composition-rule2
== true
>> print output
[Customer]++1-0..*[Order]
>>

5°) Next case is the same composition rule with the “(at least 1)” refinement:

composition-rule2:  [set class1 word! 'has set class2 word! (cardinality: "*" cardinality0: "0") copy rest to end
(if ((pick rest 1) = to-paren "s")[cardinality: "*" ]
if ((pick rest 2) = to-paren "at least 1") [cardinality0: "1"]
append output rejoin ["[" Class1 "]++1-" cardinality0 ".." cardinality "[" Class2 "]"]
)
]

Test is OK:

>> parse [Order has LineItem(s) (at least 1)] composition-rule2
== true
>> print output
[Order]++1-1..*[LineItem]
>>

Regression Test is OK:

>> parse [Order has LineItem(s)] composition-rule3
== true
>> print output
[Order]++1-0..*[LineItem]
>>

But the rule above is not really complete. We need to take into account not only “at least 1″ but also “at least 2″ etc. After some trials and errors, I have modified the rule like this:

composition-rule2:  [set class1 word! 'has set class2 word! (cardinality: "*" cardinality0: "0") copy rest to end
(
if find mold/only rest "(s)" [cardinality: "*" ]
if find  mold/only rest "(at least" [parse mold/only rest [thru "at least " copy cardinality0 to ")"] ]
append output rejoin ["[" Class1 "]++1-" cardinality0 ".." cardinality "[" Class2 "]"]
)
]

Test gives:

>> output: copy ""
== ""
>> parse [Order has LineItem(s) (at least 2)] composition-rule2
== true
>> print output
[Order]++1-2..*[LineItem]
>>

6°) Association rule like [Order uses 1 PaymentMethod]:

This rule is easy to parse:

association-rule: [set class1 word! 'uses set n integer! set class2 word!
(append output rejoin ["[" Class1 "]0..*" "->" n "[" Class2 "]"])
]

output: copy ""
parse [Order uses 1 PaymentMethod] association-rule
print output

which results into

>> parse [Order uses 1 PaymentMethod] association-rule
== true
>> print output
[Order]0..*->1[PaymentMethod]

7°) Multiple Inheritance Rule:

Once again we have problem with special characters, here the comma so we replaced it by “/”:

classes: copy []
slash: to-lit-word "/"
inheritance-rule2: [set class word! 'can 'be
[some [copy x to slash thru slash (append classes x)] copy x to end
(append classes x)]

(foreach class2 classes [
append output rejoin ["[" class "]" '^ "[" class2 "]" newline]
])
]

output: copy ""
parse [PaymentMethod can be Credit / Cash / Check] inheritance-rule2
print output

Output is below:

>> parse [PaymentMethod can be Credit / Cash / Check] inheritance-rule2
== true
>> print output
[PaymentMethod]^[Credit]
[PaymentMethod]^[Cash]
[PaymentMethod]^[Check]

8°) Definition rule with methods like in [Product is defined by Description, Weight / getPricePerWeight, getWeight]

attribute: copy []
class: copy []
fs: to-lit-word "/"
double-fs: to-lit-word "//"

output: copy ""

definition-rule:  [
    some [set class word! (append output join class "|") 'is 'defined 'by [
        some [
          copy attribute to fs thru fs (append output join attribute ";")
        ]
    ]
    copy attribute to end (append output attribute)]
    (replace output "//" "|")
]

parse [Product is defined by Description / Weight // getPricePerWeight / getWeight ] definition-rule
print output

Output gives:

>> parse [Product is defined by Description / Weight // getPricePerWeight
/ getWeight ] definition-rule2
== true
>> print output
Product|Description;Weight|getPricePerWeight;getWeight
>>

9°) Last case is the same case as the ‘uses case:

association-rule: [set class1 word! ['uses | 'refers 'to] set n integer! set class2 word!
(append output rejoin ["[" Class1 "]0..*" "->" n "[" Class2 "]"])
]

output: copy ""
parse [LineItem refers to 1 Product] association-rule
print output

which output is:

>> parse [LineItem refers to 1 Product] association-rule
== true
>> print output
[LineItem]0..*->1[Product]
>>

Finally, let’s put all the pieces together:

note-rule: [(color: "beige") some [
  'note [
          copy note-string to 'fond thru 'fond copy color to end
          (append output rejoin ["note: " note-string "{" "bg:" color "}"])
          |
          copy note-string to  end  (append output rejoin ["note: " note-string "{" "bg:" color "}"])              

    ]
  ]
  |           copy note-string to 'fond thru 'fond copy color to end
          (append output rejoin ["note: " note-string "{" "bg:" color "}"])
          |
          copy note-string to  end  (append output rejoin ["note: " note-string "{" "bg:" color "}"])
]

inheritance-rule: [some [ [copy Class to 'is thru 'is 'a copy Base-Class to end (append output rejoin ["[" Class "]^[" Base-Class "]"])]
 ]
]

composition-rule: [set class1 word! 'has set m integer! 'to set n integer! set class2 word! (append output rejoin ["[" Class1 "]++" m "-" n "[" Class2 "]"])]

attribute: copy []
class: copy []
fs: to-lit-word "/"
output: copy ""

definition-rule:  [
    some [set class word! (append output join class "|") 'is 'defined 'by [
        some [copy attribute to fs thru fs (append output join attribute ";")]
    ]
    copy attribute to end (append output attribute)]
]

composition-rule2:  [set class1 word! 'has set class2 word! (cardinality: "*" cardinality0: "0") copy rest to end
(
if find mold/only rest "(s)" [cardinality: "*" ]
if find  mold/only rest "(at least" [parse mold/only rest [thru "at least " copy cardinality0 to ")"] ]
append output rejoin ["[" Class1 "]++1-" cardinality0 ".." cardinality "[" Class2 "]"]
)
]

classes: copy []
slash: to-lit-word "/"
inheritance-rule2: [set class word! 'can 'be
[some [copy x to slash thru slash (append classes x)] copy x to end
(append classes x)]

(foreach class2 classes [
append output rejoin ["[" class "]" '^ "[" class2 "]" newline]
])
]

attribute: copy []
class: copy []
fs: to-lit-word "/"
double-fs: to-lit-word "//"

output: copy ""

definition-rule:  [
    some [set class word! (append output join class "|") 'is 'defined 'by [
        some [
          copy attribute to fs thru fs (append output join attribute ";")
        ]
    ]
    copy attribute to end (append output attribute)]
    (replace output "//" "|")
]

association-rule: [set class1 word! ['uses | 'refers 'to] set n integer! set class2 word!
(append output rejoin ["[" Class1 "]0..*" "->" n "[" Class2 "]"])
]

specific-rules: [inheritance-rule |
inheritance-rule2 |
composition-rule |
definition-rule |
composition-rule2 |
association-rule]

yuml-rule: [[specific-rules] | note-rule ]

Let’s test it with

output: copy ""
parse [Product is defined by Description / Weight // getPricePerWeight / getWeight ] yuml-rule
print output

This sample works:

>> parse [Product is defined by Description / Weight // getPricePerWeight
/ getWeight ] yuml-rule
== true
>> print output
Product|Description;Weight|getPricePerWeight;getWeight
>>

Let’s now introduce the yUML rules inside the Robot Worker:

Rebol [
    Name: "Yuml Class Diagram Robot"
    Description: "Generate Yuml Class Diagram Syntax"
    Version: 1.0.0
    Change: ""
]

ROBOT: make object! [

  output: copy ""

note-rule: [(color: "beige") some [
  'note [
          copy note-string to 'fond thru 'fond copy color to end
          (append output rejoin ["note: " note-string "{" "bg:" color "}"])
          |
          copy note-string to  end  (append output rejoin ["note: " note-string "{" "bg:" color "}"])              

    ]
  ]
  |           copy note-string to 'fond thru 'fond copy color to end
          (append output rejoin ["note: " note-string "{" "bg:" color "}"])
          |
          copy note-string to  end  (append output rejoin ["note: " note-string "{" "bg:" color "}"])
]

;====================================================

inheritance-rule: [some [ [copy Class to 'is thru 'is 'a copy Base-Class to end (append output rejoin ["[" Class "]^[" Base-Class "]"])]
 ]
]

composition-rule: [set class1 word! 'has set m integer! 'to set n integer! set class2 word! (append output rejoin ["[" Class1 "]++" m "-" n "[" Class2 "]"])]

attribute: copy []
class: copy []
fs: to-lit-word "/"
output: copy ""

definition-rule:  [
    some [set class word! (append output join class "|") 'is 'defined 'by [
        some [copy attribute to fs thru fs (append output join attribute ";")]
    ]
    copy attribute to end (append output attribute)]
]

composition-rule2:  [set class1 word! 'has set class2 word! (cardinality: "*" cardinality0: "0") copy rest to end
(
if find mold/only rest "(s)" [cardinality: "*" ]
if find  mold/only rest "(at least" [parse mold/only rest [thru "at least " copy cardinality0 to ")"] ]
append output rejoin ["[" Class1 "]++1-" cardinality0 ".." cardinality "[" Class2 "]"]
)
]

classes: copy []
slash: to-lit-word "/"
inheritance-rule2: [set class word! 'can 'be
[some [copy x to slash thru slash (append classes x)] copy x to end
(append classes x)]

(foreach class2 classes [
append output rejoin ["[" class "]" '^ "[" class2 "]" newline]
])
]

attribute: copy []
class: copy []
fs: to-lit-word "/"
double-fs: to-lit-word "//"

output: copy ""

definition-rule:  [
    some [set class word! (append output join class "|") 'is 'defined 'by [
        some [
          copy attribute to fs thru fs (append output join attribute ";")
        ]
    ]
    copy attribute to end (append output attribute)]
    (replace output "//" "|")
]

association-rule: [set class1 word! ['uses | 'refers 'to] set n integer! set class2 word!
(append output rejoin ["[" Class1 "]0..*" "->" n "[" Class2 "]"])
]

specific-rules: [inheritance-rule |
inheritance-rule2 |
composition-rule |
definition-rule |
composition-rule2 |
association-rule]

yuml-rule: [[specific-rules] | note-rule ]
;====================================================

  ;task1 function
  Generate: func [yuml-orders][

    output: copy ""

    block-orders-draft: parse/all yuml-orders "^/"
    block-orders: copy []
    foreach order block-orders-draft [

      if (length? (order: trim/head/tail order)) > 0 [
          append block-orders  order
      ]
    ]

    foreach order block-orders [
      order-block: to-block order
      parse order-block yuml-rule
      append output newline
    ]
  ]

  ;task2 function
  list: func [][
      foreach Task Tasks-List [
        print Task
      ]
  ]

  ;core engine
  run: func
  [

      Tasks-List: copy [] ; reset the list
      output: copy ""
      do bind code 'self
  ]

]

Worker: Make Robot[]

Yuml-Orders-list: [

  {
    Customer is a User
    Customer has 1 to 2 Address
    Customer is defined by First Name / Last Name / Email
    Customer has Order(s)

  }

  {
    Order has LineItem(s) (at least 1)
    Order uses 1 PaymentMethod
    PaymentMethod can be Credit / Cash / Check
    Product is defined by Description / Weight // getPricePerWeight / getWeight
    Product is used by LineItem(s)
  }

]

Robot-Orders: [
   Yuml-Output-List: copy []

   foreach Yuml-Orders Yuml-Orders-list [
       Print ["Yuml-Orders: " Yuml-Orders " started ..." newline]
       generate Yuml-Orders
       Print output
       Append Yuml-Output-List copy output

       Print ["Yuml-Orders: " Yuml-Orders " done! " newline]
       Print Newline
   ]

   Probe Yuml-Output-List
   write clipboard:// mold Yuml-Output-List
   Print "Copied to clipboard..."
]

Worker/Run Robot-Orders
input

The Robot output is this:

[{
[Customer]^[User]
[Customer]++1-2[Address]
Customer|FirstName;LastName;Email
Customer|[Customer]++1-0..*[Order]
} 

{
Order|[Order]++1-1..*[LineItem]
Order|[Order]0..*->1[PaymentMethod]
[PaymentMethod]^^[Credit]
[PaymentMethod]^^[Cash]
[PaymentMethod]^^[Check]

Product|Description;Weight|getPricePerWeight;getWeight
Product|note: Product is used by LineItem s{bg:beige}
}
]

So we have a few bugs, we’ll see how to correct them next time.