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