bundles/org.simantics.platform.ui.ontology/scl/Simantics/PlatformUI.scl

   1 /*******************************************************************************
   2  * Copyright (c) 2019 Association for Decentralized Information Management
   3  * in Industry THTH ry.
   4  * All rights reserved. This program and the accompanying materials
   5  * are made available under the terms of the Eclipse Public License v1.0
   6  * which accompanies this distribution, and is available at
   7  * http://www.eclipse.org/legal/epl-v10.html
   8  *
   9  * Contributors:
  10  *     VTT Technical Research Centre of Finland - initial API and implementation
  11  *     Semantum Oy - reorganization
  12  *******************************************************************************/
  13 include "Simantics/All"
  14 include "SWT/All"
  15 import "UI/Progress"
  16 import "Simantics/IssueUI"
  17
  18 useSelectedHandler :: Variable -> (String -> Maybe String) -> <WriteGraph> String
  19 useSelectedHandler input parameters = do
  20   model = represents input
  21   resources = map wseResource $ decodeWSES $ parameters "selection"
  22   for resources $ linkSharedOntology model
  23   ""
  24
  25 unlinkSelectedHandler :: Variable -> (String -> Maybe String) -> <WriteGraph> String
  26 unlinkSelectedHandler input parameters = do
  27   model = represents input
  28   resources = map wseResource $ decodeWSES $ parameters "selection"
  29   unlinkSharedOntologyWithUI input resources
  30   ""
  31
  32 createNewHandler :: Variable -> (String -> Maybe String) -> <WriteGraph> String
  33 createNewHandler input parameters = do
  34   createSharedOntologyWithUI L0.SharedOntology
  35   ""
  36
  37 importHandler :: Variable -> (String -> Maybe String) -> <WriteGraph> String
  38 importHandler input parameters = do
  39   importSharedOntologyWithUI input
  40   ""
  41
  42 fooHandler :: Variable -> CommandContext -> <WriteGraph> Maybe CommandResult
  43 fooHandler self ctx = do
  44   val = fromJust $ possibleString ctx "selected"
  45   setProjectComponentState self "currentSelection" val
  46   Nothing
  47
  48 availableRanges :: Variable -> <ReadGraph> [String]
  49 availableRanges input = do
  50   u = uri input
  51   res = represents input
  52   ranges = objectsWithType res L0.ConsistsOf SHEET.Range
  53   map nameOf ranges
  54
  55 defaultRange :: Variable -> <ReadGraph> String
  56 defaultRange input = do
  57   ranges = availableRanges input
  58   if (length ranges) == 0 then "" else ranges!0
  59
  60 currentRangeName :: Variable -> Variable -> <ReadGraph> String
  61 currentRangeName self input =
  62   projectComponentState self "#currentSelection" (defaultRange input)
  63
  64 currentRangeExpressionVariable :: Variable -> Variable -> <ReadGraph> Variable
  65 currentRangeExpressionVariable self input = do
  66   name = projectComponentState self "./Combo#currentSelection" (defaultRange input)
  67   browse input ("/" + name + "#cells")
  68
  69 currentRangeExpression :: Variable -> Variable -> <ReadGraph> String
  70 currentRangeExpression self input = do
  71   variable = currentRangeExpressionVariable self input
  72   value $ browse variable "#expression"
  73
  74 currentRangeTextAndErrors :: Variable -> Variable -> <ReadGraph> TextAndErrors
  75 currentRangeTextAndErrors self input = do
  76   expression = currentRangeExpression self input
  77   createTextAndErrors expression []
  78
  79 fooHandler2 :: Variable -> CommandContext -> <WriteGraph> Maybe CommandResult
  80 fooHandler2 self ctx = do
  81   val = fromJust $ possibleString ctx "text"
  82   setExpression self val
  83   Nothing
  84
  85 modifyCodeHandler :: Variable -> Variable -> CommandContext -> <WriteGraph> Maybe CommandResult
  86 modifyCodeHandler self input ctx = do
  87   val = fromJust $ possibleString ctx "text"
  88   variable = currentRangeExpressionVariable self input
  89   setExpression variable val
  90   Nothing
  91
  92 standardPropertiesElementTransformation :: Variable -> <ReadGraph> Variable
  93 standardPropertiesElementTransformation var = do
  94   match getPossibleType var with
  95     Nothing -> var
  96     Just resourceType -> if isInheritedFrom resourceType DIA.Element then do
  97         match possibleObject (represents var) MOD.ElementToComponent with
  98           Nothing -> var
  99           Just component -> resourceVariable component
 100       else var
 101
 102 configureButtonClickHandler :: Resource -> CommandContext -> <Proc> Maybe CommandResult
 103 configureButtonClickHandler indexRoot context = do
 104     showIssueConfigurationDialog indexRoot
 105     Nothing
 106
 107 configureButtonClick :: Variable -> <ReadGraph,Proc> AbstractEventHandler
 108 configureButtonClick self = do
 109   indexRoot = represents $ contextVariable self
 110   eventHandler2 $ configureButtonClickHandler indexRoot
 111
 112 validateButtonClickHandler :: Resource -> CommandContext -> <Proc> Maybe CommandResult
 113 validateButtonClickHandler indexRoot context = do
 114     runActiveValidations (createNullProgressMonitor ()) indexRoot
 115     Nothing
 116
 117 validateButtonClick :: Variable -> <ReadGraph,Proc> AbstractEventHandler
 118 validateButtonClick self = do
 119   indexRoot = represents $ contextVariable self
 120   eventHandler2 $ validateButtonClickHandler indexRoot
 121
 122 issueSourceExplorerCheckHandler :: Resource -> CommandContext -> <Proc> Maybe CommandResult
 123 issueSourceExplorerCheckHandler indexRoot context = match possibleValue context "item" with
 124   Nothing -> Nothing
 125   Just issueSource -> match possibleValue context "checked" with
 126     Nothing -> Nothing
 127     Just value -> if value then do
 128         syncWrite $ \_ -> claim issueSource ISSUE.IssueSource.Selected (parent issueSource)
 129         Nothing
 130       else do
 131         syncWrite $ \_ -> denyByPredicate issueSource ISSUE.IssueSource.Selected
 132         Nothing
 133
 134 issueSourceExplorerCheck :: Variable -> <ReadGraph,Proc> AbstractEventHandler
 135 issueSourceExplorerCheck self = do
 136   indexRoot = represents $ contextVariable self
 137   eventHandler2 $ issueSourceExplorerCheckHandler indexRoot
 138
 139 usedIssueSources :: Resource -> <ReadGraph> [Resource]
 140 usedIssueSources indexRoot = do
 141    objectsWithType indexRoot L0.ConsistsOf ISSUE.IssueSource
 142
 143 checkedStateRule :: BrowseNodeRule CheckedState
 144 checkedStateRule (ResourceX r) = if existsStatement r ISSUE.IssueSource.Selected then CHECKED else NOT_CHECKED
 145