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 -> <Proc> ()
 132     importSharedOntology2 :: String -> <Proc> [Resource]
 133     createSharedOntologyWithUI :: Resource -> <ReadGraph> ()
 134     unlinkSharedOntologyWithUI :: Variable -> [Resource] -> <ReadGraph> ()
 135     createNewVersionWithUI :: Resource -> <ReadGraph> ()
 136     createNewVersionWithoutUI :: Resource -> <WriteGraph> ()
 137     exportSharedOntology :: Resource -> String -> String -> Integer -> <ReadGraph> ()
 138     publishComponentTypeWithUI :: Resource -> <WriteGraph> ()
 139     publishSharedOntologyWithUI :: Resource -> <WriteGraph> ()
 140     isLinkedToDeep :: Resource -> Resource -> <ReadGraph> Boolean
 141     publish :: Resource -> <WriteGraph> ()
 142
 143 publishAction :: Resource -> <Proc> ()
 144 publishAction res = do
 145   syncWrite (\() -> publish res)
 146   ()
 147
 148 publishComponentTypeAction :: Resource -> <Proc> ()
 149 publishComponentTypeAction res = do
 150   syncWrite (\() -> publishComponentTypeWithUI res)
 151   ()
 152
 153 publishSharedOntologyAction :: Resource -> <Proc> ()
 154 publishSharedOntologyAction res = do
 155   syncWrite (\() -> publishSharedOntologyWithUI res)
 156   ()
 157
 158 newVersionAction :: Resource -> <Proc> ()
 159 newVersionAction res = do
 160   syncRead (\() -> createNewVersionWithUI res)
 161   ()
 162
 163 isNotPublished :: Resource -> <ReadGraph> Boolean
 164 isNotPublished r = match (untypedPossibleRelatedValue r ENTITY.published) with
 165   Just a -> False
 166   Nothing -> True
 167
 168 isContainerNotPublished :: Resource -> <ReadGraph> Boolean
 169 isContainerNotPublished r = match (possibleIndexRoot r) with
 170   Just root -> isNotPublished root
 171   Nothing -> True
 172
 173 isPublished :: Resource -> <ReadGraph> Boolean
 174 isPublished r = match (untypedPossibleRelatedValue r ENTITY.published) with
 175   Just a -> True
 176   Nothing -> False
 177
 178 isLocked :: Resource -> <ReadGraph> Boolean
 179 isLocked r = existsStatement r STR.ComponentType.Locked
 180
 181 isNotLocked = not . isLocked
 182
 183 treatAsSystemOntology :: Resource -> Boolean  -> <WriteGraph> ()
 184 treatAsSystemOntology sharedOntology setting = claimRelatedValue sharedOntology L0.SharedOntology.treatAsSystemOntology setting