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

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