X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=blobdiff_plain;ds=sidebyside;f=bundles%2Forg.simantics.modeling%2Fscl%2FSimantics%2FDiagramMapping.scl;h=c11fc532d9697f85a20dec90fa287361513a2442;hb=refs%2Fchanges%2F38%2F238%2F2;hp=7686eeba26f3f5434c4003b7219541966792157f;hpb=24e2b34260f219f0d1644ca7a138894980e25b14;p=simantics%2Fplatform.git

diff --git a/bundles/org.simantics.modeling/scl/Simantics/DiagramMapping.scl b/bundles/org.simantics.modeling/scl/Simantics/DiagramMapping.scl
index 7686eeba2..c11fc532d 100644
--- a/bundles/org.simantics.modeling/scl/Simantics/DiagramMapping.scl
+++ b/bundles/org.simantics.modeling/scl/Simantics/DiagramMapping.scl
@@ -1,124 +1,124 @@
-import "Simantics/DB"
-import "Extras/HashMap" as Map
-import "Simantics/Entity"
-import "Simantics/Model"
-import "Simantics/Diagram"
-
-import "http://www.simantics.org/Modeling-1.2" as MOD
-import "http://www.simantics.org/ModelingTemplate2d-1.0" as TMPL
-
-applyConnectionTypes :: Map.T (DiagramElement Resource) (Resource,Resource) -> <Proc,WriteGraph,ReadGraph> ()
-applyConnectionTypes elementMap = 
-    let
-        isConnection ((Connection _ _ _),_) = True
-        isConnection _ = False
-    in iter (\(a,(source,target)) -> applyConnectionType target) (filter isConnection (Map.entries elementMap))
-   
-
-// ----
-
-doElementPostProcessing (elementMap :: Map.T (DiagramElement Resource) (Resource,Resource))
-                        (elementPostProcessing :: DiagramElement Resource -> Resource -> Resource -> <Proc,ReadGraph,WriteGraph> ()) = do
-    list = sortByCluster (Map.entries elementMap) (\(a,(source,target)) -> target)
-    iter (\(a,(source,target)) -> elementPostProcessing a source target) list
-
-translateDiagrams (sourceModel :: Model)
-                 (targetModel :: Model)
-                 (folderType :: Resource) 
-                 (compositeType :: Resource)
-                 (diagramConstructor :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)])
-                 (diagramPostProcessing :: Diagram -> Diagram -> <Proc,ReadGraph,WriteGraph> ()) 
-                 (elementPostProcessing :: DiagramElement Resource -> Resource -> Resource -> <Proc,ReadGraph,WriteGraph> ()) 
-                 (sourceDiagrams :: [Diagram]) = do
-                 
-  elementMap = Map.create() :: Map.T (DiagramElement Resource) (Resource,Resource)
-
-  // Join map contains all joins of the model
-  joinMap = createJoinMap ()
-  
-  for sourceDiagrams
-    (translateDiagram sourceModel targetModel folderType 
-        compositeType diagramConstructor joinMap 
-        elementMap diagramPostProcessing)
-
-  applyConnectionTypes elementMap
-  
-  targetDiagrams = map f sourceDiagrams :: [Diagram]
-    where 
-      f sourceDiagram = fromJust 
-                      $ getTargetDiagram targetModel 
-                      $ sourceDiagram
-  
-  for targetDiagrams $ \diagram ->
-    syncActivateOnce $ toResource diagram
-    
-  doElementPostProcessing elementMap elementPostProcessing
-
-translateDiagram (sourceModel :: Model)
-                 (targetModel :: Model)
-                 (folderType :: Resource) 
-                 (compositeType :: Resource)
-                 (f :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)])
-                 (joinMap :: Dynamic -> <WriteGraph> Resource)
-                 (elementMap :: Map.T (DiagramElement Resource) (Resource,Resource))
-                 (diagramPostProcessing :: Diagram -> Diagram -> <Proc,ReadGraph,WriteGraph> ()) 
-                 (sourceDiagram :: Diagram) = do
-  disableDependencies 
-  targetDiagram = translateDiagram2 targetModel sourceDiagram folderType compositeType f joinMap elementMap
-  targetDiagram' = diagramResourceOf targetDiagram
-  denyByPredicate targetDiagram' TMPL.HasDrawingTemplate
-  execJust (possibleDrawingTemplate targetModel sourceDiagram) (\template -> claim targetDiagram' TMPL.HasDrawingTemplate template)
-  diagramPostProcessing sourceDiagram targetDiagram
-  ()
-
-possibleDrawingTemplate :: Model -> Diagram -> <ReadGraph> Maybe Resource
-possibleDrawingTemplate model d = do
-    d' = diagramResourceOf d
-    library = fromJust $ possibleResourceChild (toResource model) "Diagram Templates"
-    match (possibleObject d' TMPL.HasDrawingTemplate) with
-        Just dt -> match (possibleNameOf dt) with
-            Just name -> possibleResourceChild library name
-            _ -> Nothing
-        _ -> Nothing
-
-compositeOf :: Resource -> <ReadGraph> Resource
-compositeOf d = singleObject d MOD.DiagramToComposite 
-
-diagramOf :: Resource -> <ReadGraph> Resource
-diagramOf d = singleObject d MOD.CompositeToDiagram 
-
-makeSpec :: Model -> Diagram -> Resource -> Resource -> <WriteGraph, ReadGraph> DiagramSpec 
-makeSpec targetModel sourceDiagram folderType compositeType = 
-  match (getTargetDiagram targetModel sourceDiagram) with
-    Just targetDiagram -> ExistingDiagram targetDiagram
-    Nothing -> NewDiagram targetModel (pathOf sourceDiagram) folderType compositeType
-
-getTargetDiagram (targetModel :: Model) (sourceDiagram :: Diagram) =
-    (possibleDiagram targetModel $ pathOf sourceDiagram) :: Maybe Diagram
-
-store :: Map.T (DiagramElement Resource) (Resource,Resource) -> (DiagramElement Resource) -> Resource -> Resource -> <Proc,WriteGraph,ReadGraph> ()
-store elementMap a b c = do
-  Map.put elementMap a (b,c)
-  ()
-
-getTargetComponent (targetDiagram :: Diagram) (sourceComponent :: Resource) =
-    (possibleResourceChild (toResource targetDiagram) (fromJust $ possibleNameOf sourceComponent)) :: Maybe Resource
-
-translateDiagram2 (targetModel :: Model)  
-                  (sourceDiagram :: Diagram) 
-                  (folderType :: Resource)
-                  (compositeType :: Resource)
-                  (f :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)]) 
-                  (joinMap :: Dynamic -> <WriteGraph> Resource)
-                  (elementMap ::  Map.T (DiagramElement Resource) (Resource,Resource)) = do
-  spec = makeSpec targetModel sourceDiagram folderType compositeType
-  elementSpecs = f sourceDiagram
-  in1 = (filter (not . isReferring) elementSpecs + filter isReferring elementSpecs)
-    where
-      isReferring ((Connection _ _ _),_) = True
-      isReferring ((Monitor _ _ _ _),_) = True
-      isReferring _ = False
-  in2 = map (\(a,b)->a) in1
-  (diagram, elements) = createDiagramR spec joinMap in2 
-  iter (\((a,b),c) -> store elementMap a b c) (zip in1 elements)
+import "Simantics/DB"
+import "Extras/HashMap" as Map
+import "Simantics/Entity"
+import "Simantics/Model"
+import "Simantics/Diagram"
+
+import "http://www.simantics.org/Modeling-1.2" as MOD
+import "http://www.simantics.org/ModelingTemplate2d-1.0" as TMPL
+
+applyConnectionTypes :: Map.T (DiagramElement Resource) (Resource,Resource) -> <Proc,WriteGraph,ReadGraph> ()
+applyConnectionTypes elementMap = 
+    let
+        isConnection ((Connection _ _ _),_) = True
+        isConnection _ = False
+    in iter (\(a,(source,target)) -> applyConnectionType target) (filter isConnection (Map.entries elementMap))
+   
+
+// ----
+
+doElementPostProcessing (elementMap :: Map.T (DiagramElement Resource) (Resource,Resource))
+                        (elementPostProcessing :: DiagramElement Resource -> Resource -> Resource -> <Proc,ReadGraph,WriteGraph> ()) = do
+    list = sortByCluster (Map.entries elementMap) (\(a,(source,target)) -> target)
+    iter (\(a,(source,target)) -> elementPostProcessing a source target) list
+
+translateDiagrams (sourceModel :: Model)
+                 (targetModel :: Model)
+                 (folderType :: Resource) 
+                 (compositeType :: Resource)
+                 (diagramConstructor :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)])
+                 (diagramPostProcessing :: Diagram -> Diagram -> <Proc,ReadGraph,WriteGraph> ()) 
+                 (elementPostProcessing :: DiagramElement Resource -> Resource -> Resource -> <Proc,ReadGraph,WriteGraph> ()) 
+                 (sourceDiagrams :: [Diagram]) = do
+                 
+  elementMap = Map.create() :: Map.T (DiagramElement Resource) (Resource,Resource)
+
+  // Join map contains all joins of the model
+  joinMap = createJoinMap ()
+  
+  for sourceDiagrams
+    (translateDiagram sourceModel targetModel folderType 
+        compositeType diagramConstructor joinMap 
+        elementMap diagramPostProcessing)
+
+  applyConnectionTypes elementMap
+  
+  targetDiagrams = map f sourceDiagrams :: [Diagram]
+    where 
+      f sourceDiagram = fromJust 
+                      $ getTargetDiagram targetModel 
+                      $ sourceDiagram
+  
+  for targetDiagrams $ \diagram ->
+    syncActivateOnce $ toResource diagram
+    
+  doElementPostProcessing elementMap elementPostProcessing
+
+translateDiagram (sourceModel :: Model)
+                 (targetModel :: Model)
+                 (folderType :: Resource) 
+                 (compositeType :: Resource)
+                 (f :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)])
+                 (joinMap :: Dynamic -> <WriteGraph> Resource)
+                 (elementMap :: Map.T (DiagramElement Resource) (Resource,Resource))
+                 (diagramPostProcessing :: Diagram -> Diagram -> <Proc,ReadGraph,WriteGraph> ()) 
+                 (sourceDiagram :: Diagram) = do
+  disableDependencies 
+  targetDiagram = translateDiagram2 targetModel sourceDiagram folderType compositeType f joinMap elementMap
+  targetDiagram' = diagramResourceOf targetDiagram
+  denyByPredicate targetDiagram' TMPL.HasDrawingTemplate
+  execJust (possibleDrawingTemplate targetModel sourceDiagram) (\template -> claim targetDiagram' TMPL.HasDrawingTemplate template)
+  diagramPostProcessing sourceDiagram targetDiagram
+  ()
+
+possibleDrawingTemplate :: Model -> Diagram -> <ReadGraph> Maybe Resource
+possibleDrawingTemplate model d = do
+    d' = diagramResourceOf d
+    library = fromJust $ possibleResourceChild (toResource model) "Diagram Templates"
+    match (possibleObject d' TMPL.HasDrawingTemplate) with
+        Just dt -> match (possibleNameOf dt) with
+            Just name -> possibleResourceChild library name
+            _ -> Nothing
+        _ -> Nothing
+
+compositeOf :: Resource -> <ReadGraph> Resource
+compositeOf d = singleObject d MOD.DiagramToComposite 
+
+diagramOf :: Resource -> <ReadGraph> Resource
+diagramOf d = singleObject d MOD.CompositeToDiagram 
+
+makeSpec :: Model -> Diagram -> Resource -> Resource -> <WriteGraph, ReadGraph> DiagramSpec 
+makeSpec targetModel sourceDiagram folderType compositeType = 
+  match (getTargetDiagram targetModel sourceDiagram) with
+    Just targetDiagram -> ExistingDiagram targetDiagram
+    Nothing -> NewDiagram targetModel (pathOf sourceDiagram) folderType compositeType
+
+getTargetDiagram (targetModel :: Model) (sourceDiagram :: Diagram) =
+    (possibleDiagram targetModel $ pathOf sourceDiagram) :: Maybe Diagram
+
+store :: Map.T (DiagramElement Resource) (Resource,Resource) -> (DiagramElement Resource) -> Resource -> Resource -> <Proc,WriteGraph,ReadGraph> ()
+store elementMap a b c = do
+  Map.put elementMap a (b,c)
+  ()
+
+getTargetComponent (targetDiagram :: Diagram) (sourceComponent :: Resource) =
+    (possibleResourceChild (toResource targetDiagram) (fromJust $ possibleNameOf sourceComponent)) :: Maybe Resource
+
+translateDiagram2 (targetModel :: Model)  
+                  (sourceDiagram :: Diagram) 
+                  (folderType :: Resource)
+                  (compositeType :: Resource)
+                  (f :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)]) 
+                  (joinMap :: Dynamic -> <WriteGraph> Resource)
+                  (elementMap ::  Map.T (DiagramElement Resource) (Resource,Resource)) = do
+  spec = makeSpec targetModel sourceDiagram folderType compositeType
+  elementSpecs = f sourceDiagram
+  in1 = (filter (not . isReferring) elementSpecs + filter isReferring elementSpecs)
+    where
+      isReferring ((Connection _ _ _),_) = True
+      isReferring ((Monitor _ _ _ _),_) = True
+      isReferring _ = False
+  in2 = map (\(a,b)->a) in1
+  (diagram, elements) = createDiagramR spec joinMap in2 
+  iter (\((a,b),c) -> store elementMap a b c) (zip in1 elements)
   diagram :: Diagram
\ No newline at end of file