2 import "Extras/HashMap" as Map
3 import "Simantics/Entity"
4 import "Simantics/Model"
5 import "Simantics/Diagram"
7 import "http://www.simantics.org/Modeling-1.2" as MOD
8 import "http://www.simantics.org/ModelingTemplate2d-1.0" as TMPL
10 applyConnectionTypes :: Map.T (DiagramElement Resource) (Resource,Resource) -> <Proc,WriteGraph,ReadGraph> ()
11 applyConnectionTypes elementMap =
13 isConnection ((Connection _ _ _),_) = True
14 isConnection _ = False
15 in iter (\(a,(source,target)) -> applyConnectionType target) (filter isConnection (Map.entries elementMap))
20 doElementPostProcessing (elementMap :: Map.T (DiagramElement Resource) (Resource,Resource))
21 (elementPostProcessing :: DiagramElement Resource -> Resource -> Resource -> <Proc,ReadGraph,WriteGraph> ()) = do
22 list = sortByCluster (Map.entries elementMap) (\(a,(source,target)) -> target)
23 iter (\(a,(source,target)) -> elementPostProcessing a source target) list
25 translateDiagrams (sourceModel :: Model)
26 (targetModel :: Model)
27 (folderType :: Resource)
28 (compositeType :: Resource)
29 (diagramConstructor :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)])
30 (diagramPostProcessing :: Diagram -> Diagram -> <Proc,ReadGraph,WriteGraph> ())
31 (elementPostProcessing :: DiagramElement Resource -> Resource -> Resource -> <Proc,ReadGraph,WriteGraph> ())
32 (sourceDiagrams :: [Diagram]) = do
34 elementMap = Map.create() :: Map.T (DiagramElement Resource) (Resource,Resource)
36 // Join map contains all joins of the model
37 joinMap = createJoinMap ()
40 (translateDiagram sourceModel targetModel folderType
41 compositeType diagramConstructor joinMap
42 elementMap diagramPostProcessing)
44 applyConnectionTypes elementMap
46 targetDiagrams = map f sourceDiagrams :: [Diagram]
48 f sourceDiagram = fromJust
49 $ getTargetDiagram targetModel
52 for targetDiagrams $ \diagram ->
53 syncActivateOnce diagram
55 doElementPostProcessing elementMap elementPostProcessing
57 translateDiagram (sourceModel :: Model)
58 (targetModel :: Model)
59 (folderType :: Resource)
60 (compositeType :: Resource)
61 (f :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)])
62 (joinMap :: Dynamic -> <WriteGraph> Resource)
63 (elementMap :: Map.T (DiagramElement Resource) (Resource,Resource))
64 (diagramPostProcessing :: Diagram -> Diagram -> <Proc,ReadGraph,WriteGraph> ())
65 (sourceDiagram :: Diagram) = do
67 targetDiagram = translateDiagram2 targetModel sourceDiagram folderType compositeType f joinMap elementMap
68 targetDiagram' = diagramResourceOf targetDiagram
69 denyByPredicate targetDiagram' TMPL.HasDrawingTemplate
70 execJust (possibleDrawingTemplate targetModel sourceDiagram) (\template -> claim targetDiagram' TMPL.HasDrawingTemplate template)
71 diagramPostProcessing sourceDiagram targetDiagram
74 possibleDrawingTemplate :: Model -> Diagram -> <ReadGraph> Maybe Resource
75 possibleDrawingTemplate model d = do
76 d' = diagramResourceOf d
77 library = fromJust $ possibleResourceChild model "Diagram Templates"
78 match (possibleObject d' TMPL.HasDrawingTemplate) with
79 Just dt -> match (possibleNameOf dt) with
80 Just name -> possibleResourceChild library name
84 compositeOf :: Resource -> <ReadGraph> Resource
85 compositeOf d = singleObject d MOD.DiagramToComposite
87 diagramOf :: Resource -> <ReadGraph> Resource
88 diagramOf d = singleObject d MOD.CompositeToDiagram
90 makeSpec :: Model -> Diagram -> Resource -> Resource -> <WriteGraph, ReadGraph> DiagramSpec
91 makeSpec targetModel sourceDiagram folderType compositeType =
92 match (getTargetDiagram targetModel sourceDiagram) with
93 Just targetDiagram -> ExistingDiagram targetDiagram
94 Nothing -> NewDiagram targetModel (pathOf sourceDiagram) folderType compositeType
96 getTargetDiagram (targetModel :: Model) (sourceDiagram :: Diagram) =
97 (possibleDiagram targetModel $ pathOf sourceDiagram) :: Maybe Diagram
99 store :: Map.T (DiagramElement Resource) (Resource,Resource) -> (DiagramElement Resource) -> Resource -> Resource -> <Proc,WriteGraph,ReadGraph> ()
100 store elementMap a b c = do
101 Map.put elementMap a (b,c)
104 getTargetComponent (targetDiagram :: Diagram) (sourceComponent :: Resource) =
105 (possibleResourceChild targetDiagram (fromJust $ possibleNameOf sourceComponent)) :: Maybe Resource
107 translateDiagram2 (targetModel :: Model)
108 (sourceDiagram :: Diagram)
109 (folderType :: Resource)
110 (compositeType :: Resource)
111 (f :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)])
112 (joinMap :: Dynamic -> <WriteGraph> Resource)
113 (elementMap :: Map.T (DiagramElement Resource) (Resource,Resource)) = do
114 spec = makeSpec targetModel sourceDiagram folderType compositeType
115 elementSpecs = f sourceDiagram
116 in1 = (filter (not . isReferring) elementSpecs + filter isReferring elementSpecs)
118 isReferring ((Connection _ _ _),_) = True
119 isReferring ((Monitor _ _ _ _),_) = True
120 isReferring _ = False
121 in2 = map (\(a,b)->a) in1
122 (diagram, elements) = createDiagramR spec joinMap in2
123 iter (\((a,b),c) -> store elementMap a b c) (zip in1 elements)