...
 
Commits (11)
......@@ -44,7 +44,7 @@ wrapIWorldConnectionTask :: (ConnectionHandlersIWorld l r w) (sds () r w) -> Con
/**
* Create a task that finishes instantly
*/
mkInstantTask :: (TaskId *IWorld -> (MaybeError TaskException a,*IWorld)) -> Task a | iTask a
mkInstantTask :: (TaskId *IWorld -> (MaybeError TaskException a,*IWorld)) -> Task a
/**
* Apply a function on the task continuation of the task result
......
......@@ -112,7 +112,7 @@ where
= (toDyn <$> mbl, out, env)
onDestroy` l env = abort ("onDestroy does not match with type l=" +++ toString (typeCodeOfDynamic l))
mkInstantTask :: (TaskId *IWorld -> (MaybeError TaskException a,*IWorld)) -> Task a | iTask a
mkInstantTask :: (TaskId *IWorld -> (MaybeError TaskException a,*IWorld)) -> Task a
mkInstantTask iworldfun = Task eval
where
eval DestroyEvent _ iworld = (DestroyedResult, iworld)
......
......@@ -80,6 +80,7 @@ where
wrapEditor = sequenceLayouts
[wrapUI UIContainer
,copySubUIAttributes SelectAll [0] []
,delUIAttributes (SelectKeys ["initUI","taskId","editorId"]) //Don't duplicate the UI initialization code
,layoutSubUIs hasTitle (setUIType UIPanel)
,layoutSubUIs hasPrompt (sequenceLayouts [createPrompt,fillPrompt])
]
......
......@@ -18,7 +18,7 @@ instance Functor Task
* @param The possible continuations
* @return The continuation's result
*/
(>>*) infixl 1 :: !(Task a) ![TaskCont a (Task b)] -> Task b | iTask a & iTask b
(>>*) infixl 1 :: !(Task a) ![TaskCont a (Task b)] -> Task b | TC, JSONEncode{|*|} a
//Standard monadic operations:
......@@ -31,7 +31,7 @@ instance Functor Task
* @param Second: The second task, which receives the result of the first task
* @return The combined task
*/
(>>=) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>=) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
/**
* Combines two tasks sequentially. The first task is executed first.
......@@ -42,7 +42,7 @@ instance Functor Task
* @param Second: The second task
* @return The combined task
*/
(>>|) infixl 1 :: !(Task a) !(Task b) -> Task b | iTask a & iTask b
(>>|) infixl 1 :: !(Task a) !(Task b) -> Task b | TC, JSONEncode{|*|} a
/**
* Combines two tasks sequentially but explicitly waits for user input to confirm the completion of
......@@ -52,7 +52,7 @@ instance Functor Task
* @param Second: The second task, which receives the result of the first task
* @return The combined task
*/
(>>!) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>!) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
/**
* Combines two tasks sequentially but continues only when the first task has a stable value.
*
......@@ -60,7 +60,7 @@ instance Functor Task
* @param Second: The second task, which receives the result of the first task
* @return The combined task
*/
(>>-) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>-) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
/**
* Combines two tasks sequentially but continues only when the first task has a stable value.
*
......@@ -78,7 +78,7 @@ instance Functor Task
* @param Second: The second task, which receives the result of the first task
* @return The combined task
*/
(>>~) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>~) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
/**
* Combines two tasks sequentially just as >>=, but the result of the second task is disregarded.
*
......@@ -87,7 +87,7 @@ instance Functor Task
*
* @return The combined task
*/
(>>^) infixl 1 :: !(Task a) (Task b) -> Task a| iTask a & iTask b
(>>^) infixl 1 :: !(Task a) (Task b) -> Task a| TC, JSONEncode{|*|} a & TC, JSONEncode{|*|} b
/**
* Infix shorthand for transform combinator
*
......
......@@ -29,25 +29,25 @@ import iTasks.WF.Tasks.SDS
instance Functor Task where
fmap f t = t @ f
(>>*) infixl 1 :: !(Task a) ![TaskCont a (Task b)] -> Task b | iTask a & iTask b
(>>*) infixl 1 :: !(Task a) ![TaskCont a (Task b)] -> Task b | TC, JSONEncode{|*|} a
(>>*) task steps = step task (const Nothing) steps
(>>=) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>=) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
(>>=) taska taskbf = step taska (const Nothing) [OnAction ActionContinue (hasValue taskbf), OnValue (ifStable taskbf)]
(>>|) infixl 1 :: !(Task a) !(Task b) -> Task b | iTask a & iTask b
(>>|) infixl 1 :: !(Task a) !(Task b) -> Task b | TC, JSONEncode{|*|} a
(>>|) l r = l >>* [OnAction ActionContinue (always r), OnValue (ifStable (\_->r))]
(>>!) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>!) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
(>>!) taska taskbf = step taska (const Nothing) [OnAction ActionContinue (hasValue taskbf)]
(>>-) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>-) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
(>>-) taska taskbf = step taska (const Nothing) [OnValue (ifStable taskbf)]
(>>~) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>~) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | TC, JSONEncode{|*|} a
(>>~) taska taskbf = step taska (const Nothing) [OnValue (hasValue taskbf)]
(>>^) infixl 1 :: !(Task a) (Task b) -> Task a | iTask a & iTask b
(>>^) infixl 1 :: !(Task a) (Task b) -> Task a | TC, JSONEncode{|*|} a & TC, JSONEncode{|*|} b
(>>^) taska taskb = taska >>= \x -> taskb >>| return x
(@?) infixl 1 :: !(Task a) !((TaskValue a) -> TaskValue b) -> Task b
......
......@@ -17,7 +17,7 @@ from iTasks.UI.Editor import :: EditMode
* @default ()
* @return A task that will return the value defined by the parameter
*/
return :: !a -> Task a | iTask a
return :: !a -> Task a
//Backwards compatibility
treturn :== return
......@@ -29,7 +29,7 @@ treturn :== return
* @param Value: The exception value
* @return The combined task
*/
throw :: !e -> Task a | iTask a & iTask, toString e
throw :: !e -> Task a | TC, toString e
/**
* Evaluate a "World" function that does not yield any result once.
......@@ -45,7 +45,7 @@ appWorld :: !(*World -> *World) -> Task ()
* @param World function: The function to evaluate
* @return A task that evaluates the function and yield a
*/
accWorld :: !(*World -> *(a,*World)) -> Task a | iTask a
accWorld :: !(*World -> *(a,*World)) -> Task a
/**
* Evaluate a "World" function that also returns a MaybeError value.
......@@ -55,7 +55,7 @@ accWorld :: !(*World -> *(a,*World)) -> Task a | iTask a
*
* @return A task that evaluates the function
*/
accWorldError :: !(*World -> (MaybeError e a, *World)) !(e -> err) -> Task a | iTask a & TC, toString err
accWorldError :: !(*World -> (MaybeError e a, *World)) !(e -> err) -> Task a | TC, toString err
/**
* Evaluate a "World" function that also returns a MaybeOSError value.
......@@ -65,7 +65,7 @@ accWorldError :: !(*World -> (MaybeError e a, *World)) !(e -> err) -> Task a |
*
* @return A task that evaluates the function
*/
accWorldOSError :: !(*World -> (MaybeOSError a, *World)) -> Task a | iTask a
accWorldOSError :: !(*World -> (MaybeOSError a, *World)) -> Task a
:: OSException = OSException !OSError
instance toString OSException
......
......@@ -19,19 +19,19 @@ import StdString, StdBool, StdInt, StdMisc, StdFunc
import qualified Data.Set as DS
import qualified Data.Map as DM
return :: !a -> (Task a) | iTask a
return :: !a -> (Task a)
return a = mkInstantTask (\taskId iworld-> (Ok a, iworld))
throw :: !e -> Task a | iTask a & iTask, toString e
throw :: !e -> Task a | TC, toString e
throw e = mkInstantTask (\taskId iworld -> (Error (exception e), iworld))
appWorld :: !(*World -> *World) -> Task ()
appWorld fun = accWorld $ tuple () o fun
accWorld :: !(*World -> *(a, *World)) -> Task a | iTask a
accWorld :: !(*World -> *(a, *World)) -> Task a
accWorld fun = accWorldError (appFst Ok o fun) \_->""
accWorldError :: !(*World -> (MaybeError e a, *World)) !(e -> err) -> Task a | iTask a & TC, toString err
accWorldError :: !(*World -> (MaybeError e a, *World)) !(e -> err) -> Task a | TC, toString err
accWorldError fun errf = mkInstantTask eval
where
eval taskId iworld=:{IWorld|world}
......@@ -40,7 +40,7 @@ where
Error e = (Error (exception (errf e)), {IWorld|iworld & world = world})
Ok v = (Ok v, {IWorld|iworld & world = world})
accWorldOSError :: !(*World -> (MaybeOSError a, *World)) -> Task a | iTask a
accWorldOSError :: !(*World -> (MaybeOSError a, *World)) -> Task a
accWorldOSError fun = accWorldError fun OSException
instance toString OSException
......@@ -58,18 +58,34 @@ interactR shared handlers editor
= Task (readRegisterCompletely shared NoValue (\event->mkUIIfReset event (asyncSDSLoaderUI Read)) (evalInteractInit shared handlers editor \_ _->modifyCompletely (\()->undef) nullShare))
//This initializes the editor state and continues with the actual interact task
evalInteractInit sds handlers editor writefun r event evalOpts=:{TaskEvalOpts|taskId} iworld
evalInteractInit sds handlers editor writefun r _ evalOpts iworld
//Get initial value
# mode = handlers.onInit r
# v = case mode of
Enter = Nothing
Update x = Just x
View x = Just x
= evalInteract r v Nothing (mode=:View _) sds handlers editor writefun ResetEvent evalOpts iworld
= evalInteractInitWithValue r v (mode =: View _) sds handlers editor writefun evalOpts iworld
evalInteractInitWithValue r v mode sds handlers editor writefun evalOpts=:{TaskEvalOpts|taskId, lastEval} iworld
# resetMode = case (mode, v) of
(True, Just v) = View v
(True, _) = abort "view mode without value\n"
(_, Nothing) = Enter
(_, Just v) = Update v
= case withVSt taskId (editor.Editor.genUI 'DM'.newMap [] resetMode) iworld of
(Error e, iworld) = (ExceptionResult (exception e), iworld)
(Ok (UI type attr items, st), iworld)
# change = ReplaceUI (UI type (addClassAttr "interact" attr) items)
= (ValueResult
(maybe NoValue (\v->Value (r,v) False) v)
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract r (Just st) mode sds handlers editor writefun))
, iworld)
evalInteract ::
r
(Maybe v)
(Maybe EditState)
Bool
(sds () r w)
......@@ -90,9 +106,9 @@ evalInteract ::
*IWorld
-> *(TaskResult (r,v),*IWorld)
| iTask r & iTask v & TC r & TC w & Registrable sds
evalInteract _ _ _ _ _ _ _ _ DestroyEvent {TaskEvalOpts|taskId} iworld
evalInteract _ _ _ _ _ _ _ DestroyEvent {TaskEvalOpts|taskId} iworld
= (DestroyedResult, 'SDS'.clearTaskSDSRegistrations ('DS'.singleton taskId) iworld)
evalInteract r v mst mode sds handlers editor writefun event=:(EditEvent eTaskId name edit) evalOpts=:{taskId,lastEval} iworld
evalInteract r mst mode sds handlers editor writefun event=:(EditEvent eTaskId name edit) evalOpts=:{taskId,lastEval} iworld
| isNothing mst = (ExceptionResult (exception "corrupt editor state"), iworld)
| eTaskId == taskId
# (res, iworld) = withVSt taskId (editor.Editor.onEdit [] (s2dp name,edit) (fromJust mst)) iworld
......@@ -112,7 +128,7 @@ evalInteract r v mst mode sds handlers editor writefun event=:(EditEvent eTaskId
(Value (r,nv) False)
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract r (Just nv) (Just st) mode sds handlers editor writefun))
(Task (evalInteract r (Just st) mode sds handlers editor writefun))
, iworld))
event evalOpts iworld
//There is no update function
......@@ -121,37 +137,23 @@ evalInteract r v mst mode sds handlers editor writefun event=:(EditEvent eTaskId
(Value (r,nv) False)
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract r (Just nv) (Just st) mode sds handlers editor writefun))
(Task (evalInteract r (Just st) mode sds handlers editor writefun))
, iworld)
Nothing
= (ValueResult
NoValue
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract r Nothing (Just st) mode sds handlers editor writefun))
(Task (evalInteract r (Just st) mode sds handlers editor writefun))
, iworld)
Error e = (ExceptionResult (exception e), iworld)
evalInteract r v mst mode sds handlers editor writefun ResetEvent evalOpts=:{taskId,lastEval} iworld
# resetMode = case (mode, v) of
(True, Just v) = View v
(True, _) = abort "view mode without value\n"
(_, Nothing) = Enter
(_, Just v) = Update v
= case withVSt taskId (editor.Editor.genUI 'DM'.newMap [] resetMode) iworld of
(Error e, iworld) = (ExceptionResult (exception e), iworld)
(Ok (UI type attr items, st), iworld)
# change = ReplaceUI (UI type (addClassAttr "interact" attr) items)
# mbv = editor.Editor.valueFromState st
# v = maybe v Just mbv
= (ValueResult
(maybe NoValue (\v->Value (r,v) False) v)
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract r v (Just st) mode sds handlers editor writefun))
, iworld)
evalInteract r v mst mode sds handlers editor writefun event=:(RefreshEvent taskIds _) evalOpts=:{taskId,lastEval} iworld
evalInteract r mst mode sds handlers editor writefun ResetEvent evalOpts iworld
# v = maybe Nothing editor.Editor.valueFromState mst
= evalInteractInitWithValue r v mode sds handlers editor writefun evalOpts iworld
evalInteract r mst mode sds handlers editor writefun event=:(RefreshEvent taskIds _) evalOpts=:{taskId,lastEval} iworld
| isNothing mst = (ExceptionResult (exception "corrupt editor state"), iworld)
# st = fromJust mst
# v = editor.Editor.valueFromState st
| 'DS'.member taskId taskIds
= readRegisterCompletely sds (maybe NoValue (\v->Value (r,v) False) v) (\e->mkUIIfReset e (asyncSDSLoaderUI Read))
(\r event evalOpts iworld
......@@ -165,24 +167,25 @@ evalInteract r v mst mode sds handlers editor writefun event=:(RefreshEvent task
# v = editor.Editor.valueFromState st
= case mbf of
Just f = writefun f sds NoValue (\_->change)
(\_->evalInteract r v (Just st) mode sds handlers editor writefun)
(\_->evalInteract r (Just st) mode sds handlers editor writefun)
event evalOpts iworld
Nothing
= (ValueResult
(maybe NoValue (\v -> Value (r,v) False) v)
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract r v (Just st) mode sds handlers editor writefun))
(Task (evalInteract r (Just st) mode sds handlers editor writefun))
, iworld)
)
event evalOpts iworld
evalInteract r v mst mode sds handlers editor writefun event {lastEval} iworld
evalInteract r mst mode sds handlers editor writefun event {lastEval} iworld
# v = maybe Nothing editor.Editor.valueFromState mst
//An event for a sibling?
= (ValueResult
(maybe NoValue (\v->Value (r,v) False) v)
(mkTaskEvalInfo lastEval)
NoChange
(Task (evalInteract r v mst mode sds handlers editor writefun))
(Task (evalInteract r mst mode sds handlers editor writefun))
, iworld)
uniqueMode :: (EditMode a) -> *(EditMode a)
......
......@@ -96,7 +96,7 @@ where
clock = sdsFocus {start=zero,interval=poll} iworldTimespec
tcplisten :: !Int !Bool !(sds () r w) (ConnectionHandlers l r w) -> Task [l] | iTask l & iTask r & iTask w & RWShared sds
tcplisten port removeClosed sds handlers = Task eval
tcplisten port removeClosed sds handlers = Task evalinit
where
evalinit DestroyEvent _ iworld = (DestroyedResult, iworld)
evalinit event evalOpts=:{TaskEvalOpts|taskId} iworld
......
......@@ -20,7 +20,7 @@ from Data.Maybe import :: Maybe
* @return The value read
* @throws SharedException
*/
get :: !(sds () a w) -> Task a | iTask a & Readable sds & TC w
get :: !(sds () a w) -> Task a | TC a & Readable sds & TC w
/**
* Writes shared data.
......@@ -30,7 +30,7 @@ get :: !(sds () a w) -> Task a | iTask a & Readable sds & TC w
* @return The value written
* @throws SharedException
*/
set :: !a !(sds () r a) -> Task a | iTask a & TC r & Writeable sds
set :: !a !(sds () r a) -> Task a | TC a & TC r & Writeable sds
/**
* Updates shared data in one atomic operation.
......@@ -40,7 +40,7 @@ set :: !a !(sds () r a) -> Task a | iTask a & TC r & Writeable sds
* @return The value written
* @throws SharedException
*/
upd :: !(r -> w) !(sds () r w) -> Task w | iTask r & iTask w & RWShared sds
upd :: !(r -> w) !(sds () r w) -> Task w | TC r & TC w & RWShared sds
/**
* Reads shared data continously
......@@ -49,5 +49,4 @@ upd :: !(r -> w) !(sds () r w) -> Task w | iTask r & iTask w & RWShared sds
* @return The value read
* @throws SharedException
*/
watch :: !(sds () r w) -> Task r | iTask r & TC w & Readable, Registrable sds
watch :: !(sds () r w) -> Task r | TC r & TC w & Readable, Registrable sds
......@@ -13,16 +13,16 @@ import iTasks.Internal.TaskEval
import iTasks.Internal.TaskState
import iTasks.Internal.Util
get :: !(sds () a w) -> Task a | iTask a & Readable sds & TC w
get :: !(sds () a w) -> Task a | TC a & Readable sds & TC w
get sds = Task (readCompletely sds NoValue (unTask o return))
set :: !a !(sds () r a) -> Task a | iTask a & TC r & Writeable sds
set :: !a !(sds () r a) -> Task a | TC a & TC r & Writeable sds
set val sds = Task (writeCompletely val sds NoValue (unTask (return val)))
upd :: !(r -> w) !(sds () r w) -> Task w | iTask r & iTask w & RWShared sds
upd :: !(r -> w) !(sds () r w) -> Task w | TC r & TC w & RWShared sds
upd fun sds = Task (modifyCompletely fun sds NoValue (\e->mkUIIfReset e (asyncSDSLoaderUI Modify)) (unTask o return))
watch :: !(sds () r w) -> Task r | iTask r & TC w & Readable, Registrable sds
watch :: !(sds () r w) -> Task r | TC r & TC w & Readable, Registrable sds
watch sds = Task (readRegisterCompletely sds NoValue mkUi cont)
where
cont r event {lastEval} iworld
......