|
| 1 | +(* Copyright 2017 Yurii Litvinov |
| 2 | + * |
| 3 | + * Licensed under the Apache License, Version 2.0 (the "License"); |
| 4 | + * you may not use this file except in compliance with the License. |
| 5 | + * You may obtain a copy of the License at |
| 6 | + * |
| 7 | + * http://www.apache.org/licenses/LICENSE-2.0 |
| 8 | + * |
| 9 | + * Unless required by applicable law or agreed to in writing, software |
| 10 | + * distributed under the License is distributed on an "AS IS" BASIS, |
| 11 | + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
| 12 | + * See the License for the specific language governing permissions and |
| 13 | + * limitations under the License. *) |
| 14 | + |
| 15 | +namespace Repo.Metametamodels |
| 16 | + |
| 17 | +open Repo |
| 18 | +open Repo.DataLayer |
| 19 | +open Repo.InfrastructureSemanticLayer |
| 20 | + |
| 21 | +/// Initializes repository with Constraints Metamodel, first testing metamodel of a real language. |
| 22 | +type ConstraintsMetamodelBuilder() = |
| 23 | + interface IModelBuilder with |
| 24 | + member this.Build(repo: IRepo): unit = |
| 25 | + let infrastructure = InfrastructureSemanticLayer.InfrastructureSemantic(repo) |
| 26 | + let metamodel = infrastructure.Metamodel.Model |
| 27 | + |
| 28 | + let find name = CoreSemanticLayer.Model.findNode metamodel name |
| 29 | + let findAssociation node name = CoreSemanticLayer.Model.findAssociationWithSource node name |
| 30 | + |
| 31 | + let metamodelElement = find "Element" |
| 32 | + let metamodelNode = find "Node" |
| 33 | + let metamodelGeneralization = find "Generalization" |
| 34 | + let metamodelAssociation = find "Association" |
| 35 | + let metamodelAttribute = find "Attribute" |
| 36 | + |
| 37 | + let metamodelStringNode = find "String" |
| 38 | + let metamodelBooleanNode = find "Boolean" |
| 39 | + let metamodelMetatypeNode = find "Metatype" |
| 40 | + let metamodelAttributeKindNode = find "AttributeKind" |
| 41 | + |
| 42 | + let attributesAssociation = findAssociation metamodelElement "attributes" |
| 43 | + |
| 44 | + let shapeAssociation = findAssociation metamodelElement "shape" |
| 45 | + let isAbstractAssociation = findAssociation metamodelElement "isAbstract" |
| 46 | + let instanceMetatypeAssociation = findAssociation metamodelElement "instanceMetatype" |
| 47 | + |
| 48 | + let attributeKindAssociation = findAssociation metamodelAttribute "kind" |
| 49 | + let attributeStringValueAssociation = findAssociation metamodelAttribute "stringValue" |
| 50 | + |
| 51 | + let edgeTargetNameAssociation = findAssociation metamodelAssociation "targetName" |
| 52 | + |
| 53 | + let model = repo.CreateModel("ConstraintsMetamodel", metamodel) |
| 54 | + model.Properties <- model.Properties.Add ("IsVisible", false.ToString()) |
| 55 | + |
| 56 | + let (~+) (name, shape, isAbstract) = |
| 57 | + let node = infrastructure.Instantiate model metamodelNode :?> INode |
| 58 | + node.Name <- name |
| 59 | + infrastructure.Element.SetAttributeValue node "shape" shape |
| 60 | + infrastructure.Element.SetAttributeValue node "isAbstract" (if isAbstract then "true" else "false") |
| 61 | + infrastructure.Element.SetAttributeValue node "instanceMetatype" "Metatype.Node" |
| 62 | + |
| 63 | + node |
| 64 | + |
| 65 | + let (--|>) (source: IElement) target = |
| 66 | + model.CreateGeneralization(metamodelGeneralization, source, target) |> ignore |
| 67 | + |
| 68 | + let (--->) (source: IElement) (target, targetName, linkName) = |
| 69 | + let edge = infrastructure.Instantiate model metamodelAssociation :?> IAssociation |
| 70 | + edge.Source <- Some source |
| 71 | + edge.Target <- Some target |
| 72 | + edge.TargetName <- targetName |
| 73 | + |
| 74 | + infrastructure.Element.SetAttributeValue edge "shape" "View/Pictures/edge.png" |
| 75 | + infrastructure.Element.SetAttributeValue edge "isAbstract" "false" |
| 76 | + infrastructure.Element.SetAttributeValue edge "instanceMetatype" "Metatype.Edge" |
| 77 | + infrastructure.Element.SetAttributeValue edge "name" linkName |
| 78 | + |
| 79 | + edge |
| 80 | + |
| 81 | + let abstractNode = +("AbstractNode", "", true) |
| 82 | + let initialNode = +("InitialNode", "View/Pictures/initialBlock.png", false) |
| 83 | + let finalNode = +("FinalNode", "View/Pictures/finalBlock.png", false) |
| 84 | + |
| 85 | + let abstractMotorsBlock = +("AbstractMotorsBlock", "", true) |
| 86 | + infrastructure.Element.AddAttribute abstractMotorsBlock "ports" "AttributeKind.String" "M3, M4" |
| 87 | + |
| 88 | + let abstractMotorsPowerBlock = +("AbstractMotorsPowerBlock", "", true) |
| 89 | + infrastructure.Element.AddAttribute abstractMotorsPowerBlock "power" "AttributeKind.Int" "100" |
| 90 | + |
| 91 | + let motorsForward = +("MotorsForward", "View/Pictures/enginesForwardBlock.png", false) |
| 92 | + let motorsBackward = +("MotorsBackward", "View/Pictures/enginesBackwardBlock.png", false) |
| 93 | + let motorsStop = +("MotorsStop", "View/Pictures/enginesStopBlock.png", false) |
| 94 | + let timer = +("Timer", "View/Pictures/timerBlock.png", false) |
| 95 | + |
| 96 | + let allNodes = +("AllNodes", "View/Pictures/allNodes.png", false) |
| 97 | + let noNodes = +("NoNodes", "View/Pictures/noNodes.png", false) |
| 98 | + let orNode = +("OrNode", "View/Pictures/orNode.png", false) |
| 99 | + let notNode = +("NotNode", "View/Pictures/notNode.png", false) |
| 100 | + |
| 101 | + let link = abstractNode ---> (abstractNode, "target", "Link") |
| 102 | + infrastructure.Element.AddAttribute link "guard" "AttributeKind.String" "" |
| 103 | + |
| 104 | + infrastructure.Element.AddAttribute timer "delay" "AttributeKind.Int" "1000" |
| 105 | + |
| 106 | + finalNode --|> abstractNode |
| 107 | + motorsForward --|> abstractMotorsPowerBlock |
| 108 | + motorsBackward --|> abstractMotorsPowerBlock |
| 109 | + abstractMotorsPowerBlock --|> abstractMotorsBlock |
| 110 | + motorsStop --|> abstractMotorsBlock |
| 111 | + abstractMotorsBlock --|> abstractNode |
| 112 | + timer --|> abstractNode |
| 113 | + allNodes --|> abstractNode |
| 114 | + noNodes --|> abstractNode |
| 115 | + orNode --|> abstractNode |
| 116 | + notNode --|> abstractNode |
| 117 | + |
| 118 | + () |
0 commit comments