implementation module GinORYX

import StdBool
import StdEnum
from StdFunc import const,o,flip
import StdList
import StdMisc
import StdTuple
from Map import qualified get, fromList
import JSON
import Maybe
import Text

import iTasks

import GinAbstractSyntax
import GinFlowLibrary
import GinParser
import GinSyntax

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, JSONNode
derive gVisualizeHtml	ORYXBound, ORYXBounds, ORYXChildShape, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXProperties, ORYXProperty, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError, JSONNode
derive gVisualizeEditor	ORYXBound, ORYXBounds, ORYXChildShape, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXProperties, ORYXProperty, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError, JSONNode
derive gUpdate	    	ORYXBound, ORYXBounds, ORYXChildShape, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXProperties, ORYXProperty, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError, JSONNode
derive gDefaultMask		ORYXBound, ORYXBounds, ORYXChildShape, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXProperties, ORYXProperty, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError, JSONNode
derive gVerify  		ORYXBound, ORYXBounds, ORYXChildShape, ORYXDiagram, ORYXDocker, ORYXOutgoing, ORYXProperties, ORYXProperty, ORYXStencilReference, ORYXStencilSetReference, ORYXTarget, ORYXError, JSONNode

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 = ('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 = ('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 '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 'Map'.get arcres.ORYXOutgoing.resourceId shapeMap of
		Just arc 
				 = case arc.ORYXChildShape.outgoing of
			[toRes]	= case '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 '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) = '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 }