implementation module iTasks.Gin.ORYX import StdBool import StdEnum from StdFunc import const,o,flip import StdList import StdMisc import StdTuple import StdOverloaded from Data.Map import qualified get, fromList import Text.JSON import Data.Maybe import Text import Data.Graph //import iTasks import iTasks.Gin.AbstractSyntax import iTasks.Gin.FlowLibrary import iTasks.Gin.Parser import iTasks.Gin.Syntax derive gEq ORYXBound, ORYXBounds, ORYXChildShape, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXProperties, ORYXProperty, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError derive JSONEncode ORYXBound, ORYXBounds, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError derive JSONDecode ORYXBound, ORYXBounds, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError derive gVisualizeText ORYXBound, ORYXBounds, ORYXChildShape, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXProperties, ORYXProperty, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError derive gGridRows ORYXBound, ORYXBounds, ORYXChildShape, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXProperties, ORYXProperty, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError derive gHeaders ORYXBound, ORYXBounds, ORYXChildShape, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXProperties, ORYXProperty, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError derive gVisualizeEditor ORYXBound, ORYXBounds, ORYXChildShape, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXProperties, ORYXProperty, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError derive gUpdate ORYXBound, ORYXBounds, ORYXChildShape, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXProperties, ORYXProperty, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError derive gVerify ORYXBound, ORYXBounds, ORYXChildShape, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXProperties, ORYXProperty, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError derive gDefault ORYXBound, ORYXBounds, ORYXChildShape, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXProperties, ORYXProperty, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError JSONEncode{|ORYXChildShape|} {resourceId, properties, stencil, childShapes, outgoing, bounds, dockers, target} # target` = case target of Just t = [("target", toJSON t)] Nothing = [] # fields = [ ("resourceId" , toJSON resourceId) , ("properties" , toJSON properties) , ("stencil" , toJSON stencil) , ("childShapes", toJSON childShapes) , ("outgoing" , toJSON outgoing) , ("bounds" , toJSON bounds) , ("dockers" , toJSON dockers) : target` ] = [JSONObject fields] JSONDecode{|ORYXChildShape|} [node:nodes] # mResourceId = jsonQuery "resourceId" node # mProperties = jsonQuery "properties" node # mStencil = jsonQuery "stencil" node # mChildShapes = jsonQuery "childShapes" node # mOutgoing = jsonQuery "outgoing" node # mBounds = jsonQuery "bounds" node # mDockers = jsonQuery "dockers" node # mTarget = jsonQuery "target" node | isNothing mResourceId = (Nothing, nodes) | isNothing mProperties = (Nothing, nodes) | isNothing mStencil = (Nothing, nodes) | isNothing mChildShapes = (Nothing, nodes) | isNothing mOutgoing = (Nothing, nodes) | isNothing mBounds = (Nothing, nodes) | isNothing mDockers = (Nothing, nodes) = (Just { ORYXChildShape | resourceId = fromJust mResourceId , properties = fromJust mProperties , stencil = fromJust mStencil , childShapes = fromJust mChildShapes , outgoing = fromJust mOutgoing , bounds = fromJust mBounds , dockers = fromJust mDockers , target = mTarget } , nodes) JSONEncode{|ORYXProperties|} (ORYXProperties properties) = [JSONObject (map (\{ORYXProperty | key, value} -> (key, value)) properties)] JSONDecode{|ORYXProperties|} [JSONObject fields:nodes] # properties = ORYXProperties (map (\(key, value) -> {ORYXProperty | key = key, value = value}) fields) = (Just properties, nodes) JSONDecode{|ORYXProperties|} nodes = (Nothing, nodes) newORYXEditor :: ORYXStencilSetReference -> ORYXEditor newORYXEditor stencilset = { ORYXEditor | diagram = newORYXDiagram stencilset , stencilset = stencilset , errors = [] } //where //oryxAlwaysValid :: !ORYXEditor *IWorld -> (!WorldPredicateResult,!*IWorld) //oryxAlwaysValid _ iworld = (WPRValid Nothing, iworld) emptyORYXEditor :: ORYXEditor emptyORYXEditor = newORYXEditor emptyStencilSet where emptyStencilSet :: ORYXStencilSetReference emptyStencilSet = { ORYXStencilSetReference | url = "" , namespace = "" } petriNetORYXEditor :: ORYXEditor petriNetORYXEditor = newORYXEditor petriNetStencilSet where petriNetStencilSet :: ORYXStencilSetReference petriNetStencilSet = { ORYXStencilSetReference | url = "petrinets/petrinet.json" , namespace = "http://b3mn.org/stencilset/petrinet#" } newORYXDiagram :: ORYXStencilSetReference -> ORYXDiagram newORYXDiagram stencilset = { ORYXDiagram | resourceId = "oryx_78E522C8-943A-44FF-B391-14BE8630F198" , properties = ORYXProperties [] , stencil = { ORYXStencilReference | id = "Diagram" } , childShapes = [] , bounds = { ORYXBounds | lowerRight = { ORYXBound | x = 1485.0, y = 1050.0 } , upperLeft = { ORYXBound | x = 0.0, y = 0.0 } } , stencilset = stencilset , ssextensions = [] } bpmnORYXEditor :: ORYXEditor bpmnORYXEditor = newORYXEditor bpmnStencilSet where bpmnStencilSet :: ORYXStencilSetReference bpmnStencilSet = { ORYXStencilSetReference | url = "bpmn2.0/bpmn2.0.json" , namespace = "http://b3mn.org/stencilset/bpmn2.0#" } xmasORYXEditor :: ORYXEditor xmasORYXEditor = newORYXEditor xmasStencilSet where xmasStencilSet :: ORYXStencilSetReference xmasStencilSet = { ORYXStencilSetReference | url = "xmas/xmas.json" , namespace = "http://mbsd.icis.ru.nl/itasks/xmas#" } ginORYXDiagram :: ORYXDiagram ginORYXDiagram = newORYXDiagram ginStencilSet ginORYXEditor :: !ORYXDiagram -> ORYXEditor ginORYXEditor diagram = { ORYXEditor | newORYXEditor ginStencilSet & diagram = diagram } ginStencilSet :: ORYXStencilSetReference ginStencilSet = { ORYXStencilSetReference | url = "/services/json/stencils/gin" , namespace = "http://mbsd.icis.ru.nl/itasks/gin#" } oryxDiagramToGraph :: !Bindings !ORYXDiagram -> GGraph oryxDiagramToGraph bindings diagram = oryxChildShapesToGraph bindings diagram.ORYXDiagram.childShapes oryxChildShapesToGraph :: !Bindings ![ORYXChildShape] -> GGraph oryxChildShapesToGraph bindings shapes // shapeMap :: Map ORYXResourceId ORYXChildShape # shapeMap = ('Data.Map'.fromList o map (\shape -> (shapeId shape, shape))) shapes // nodes :: [(NodeIndex, ORYXChildShape)] # (nodes, graph) = addShapes (filter (not o isEdge) shapes) emptyGraph // nodeMap :: Map ORYXResourceId NodeIndex # nodeMap = ('Data.Map'.fromList o map (\(index,node) -> (shapeId node, index))) nodes //find outgoing edges for each node # edges = (flatten o map (oryxChildShapeToEdges shapeMap nodeMap)) nodes = GGraph (addEdges edges graph) where addShapes :: ![ORYXChildShape] !(Graph GNode GEdge) -> ([(NodeIndex,ORYXChildShape)], Graph GNode GEdge) addShapes [] graph = ([], graph) addShapes [shape:shapes] graph # (index, graph) = addNode (oryxChildShapeToNode bindings shape) graph # (indexedShapes, graph) = addShapes shapes graph = ([(index,shape):indexedShapes], graph) addEdges :: ![(EdgeIndex,GEdge)] !(Graph GNode GEdge) -> Graph GNode GEdge addEdges [] graph = graph addEdges [(edgeIndex,edge):edges] graph = addEdges edges (addEdge edge edgeIndex graph) oryxChildShapeToNode :: !Bindings !ORYXChildShape -> GNode oryxChildShapeToNode bindings shape # mDecl = runParse (getDeclaration (shapeName shape) bindings) = case mDecl of GError [(_, err)] = abort ("oryxChildShapeToNode: Invalid shape " +++ shapeName shape) GSuccess decl = { GNode | identifier = shape.ORYXChildShape.resourceId , name = shapeName shape , position = { GPosition | x = shape.ORYXChildShape.bounds.ORYXBounds.upperLeft.ORYXBound.x , y = shape.ORYXChildShape.bounds.ORYXBounds.upperLeft.ORYXBound.y } , actualParams = oryxChildShapeToActualParams bindings (snd decl) shape } oryxChildShapeToActualParams :: !Bindings GDeclaration !ORYXChildShape -> [GExpression] oryxChildShapeToActualParams bindings decl shape # propMap = propertyMap (shape.ORYXChildShape.properties) = map (oryxChildShapeToActualParam bindings shape propMap) decl.GDeclaration.formalParams oryxChildShapeToActualParam :: !Bindings !ORYXChildShape (Map String JSONNode) !GFormalParameter -> GExpression oryxChildShapeToActualParam bindings childShape propMap formalParam | isTask formalParam.GFormalParameter.type && (not o isEmpty) childShape.ORYXChildShape.childShapes = GGraphExpression (oryxChildShapesToGraph bindings childShape.ORYXChildShape.childShapes) = case 'Data.Map'.get formalParam.GFormalParameter.name propMap of Just (JSONString value) = GCleanExpression value Nothing = abort ("oryxChildShapeToActualParam: " +++ formalParam.GFormalParameter.name +++ " parameter not found") oryxChildShapeToEdges :: (Map ORYXResourceId ORYXChildShape) (Map ORYXResourceId Int) (!Int,!ORYXChildShape) -> [(EdgeIndex,GEdge)] oryxChildShapeToEdges shapeMap nodeMap (fromIndex,fromNode) = catMaybes (map (oryxOutgoingToEdge shapeMap nodeMap fromIndex) fromNode.ORYXChildShape.outgoing) oryxOutgoingToEdge :: (Map ORYXResourceId ORYXChildShape) (Map ORYXResourceId Int) !Int !ORYXOutgoing -> Maybe (EdgeIndex,GEdge) oryxOutgoingToEdge shapeMap nodeMap fromIndex arcres = case 'Data.Map'.get arcres.ORYXOutgoing.resourceId shapeMap of Just arc = case arc.ORYXChildShape.outgoing of [toRes] = case 'Data.Map'.get toRes.ORYXOutgoing.resourceId nodeMap of Just toIndex = Just ((fromIndex,toIndex), { GEdge | identifier = arc.ORYXChildShape.resourceId , pattern = oryxPropertiesToPattern arc.ORYXChildShape.properties } ) Nothing = abort "oryxChildShapeToEdge: Arc outgoing resourceId not found" [] = Nothing //Arc not connected to node _ = abort "oryxChildShapeToEdge: arc cannot point to multiple nodes" Nothing = abort "oryxChildShapeToEdge: Node outgoing resourceId not found" oryxPropertiesToPattern :: !ORYXProperties -> Maybe GPattern oryxPropertiesToPattern properties = case 'Data.Map'.get "pattern" (propertyMap properties) of Just (JSONString s) = case trim s of "" = Nothing s` = Just s` _ = Nothing propertyMap :: !ORYXProperties -> Map String JSONNode propertyMap (ORYXProperties properties) = 'Data.Map'.fromList [ (p.ORYXProperty.key, p.ORYXProperty.value) \\ p <- properties ] shapeId :: !ORYXChildShape -> String shapeId shape = shape.ORYXChildShape.resourceId shapeName :: !ORYXChildShape -> String shapeName shape = shape.ORYXChildShape.stencil.ORYXStencilReference.id isEdge :: !ORYXChildShape -> Bool isEdge shape = shapeName shape == "Arc" updateDiagramExtensions :: !GModule -> GModule updateDiagramExtensions gmod =: { moduleKind = GCleanModule _ } = gmod //GCleanModule does not contain diagrams updateDiagramExtensions gmod =: { moduleKind = GGraphicalModule definitions } = { GModule | gmod & moduleKind = GGraphicalModule (map updateDefinition definitions) } where updateDefinition :: !GDefinition -> GDefinition updateDefinition gdef = { GDefinition | gdef & body = updateDiagram gdef.GDefinition.body } updateDiagram :: !ORYXDiagram -> ORYXDiagram updateDiagram diagram = { ORYXDiagram | diagram & ssextensions = [ "http://mbsd.icis.ru.nl/itasks/gin/" +++ imp +++ "#" \\ imp <- gmod.GModule.imports ] } makeORYXError :: !ORYXDiagram !(GPath,String) -> ORYXError makeORYXError diagram ([],message) = { ORYXError | resourceId = "", message = message, paramName = Nothing } makeORYXError _ ([NodePath p:_],message) = { ORYXError | resourceId = p, message = message, paramName = Nothing } makeORYXError _ ([ParamPath name:NodePath p:_],message) = { ORYXError | resourceId = p, message = message, paramName = Just name } makeORYXError _ ([EdgePath p:_],message) = { ORYXError | resourceId = p, message = message, paramName = Nothing }