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

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