362 lines
14 KiB
Standard ML
362 lines
14 KiB
Standard ML
(*****************************************************************************
|
|
* uml2cdl --- a converter from UML models to WS-CDL. part of su4sml
|
|
* http://projects.brucker.ch/su4sml/
|
|
*
|
|
* cdl2xml.sml ---
|
|
* This file is part of uml2cdl.
|
|
*
|
|
* Copyright (c) 2005-2007, ETH Zurich, Switzerland
|
|
*
|
|
* All rights reserved.
|
|
*
|
|
* Redistribution and use in source and binary forms, with or without
|
|
* modification, are permitted provided that the following conditions are
|
|
* met:
|
|
*
|
|
* * Redistributions of source code must retain the above copyright
|
|
* notice, this list of conditions and the following disclaimer.
|
|
*
|
|
* * Redistributions in binary form must reproduce the above
|
|
* copyright notice, this list of conditions and the following
|
|
* disclaimer in the documentation and/or other materials provided
|
|
* with the distribution.
|
|
*
|
|
* * Neither the name of the copyright holders nor the names of its
|
|
* contributors may be used to endorse or promote products derived
|
|
* from this software without specific prior written permission.
|
|
*
|
|
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
|
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
|
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
|
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
|
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
|
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
|
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
|
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
|
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
******************************************************************************)
|
|
(**
|
|
* functions for serializing cdl types to xml trees.
|
|
*)
|
|
structure Cdl2Xml =
|
|
struct
|
|
open CDL
|
|
fun filter_opt_args opt = map (fn (x,y) => (x,valOf y))
|
|
(List.filter (fn (x,y) => Option.isSome y) opt)
|
|
|
|
fun option_to_list (SOME s) = [s]
|
|
| option_to_list NONE = nil
|
|
|
|
(* FIX: empty for now *)
|
|
fun tTokenLocator2Xml it = XmlTree.Node (("tokenLocator",[]),[])
|
|
fun tPassing2Xml it = XmlTree.Node (("passing",[]),[])
|
|
fun tIdentity2Xml it = XmlTree.Node (("identity",[]),[])
|
|
fun tException2Xml it = XmlTree.Node (("exceptionBlock",[]),[])
|
|
fun tFinalizer2Xml it = XmlTree.Node (("finalizerBlock",[]),[])
|
|
fun tRecord2Xml it = XmlTree.Node (("record",[]),[])
|
|
fun tFinalizerReference2Xml it = XmlTree.Node (("finalizerReference",[]),[])
|
|
fun tTimeout2Xml it = XmlTree.Node (("timeout",[]),[])
|
|
|
|
fun tSourceVariableRef2Xml (it:tSourceVariableRef) = XmlTree.Node (("source",[("variable",#variable it)]),[])
|
|
fun tVariableRef2Xml s (it:tVariableRef) = XmlTree.Node ((s,[("variable",#variable it)]),[])
|
|
|
|
|
|
fun tCopy2Xml (it:tCopy) = XmlTree.Node (("copy",[("name",#name it)]),
|
|
[tSourceVariableRef2Xml (#source it),
|
|
tVariableRef2Xml "target" (#target it)])
|
|
|
|
|
|
fun tBind2Xml it = XmlTree.Node (("bind",[]),[])
|
|
|
|
fun tDescription2Xml (it:CDL.tDescription) =
|
|
XmlTree.Node (("description",[("type",CDL.tDescriptionType2String (#description_type it))]), [XmlTree.Text (#content it)])
|
|
|
|
fun tParticipate2Xml (it:CDL.tParticipate) =
|
|
XmlTree.Node (("participate",[("relationshipType",#relationshipType it),
|
|
("fromRoleTypeRef",#fromRole it),
|
|
("toRoleTypeRef",#toRole it)]),[])
|
|
|
|
|
|
fun tRelationshipRef2Xml it = XmlTree.Node (("relationship",[("type",it)]),[])
|
|
|
|
fun tVariableRecordRef2Xml s (it:CDL.tVariableRecordRef) =
|
|
let val opt_args = filter_opt_args [("variable",#variable it),
|
|
("causeException",Option.map Bool.toString (#causeException it))]
|
|
in XmlTree.Node ((s,opt_args),[])
|
|
end
|
|
|
|
|
|
fun tExchange2Xml (it:CDL.tExchange) =
|
|
let val opt_args = filter_opt_args [("informationType",#informationType it),
|
|
("channelType",#channelType it)]
|
|
in
|
|
XmlTree.Node (("exchange",[("name",#name it),
|
|
("action",CDL.tAction2String (#action it))]
|
|
@opt_args),
|
|
[tVariableRecordRef2Xml "send" (#send it),
|
|
tVariableRecordRef2Xml "receive" (#receive it)])
|
|
end
|
|
|
|
|
|
(* FIX: handle optional attribute roleTypes *)
|
|
fun tVariable2Xml (it:CDL.tVariable) =
|
|
let val opt_args = filter_opt_args [("informationType",#informationType it),
|
|
("channelType",#channelType it),
|
|
("mutable",Option.map Bool.toString (#mutable it)),
|
|
("free",Option.map Bool.toString (#free it)),
|
|
("silent",Option.map Bool.toString (#silent it)),
|
|
("roleTypes", #roleTypes it)]
|
|
in
|
|
XmlTree.Node (("variable",[("name",#name it)]@opt_args),[])
|
|
end
|
|
|
|
fun tVariableDefinitions2Xml it = XmlTree.Node (("variableDefinitions",[]),
|
|
map tVariable2Xml it)
|
|
|
|
|
|
fun tActivity2Xml (CDL.sequence it) = XmlTree.Node (("sequence",[]),
|
|
map tActivity2Xml it)
|
|
| tActivity2Xml (CDL.parallel it) = XmlTree.Node (("parallel",[]),
|
|
map tActivity2Xml it)
|
|
| tActivity2Xml (CDL.choice it) = XmlTree.Node (("choice",[]),
|
|
map tActivity2Xml it)
|
|
| tActivity2Xml (CDL.workunit it) = tWorkunit2Xml it
|
|
| tActivity2Xml (CDL.interaction it) =
|
|
let val opt_args = filter_opt_args
|
|
[("align",Option.map Bool.toString (#align it)),
|
|
("initiate",Option.map Bool.toString (#initiate it))]
|
|
in
|
|
XmlTree.Node (("interaction",[("name",#name it),
|
|
("channelVariable",#channelVariable it),
|
|
("operation",#operation it)]@opt_args),
|
|
List.concat [[tParticipate2Xml (#participate it)],
|
|
map tExchange2Xml (#exchange it),
|
|
map tTimeout2Xml (option_to_list (#timeout it)),
|
|
map tRecord2Xml (#record it)])
|
|
end
|
|
| tActivity2Xml (CDL.perform it) =
|
|
let val opt_args = filter_opt_args [("choreographyInstanceId",
|
|
#choreographyInstanceId it)]
|
|
in
|
|
XmlTree.Node (("perform",[("choreographyName",#choreographyName it)]@opt_args),
|
|
List.concat [map tBind2Xml (#bind it),
|
|
map tChoreography2Xml (option_to_list (#choreography it))])
|
|
end
|
|
| tActivity2Xml (CDL.assign it) =
|
|
XmlTree.Node (("assign",[("roleType",#roleType it)]),
|
|
map tCopy2Xml (#copy it))
|
|
| tActivity2Xml (CDL.silentAction it) =
|
|
let val opt_args = filter_opt_args [("roleType",#roleType it)]
|
|
in
|
|
XmlTree.Node (("silentAction",opt_args), map tDescription2Xml
|
|
(option_to_list (#description it)))
|
|
end
|
|
| tActivity2Xml (CDL.noAction it) =
|
|
let val opt_args = filter_opt_args [("roleType",#roleType it)]
|
|
in
|
|
XmlTree.Node (("noAction",opt_args),[])
|
|
end
|
|
| tActivity2Xml (CDL.finalize it) =
|
|
XmlTree.Node (("finalize",[("name",#name it)]),
|
|
map tFinalizerReference2Xml (#finalizerReference it))
|
|
and tWorkunit2Xml (it:CDL.tWorkunit) =
|
|
let val opt_args = filter_opt_args [("guard",#guard it),
|
|
("repeat", #repeat it),
|
|
("block", Option.map Bool.toString (#block it))]
|
|
in
|
|
XmlTree.Node (("workunit",[("name",#name it)]@opt_args),
|
|
map tActivity2Xml (#activity it))
|
|
end
|
|
and tChoreography2Xml ((CDL.choreography it):CDL.tChoreography) =
|
|
let val opt_args = filter_opt_args [("complete",#complete it),
|
|
("isolation",Option.map Bool.toString (#isolation it)),
|
|
("root",Option.map Bool.toString (#root it)),
|
|
("coordination",Option.map Bool.toString (#coordination it))]
|
|
in
|
|
XmlTree.Node (("choreography",[("name",#name it)]@opt_args),
|
|
List.concat [map tRelationshipRef2Xml (#relationship it),
|
|
[tVariableDefinitions2Xml (#variableDefinitions it)],
|
|
map tChoreography2Xml (#choreography it),
|
|
[tActivity2Xml (#activity it)],
|
|
map tException2Xml (#exceptionBlock it),
|
|
map tFinalizer2Xml (#finalizerBlock it)])
|
|
end
|
|
|
|
fun tTokenReference2Xml (it:CDL.tTokenReference) =
|
|
XmlTree.Node (("token",[("name",it)]),[])
|
|
|
|
fun tReference2Xml (it:CDL.tReference) =
|
|
XmlTree.Node (("reference",[]), [tTokenReference2Xml (#token it)])
|
|
|
|
fun tRoleRef32Xml (it:CDL.tRoleRef3) =
|
|
let val opt_args = filter_opt_args [("behavior",#behavior it)]
|
|
in
|
|
XmlTree.Node (("roleType",[("typeRef",#ref_type it)]@opt_args),[])
|
|
end
|
|
|
|
fun tChannelType2Xml (it:CDL.tChannelType) =
|
|
let val opt_args = filter_opt_args
|
|
[("usage",Option.map CDL.tUsage2String (#usage it)),
|
|
("action", Option.map CDL.tAction2String (#action it))]
|
|
in
|
|
XmlTree.Node (("channelType",[("name",#name it)]),
|
|
List.concat [map tPassing2Xml (#passing it),
|
|
[tRoleRef32Xml (#role it)],
|
|
[tReference2Xml (#reference it)],
|
|
map tIdentity2Xml (option_to_list (#identity it))])
|
|
end
|
|
|
|
fun tBehavior2Xml (it:CDL.tBehavior) =
|
|
let val opt_args = filter_opt_args [("interface",#interface it)]
|
|
in
|
|
XmlTree.Node (("behavior",[("name",#name it)]),[])
|
|
end
|
|
|
|
fun tRoleRef22Xml (it:CDL.tRoleRef2) =
|
|
XmlTree.Node (("roleType",[("typeRef",#ref_type it)]),[])
|
|
|
|
fun tParticipantType2Xml (it:CDL.tParticipantType) =
|
|
XmlTree.Node (("participantType",[("name",#name it)]),
|
|
map tRoleRef22Xml (#role it))
|
|
|
|
fun tRoleRef2Xml (it:CDL.tRoleRef) =
|
|
XmlTree.Node (("roleType",[("typeRef",#ref_type it)]),[])
|
|
|
|
fun tRelationshipType2Xml (it:CDL.tRelationshipType) =
|
|
XmlTree.Node (("relationshipType",[("name",#name it)]),
|
|
[tRoleRef2Xml (#1 (#role it)),
|
|
tRoleRef2Xml (#2 (#role it))])
|
|
|
|
fun tToken2Xml (it:CDL.tToken) =
|
|
XmlTree.Node (("token",[("name",#name it),
|
|
("informationType",#informationType it)]),
|
|
[])
|
|
|
|
|
|
fun tRoleType2XML (it:CDL.tRoleType) =
|
|
XmlTree.Node (("roleType",[("name",#name it)]),
|
|
map tBehavior2Xml (#behavior it))
|
|
|
|
|
|
fun tInformationType2Xml (it:CDL.tInformationType) =
|
|
let val opt_args = filter_opt_args [("type",#information_type it),
|
|
("element",#element it),
|
|
("exceptionType",Option.map Bool.toString (#exceptionType it))]
|
|
in
|
|
XmlTree.Node (("informationType",[("name",#name it)]@opt_args),
|
|
[])
|
|
end
|
|
|
|
|
|
fun tPackage2Xml (package:CDL.tPackage) =
|
|
XmlTree.Node (("package",[("name",#name package),
|
|
("author",#author package),
|
|
("version",#version package),
|
|
("targetNamespace",#targetNamespace package),
|
|
("xmlns","http://www.w3.org/2005/10/cdl"),
|
|
("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance"),
|
|
(* SAP seems to use these ones also: *)
|
|
("xmlns:cdl2bpelns","http://cdl2bpel.cecka.sap.com"),
|
|
("xmlns:choreons","http://unspecified.namespace"), (* ??? *)
|
|
("xmlns:xsd","http://www.w3.org/2001/XMLSchema")
|
|
]),
|
|
List.concat [[XML_Schema2Xml.xsdSchema2Xml (#schema package)],
|
|
map tInformationType2Xml (#informationType package),
|
|
map tToken2Xml (#token package),
|
|
map tTokenLocator2Xml (#tokenLocator package),
|
|
map tRoleType2XML (#roleType package),
|
|
map tRelationshipType2Xml (#relationshipType package),
|
|
map tParticipantType2Xml (#participantType package),
|
|
map tChannelType2Xml (#channelType package),
|
|
map tChoreography2Xml (#choreography package)])
|
|
|
|
|
|
|
|
|
|
(* just for testing purposes:
|
|
val exampleChoreography = ({name="WP35_CDL",author="Juergen Doser",version="0.01",
|
|
targetNamespace="http://eu.trustcom/...",
|
|
informationType=[{name="dummy",
|
|
information_type=SOME "dummyT",
|
|
element=NONE,
|
|
exceptionType=NONE}],
|
|
token=[{name="customerRef",informationType="xsi:uri"},
|
|
{name="designerRef",informationType="xsi:uri"},
|
|
{name="analysisRef",informationType="xsi:uri"},
|
|
{name="manufacturabilityRef",
|
|
informationType="xsi:uri"}],
|
|
tokenLocator=[],
|
|
roleType=[{name="BPEL_Engine",
|
|
behavior=[{name="BPEL_Engine",
|
|
interface=NONE}]},
|
|
{name="Customer_Negotiation",
|
|
behavior=[{name="Customer_Negotiation",
|
|
interface=NONE}]},
|
|
{name="Design",
|
|
behavior=[{name="Design",interface=NONE}]},
|
|
{name="Analysis",
|
|
behavior=[{name="Analysis",interface=NONE}]},
|
|
{name="Manufacturability_Evaluation",
|
|
behavior=[{name="Manufacturability_Evaluation",
|
|
interface=NONE}]}],
|
|
relationshipType=[{name="BPEL_Design",
|
|
role=({ref_type="BPEL_Engine",
|
|
behavior=NONE},
|
|
{ref_type="Design",
|
|
behavior=NONE})},
|
|
{name="BPEL_Customer",
|
|
role=({ref_type="BPEL_Engine",
|
|
behavior=NONE},
|
|
{ref_type="Customer_Negotiation",
|
|
behavior=NONE})},
|
|
{name="Design_Analysis",
|
|
role=({ref_type="Analysis",
|
|
behavior=NONE},
|
|
{ref_type="Design",
|
|
behavior=NONE})},
|
|
{name="Design_Manufacturability",
|
|
role=({ref_type="Design",
|
|
behavior=NONE},
|
|
{ref_type="Manufacturability_Evaluation",behavior=NONE})}],
|
|
participantType=[],
|
|
channelType=[{name="CustomerChannel",usage=NONE,
|
|
action=NONE,passing=[],
|
|
role=[{ref_type="Customer_Negotiation",
|
|
behavior=NONE}],
|
|
reference=[{token={name="customerRef"}}],
|
|
identity=nil},
|
|
{name="DesignChannel",usage=NONE,
|
|
action=NONE,passing=[],
|
|
role=[{ref_type="Design",
|
|
behavior=NONE}],
|
|
reference=[{token={name="designRef"}}],
|
|
identity=nil},
|
|
{name="AnalysisChannel",usage=NONE,
|
|
action=NONE,passing=[],
|
|
role=[{ref_type="Analysis",
|
|
behavior=NONE}],
|
|
reference=[{token={name="analysisRef"}}],
|
|
identity=nil},
|
|
{name="ManufacturabilityChannel",usage=NONE,
|
|
action=NONE,passing=[],
|
|
role=[{ref_type="Manufacturability_Evaluation",
|
|
behavior=NONE}],
|
|
reference=[{token={name="manufacturabilityRef"}}],
|
|
identity=nil}],
|
|
choreography=[CDL.choreography {name="Negotiation",
|
|
complete=NONE,isolation=NONE,
|
|
root=NONE,coordination=NONE,
|
|
relationship=[],
|
|
variableDefinitions=[],
|
|
choreography=[],
|
|
activity=[],
|
|
exceptionBlock=[],
|
|
finalizerBlock=[]
|
|
}]
|
|
})
|
|
|
|
val test = WriteXmlTree.writeFile "test.cdl" (tPackage2Xml exampleChoreography) *)
|
|
end
|