bundles/org.simantics.modeling/scl/Simantics/DiagramMapping.scl

   1 import "Simantics/DB"
   2 import "Extras/HashMap" as Map
   3 import "Simantics/Entity"
   4 import "Simantics/Model"
   5 import "Simantics/Diagram"
   6
   7 import "http://www.simantics.org/Modeling-1.2" as MOD
   8 import "http://www.simantics.org/ModelingTemplate2d-1.0" as TMPL
   9
  10 applyConnectionTypes :: Map.T (DiagramElement Resource) (Resource,Resource) -> <Proc,WriteGraph,ReadGraph> ()
  11 applyConnectionTypes elementMap =
  12     let
  13         isConnection ((Connection _ _ _),_) = True
  14         isConnection _ = False
  15     in iter (\(a,(source,target)) -> applyConnectionType target) (filter isConnection (Map.entries elementMap))
  16
  17
  18 // ----
  19
  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
  24
  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
  33
  34   elementMap = Map.create() :: Map.T (DiagramElement Resource) (Resource,Resource)
  35
  36   // Join map contains all joins of the model
  37   joinMap = createJoinMap ()
  38
  39   for sourceDiagrams
  40     (translateDiagram sourceModel targetModel folderType
  41         compositeType diagramConstructor joinMap
  42         elementMap diagramPostProcessing)
  43
  44   applyConnectionTypes elementMap
  45
  46   targetDiagrams = map f sourceDiagrams :: [Diagram]
  47     where
  48       f sourceDiagram = fromJust
  49                       $ getTargetDiagram targetModel
  50                       $ sourceDiagram
  51
  52   for targetDiagrams $ \diagram ->
  53     syncActivateOnce diagram
  54
  55   doElementPostProcessing elementMap elementPostProcessing
  56
  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
  66   disableDependencies
  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
  72   ()
  73
  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
  81             _ -> Nothing
  82         _ -> Nothing
  83
  84 compositeOf :: Resource -> <ReadGraph> Resource
  85 compositeOf d = singleObject d MOD.DiagramToComposite
  86
  87 diagramOf :: Resource -> <ReadGraph> Resource
  88 diagramOf d = singleObject d MOD.CompositeToDiagram
  89
  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
  95
  96 getTargetDiagram (targetModel :: Model) (sourceDiagram :: Diagram) =
  97     (possibleDiagram targetModel $ pathOf sourceDiagram) :: Maybe Diagram
  98
  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)
 102   ()
 103
 104 getTargetComponent (targetDiagram :: Diagram) (sourceComponent :: Resource) =
 105     (possibleResourceChild targetDiagram (fromJust $ possibleNameOf sourceComponent)) :: Maybe Resource
 106
 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)
 117     where
 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)
 124   diagram :: Diagram