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

   1 import "JavaBuiltin" as Java
   2 include "Simantics/Variables"
   3 include "Simantics/Ontologies"
   4 include "Simantics/SCL"
   5 include "Simantics/Misc"
   6 import "http://www.simantics.org/Layer0-1.1/Entity" as ENTITY
   7
   8 createClusterSet :: Resource -> <WriteGraph> ()
   9 createClusterSet r = do
  10     newClusterSet r
  11     selectClusterSet r
  12     ()
  13
  14 createLibrary :: Resource -> Resource -> String -> Boolean -> <WriteGraph> Resource
  15 createLibrary parentLibrary libraryType name clusterSet = do
  16     selectClusterSet parentLibrary
  17     library = newResource ()
  18     match clusterSet with
  19         True -> createClusterSet library
  20         False -> ()
  21     claim library L0.InstanceOf libraryType
  22     claimRelatedValue library L0.HasName name
  23     claim parentLibrary L0.ConsistsOf library
  24     library
  25
  26 uriParts :: String -> [String]
  27 uriParts uri = do
  28     match uri with
  29         "http://" -> []
  30         _ -> do
  31             parts = splitURI uri
  32             addList (uriParts (parts!0)) (parts!1)
  33
  34 getOrCreateLibrary :: Resource -> Resource -> String -> Boolean -> <WriteGraph> Resource
  35 getOrCreateLibrary parentLibrary libraryType name clusterSet = do
  36     match possibleResourceChild parentLibrary name with
  37         Just child -> child
  38         Nothing -> createLibrary parentLibrary libraryType name clusterSet
  39
  40 createSharedOntology :: String -> Resource -> <WriteGraph> Resource
  41 createSharedOntology uri ontologyType = do
  42     path = uriParts uri
  43     lastId = length path - 1
  44     parentLibrary = foldl (\p id -> getOrCreateLibrary p L0.Library (path!id) False)
  45         (getRootLibrary ())
  46         [0..lastId-1]
  47     res = getOrCreateLibrary parentLibrary ontologyType (path!lastId) True
  48     createSCLModule res "SCLMain"
  49     res
  50
  51 traverseOntologies :: Resource -> (Resource -> <ReadGraph> Boolean) -> <ReadGraph> [Resource]
  52 traverseOntologies library filterFn =
  53     if library `isInstanceOf` L0.Ontology then (filter filterFn [library])
  54     else if library `isInstanceOf` SIMU.Model then []
  55     else if library `isInstanceOf` L0.Library then
  56         foldl (\result r -> (result + (traverseOntologies r filterFn))) [] (library # L0.ConsistsOf)
  57     else []
  58
  59 traverseSharedOntologies :: Resource -> <ReadGraph> [Resource]
  60 traverseSharedOntologies library = traverseOntologies library acceptSharedOntology
  61
  62 acceptSharedOntology :: Resource -> <ReadGraph> Boolean
  63 acceptSharedOntology ontology =
  64     if ontology `isInstanceOf` L0.SharedOntology then
  65         not $ relatedValue ontology L0.SharedOntology.treatAsSystemOntology
  66     else False
  67
  68 traverseSystemOntologies :: Resource -> <ReadGraph> [Resource]
  69 traverseSystemOntologies library = traverseOntologies library acceptSystemOntology
  70
  71 acceptSystemOntology :: Resource -> <ReadGraph> Boolean
  72 acceptSystemOntology ontology =
  73     if ontology `isInstanceOf` L0.SharedOntology then
  74         relatedValue ontology L0.SharedOntology.treatAsSystemOntology
  75     else True
  76
  77 linkSharedOntology :: Resource -> Resource -> <WriteGraph> ()
  78 linkSharedOntology model ontology = do
  79     markUndoPoint ()
  80     claim model L0.IsLinkedTo ontology
  81     addCommentMetadata ("Linked shared ontology " + (relatedValue2 ontology L0.HasName) + " to " + (relatedValue2 model L0.HasName))
  82     ()
  83
  84 unlinkSharedOntology :: Resource -> Resource -> <WriteGraph> ()
  85 unlinkSharedOntology model ontology = do
  86     markUndoPoint ()
  87     deny model L0.IsLinkedTo ontology
  88     addCommentMetadata ("Unlinked shared ontology " + (relatedValue2 ontology L0.HasName) + " from " + (relatedValue2 model L0.HasName))
  89     ()
  90
  91 getSharedOntologies :: () -> <ReadGraph> [Resource]
  92 getSharedOntologies dummy = traverseSharedOntologies $ getRootLibrary ()
  93
  94 getSystemOntologies :: () -> <ReadGraph> [Resource]
  95 getSystemOntologies dummy = traverseSystemOntologies $ getRootLibrary ()
  96
  97 getVisibleSystemOntologies :: () -> <ReadGraph> [Resource]
  98 getVisibleSystemOntologies dummy = do
  99     match (queryPreference "org.simantics" "ontology.visibility") with
 100       "shared" -> []
 101       "all" -> getSystemOntologies ()
 102       "" -> []
 103
 104 usedSharedOntologies :: Resource -> <ReadGraph> [Resource]
 105 usedSharedOntologies model = do
 106     ontologies = getSharedOntologies ()
 107     let f e = existsStatement3 model L0.IsLinkedTo e
 108     in filter f ontologies
 109
 110 availableSharedOntologies :: Resource -> <ReadGraph> [Resource]
 111 availableSharedOntologies r = do
 112     ontologies = getSharedOntologies ()
 113     ontologies = filter f ontologies
 114         where f ontology = not $ existsStatement3 r L0.IsLinkedTo ontology
 115     ontologies = filter f ontologies
 116         where f ontology = not $ isLinkedToDeep ontology r
 117     ontologies
 118
 119 querySharedOntologyType :: () -> <ReadGraph> Resource
 120 querySharedOntologyType dummy = do
 121     ontologies = listOntologies ()
 122     types = foldl (\result ontology -> (result + (searchByType ontology L0.IndexRootType))) [] $ listOntologies ()
 123     types = filter f types
 124       where f res = not $ isInheritedFrom res SIMU.Model
 125     types = filter f types
 126       where f res = not $ existsStatement res L0.Abstract
 127     types!0
 128
 129 importJava "org.simantics.modeling.ModelingUtils" where
 130     importSharedOntologyWithUI :: Variable -> <ReadGraph> ()
 131     importSharedOntology :: String -> ()
 132     createSharedOntologyWithUI :: Resource -> <ReadGraph> ()
 133     unlinkSharedOntologyWithUI :: Variable -> [Resource] -> <ReadGraph> ()
 134     createNewVersionWithUI :: Resource -> <ReadGraph> ()
 135     createNewVersionWithoutUI :: Resource -> <WriteGraph> ()
 136     exportSharedOntology :: Resource -> String -> String -> Integer -> <ReadGraph> ()
 137     publishComponentTypeWithUI :: Resource -> <WriteGraph> ()
 138     publishSharedOntologyWithUI :: Resource -> <WriteGraph> ()
 139     isLinkedToDeep :: Resource -> Resource -> <ReadGraph> Boolean
 140     publish :: Resource -> <WriteGraph> ()
 141
 142 publishAction :: Resource -> <Proc> ()
 143 publishAction res = do
 144   syncWrite (\() -> publish res)
 145   ()
 146
 147 publishComponentTypeAction :: Resource -> <Proc> ()
 148 publishComponentTypeAction res = do
 149   syncWrite (\() -> publishComponentTypeWithUI res)
 150   ()
 151
 152 publishSharedOntologyAction :: Resource -> <Proc> ()
 153 publishSharedOntologyAction res = do
 154   syncWrite (\() -> publishSharedOntologyWithUI res)
 155   ()
 156
 157 newVersionAction :: Resource -> <Proc> ()
 158 newVersionAction res = do
 159   syncRead (\() -> createNewVersionWithUI res)
 160   ()
 161
 162 isNotPublished :: Resource -> <ReadGraph> Boolean
 163 isNotPublished r = match (untypedPossibleRelatedValue r ENTITY.published) with
 164   Just a -> False
 165   Nothing -> True
 166
 167 isContainerNotPublished :: Resource -> <ReadGraph> Boolean
 168 isContainerNotPublished r = match (possibleIndexRoot r) with
 169   Just root -> isNotPublished root
 170   Nothing -> True
 171
 172 isPublished :: Resource -> <ReadGraph> Boolean
 173 isPublished r = match (untypedPossibleRelatedValue r ENTITY.published) with
 174   Just a -> True
 175   Nothing -> False
 176
 177 isLocked :: Resource -> <ReadGraph> Boolean
 178 isLocked r = existsStatement r STR.ComponentType.Locked
 179
 180 isNotLocked = not . isLocked
 181
 182 treatAsSystemOntology :: Resource -> Boolean  -> <WriteGraph> ()
 183 treatAsSystemOntology sharedOntology setting = claimRelatedValue sharedOntology L0.SharedOntology.treatAsSystemOntology setting