Verified Commit adef761c authored by Peter Achten's avatar Peter Achten Committed by Camil Staps

Merge remote-tracking branch 'remotes/origin/master' into...

Merge remote-tracking branch 'remotes/origin/master' into server-and-client-side-svg-rendering-with-abc-interpreter

# Conflicts:
#	Libraries/iTasks/Extensions/SVG/SVGEditor.icl
parent 66036880
test:
image: "camilstaps/clean:nightly"
before_script:
- install_clean.sh "bundle-complete abc-interpreter"
- install_clean_nightly.sh test
- install_clean.sh bundle-complete
- apt-get update -qq
- apt-get install -y -qq build-essential libsqlite3-dev libmariadbclient-dev-compat
script:
......
# Stopping the server #
## Manual ##
To cleanly stop the iTasks server you can can either
- Start the `shutdown` task from the `iTasks.WF.Tasks.System` module, the server will stop with the specified exit code.
- Send a SIGINT or SIGTERM signal to the application (i.e. by pressing CTRL+C), the server will stop with exit code 1
This will gracefully close all connections and stop the server.
Other ways of stopping the server (e.g. sending a SIGKILL signal) may result
in corrupted data for shares and tasks.
## Automatic ##
In some cases, the iTasks server will automatically terminate.
- If there are only startup tasks defined which are all stable the server will stop with exit code 0
- If there is an uncaught exception in a startup task the server will stop with exit code 1
......@@ -43,25 +43,30 @@ doTasksWithOptions initFun startable world
# (cli,world) = getCommandLine world
# (options,world) = defaultEngineOptions world
# mbOptions = initFun cli options
| mbOptions =:(Error _) = show (fromError mbOptions) world
| mbOptions =:(Error _) = show (fromError mbOptions) (setReturnCode 1 world)
# options = fromOk mbOptions
# iworld = createIWorld options world
# mbIWorld = createIWorld options world
| mbIWorld =: Left _
# (Left (err, world)) = mbIWorld
= show [err] (setReturnCode 1 world)
# (Right iworld) = mbIWorld
# (symbolsResult, iworld) = initSymbolsShare options.distributed options.appName iworld
| symbolsResult =: (Error _) = show ["Error reading symbols while required: " +++ fromError symbolsResult] (destroyIWorld iworld)
| symbolsResult =: (Error _) = show ["Error reading symbols while required: " +++ fromError symbolsResult] (setReturnCode 1 (destroyIWorld iworld))
# iworld = serve (startupTasks options) (tcpTasks options.serverPort options.keepaliveTime) (timeout options.timeout) iworld
= destroyIWorld iworld
where
webTasks = [t \\ WebTask t <- toStartable startable]
startupTasks {distributed, sdsPort}
//If distributed, start sds service task
= (if distributed [startTask (sdsServiceTask sdsPort)] [])
++ [startTask flushWritesWhenIdle
= (if distributed [systemTask (startTask (sdsServiceTask sdsPort))] [])
++ [systemTask (startTask flushWritesWhenIdle)
//If there no webtasks, stop when stable, otherwise cleanup old sessions
,startTask if (webTasks =: []) stopOnStable removeOutdatedSessions
,systemTask (startTask if (webTasks =: []) stopOnStable removeOutdatedSessions)
//Start all startup tasks
:[t \\ StartupTask t <- toStartable startable]]
startTask t = {StartupTask|attributes=defaultValue,task=TaskWrapper t}
systemTask t = {StartupTask|t&attributes='DM'.put "system" "yes" t.StartupTask.attributes}
initSymbolsShare False _ iworld = (Ok (), iworld)
initSymbolsShare True appName iworld = case storeSymbols (IF_WINDOWS (appName +++ ".exe") appName) iworld of
......@@ -197,7 +202,7 @@ defaultEngineOptions world
# (appPath,world) = determineAppPath world
# (appVersion,world) = determineAppVersion appPath world
# appDir = takeDirectory appPath
# appName = (dropExtension o dropDirectory) appPath
# appName = (if (takeExtension appPath == "exe") dropExtension id o dropDirectory) appPath
# options =
{ appName = appName
, appPath = appPath
......
definition module iTasks.Extensions.Editors.Ace
/**
* Integration of Cloud9 Ace code editor
*/
* Integration of Cloud9 Ace code editor
*/
import iTasks
import iTasks.UI.Editor
import Data.Maybe
// A drop-in replacement for textArea using ace
/**
* A drop-in replacement for textArea using Ace.
*/
aceTextArea :: Editor String
// An Ace editor with more fine-grained control
/**
* An Ace editor with more fine-grained control
*/
:: AceState =
{ lines :: ![String] //The lines of text in the editor
, cursor :: !(!Int,!Int) //The location of the cursor (<row>,<column>)
, selection :: !Maybe AceRange //A text selection is delimited by this position and the cursor position
, disabled :: !Bool //Disallow editing
{ value :: !String //* The string in the editor
, cursor :: !(!Int,!Int) //* The location of the cursor (<row>,<column>)
, selection :: !Maybe AceRange //* A text selection is delimited by this position and the cursor position
, disabled :: !Bool //* Disallow editing
}
:: AceRange =
{ start :: !(!Int,!Int)
, end :: !(!Int,!Int)
{ start :: !(!Int,!Int)
, end :: !(!Int,!Int)
}
:: AceOptions =
{ theme :: !String //The Ace theme to use
, mode :: !String //The Ace highlight mode to use
}
{ theme :: !String //* The Ace theme to use
, mode :: !String //* The Ace highlight mode to use
}
derive class iTask AceState, AceRange
......@@ -34,5 +40,4 @@ derive gDefault AceOptions
derive JSONEncode AceOptions
derive JSONDecode AceOptions
aceEditor :: Editor (!AceOptions,!AceState)
This diff is collapsed.
......@@ -172,7 +172,6 @@ where
((dynamicCompoundEditor $ editor p).CompoundEditor.onEdit dp event mbSt childSts vst)
onRefresh dp (p, new) st=:(p`, mbSt) childSts vst
| p === p` = (Ok (NoChange, st, childSts), vst) // HACK: only refresh on parameter change
= appFst
(fmap $ appSnd3 \st -> (p, st))
((dynamicCompoundEditor $ editor p).CompoundEditor.onRefresh dp new mbSt childSts vst)
......@@ -346,7 +345,13 @@ where
)
// TODO: how to get UI attributes?
// TODO: fine-grained replacement
onRefresh dp new _ _ vst = appFst (fmap $ appFst3 ReplaceUI) $ genUI 'Map'.newMap dp (Update new) vst
onRefresh dp new st childSts vst
| isNotChanged (valueFromState st childSts) new = (Ok (NoChange, st, childSts), vst)
= appFst (fmap $ appFst3 ReplaceUI) $ genUI 'Map'.newMap dp (Update new) vst
where
isNotChanged (Just (DynamicEditorValue consId val)) (DynamicEditorValue consId` val`) =
consId == consId` && val === val`
isNotChanged _ _ = False
// TODO: accept ID or index
genChildEditors :: !DataPath !DynamicConsId !(EditMode DEVal) !*VSt
......
......@@ -256,16 +256,21 @@ where
onBeforeChildRemove me args world
# (layer,world) = args.[1] .# "layer" .? world
// for windows, based on control class
# (removeMethod, world) = layer .# "remove" .? world
| not (jsIsUndefined removeMethod) = (layer .# "remove" .$! ()) world
// for all other objects
//If there is an attached popup remove it first
# world = removePopup layer world
// for windows, based on control class
# (removeMethod, world) = layer .# "remove" .? world
| not (jsIsUndefined removeMethod) = (layer .# "remove" .$! ()) world
// for all other objects
# (mapObj,world) = me .# "map" .? world
# world = (mapObj.# "removeLayer" .$! layer) world
# (popup, world) = layer .# "myPopup" .? world
| jsIsUndefined popup = world
# world = (mapObj.# "removeLayer" .$! popup) world
= world
# world = (mapObj.# "removeLayer" .$! layer) world
= world
where
removePopup layer world
# (popup, world) = layer .# "myPopup" .? world
| jsIsUndefined popup = world
# (mapObj,world) = me .# "map" .? world
= (mapObj.# "removeLayer" .$! popup) world
onWindowRemove me windowId _ world
// remove children from iTasks component
......
......@@ -118,7 +118,7 @@ derive JSONDecode ClientToServerMsg, Map
toUIAttributes :: !(ServerToClientAttr s) !*VSt -> (!UIAttributes, !*VSt)
toUIAttributes attr vst
# (attr,vst) = serializeInVSt attr vst
# (attr,vst) = serializeForClient attr vst
= ('Data.Map'.fromList [(JS_ATTR_SVG,JSONString attr)], vst)
fromUIAttributes :: !String !JSVal !*JSWorld -> (!ServerToClientAttr s,!*JSWorld)
......@@ -200,7 +200,7 @@ where
= case editModeValue mode of
Nothing = (Error "Error in module SVGEditor (fromSVGEditor/initServerSideUI): SVG editors cannot be used in Enter EditMode.",world)
Just model
#! (serializedModel,world) = serializeInVSt model world
#! (serializedModel,world) = serializeForClient model world
= trace_n ("initServerSideUI of task with taskId = " +++ taskId)
(Ok (uia UIComponent ('Data.Map'.union uiAttrs ('Data.Map'.union (valueAttr (JSONString serializedModel)) (sizeAttr FlexSize FlexSize))),initServerSVGState model),world)
......@@ -248,7 +248,7 @@ where
#! (attrs,mask,vst) = serverHandleModel svglet mask False vst
= trace_n ("serverHandleEditFromClient ClientNeedsSVG")
(Ok (attributesToUIChange attrs,mask),vst)
// serverHandleEditFromContext is called at the server side whenever the context has acquired a new data model that needs to be rendered at the associated client component.
// This information is passed to the associated client via its attributes, and will be handled via the `onAttributeChange` function.
serverHandleEditFromContext :: !(SVGEditor s v) !DataPath !s !(ServerSVGState s) !*VSt -> (!MaybeErrorString (!UIChange,!ServerSVGState s), !*VSt) | gEq{|*|} s
......
......@@ -3,9 +3,14 @@ definition module iTasks.Internal.EngineTasks
* This module defines the separate system tasks that the iTasks engine performs
*/
from iTasks.WF.Definition import :: Task
from iTasks.Internal.Generic.Visualization import generic gText, :: TextFormat
from iTasks.Internal.IWorld import :: IWorld
from Data.Maybe import :: Maybe
removeOutdatedSessions :: Task ()
flushWritesWhenIdle:: Task ()
stopOnStable :: Task ()
printStdErr :: v !*IWorld -> *IWorld | gText{|*|} v
......@@ -12,8 +12,9 @@ import iTasks.Internal.TaskStore
import iTasks.SDS.Combinators.Common
import iTasks.UI.Definition
import iTasks.WF.Definition
import Text
from Data.Map import newMap
from Data.Map import newMap, member
everyTick :: (*IWorld -> *(!MaybeError TaskException (), !*IWorld)) -> Task ()
everyTick f = Task eval
......@@ -80,18 +81,24 @@ flushWritesWhenIdle = everyTick \iworld->case read taskEvents EmptyContext iworl
(Ok _,iworld) = (Ok (),iworld)
//When we don't run the built-in HTTP server we don't want to loop forever so we stop the loop
//once all tasks are stable
//once all non-system tasks are stable
stopOnStable :: Task ()
stopOnStable = everyTick \iworld=:{IWorld|shutdown}->case read (sdsFocus {InstanceFilter|defaultValue & includeProgress=True} filteredInstanceIndex) EmptyContext iworld of
stopOnStable = everyTick \iworld->case read (sdsFocus {InstanceFilter|defaultValue & includeProgress=True, includeStartup=True, includeAttributes=True} filteredInstanceIndex) EmptyContext iworld of
(Ok (ReadingDone index), iworld)
# shutdown = case shutdown of
Nothing = if (allStable index) (Just (if (exceptionOccurred index) 1 0)) Nothing
_ = shutdown
= (Ok (), {IWorld|iworld & shutdown = shutdown})
# iworld = if (isNothing iworld.shutdown && all isStable (filter (not o isSystem) index))
{IWorld | iworld & shutdown=Just 0}
iworld
= (Ok (), iworld)
(Ok _,iworld)
= (Error (exception "Unexpeced SDS state"),iworld)
(Error e, iworld) = (Error e, iworld)
where
allStable instances = all (\v -> v =: Stable || v =: (Exception _)) (values instances)
exceptionOccurred instances = any (\v -> v =: (Exception _)) (values instances)
values instances = [value \\ (_,_,Just {InstanceProgress|value},_) <- instances]
isStable (_, _, Nothing, _) = False
isStable (_, _, Just {InstanceProgress|value}, attributes) = value =: Stable
isSystem (_, _, Just {InstanceProgress|value}, attributes) = member "system" (fromMaybe newMap attributes)
isSystem _ = False
printStdErr :: v !*IWorld -> *IWorld | gText{|*|} v
printStdErr v iw=:{world}
= {iw & world=snd (fclose (stderr <<< toSingleLineText v <<< "\n") world)}
......@@ -6,6 +6,7 @@ from Data.Maybe import :: Maybe
from Data.Error import :: MaybeError(..), :: MaybeErrorString(..)
from Data.Set import :: Set
from Data.Queue import :: Queue
from Data.Either import :: Either
from StdFile import class FileSystem, class FileEnv
from System.Time import :: Timestamp, :: Timespec
from Text.GenJSON import :: JSONNode
......@@ -40,7 +41,7 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
, memoryShares :: !Map String Dynamic // Run-time memory shares
, readCache :: !Map (String,String) Dynamic // Cached share reads
, writeCache :: !Map (String,String) (Dynamic,DeferredWrite) // Cached deferred writes
, abcInterpreterEnv :: !Maybe PrelinkedInterpretationEnvironment // Used to serialize expressions for the client
, abcInterpreterEnv :: !PrelinkedInterpretationEnvironment // Used to serialize expressions for the client
, ioTasks :: !*IOTasks // The low-level input/output tasks
, ioStates :: !IOStates // Results of low-level io tasks, indexed by the high-level taskid that it is linked to
......@@ -105,9 +106,9 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
* @param The engine options
* @param The world
*
* @return An initialized iworld
* @result An initialized iworld or world together with an error string on failure
*/
createIWorld :: !EngineOptions !*World -> *IWorld
createIWorld :: !EngineOptions !*World -> Either (!String, !*World) *IWorld
/**
* Destroys the iworld state
......
......@@ -21,6 +21,7 @@ from StdFunc import const, o, seqList, :: St
from StdMisc import abort
from StdOrdList import sortBy
from ABC.Interpreter import prepare_prelinked_interpretation
from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SChannel_, :: TCP_DuplexChannel, :: DuplexChannel, :: IPAddress, :: ByteSeq
import System.Time, StdList, Text.Encodings.Base64, _SystemArray, StdBool, StdTuple, Text.GenJSON, Data.Error, Math.Random
......@@ -41,36 +42,41 @@ from iTasks.SDS.Combinators.Common import toReadOnly
from ABC.Interpreter import :: PrelinkedInterpretationEnvironment
createIWorld :: !EngineOptions !*World -> *IWorld
createIWorld :: !EngineOptions !*World -> Either (!String, !*World) *IWorld
createIWorld options world
# (ts=:{tv_nsec=seed}, world) = nsTime world
= {IWorld
|options = options
,clock = ts
,current =
{TaskEvalState
|taskTime = 0
,taskInstance = 0
,sessionInstance = Nothing
,attachmentChain = []
,nextTaskNo = 0
}
,sdsNotifyRequests = 'DM'.newMap
,sdsNotifyReqsByTask = 'DM'.newMap
,memoryShares = 'DM'.newMap
,readCache = 'DM'.newMap
,writeCache = 'DM'.newMap
,abcInterpreterEnv = Nothing
,shutdown = Nothing
,ioTasks = {done = [], todo = []}
,ioStates = 'DM'.newMap
,sdsEvalStates = 'DM'.newMap
,world = world
,signalHandlers = []
,resources = []
,random = genRandInt seed
,onClient = False
}
# (ts=:{tv_nsec=seed}, world) = nsTime world
# (mbAbcEnv, world) = prepare_prelinked_interpretation options.byteCodePath world
= case mbAbcEnv of
Just abcEnv = Right
{IWorld
|options = options
,clock = ts
,current =
{TaskEvalState
|taskTime = 0
,taskInstance = 0
,sessionInstance = Nothing
,attachmentChain = []
,nextTaskNo = 0
}
,sdsNotifyRequests = 'DM'.newMap
,sdsNotifyReqsByTask = 'DM'.newMap
,memoryShares = 'DM'.newMap
,readCache = 'DM'.newMap
,writeCache = 'DM'.newMap
,abcInterpreterEnv = abcEnv
,shutdown = Nothing
,ioTasks = {done = [], todo = []}
,ioStates = 'DM'.newMap
,sdsEvalStates = 'DM'.newMap
,world = world
,signalHandlers = []
,resources = []
,random = genRandInt seed
,onClient = False
}
Nothing =
Left ("Failed to parse bytecode, is ByteCode set in the project file?", world)
// Determines the server executables path
determineAppPath :: !*World -> (!FilePath, !*World)
......
......@@ -26,12 +26,6 @@ dynamicJSONDecode :: !JSONNode -> Maybe a
* WebAssembly interpreter. The values are serialized using GraphCopy after
* which the descriptors are replaced by the descriptors of the client.
* @param The expression to serialize.
* @result `Error` if the bytecode could not be loaded (which may happen due to
* incorrect project settings); otherwise a serialized string.
* @result The serialized string.
*/
serializeForClient :: f !*IWorld -> *(!MaybeErrorString String, !*IWorld)
/**
* Like `serializeForClient`, but in a `VSt`.
*/
serializeInVSt :: f !*VSt -> *(!String, !*VSt)
serializeForClient :: f !*VSt -> *(!String, !*VSt)
......@@ -51,19 +51,5 @@ dynamicJSONDecode :: !JSONNode -> Maybe a
dynamicJSONDecode (JSONArray [JSONString "_DYNAMICENCODE_",JSONString str]) = Just (fst (copy_from_string (base64URLDecode str)))
dynamicJSONDecode _ = Nothing
serializeForClient :: f !*IWorld -> *(!MaybeErrorString String, !*IWorld)
serializeForClient f iworld=:{abcInterpreterEnv=Just e}
= (Ok (serialize_for_prelinked_interpretation f e), iworld)
serializeForClient f iworld=:{abcInterpreterEnv=Nothing,world,options}
# (env,world) = prepare_prelinked_interpretation options.byteCodePath world
# iworld & world = world
= case env of
Nothing -> (Error "Failed to parse bytecode, is ByteCode set in the project file?", iworld)
Just e -> serializeForClient f {iworld & abcInterpreterEnv=Just e}
serializeInVSt :: f !*VSt -> *(!String, !*VSt)
serializeInVSt f vst=:{iworld}
# (s,iworld) = serializeForClient f iworld
= case s of
Error e -> abort (e+++"\n")
Ok s -> (s, {vst & iworld=iworld})
serializeForClient :: f !*VSt -> *(!String, !*VSt)
serializeForClient f vst=:{VSt| abcInterpreterEnv} = (serialize_for_prelinked_interpretation f abcInterpreterEnv, vst)
......@@ -7,6 +7,7 @@ import iTasks.Internal.Store, iTasks.Internal.TaskStore, iTasks.Internal.Util
import iTasks.UI.Layout
import iTasks.Internal.SDSService
import iTasks.Internal.Util
import iTasks.Internal.EngineTasks
from iTasks.WF.Combinators.Core import :: SharedTaskList
from iTasks.WF.Combinators.Core import :: ParallelTaskType(..), :: ParallelTask(..)
......@@ -65,6 +66,7 @@ processEvents max iworld
(Error msg,iworld=:{IWorld|world})
= (Ok (),{IWorld|iworld & world = world})
derive gText InstanceType
evalTaskInstance :: !InstanceNo !Event !*IWorld -> (!MaybeErrorString (TaskValue DeferredJSON),!*IWorld)
evalTaskInstance instanceNo event iworld
# iworld = mbResetUIState instanceNo event iworld
......@@ -141,6 +143,9 @@ where
NoChange = (Ok value,iworld)
change = (Ok value, queueUIChange instanceNo change iworld)
ExceptionResult (e,description)
# iworld = if (type =: StartupInstance)
(printStdErr description {iworld & shutdown=Just 1})
iworld
= exitWithException instanceNo description iworld
DestroyedResult
= (Ok NoValue, iworld)
......
......@@ -435,7 +435,7 @@ where
*(!.ioChannels, !*IWorld)
-> *IWorld
taskStateException mbTaskState instanceNo ioStates closeIO (ioChannels, iworld)
# iworld = iShow ["Exception in TaskServer: taskStateException: " +++ fromError mbTaskState] iworld
# iworld = iShow ["Exception in TaskServer: taskStateException: " <+++ fromError mbTaskState <+++ " " <+++ instanceNo] iworld
# iworld = if (instanceNo > 0) (queueRefresh [(taskId, "Exception for " <+++ instanceNo)] iworld) iworld
# ioStates = put taskId (IOException (fromError mbTaskState)) ioStates
= closeIO (ioChannels, {iworld & ioStates = ioStates})
......@@ -447,7 +447,7 @@ where
*(!.ioChannels, !*IWorld)
-> *IWorld
sdsException mbSdsErr instanceNo ioStates closeIO (ioChannels, iworld)
# iworld = iShow ["Exception in TaskServer: sdsException: " +++ snd (fromError mbSdsErr)] iworld
# iworld = iShow ["Exception in TaskServer: sdsException: " <+++ snd (fromError mbSdsErr) <+++ " " <+++ instanceNo] iworld
# iworld = if (instanceNo > 0) (queueRefresh [(taskId, "Exception for " <+++ instanceNo)] iworld) iworld
# ioStates = put taskId (IOException (snd (fromError mbSdsErr))) ioStates
= closeIO (ioChannels, {iworld & ioStates = ioStates})
......
......@@ -4,6 +4,7 @@ definition module iTasks.UI.Editor
* the interact core task uses these editors to generate and update the user interface
*/
from ABC.Interpreter import :: PrelinkedInterpretationEnvironment
from iTasks.UI.Definition import :: UI, :: UIAttributes, :: UIChange, :: UIAttributeChange, :: TaskId
from iTasks.UI.JavaScript import :: JSWorld, :: JSVal
......@@ -129,9 +130,9 @@ derive bimap EditMode
:: *VSt =
{ taskId :: !String //* The id of the task the visualisation belongs to
, optional :: !Bool //* Create optional form fields
, iworld :: !*IWorld //* The iworld, used for example if external tools are needed to create editors
, selectedConsIndex :: !Int //* Index of the selected constructor in an OBJECT
, pathInEditMode :: [Bool] //* Path of LEFT/RIGHT choices used when UI is generated in edit mode
, abcInterpreterEnv :: !PrelinkedInterpretationEnvironment //* Used to serialize expressions for the client
}
withVSt :: !TaskId !.(*VSt -> (!a, !*VSt)) !*IWorld -> (!a, !*IWorld)
......
......@@ -116,15 +116,15 @@ mapEditMode f (View x) = View $ f x
derive bimap EditMode
withVSt :: !TaskId !.(*VSt -> (!a, !*VSt)) !*IWorld -> (!a, !*IWorld)
withVSt taskId f iworld
withVSt taskId f iworld=:{IWorld| abcInterpreterEnv}
# (x, vst) = f { VSt
| taskId = toString taskId
, optional = False
, selectedConsIndex = -1
, pathInEditMode = abort "VSt.dataPathInEditMode should be set by OBJECT instance of gEditor"
, iworld = iworld
, abcInterpreterEnv = abcInterpreterEnv
}
= (x, vst.iworld)
= (x, iworld)
newLeafState :: EditState
newLeafState = LeafState {LeafState|touched=False,state=JSONNull}
......@@ -151,15 +151,13 @@ withClientSideInit ::
!(JSVal *JSWorld -> *JSWorld)
!(UIAttributes DataPath a *VSt -> *(!MaybeErrorString (!UI, !st), !*VSt))
!UIAttributes !DataPath !a !*VSt -> *(!MaybeErrorString (!UI, !st), !*VSt)
withClientSideInit initUI genUI attr dp val vst=:{VSt|taskId} = case genUI attr dp val vst of
(Ok (UI type attr items,mask),vst=:{VSt|iworld}) -> case serializeForClient (wrapInitUIFunction initUI) iworld of
(Ok initUI,iworld)
# extraAttr = 'DM'.fromList
[("taskId", JSONString taskId)
,("editorId",JSONString (editorId dp))
,("initUI", JSONString initUI)
]
-> (Ok (UI type ('DM'.union extraAttr attr) items,mask), {VSt|vst & iworld = iworld})
(Error e,iworld)
-> (Error e, {VSt|vst & iworld = iworld})
e -> e
withClientSideInit initUI genUI attr dp val vst=:{VSt| taskId} = case genUI attr dp val vst of
(Ok (UI type attr items,mask),vst)
# (initUI, vst) = serializeForClient (wrapInitUIFunction initUI) vst
# extraAttr = 'DM'.fromList
[("taskId", JSONString taskId)
,("editorId",JSONString (editorId dp))
,("initUI", JSONString initUI)
]
= (Ok (UI type ('DM'.union extraAttr attr) items,mask), vst)
e = e
......@@ -62,7 +62,7 @@ injectEditorValue :: !(a -> b) !(b -> MaybeErrorString a) !(Editor b) -> Editor
/**
* Map the value of an editor to another domain which is 'smaller' than the original domain
*/
surjectEditorValue :: !(a -> b) !(b (Maybe a) -> a) !(Editor b) -> Editor a | JSONEncode{|*|}, JSONDecode{|*|} a
surjectEditorValue :: !(a (Maybe b) -> b) !(b (Maybe a) -> a) !(Editor b) -> Editor a | JSONEncode{|*|}, JSONDecode{|*|} a
/**
* Map the value of an editor to another domain, without mapping changes in the editor back
......
......@@ -161,11 +161,12 @@ where
= (Ok (mergeUIChanges change attrChange, st), vst)
_ = (Ok (change, st), vst)
surjectEditorValue :: !(a -> b) !(b (Maybe a) -> a) !(Editor b) -> Editor a | JSONEncode{|*|}, JSONDecode{|*|} a
surjectEditorValue tof fromf {Editor|genUI=editorGenUI,onEdit=editorOnEdit,onRefresh=editorOnRefresh,valueFromState=editorValueFromState} = editorModifierWithStateToEditor
{EditorModifierWithState|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh,valueFromState=valueFromState}
surjectEditorValue :: !(a (Maybe b) -> b) !(b (Maybe a) -> a) !(Editor b) -> Editor a | JSONEncode{|*|}, JSONDecode{|*|} a
surjectEditorValue tof fromf {Editor|genUI=editorGenUI,onEdit=editorOnEdit,onRefresh=editorOnRefresh,valueFromState=editorValueFromState}
= editorModifierWithStateToEditor
{EditorModifierWithState|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh,valueFromState=valueFromState}
where
genUI attr dp mode vst = case editorGenUI attr dp (mapEditMode tof mode) vst of
genUI attr dp mode vst = case editorGenUI attr dp (mapEditMode (\a -> tof a Nothing) mode) vst of
(Error e,vst) = (Error e,vst)
//Track value of the 'outer' editor
(Ok (ui, st),vst) = (Ok (ui, editModeValue mode, st), vst)
......@@ -174,7 +175,7 @@ where
(Error e, vst) = (Error e, vst)
(Ok (change, st),vst) = (Ok (change, updatedState mbOldA st, st), vst)