Commit 1bbe8add authored by Bas Lijnse's avatar Bas Lijnse Committed by Steffen Michels

Exposed share read in interact task value

parent 7c7d1011
...@@ -77,7 +77,7 @@ instance toString OSException ...@@ -77,7 +77,7 @@ instance toString OSException
* Core interaction task. All other interaction tasks are derived from this * Core interaction task. All other interaction tasks are derived from this
* one. `interactR` is almost identical but does not update the given sds. * one. `interactR` is almost identical but does not update the given sds.
*/ */
interactRW :: !(sds () r w) (InteractionHandlers r w v) (Editor v) -> Task v | iTask r & iTask v & TC r & TC w & RWShared sds interactRW :: !(sds () r w) (InteractionHandlers r w v) (Editor v) -> Task (r,v) | iTask r & iTask v & TC r & TC w & RWShared sds
//* See documentation on `interactRW`. //* See documentation on `interactRW`.
interactR :: (sds () r w) (InteractionHandlers r w v) (Editor v) -> Task v | iTask r & iTask v & TC r & TC w & Registrable sds interactR :: (sds () r w) (InteractionHandlers r w v) (Editor v) -> Task (r,v) | iTask r & iTask v & TC r & TC w & Registrable sds
...@@ -47,12 +47,12 @@ instance toString OSException ...@@ -47,12 +47,12 @@ instance toString OSException
where where
toString (OSException (_,err)) = "Error performing OS operation: " +++ err toString (OSException (_,err)) = "Error performing OS operation: " +++ err
interactRW :: !(sds () r w) (InteractionHandlers r w v) (Editor v) -> Task v interactRW :: !(sds () r w) (InteractionHandlers r w v) (Editor v) -> Task (r,v)
| iTask r & iTask v & TC r & TC w & RWShared sds | iTask r & iTask v & TC r & TC w & RWShared sds
interactRW shared handlers editor interactRW shared handlers editor
= Task (readRegisterCompletely shared NoValue (\event->mkUIIfReset event (asyncSDSLoaderUI Read)) (evalInteractInit shared handlers editor modifyCompletely)) = Task (readRegisterCompletely shared NoValue (\event->mkUIIfReset event (asyncSDSLoaderUI Read)) (evalInteractInit shared handlers editor modifyCompletely))
interactR :: (sds () r w) (InteractionHandlers r w v) (Editor v) -> Task v interactR :: (sds () r w) (InteractionHandlers r w v) (Editor v) -> Task (r,v)
| iTask r & iTask v & TC r & TC w & Registrable sds | iTask r & iTask v & TC r & TC w & Registrable sds
interactR shared handlers editor interactR shared handlers editor
= Task (readRegisterCompletely shared NoValue (\event->mkUIIfReset event (asyncSDSLoaderUI Read)) (evalInteractInit shared handlers editor \_ _->modifyCompletely (\()->undef) nullShare)) = Task (readRegisterCompletely shared NoValue (\event->mkUIIfReset event (asyncSDSLoaderUI Read)) (evalInteractInit shared handlers editor \_ _->modifyCompletely (\()->undef) nullShare))
...@@ -65,9 +65,10 @@ evalInteractInit sds handlers editor writefun r event evalOpts=:{TaskEvalOpts|ta ...@@ -65,9 +65,10 @@ evalInteractInit sds handlers editor writefun r event evalOpts=:{TaskEvalOpts|ta
Enter = Nothing Enter = Nothing
Update x = Just x Update x = Just x
View x = Just x View x = Just x
= evalInteract v Nothing (mode=:View _) sds handlers editor writefun ResetEvent evalOpts iworld = evalInteract r v Nothing (mode=:View _) sds handlers editor writefun ResetEvent evalOpts iworld
evalInteract :: evalInteract ::
r
(Maybe v) (Maybe v)
(Maybe EditState) (Maybe EditState)
Bool Bool
...@@ -77,21 +78,21 @@ evalInteract :: ...@@ -77,21 +78,21 @@ evalInteract ::
( (
(r -> w) (r -> w)
(sds () r w) (sds () r w)
(TaskValue v) (TaskValue (r,v))
(Event -> UIChange) (Event -> UIChange)
(w -> Event -> TaskEvalOpts -> *IWorld -> *(TaskResult v,*IWorld)) (w -> Event -> TaskEvalOpts -> *IWorld -> *(TaskResult (r,v),*IWorld))
Event Event
TaskEvalOpts TaskEvalOpts
*IWorld *IWorld
-> *(TaskResult v,*IWorld)) -> *(TaskResult (r,v),*IWorld))
Event Event
TaskEvalOpts TaskEvalOpts
*IWorld *IWorld
-> *(TaskResult v,*IWorld) -> *(TaskResult (r,v),*IWorld)
| iTask r & iTask v & TC r & TC w & Registrable sds | 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) = (DestroyedResult, 'SDS'.clearTaskSDSRegistrations ('DS'.singleton taskId) iworld)
evalInteract v mst mode sds handlers editor writefun event=:(EditEvent eTaskId name edit) evalOpts=:{taskId,lastEval} iworld evalInteract r v mst mode sds handlers editor writefun event=:(EditEvent eTaskId name edit) evalOpts=:{taskId,lastEval} iworld
| isNothing mst = (ExceptionResult (exception "corrupt editor state"), iworld) | isNothing mst = (ExceptionResult (exception "corrupt editor state"), iworld)
| eTaskId == taskId | eTaskId == taskId
# (res, iworld) = withVSt taskId (editor.Editor.onEdit [] (s2dp name,edit) (fromJust mst)) iworld # (res, iworld) = withVSt taskId (editor.Editor.onEdit [] (s2dp name,edit) (fromJust mst)) iworld
...@@ -104,33 +105,33 @@ evalInteract v mst mode sds handlers editor writefun event=:(EditEvent eTaskId n ...@@ -104,33 +105,33 @@ evalInteract v mst mode sds handlers editor writefun event=:(EditEvent eTaskId n
//We have an update function //We have an update function
Just f = writefun f sds NoValue (\_->change) Just f = writefun f sds NoValue (\_->change)
// We cannot just do this because this will loop endlessly: // We cannot just do this because this will loop endlessly:
// (\_->evalInteract l (Just v) st mode sds handlers editor writefun) // (\_->evalInteract (Just v) st mode sds handlers editor writefun)
// Therefore we delay it by returning the continuation in a value instead of directly: // Therefore we delay it by returning the continuation in a value instead of directly:
(\w event {TaskEvalOpts|lastEval} iworld-> (\w event {TaskEvalOpts|lastEval} iworld->
(ValueResult (ValueResult
(Value nv False) (Value (r,nv) False)
(mkTaskEvalInfo lastEval) (mkTaskEvalInfo lastEval)
change change
(Task (evalInteract (Just nv) (Just st) mode sds handlers editor writefun)) (Task (evalInteract r (Just nv) (Just st) mode sds handlers editor writefun))
, iworld)) , iworld))
event evalOpts iworld event evalOpts iworld
//There is no update function //There is no update function
Nothing Nothing
= (ValueResult = (ValueResult
(Value nv False) (Value (r,nv) False)
(mkTaskEvalInfo lastEval) (mkTaskEvalInfo lastEval)
change change
(Task (evalInteract (Just nv) (Just st) mode sds handlers editor writefun)) (Task (evalInteract r (Just nv) (Just st) mode sds handlers editor writefun))
, iworld) , iworld)
Nothing Nothing
= (ValueResult = (ValueResult
NoValue NoValue
(mkTaskEvalInfo lastEval) (mkTaskEvalInfo lastEval)
change change
(Task (evalInteract Nothing (Just st) mode sds handlers editor writefun)) (Task (evalInteract r Nothing (Just st) mode sds handlers editor writefun))
, iworld) , iworld)
Error e = (ExceptionResult (exception e), iworld) Error e = (ExceptionResult (exception e), iworld)
evalInteract v mst mode sds handlers editor writefun ResetEvent evalOpts=:{taskId,lastEval} iworld evalInteract r v mst mode sds handlers editor writefun ResetEvent evalOpts=:{taskId,lastEval} iworld
# resetMode = case (mode, v) of # resetMode = case (mode, v) of
(True, Just v) = View v (True, Just v) = View v
(True, _) = abort "view mode without value\n" (True, _) = abort "view mode without value\n"
...@@ -143,16 +144,16 @@ evalInteract v mst mode sds handlers editor writefun ResetEvent evalOpts=:{taskI ...@@ -143,16 +144,16 @@ evalInteract v mst mode sds handlers editor writefun ResetEvent evalOpts=:{taskI
# mbv = editor.Editor.valueFromState st # mbv = editor.Editor.valueFromState st
# v = maybe v Just mbv # v = maybe v Just mbv
= (ValueResult = (ValueResult
(maybe NoValue (\v->Value v False) v) (maybe NoValue (\v->Value (r,v) False) v)
(mkTaskEvalInfo lastEval) (mkTaskEvalInfo lastEval)
change change
(Task (evalInteract v (Just st) mode sds handlers editor writefun)) (Task (evalInteract r v (Just st) mode sds handlers editor writefun))
, iworld) , iworld)
evalInteract v mst mode sds handlers editor writefun event=:(RefreshEvent taskIds _) evalOpts=:{taskId,lastEval} iworld evalInteract r v mst mode sds handlers editor writefun event=:(RefreshEvent taskIds _) evalOpts=:{taskId,lastEval} iworld
| isNothing mst = (ExceptionResult (exception "corrupt editor state"), iworld) | isNothing mst = (ExceptionResult (exception "corrupt editor state"), iworld)
# st = fromJust mst # st = fromJust mst
| 'DS'.member taskId taskIds | 'DS'.member taskId taskIds
= readRegisterCompletely sds (maybe NoValue (\v->Value v False) v) (\e->mkUIIfReset e (asyncSDSLoaderUI Read)) = readRegisterCompletely sds (maybe NoValue (\v->Value (r,v) False) v) (\e->mkUIIfReset e (asyncSDSLoaderUI Read))
(\r event evalOpts iworld (\r event evalOpts iworld
# (mbV, mbf) = handlers.InteractionHandlers.onRefresh r v # (mbV, mbf) = handlers.InteractionHandlers.onRefresh r v
# mbChange = case mbV of # mbChange = case mbV of
...@@ -164,24 +165,24 @@ evalInteract v mst mode sds handlers editor writefun event=:(RefreshEvent taskId ...@@ -164,24 +165,24 @@ evalInteract v mst mode sds handlers editor writefun event=:(RefreshEvent taskId
# v = editor.Editor.valueFromState st # v = editor.Editor.valueFromState st
= case mbf of = case mbf of
Just f = writefun f sds NoValue (\_->change) Just f = writefun f sds NoValue (\_->change)
(\_->evalInteract v (Just st) mode sds handlers editor writefun) (\_->evalInteract r v (Just st) mode sds handlers editor writefun)
event evalOpts iworld event evalOpts iworld
Nothing Nothing
= (ValueResult = (ValueResult
(maybe NoValue (\v -> Value v False) v) (maybe NoValue (\v -> Value (r,v) False) v)
(mkTaskEvalInfo lastEval) (mkTaskEvalInfo lastEval)
change change
(Task (evalInteract v (Just st) mode sds handlers editor writefun)) (Task (evalInteract r v (Just st) mode sds handlers editor writefun))
, iworld) , iworld)
) )
event evalOpts iworld event evalOpts iworld
evalInteract v mst mode sds handlers editor writefun event {lastEval} iworld evalInteract r v mst mode sds handlers editor writefun event {lastEval} iworld
//An event for a sibling? //An event for a sibling?
= (ValueResult = (ValueResult
(maybe NoValue (\v->Value v False) v) (maybe NoValue (\v->Value (r,v) False) v)
(mkTaskEvalInfo lastEval) (mkTaskEvalInfo lastEval)
NoChange NoChange
(Task (evalInteract v mst mode sds handlers editor writefun)) (Task (evalInteract r v mst mode sds handlers editor writefun))
, iworld) , iworld)
uniqueMode :: (EditMode a) -> *(EditMode a) uniqueMode :: (EditMode a) -> *(EditMode a)
......
...@@ -95,7 +95,7 @@ findSelection target options idxs = target <$> getItems options idxs ...@@ -95,7 +95,7 @@ findSelection target options idxs = target <$> getItems options idxs
enterInformation :: ![EnterOption m] -> Task m | iTask m enterInformation :: ![EnterOption m] -> Task m | iTask m
enterInformation options = enterInformation` (enterEditor options) enterInformation options = enterInformation` (enterEditor options)
enterInformation` (EnterUsing fromf editor) enterInformation` (EnterUsing fromf editor)
= interactRW unitShare handlers editor @ (\v -> fromf v) = interactRW unitShare handlers editor @ (fromf o snd)
where where
handlers = {onInit = const Enter, onEdit = \_ -> Nothing, onRefresh = \r _ -> (undef,Nothing)} handlers = {onInit = const Enter, onEdit = \_ -> Nothing, onRefresh = \r _ -> (undef,Nothing)}
...@@ -108,41 +108,33 @@ updateInformation :: ![UpdateOption m] m -> Task m | iTask m ...@@ -108,41 +108,33 @@ updateInformation :: ![UpdateOption m] m -> Task m | iTask m
updateInformation options m = updateInformation` (updateEditor options) m updateInformation options m = updateInformation` (updateEditor options) m
updateInformation` (UpdateUsing tof fromf editor) m updateInformation` (UpdateUsing tof fromf editor) m
= interactRW unitShare {onInit = const (Update $ tof m), onEdit = \_ -> Nothing, onRefresh = \r v -> (v,Nothing)} = interactRW unitShare {onInit = const (Update $ tof m), onEdit = \_ -> Nothing, onRefresh = \r v -> (v,Nothing)}
editor @ (\v -> fromf m v) editor @ (\(_,v) -> fromf m v)
updateSharedInformation :: ![UpdateSharedOption r w] !(sds () r w) -> Task r | iTask r & iTask w & RWShared sds updateSharedInformation :: ![UpdateSharedOption r w] !(sds () r w) -> Task r | iTask r & iTask w & RWShared sds
updateSharedInformation options sds = updateSharedInformation` (updateSharedEditor options) sds updateSharedInformation options sds = updateSharedInformation` (updateSharedEditor options) sds
updateSharedInformation` (UpdateSharedUsing tof fromf conflictf editor) sds updateSharedInformation` (UpdateSharedUsing tof fromf conflictf editor) sds
= interactRW sds {onInit = \r -> Update $ tof r, onEdit = \v -> Just (\r -> fromf r v), onRefresh = \r v -> (conflictf (tof r) v, Nothing)} = interactRW sds {onInit = \r -> Update $ tof r, onEdit = \v -> Just (\r -> fromf r v), onRefresh = \r v -> (conflictf (tof r) v, Nothing)}
editor editor @ fst
||- watch sds //TEMPORARY: Don't use an extra task here
<<@ ApplyLayout unwrapUI
updateSharedInformation` (UpdateSharedUsingAuto tof fromf conflictf editor) sds updateSharedInformation` (UpdateSharedUsingAuto tof fromf conflictf editor) sds
= interactRW sds {onInit = \r -> maybe Enter Update (tof r), onEdit = \v -> (Just (\r -> fromf r v)) = interactRW sds {onInit = \r -> maybe Enter Update (tof r), onEdit = \v -> (Just (\r -> fromf r v))
, onRefresh = \r v -> (maybe Nothing (\r` -> conflictf r` v) (tof r), Nothing)} , onRefresh = \r v -> (maybe Nothing (\r` -> conflictf r` v) (tof r), Nothing)}
editor editor @ fst
||- watch sds //TEMPORARY: Don't use an extra task here
<<@ ApplyLayout unwrapUI
viewSharedInformation :: ![ViewOption r] !(sds () r w) -> Task r | iTask r & TC w & Registrable sds viewSharedInformation :: ![ViewOption r] !(sds () r w) -> Task r | iTask r & TC w & Registrable sds
viewSharedInformation options sds = viewSharedInformation` (viewEditor options) sds viewSharedInformation options sds = viewSharedInformation` (viewEditor options) sds
viewSharedInformation` (ViewUsing tof editor) sds viewSharedInformation` (ViewUsing tof editor) sds
= interactR sds {onInit = \r -> View $ tof r, onEdit = \_ -> Nothing, onRefresh = \r _ -> (Just $ tof r,Nothing)} editor = interactR sds {onInit = \r -> View $ tof r, onEdit = \_ -> Nothing, onRefresh = \r _ -> (Just $ tof r,Nothing)} editor @ fst
||- watch sds //TEMPORARY: Don't use an extra task here
<<@ ApplyLayout unwrapUI
updateInformationWithShared :: ![UpdateSharedOption (r,m) m] !(sds () r w) m -> Task m | iTask r & iTask m & TC w & RWShared sds updateInformationWithShared :: ![UpdateSharedOption (r,m) m] !(sds () r w) m -> Task m | iTask r & iTask m & TC w & RWShared sds
updateInformationWithShared options sds m = updateInformationWithShared` (updateSharedEditor options) sds m updateInformationWithShared options sds m = updateInformationWithShared` (updateSharedEditor options) sds m
updateInformationWithShared` (UpdateSharedUsing tof fromf conflictf editor) sds m updateInformationWithShared` (UpdateSharedUsing tof fromf conflictf editor) sds m
= withShared m = withShared m \sdsm ->
\sdsm ->
interactRW (sds |*< sdsm) interactRW (sds |*< sdsm)
{onInit = \(r,m) -> (Update $ tof (r,m)) {onInit = \(r,m) -> (Update $ tof (r,m))
,onEdit = \v -> (Just (\(r,m) -> fromf (r,m) v)) ,onEdit = \v -> (Just (\(r,m) -> fromf (r,m) v))
,onRefresh = \(r,m) _ -> (Just $ tof (r,m), Nothing) ,onRefresh = \(r,m) _ -> (Just $ tof (r,m), Nothing)
} editor } editor @ snd o fst
||- watch sdsm //TEMPORARY: Don't use an extra task here
<<@ ApplyLayout unwrapUI
editSelection :: ![SelectOption c a] c [Int] -> Task [a] | iTask a editSelection :: ![SelectOption c a] c [Int] -> Task [a] | iTask a
editSelection options container sel = editSelection` (selectAttributes options) (selectEditor options) container sel editSelection options container sel = editSelection` (selectAttributes options) (selectEditor options) container sel
...@@ -151,19 +143,16 @@ editSelection` attributes (SelectUsing toView fromView editor) container sel ...@@ -151,19 +143,16 @@ editSelection` attributes (SelectUsing toView fromView editor) container sel
{onInit = \r -> (Update (toView container,sel)) {onInit = \r -> (Update (toView container,sel))
,onEdit = \_ -> Nothing ,onEdit = \_ -> Nothing
,onRefresh = \_ v -> (v,Nothing) ,onRefresh = \_ v -> (v,Nothing)
} (attributes @>> editor) @ (\(_,sel) -> fromView container sel) } (attributes @>> editor) @ (\(_,(_,sel)) -> fromView container sel)
editSelectionWithShared :: ![SelectOption c a] (sds () c w) (c -> [Int]) -> Task [a] | iTask c & iTask a & TC w & RWShared sds editSelectionWithShared :: ![SelectOption c a] (sds () c w) (c -> [Int]) -> Task [a] | iTask c & iTask a & TC w & RWShared sds
editSelectionWithShared options sharedContainer initSel = editSelectionWithShared` (selectAttributes options) (selectEditor options) sharedContainer initSel editSelectionWithShared options sharedContainer initSel = editSelectionWithShared` (selectAttributes options) (selectEditor options) sharedContainer initSel
editSelectionWithShared` attributes (SelectUsing toView fromView editor) sharedContainer initSel editSelectionWithShared` attributes (SelectUsing toView fromView editor) sharedContainer initSel
= (((interactRW sharedContainer = interactRW sharedContainer
{onInit = \r -> Update (toView r, initSel r) {onInit = \r -> Update (toView r, initSel r)
,onEdit = \_ -> Nothing ,onEdit = \_ -> Nothing
,onRefresh = \r v -> ((\(_, sel) -> (toView r,sel)) <$> v,Nothing) ,onRefresh = \r v -> ((\(_, sel) -> (toView r,sel)) <$> v,Nothing)
} (attributes @>> editor) @ (\(_,sel) -> sel)) } (attributes @>> editor) @ (\(container,(_,sel)) -> fromView container sel)
-&&- watch sharedContainer //TEMPORARY: Don't use an extra task here
) @ (\(sel,container) -> fromView container sel)
) <<@ ApplyLayout unwrapUI
editSharedSelection :: ![SelectOption c a] c (Shared sds [Int]) -> Task [a] | iTask c & iTask a & RWShared sds editSharedSelection :: ![SelectOption c a] c (Shared sds [Int]) -> Task [a] | iTask c & iTask a & RWShared sds
editSharedSelection options container sharedSel = editSharedSelection` (selectAttributes options) (selectEditor options) container sharedSel editSharedSelection options container sharedSel = editSharedSelection` (selectAttributes options) (selectEditor options) container sharedSel
...@@ -172,20 +161,17 @@ editSharedSelection` attributes (SelectUsing toView fromView editor) container s ...@@ -172,20 +161,17 @@ editSharedSelection` attributes (SelectUsing toView fromView editor) container s
{onInit = \r -> Update (toView container,r) {onInit = \r -> Update (toView container,r)
,onEdit = \(_,vs) -> Just (const vs) ,onEdit = \(_,vs) -> Just (const vs)
,onRefresh = \r v -> ((\(vt, _) -> (vt, r)) <$> v,Nothing) ,onRefresh = \r v -> ((\(vt, _) -> (vt, r)) <$> v,Nothing)
} (attributes @>> editor) @ (\(_,sel) -> fromView container sel) } (attributes @>> editor) @ (\(_,(_,sel)) -> fromView container sel)
editSharedSelectionWithShared :: ![SelectOption c a] (sds1 () c w) (Shared sds2 [Int]) -> Task [a] | iTask c & iTask a & TC w & RWShared sds1 & RWShared sds2 editSharedSelectionWithShared :: ![SelectOption c a] (sds1 () c w) (Shared sds2 [Int]) -> Task [a] | iTask c & iTask a & TC w & RWShared sds1 & RWShared sds2
editSharedSelectionWithShared options sharedContainer sharedSel editSharedSelectionWithShared options sharedContainer sharedSel
= editSharedSelectionWithShared` (selectAttributes options) (selectEditor options) sharedContainer sharedSel = editSharedSelectionWithShared` (selectAttributes options) (selectEditor options) sharedContainer sharedSel
editSharedSelectionWithShared` attributes (SelectUsing toView fromView editor) sharedContainer sharedSel editSharedSelectionWithShared` attributes (SelectUsing toView fromView editor) sharedContainer sharedSel
= (((interactRW (sharedContainer |*< sharedSel) = interactRW (sharedContainer |*< sharedSel)
{onInit = \(rc, rs) -> Update (toView rc,rs) {onInit = \(rc, rs) -> Update (toView rc,rs)
,onEdit = \(_, vs) -> Just (const vs) ,onEdit = \(_, vs) -> Just (const vs)
,onRefresh = \(rc, rs) _ -> (Just (toView rc, rs), Nothing) ,onRefresh = \(rc, rs) _ -> (Just (toView rc, rs), Nothing)
} (attributes @>> editor) @ snd) } (attributes @>> editor) @ (\((container,_),(_,sel)) -> fromView container sel)
-&&- watch sharedContainer //TEMPORARY: Don't use an extra task here
) @ (\(sel,container) -> fromView container sel)
) <<@ ApplyLayout unwrapUI
//Core choice tasks //Core choice tasks
editChoice :: ![ChoiceOption a] ![a] (Maybe a) -> Task a | iTask a editChoice :: ![ChoiceOption a] ![a] (Maybe a) -> Task a | iTask a
......
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