2 import "Simantics/Entity"
3 import "Simantics/Model"
4 import "Simantics/Diagram"
6 import "http://www.simantics.org/Modeling-1.2" as MOD
7 import "http://www.simantics.org/ModelingTemplate2d-1.0" as TMPL
9 applyConnectionTypes :: MMap.T (DiagramElement Resource) (Resource,Resource) -> <Proc,WriteGraph,ReadGraph> ()
10 applyConnectionTypes elementMap =
12 isConnection ((Connection _ _ _),_) = True
13 isConnection _ = False
14 in iter (\(a,(source,target)) -> applyConnectionType target) (filter isConnection (MMap.entries elementMap))
19 doElementPostProcessing (elementMap :: MMap.T (DiagramElement Resource) (Resource,Resource))
20 (elementPostProcessing :: DiagramElement Resource -> Resource -> Resource -> <Proc,ReadGraph,WriteGraph> ()) = do
21 list = sortByCluster (MMap.entries elementMap) (\(a,(source,target)) -> target)
22 iter (\(a,(source,target)) -> elementPostProcessing a source target) list
24 translateDiagrams (sourceModel :: Model)
25 (targetModel :: Model)
26 (folderType :: Resource)
27 (compositeType :: Resource)
28 (diagramConstructor :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)])
29 (diagramPostProcessing :: Diagram -> Diagram -> <Proc,ReadGraph,WriteGraph> ())
30 (elementPostProcessing :: DiagramElement Resource -> Resource -> Resource -> <Proc,ReadGraph,WriteGraph> ())
31 (sourceDiagrams :: [Diagram]) = do
33 elementMap = MMap.create () :: MMap.T (DiagramElement Resource) (Resource,Resource)
35 // Join map contains all joins of the model
36 joinMap = createJoinMap ()
39 (translateDiagram sourceModel targetModel folderType
40 compositeType diagramConstructor joinMap
41 elementMap diagramPostProcessing)
43 applyConnectionTypes elementMap
45 targetDiagrams = map f sourceDiagrams :: [Diagram]
47 f sourceDiagram = fromJust
48 $ getTargetDiagram targetModel
51 for targetDiagrams $ \diagram ->
52 syncActivateOnce diagram
54 doElementPostProcessing elementMap elementPostProcessing
56 translateDiagram (sourceModel :: Model)
57 (targetModel :: Model)
58 (folderType :: Resource)
59 (compositeType :: Resource)
60 (f :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)])
61 (joinMap :: Dynamic -> <WriteGraph> Resource)
62 (elementMap :: MMap.T (DiagramElement Resource) (Resource,Resource))
63 (diagramPostProcessing :: Diagram -> Diagram -> <Proc,ReadGraph,WriteGraph> ())
64 (sourceDiagram :: Diagram) = do
66 targetDiagram = translateDiagram2 targetModel sourceDiagram folderType compositeType f joinMap elementMap
67 targetDiagram' = diagramResourceOf targetDiagram
68 denyByPredicate targetDiagram' TMPL.HasDrawingTemplate
69 execJust (possibleDrawingTemplate targetModel sourceDiagram) (\template -> claim targetDiagram' TMPL.HasDrawingTemplate template)
70 diagramPostProcessing sourceDiagram targetDiagram
73 possibleDrawingTemplate :: Model -> Diagram -> <ReadGraph> Maybe Resource
74 possibleDrawingTemplate model d = do
75 d' = diagramResourceOf d
76 library = fromJust $ possibleResourceChild model "Diagram Templates"
77 match (possibleObject d' TMPL.HasDrawingTemplate) with
78 Just dt -> match (possibleNameOf dt) with
79 Just name -> possibleResourceChild library name
83 compositeOf :: Resource -> <ReadGraph> Resource
84 compositeOf d = singleObject d MOD.DiagramToComposite
86 diagramOf :: Resource -> <ReadGraph> Resource
87 diagramOf d = singleObject d MOD.CompositeToDiagram
89 makeSpec :: Model -> Diagram -> Resource -> Resource -> <WriteGraph, ReadGraph> DiagramSpec
90 makeSpec targetModel sourceDiagram folderType compositeType =
91 match (getTargetDiagram targetModel sourceDiagram) with
92 Just targetDiagram -> ExistingDiagram targetDiagram
93 Nothing -> NewDiagram targetModel (pathOf sourceDiagram) folderType compositeType
95 getTargetDiagram (targetModel :: Model) (sourceDiagram :: Diagram) =
96 (possibleDiagram targetModel $ pathOf sourceDiagram) :: Maybe Diagram
98 store :: MMap.T (DiagramElement Resource) (Resource,Resource) -> (DiagramElement Resource) -> Resource -> Resource -> <Proc,WriteGraph,ReadGraph> ()
99 store elementMap a b c = do
100 MMap.put elementMap a (b,c)
103 getTargetComponent (targetDiagram :: Diagram) (sourceComponent :: Resource) =
104 (possibleResourceChild targetDiagram (fromJust $ possibleNameOf sourceComponent)) :: Maybe Resource
106 translateDiagram2 (targetModel :: Model)
107 (sourceDiagram :: Diagram)
108 (folderType :: Resource)
109 (compositeType :: Resource)
110 (f :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)])
111 (joinMap :: Dynamic -> <WriteGraph> Resource)
112 (elementMap :: MMap.T (DiagramElement Resource) (Resource,Resource)) = do
113 spec = makeSpec targetModel sourceDiagram folderType compositeType
114 elementSpecs = f sourceDiagram
115 in1 = (filter (not . isReferring) elementSpecs + filter isReferring elementSpecs)
117 isReferring ((Connection _ _ _),_) = True
118 isReferring ((Monitor _ _ _ _),_) = True
119 isReferring _ = False
120 in2 = map (\(a,b)->a) in1
121 (diagram, elements) = createDiagramR spec joinMap in2
122 iter (\((a,b),c) -> store elementMap a b c) (zip in1 elements)