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