Commit 4792ca9d authored by Steffen Michels's avatar Steffen Michels

Merge branch 'remove-interact-local-state' into 'master'

Remove interact local state

See merge request !328
parents eb7fd96f 2258238f
Pipeline #30096 passed with stage
in 4 minutes and 36 seconds
...@@ -83,7 +83,7 @@ filterTestsByName pattern tests = filter (\{UnitTest|name} -> indexOf pattern na ...@@ -83,7 +83,7 @@ filterTestsByName pattern tests = filter (\{UnitTest|name} -> indexOf pattern na
//UTILITY TASKS //UTILITY TASKS
testEditor :: (Editor a) (EditMode a) -> Task a | iTask a testEditor :: (Editor a) (EditMode a) -> Task a | iTask a
testEditor editor mode testEditor editor mode
= (interactR unitShare {onInit = const ((),mode), onEdit = \v l -> (l,Nothing), onRefresh = \_ l v -> (l,v,Nothing)} editor @ snd = (interactR unitShare {onInit = const mode, onEdit = \v -> Nothing, onRefresh = \_ v -> (v,Nothing)} editor @ snd
>&> \s -> Title "Editor value" @>> viewSharedInformation [ViewAs (toString o toJSON)] s @? tvFromMaybe >&> \s -> Title "Editor value" @>> viewSharedInformation [ViewAs (toString o toJSON)] s @? tvFromMaybe
) <<@ ArrangeHorizontal ) <<@ ArrangeHorizontal
...@@ -92,9 +92,16 @@ testEditorWithShare editor model viewMode = (withShared model ...@@ -92,9 +92,16 @@ testEditorWithShare editor model viewMode = (withShared model
\smodel -> \smodel ->
(Hint "Edit the shared source" @>> updateSharedInformation [] smodel) (Hint "Edit the shared source" @>> updateSharedInformation [] smodel)
||- ||-
(Title "Editor under test" @>> interactR smodel {onInit = \r -> ((),if viewMode View Update $ r) ( Title "Editor under test" @>>
,onEdit = \v l -> (l,Just (\_ -> v)) interactR
,onRefresh = \r l _ -> (l,Just r,Nothing)} editor @ snd) smodel
{ onInit = \r -> if viewMode View Update $ r
, onEdit = \v -> Just (\_ -> v)
, onRefresh = \r _ -> (Just r,Nothing)
}
editor
@ snd
)
) <<@ ArrangeHorizontal ) <<@ ArrangeHorizontal
testCommonInteractions :: String -> Task a | iTask, gDefault{|*|} a testCommonInteractions :: String -> Task a | iTask, gDefault{|*|} a
......
...@@ -67,17 +67,17 @@ accWorldOSError :: !(*World -> (MaybeOSError a, *World)) -> Task a | ...@@ -67,17 +67,17 @@ accWorldOSError :: !(*World -> (MaybeOSError a, *World)) -> Task a |
:: OSException = OSException !OSError :: OSException = OSException !OSError
instance toString OSException instance toString OSException
:: InteractionHandlers l r w v = :: InteractionHandlers r w v =
{ onInit :: !(r -> (l, EditMode v)) { onInit :: !(r -> (EditMode v))
, onEdit :: !(v l -> (l, Maybe (r -> w))) , onEdit :: !(v -> (Maybe (r -> w)))
, onRefresh :: !(r l (Maybe v) -> (l, Maybe v, Maybe (r -> w))) , onRefresh :: !(r (Maybe v) -> (Maybe v, Maybe (r -> w)))
} }
/** /**
* 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 l r w v) (Editor v) -> Task (l,v) | iTask l & 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 l r w v) (Editor v) -> Task (l,v) | iTask l & 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,52 +47,52 @@ instance toString OSException ...@@ -47,52 +47,52 @@ 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 l r w v) (Editor v) -> Task (l,v) interactRW :: !(sds () r w) (InteractionHandlers r w v) (Editor v) -> Task (r,v)
| iTask l & 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 l r w v) (Editor v) -> Task (l,v) interactR :: (sds () r w) (InteractionHandlers r w v) (Editor v) -> Task (r,v)
| iTask l & 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))
//This initializes the editor state and continues with the actual interact task //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 event evalOpts=:{TaskEvalOpts|taskId} iworld
//Get initial value //Get initial value
# (l, mode) = handlers.onInit r # mode = handlers.onInit r
# v = case mode of # v = case mode of
Enter = Nothing Enter = Nothing
Update x = Just x Update x = Just x
View x = Just x View x = Just x
= evalInteract l 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 ::
l r
(Maybe v) (Maybe v)
(Maybe EditState) (Maybe EditState)
Bool Bool
(sds () r w) (sds () r w)
(InteractionHandlers l r w v) (InteractionHandlers r w v)
(Editor v) (Editor v)
( (
(r -> w) (r -> w)
(sds () r w) (sds () r w)
(TaskValue (l,v)) (TaskValue (r,v))
(Event -> UIChange) (Event -> UIChange)
(w -> Event -> TaskEvalOpts -> *IWorld -> *(TaskResult (l,v),*IWorld)) (w -> Event -> TaskEvalOpts -> *IWorld -> *(TaskResult (r,v),*IWorld))
Event Event
TaskEvalOpts TaskEvalOpts
*IWorld *IWorld
-> *(TaskResult (l,v),*IWorld)) -> *(TaskResult (r,v),*IWorld))
Event Event
TaskEvalOpts TaskEvalOpts
*IWorld *IWorld
-> *(TaskResult (l,v),*IWorld) -> *(TaskResult (r,v),*IWorld)
| iTask l & 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 l 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
...@@ -100,38 +100,38 @@ evalInteract l v mst mode sds handlers editor writefun event=:(EditEvent eTaskId ...@@ -100,38 +100,38 @@ evalInteract l v mst mode sds handlers editor writefun event=:(EditEvent eTaskId
Ok (change, st) Ok (change, st)
= case editor.Editor.valueFromState st of = case editor.Editor.valueFromState st of
Just nv Just nv
# (l, mbf) = handlers.InteractionHandlers.onEdit nv l # mbf = handlers.InteractionHandlers.onEdit nv
= case mbf of = case mbf of
//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 (l, nv) False) (Value (r,nv) False)
(mkTaskEvalInfo lastEval) (mkTaskEvalInfo lastEval)
change change
(Task (evalInteract l (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 (l, nv) False) (Value (r,nv) False)
(mkTaskEvalInfo lastEval) (mkTaskEvalInfo lastEval)
change change
(Task (evalInteract l (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 l 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 l 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"
...@@ -144,18 +144,18 @@ evalInteract l v mst mode sds handlers editor writefun ResetEvent evalOpts=:{tas ...@@ -144,18 +144,18 @@ evalInteract l v mst mode sds handlers editor writefun ResetEvent evalOpts=:{tas
# 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 (l, v) False) v) (maybe NoValue (\v->Value (r,v) False) v)
(mkTaskEvalInfo lastEval) (mkTaskEvalInfo lastEval)
change change
(Task (evalInteract l v (Just st) mode sds handlers editor writefun)) (Task (evalInteract r v (Just st) mode sds handlers editor writefun))
, iworld) , iworld)
evalInteract l 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 (l, 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
# (l, mbV, mbf) = handlers.InteractionHandlers.onRefresh r l v # (mbV, mbf) = handlers.InteractionHandlers.onRefresh r v
# mbChange = case mbV of # mbChange = case mbV of
Just v = withVSt taskId (editor.Editor.onRefresh [] v st) iworld Just v = withVSt taskId (editor.Editor.onRefresh [] v st) iworld
Nothing = (Ok (NoChange, st), iworld) Nothing = (Ok (NoChange, st), iworld)
...@@ -165,24 +165,24 @@ evalInteract l v mst mode sds handlers editor writefun event=:(RefreshEvent task ...@@ -165,24 +165,24 @@ evalInteract l v mst mode sds handlers editor writefun event=:(RefreshEvent task
# 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 l 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 (l, v) False) v) (maybe NoValue (\v -> Value (r,v) False) v)
(mkTaskEvalInfo lastEval) (mkTaskEvalInfo lastEval)
change change
(Task (evalInteract l 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 l 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 (l, v) False) v) (maybe NoValue (\v->Value (r,v) False) v)
(mkTaskEvalInfo lastEval) (mkTaskEvalInfo lastEval)
NoChange NoChange
(Task (evalInteract l 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)
......
...@@ -13,6 +13,7 @@ import iTasks.WF.Tasks.Core ...@@ -13,6 +13,7 @@ import iTasks.WF.Tasks.Core
import iTasks.WF.Tasks.SDS import iTasks.WF.Tasks.SDS
import iTasks.WF.Combinators.Overloaded import iTasks.WF.Combinators.Overloaded
import iTasks.WF.Combinators.Common import iTasks.WF.Combinators.Common
import iTasks.WF.Combinators.SDS
import iTasks.SDS.Sources.Core import iTasks.SDS.Sources.Core
import iTasks.SDS.Sources.System import iTasks.SDS.Sources.System
import iTasks.SDS.Combinators.Common import iTasks.SDS.Combinators.Common
...@@ -69,7 +70,6 @@ selectEditor [SelectInTabs toView fromView:_] = SelectUsing toView fromView tabB ...@@ -69,7 +70,6 @@ selectEditor [SelectInTabs toView fromView:_] = SelectUsing toView fromView tabB
selectEditor [_:es] = selectEditor es selectEditor [_:es] = selectEditor es
selectEditor [] = SelectUsing (const []) (\_ _ -> []) dropdown //Empty dropdown selectEditor [] = SelectUsing (const []) (\_ _ -> []) dropdown //Empty dropdown
//Convert choice options to select options //Convert choice options to select options
selectOptions :: (o -> s) [ChoiceOption o] -> [SelectOption [o] s] | gText{|*|} o selectOptions :: (o -> s) [ChoiceOption o] -> [SelectOption [o] s] | gText{|*|} o
selectOptions target options = selectOptions` False options selectOptions target options = selectOptions` False options
...@@ -95,70 +95,77 @@ findSelection target options idxs = target <$> getItems options idxs ...@@ -95,70 +95,77 @@ 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 = \_ l -> (l, Nothing), onRefresh = \r l _ -> (l,undef,Nothing)} handlers = {onInit = const Enter, onEdit = \_ -> Nothing, onRefresh = \r _ -> (undef,Nothing)}
viewInformation :: ![ViewOption m] !m -> Task m | iTask m viewInformation :: ![ViewOption m] !m -> Task m | iTask m
viewInformation options m = viewInformation` (viewEditor options) m viewInformation options m = viewInformation` (viewEditor options) m
viewInformation` (ViewUsing tof editor) m viewInformation` (ViewUsing tof editor) m
= interactR unitShare {onInit = const ((),View $ tof m), onEdit = \_ l -> (l, Nothing), onRefresh = \r l v -> (l,v,Nothing)} editor @! m = interactR unitShare {onInit = const (View $ tof m), onEdit = \_ -> Nothing, onRefresh = \r v -> (v,Nothing)} editor @! m
updateInformation :: ![UpdateOption m] m -> Task m | iTask m 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 = \_ l -> (l, Nothing), onRefresh = \r l v -> (l,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 -> (r, Update $ tof r), onEdit = \v l -> (l, Just (\r -> fromf r v)), onRefresh = \r _ v -> (r,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 @ fst
updateSharedInformation` (UpdateSharedUsingAuto tof fromf conflictf editor) sds
= interactRW sds {onInit = \r -> (r, maybe Enter Update (tof r)), onEdit = \v l -> (l, Just (\r -> fromf r v))
, onRefresh = \r _ v -> (r, maybe Nothing (\r` -> conflictf r` v) (tof r), Nothing)}
editor @ fst editor @ fst
updateSharedInformation` (UpdateSharedUsingAuto tof fromf conflictf editor) sds =
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)
}
editor
@ fst
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 -> (r, View $ tof r), onEdit = \_ l -> (l, Nothing), onRefresh = \r _ _ -> (r,Just $ tof r,Nothing)} editor @ fst = interactR sds {onInit = \r -> View $ tof r, onEdit = \_ -> Nothing, onRefresh = \r _ -> (Just $ tof r,Nothing)} editor @ fst
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
= interactRW sds = withShared m \sdsm ->
{onInit = \r -> ((r,m), Update $ tof (r,m)) interactRW (sds |*< sdsm)
,onEdit = \v (r,m) -> let nm = fromf (r,m) v in ((r,nm),Nothing) {onInit = \(r,m) -> (Update $ tof (r,m))
,onRefresh = \r (_,m) _ -> ((r,m),Just $ tof (r,m),Nothing) ,onEdit = \v -> Just (\(r,m) -> fromf (r,m) v)
} gEditor{|*|} @ (snd o fst) ,onRefresh = \(r,m) _ -> (Just $ tof (r,m), Nothing)
} editor @ snd o fst
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
editSelection` attributes (SelectUsing toView fromView editor) container sel editSelection` attributes (SelectUsing toView fromView editor) container sel
= interactRW unitShare = interactRW unitShare
{onInit = \r -> ((), Update (toView container,sel)) {onInit = \r -> (Update (toView container,sel))
,onEdit = \_ l -> (l, Nothing) ,onEdit = \_ -> Nothing
,onRefresh = \_ l v -> (l,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 -> (r, Update(toView r, initSel r)) {onInit = \r -> Update (toView r, initSel r)
,onEdit = \_ l -> (l, Nothing) ,onEdit = \_ -> Nothing
,onRefresh = \r l v -> (r,(\(_, sel) -> (toView r,sel)) <$> v,Nothing) ,onRefresh = \r v -> ((\(_, sel) -> (toView r,sel)) <$> v,Nothing)
} (attributes @>> editor) @ (\(container,(_,sel)) -> fromView container sel) } (attributes @>> editor) @ (\(container,(_,sel)) -> fromView container sel)
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
editSharedSelection` attributes (SelectUsing toView fromView editor) container sharedSel editSharedSelection` attributes (SelectUsing toView fromView editor) container sharedSel
= interactRW sharedSel = interactRW sharedSel
{onInit = \r -> ((), Update (toView container,r)) {onInit = \r -> Update (toView container,r)
,onEdit = \(_,vs) l -> (l, Just (const vs)) ,onEdit = \(_,vs) -> Just (const vs)
,onRefresh = \r l v -> (l,(\(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
...@@ -166,10 +173,10 @@ editSharedSelectionWithShared options sharedContainer sharedSel ...@@ -166,10 +173,10 @@ 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) -> (rc, Update (toView rc,rs)) {onInit = \(rc, rs) -> Update (toView rc,rs)
,onEdit = \(_, vs) l -> (l, Just (const vs)) ,onEdit = \(_, vs) -> Just (const vs)
,onRefresh = \(rc, rs) _ _ -> (rc, Just (toView rc, rs), Nothing) ,onRefresh = \(rc, rs) _ -> (Just (toView rc, rs), Nothing)
} (attributes @>> editor) @ (\(container, (_, sel)) -> fromView container sel) } (attributes @>> editor) @ (\((container,_),(_,sel)) -> fromView container sel)
//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
......
...@@ -11,7 +11,7 @@ minimalInteractUI = skip (testTaskOutput "Initial UI of minimal interaction task ...@@ -11,7 +11,7 @@ minimalInteractUI = skip (testTaskOutput "Initial UI of minimal interaction task
where where
task :: Task ((),String) task :: Task ((),String)
task = interactR unitShare handlers gEditor{|*|} task = interactR unitShare handlers gEditor{|*|}
handlers = {onInit = \() -> ((),Update "Hello world"), onEdit = \_ l -> (l,Nothing), onRefresh = \_ l v -> (l,v,Nothing)} handlers = {onInit = \() -> Update "Hello world", onEdit = \_ -> Nothing, onRefresh = \_ v -> (v,Nothing)}
events = [Left ResetEvent] events = [Left ResetEvent]
exp = [TOUIChange (ReplaceUI expMinimalEditorUI)] exp = [TOUIChange (ReplaceUI expMinimalEditorUI)]
......
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