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

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