Commit 101f92ea authored by Steffen Michels's avatar Steffen Michels

Merge branch 'master' into typed-task-editor

parents 4c2ad310 b6bcc61e
test: test:
image: "camilstaps/clean:nightly" image: "camilstaps/clean:nightly"
before_script: before_script:
- install_clean.sh "bundle-complete abc-interpreter" - install_clean.sh bundle-complete
- install_clean_nightly.sh test
- apt-get update -qq - apt-get update -qq
- apt-get install -y -qq build-essential libsqlite3-dev libmariadbclient-dev-compat - apt-get install -y -qq build-essential libsqlite3-dev libmariadbclient-dev-compat
script: 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
definition module iTasks.Extensions.Editors.Ace definition module iTasks.Extensions.Editors.Ace
/** /**
* Integration of Cloud9 Ace code editor * Integration of Cloud9 Ace code editor
*/ */
import iTasks import iTasks
import iTasks.UI.Editor import iTasks.UI.Editor
import Data.Maybe import Data.Maybe
// A drop-in replacement for textArea using ace /**
* A drop-in replacement for textArea using Ace.
*/
aceTextArea :: Editor String aceTextArea :: Editor String
// An Ace editor with more fine-grained control /**
* An Ace editor with more fine-grained control
*/
:: AceState = :: AceState =
{ lines :: ![String] //The lines of text in the editor { value :: !String //* The string in the editor
, cursor :: !(!Int,!Int) //The location of the cursor (<row>,<column>) , 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 , selection :: !Maybe AceRange //* A text selection is delimited by this position and the cursor position
, disabled :: !Bool //Disallow editing , disabled :: !Bool //* Disallow editing
} }
:: AceRange = :: AceRange =
{ start :: !(!Int,!Int) { start :: !(!Int,!Int)
, end :: !(!Int,!Int) , end :: !(!Int,!Int)
} }
:: AceOptions = :: AceOptions =
{ theme :: !String //The Ace theme to use { theme :: !String //* The Ace theme to use
, mode :: !String //The Ace highlight mode to use , mode :: !String //* The Ace highlight mode to use
} }
derive class iTask AceState, AceRange derive class iTask AceState, AceRange
...@@ -34,5 +40,4 @@ derive gDefault AceOptions ...@@ -34,5 +40,4 @@ derive gDefault AceOptions
derive JSONEncode AceOptions derive JSONEncode AceOptions
derive JSONDecode AceOptions derive JSONDecode AceOptions
aceEditor :: Editor (!AceOptions,!AceState) aceEditor :: Editor (!AceOptions,!AceState)
This diff is collapsed.
...@@ -256,16 +256,21 @@ where ...@@ -256,16 +256,21 @@ where
onBeforeChildRemove me args world onBeforeChildRemove me args world
# (layer,world) = args.[1] .# "layer" .? world # (layer,world) = args.[1] .# "layer" .? world
// for windows, based on control class //If there is an attached popup remove it first
# (removeMethod, world) = layer .# "remove" .? world # world = removePopup layer world
| not (jsIsUndefined removeMethod) = (layer .# "remove" .$! ()) world // for windows, based on control class
// for all other objects # (removeMethod, world) = layer .# "remove" .? world
| not (jsIsUndefined removeMethod) = (layer .# "remove" .$! ()) world
// for all other objects
# (mapObj,world) = me .# "map" .? world # (mapObj,world) = me .# "map" .? world
# world = (mapObj.# "removeLayer" .$! layer) world # world = (mapObj.# "removeLayer" .$! layer) world
# (popup, world) = layer .# "myPopup" .? world = world
| jsIsUndefined popup = world where
# world = (mapObj.# "removeLayer" .$! popup) world removePopup layer world
= world # (popup, world) = layer .# "myPopup" .? world
| jsIsUndefined popup = world
# (mapObj,world) = me .# "map" .? world
= (mapObj.# "removeLayer" .$! popup) world
onWindowRemove me windowId _ world onWindowRemove me windowId _ world
// remove children from iTasks component // remove children from iTasks component
......
...@@ -3,9 +3,14 @@ definition module iTasks.Internal.EngineTasks ...@@ -3,9 +3,14 @@ definition module iTasks.Internal.EngineTasks
* This module defines the separate system tasks that the iTasks engine performs * This module defines the separate system tasks that the iTasks engine performs
*/ */
from iTasks.WF.Definition import :: Task 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 () removeOutdatedSessions :: Task ()
flushWritesWhenIdle:: Task () flushWritesWhenIdle:: Task ()
stopOnStable :: Task () stopOnStable :: Task ()
printStdErr :: v !*IWorld -> *IWorld | gText{|*|} v
...@@ -81,15 +81,10 @@ flushWritesWhenIdle = everyTick \iworld->case read taskEvents EmptyContext iworl ...@@ -81,15 +81,10 @@ flushWritesWhenIdle = everyTick \iworld->case read taskEvents EmptyContext iworl
(Ok _,iworld) = (Ok (),iworld) (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 //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 :: Task ()
stopOnStable = everyTick \iworld->case read (sdsFocus {InstanceFilter|defaultValue & includeProgress=True, includeStartup=True, includeAttributes=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) (Ok (ReadingDone index), iworld)
# iworld = case exceptions index of
[] = iworld
excs
# (_, world) = fclose (stderr <<< join "\n" excs <<< "\n") iworld.world
= {IWorld | iworld & world=world, shutdown=Just 1}
# iworld = if (isNothing iworld.shutdown && all isStable (filter (not o isSystem) index)) # iworld = if (isNothing iworld.shutdown && all isStable (filter (not o isSystem) index))
{IWorld | iworld & shutdown=Just 0} {IWorld | iworld & shutdown=Just 0}
iworld iworld
...@@ -103,5 +98,7 @@ where ...@@ -103,5 +98,7 @@ where
isSystem (_, _, Just {InstanceProgress|value}, attributes) = member "system" (fromMaybe newMap attributes) isSystem (_, _, Just {InstanceProgress|value}, attributes) = member "system" (fromMaybe newMap attributes)
isSystem _ = False isSystem _ = False
exceptions instances = [e\\(_, _, Just {InstanceProgress|value=Exception e}, _)<-instances] printStdErr :: v !*IWorld -> *IWorld | gText{|*|} v
printStdErr v iw=:{world}
= {iw & world=snd (fclose (stderr <<< toSingleLineText v <<< "\n") world)}
...@@ -7,6 +7,7 @@ import iTasks.Internal.Store, iTasks.Internal.TaskStore, iTasks.Internal.Util ...@@ -7,6 +7,7 @@ import iTasks.Internal.Store, iTasks.Internal.TaskStore, iTasks.Internal.Util
import iTasks.UI.Layout import iTasks.UI.Layout
import iTasks.Internal.SDSService import iTasks.Internal.SDSService
import iTasks.Internal.Util import iTasks.Internal.Util
import iTasks.Internal.EngineTasks
from iTasks.WF.Combinators.Core import :: SharedTaskList from iTasks.WF.Combinators.Core import :: SharedTaskList
from iTasks.WF.Combinators.Core import :: ParallelTaskType(..), :: ParallelTask(..) from iTasks.WF.Combinators.Core import :: ParallelTaskType(..), :: ParallelTask(..)
...@@ -65,6 +66,7 @@ processEvents max iworld ...@@ -65,6 +66,7 @@ processEvents max iworld
(Error msg,iworld=:{IWorld|world}) (Error msg,iworld=:{IWorld|world})
= (Ok (),{IWorld|iworld & world = world}) = (Ok (),{IWorld|iworld & world = world})
derive gText InstanceType
evalTaskInstance :: !InstanceNo !Event !*IWorld -> (!MaybeErrorString (TaskValue DeferredJSON),!*IWorld) evalTaskInstance :: !InstanceNo !Event !*IWorld -> (!MaybeErrorString (TaskValue DeferredJSON),!*IWorld)
evalTaskInstance instanceNo event iworld evalTaskInstance instanceNo event iworld
# iworld = mbResetUIState instanceNo event iworld # iworld = mbResetUIState instanceNo event iworld
...@@ -141,6 +143,9 @@ where ...@@ -141,6 +143,9 @@ where
NoChange = (Ok value,iworld) NoChange = (Ok value,iworld)
change = (Ok value, queueUIChange instanceNo change iworld) change = (Ok value, queueUIChange instanceNo change iworld)
ExceptionResult (e,description) ExceptionResult (e,description)
# iworld = if (type =: StartupInstance)
(printStdErr description {iworld & shutdown=Just 1})
iworld
= exitWithException instanceNo description iworld = exitWithException instanceNo description iworld
DestroyedResult DestroyedResult
= (Ok NoValue, iworld) = (Ok NoValue, iworld)
......
...@@ -435,7 +435,7 @@ where ...@@ -435,7 +435,7 @@ where
*(!.ioChannels, !*IWorld) *(!.ioChannels, !*IWorld)
-> *IWorld -> *IWorld
taskStateException mbTaskState instanceNo ioStates closeIO (ioChannels, 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 # iworld = if (instanceNo > 0) (queueRefresh [(taskId, "Exception for " <+++ instanceNo)] iworld) iworld
# ioStates = put taskId (IOException (fromError mbTaskState)) ioStates # ioStates = put taskId (IOException (fromError mbTaskState)) ioStates
= closeIO (ioChannels, {iworld & ioStates = ioStates}) = closeIO (ioChannels, {iworld & ioStates = ioStates})
...@@ -447,7 +447,7 @@ where ...@@ -447,7 +447,7 @@ where
*(!.ioChannels, !*IWorld) *(!.ioChannels, !*IWorld)
-> *IWorld -> *IWorld
sdsException mbSdsErr instanceNo ioStates closeIO (ioChannels, 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 # iworld = if (instanceNo > 0) (queueRefresh [(taskId, "Exception for " <+++ instanceNo)] iworld) iworld
# ioStates = put taskId (IOException (snd (fromError mbSdsErr))) ioStates # ioStates = put taskId (IOException (snd (fromError mbSdsErr))) ioStates
= closeIO (ioChannels, {iworld & ioStates = ioStates}) = closeIO (ioChannels, {iworld & ioStates = ioStates})
......
...@@ -62,7 +62,7 @@ injectEditorValue :: !(a -> b) !(b -> MaybeErrorString a) !(Editor b) -> Editor ...@@ -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 * 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 * Map the value of an editor to another domain, without mapping changes in the editor back
......
...@@ -161,11 +161,12 @@ where ...@@ -161,11 +161,12 @@ where
= (Ok (mergeUIChanges change attrChange, st), vst) = (Ok (mergeUIChanges change attrChange, st), vst)
_ = (Ok (change, st), vst) _ = (Ok (change, st), vst)
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
surjectEditorValue tof fromf {Editor|genUI=editorGenUI,onEdit=editorOnEdit,onRefresh=editorOnRefresh,valueFromState=editorValueFromState} = editorModifierWithStateToEditor surjectEditorValue tof fromf {Editor|genUI=editorGenUI,onEdit=editorOnEdit,onRefresh=editorOnRefresh,valueFromState=editorValueFromState}
{EditorModifierWithState|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh,valueFromState=valueFromState} = editorModifierWithStateToEditor
{EditorModifierWithState|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh,valueFromState=valueFromState}
where 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) (Error e,vst) = (Error e,vst)
//Track value of the 'outer' editor //Track value of the 'outer' editor
(Ok (ui, st),vst) = (Ok (ui, editModeValue mode, st), vst) (Ok (ui, st),vst) = (Ok (ui, editModeValue mode, st), vst)
...@@ -174,7 +175,7 @@ where ...@@ -174,7 +175,7 @@ where
(Error e, vst) = (Error e, vst) (Error e, vst) = (Error e, vst)
(Ok (change, st),vst) = (Ok (change, updatedState mbOldA st, st), vst) (Ok (change, st),vst) = (Ok (change, updatedState mbOldA st, st), vst)
onRefresh dp newA _ st vst = case editorOnRefresh dp (tof newA) st vst of onRefresh dp newA _ st vst = case editorOnRefresh dp (tof newA (editorValueFromState st)) st vst of
(Error e, vst) = (Error e, vst) (Error e, vst) = (Error e, vst)
(Ok (change, st), vst) = (Ok (change, updatedState (Just newA) st, st), vst) (Ok (change, st), vst) = (Ok (change, updatedState (Just newA) st, st), vst)
......
...@@ -315,6 +315,19 @@ const ABC={ ...@@ -315,6 +315,19 @@ const ABC={
}, },
addresses: {}, addresses: {},
get_trace: function() {
var trace=[' {0}',ABC.interpreter.instance.exports.get_pc()/8-ABC.code_offset,'\n'];
var csp=ABC.interpreter.instance.exports.get_csp();
for (var i=1; i<=ABC_TRACE_LENGTH; i++) {
var addr=ABC.memory_array[csp/4];
if (addr==0)
break;
trace.push(' {'+i+'}',addr/8-ABC.code_offset,'\n');
csp-=8;
}
return trace;
},
}; };
ABC.loading_promise=fetch('js/app.pbc').then(function(resp){ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){
...@@ -342,9 +355,8 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){ ...@@ -342,9 +355,8 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){
} }
})(ABC.prog); })(ABC.prog);
return WebAssembly.instantiateStreaming( const util_imports={
fetch('js/abc-interpreter-util.wasm'), clean: {
{ clean: {
memory: ABC.memory, memory: ABC.memory,
has_host_reference: function (index) { has_host_reference: function (index) {
...@@ -394,8 +406,12 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){ ...@@ -394,8 +406,12 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){
case 3: console.log('thunk, arities',a,b,c); break; case 3: console.log('thunk, arities',a,b,c); break;
} }
} }
}} }
); };
return fetch('js/abc-interpreter-util.wasm')
.then(response => response.arrayBuffer())
.then(buffer => WebAssembly.instantiate(buffer, util_imports));
}).then(function(util){ }).then(function(util){
ABC.util=util; ABC.util=util;
...@@ -594,9 +610,9 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){ ...@@ -594,9 +610,9 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){
} }
}; };
return WebAssembly.instantiateStreaming( return fetch('js/abc-interpreter.wasm')
fetch('js/abc-interpreter.wasm'), .then(response => response.arrayBuffer())
interpreter_imports); .then(bytes => WebAssembly.instantiate(bytes, interpreter_imports));
}).then(function(intp){ }).then(function(intp){
ABC.interpreter=intp; ABC.interpreter=intp;
...@@ -648,16 +664,7 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){ ...@@ -648,16 +664,7 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){
(e.fileName!='abc-interpreter.js' || e.lineNumber>700)) (e.fileName!='abc-interpreter.js' || e.lineNumber>700))
throw e; throw e;
var trace=[e.message, '\n']; var trace=[e.message, '\n'].concat(ABC.get_trace());
trace.push(' {0}', ABC.interpreter.instance.exports.get_pc()/8-ABC.code_offset,'\n');
var csp=ABC.interpreter.instance.exports.get_csp();
for (var i=1; i<=ABC_TRACE_LENGTH; i++) {
var addr=ABC.memory_array[csp/4];
if (addr==0)
break;
trace.push(' {'+i+'}',addr/8-ABC.code_offset,'\n');
csp-=8;
}
console.error.apply(null,trace); console.error.apply(null,trace);
throw e.toString(); throw e.toString();
......
...@@ -15,4 +15,3 @@ traceValue :: a -> Task a | iTask a ...@@ -15,4 +15,3 @@ traceValue :: a -> Task a | iTask a
* @param The exit code of the server process * @param The exit code of the server process
*/ */
shutDown :: Int -> Task () shutDown :: Int -> Task ()
implementation module iTasks.WF.Tasks.System implementation module iTasks.WF.Tasks.System
import iTasks.WF.Definition import iTasks.Internal.EngineTasks
import iTasks.Internal.Task
import iTasks.Internal.IWorld import iTasks.Internal.IWorld
import iTasks.Internal.Generic.Visualization import iTasks.Internal.Task
import Data.Error, Data.Maybe import iTasks.WF.Definition
import StdFile
import iTasks.WF.Tasks.Core
traceValue :: a -> Task a | iTask a traceValue :: a -> Task a | iTask a
traceValue v = accWorld printStdErr traceValue v = mkInstantTask (\_ iworld->(Ok v, printStdErr v iworld))
where
printStdErr w
# (_, w) = fclose (stderr <<< toSingleLineText v <<< "\n") w
= (v, w)
shutDown :: Int -> Task () shutDown :: Int -> Task ()
shutDown exitCode = mkInstantTask (\taskId iworld -> (Ok (), {IWorld|iworld & shutdown = Just exitCode})) shutDown exitCode = mkInstantTask (\taskId iworld -> (Ok (), {IWorld|iworld & shutdown = Just exitCode}))
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment