Commit 8c1cafcf authored by Mart Lubbers's avatar Mart Lubbers

Merge branch '253-editsharedselectionwithshared-not-working-as-intended' into 'master'

Resolve "editSharedSelectionWithShared not working as intended"

Closes #253

See merge request !305
parents 2ef63304 6952d35b
Pipeline #29319 passed with stage
in 4 minutes and 34 seconds
...@@ -209,19 +209,23 @@ where ...@@ -209,19 +209,23 @@ where
onRefresh dp (newVal, newSel) (mbOldVal, oldSel, multiple) vst onRefresh dp (newVal, newSel) (mbOldVal, oldSel, multiple) vst
//Check options //Check options
# oldOpts = mbValToOptions mbOldVal # oldOptsJson = mbValToOptions mbOldVal
# newOpts = mbValToOptions $ Just newVal # newOpts = getOptions newVal
# cOptions = if (newOpts =!= oldOpts) # newOptsJson = toOption <$> newOpts
(ChangeUI [SetAttribute "options" (JSONArray newOpts)] []) # cOptions = if (newOptsJson =!= oldOptsJson)
(ChangeUI [SetAttribute "options" (JSONArray newOptsJson)] [])
NoChange NoChange
//Check selection //Check selection, if the selection is out of bounds assume the empty selection
# newSel = if (all (checkBounds newOpts) newSel) newSel []
# cSel = if (newSel =!= oldSel) (ChangeUI [SetAttribute "value" (toJSON newSel)] []) NoChange # cSel = if (newSel =!= oldSel) (ChangeUI [SetAttribute "value" (toJSON newSel)] []) NoChange
= (Ok (mergeUIChanges cOptions cSel, (Just newVal, newSel, multiple)),vst) = (Ok (mergeUIChanges cOptions cSel, (Just newVal, newSel, multiple)),vst)
valueFromState (Just val, sel, multiple) valueFromState (Just val, sel, multiple)
//The selection is only allowed to be empty when multiselect is enabled //The selection is only allowed to be empty when multiselect is enabled
| not multiple && isEmpty sel = Nothing | not multiple && lengthSel <> 0 && lengthSel <> 1 = Nothing
| otherwise = Just (val, sel) | otherwise = Just (val, sel)
where
lengthSel = length sel
valueFromState _ = Nothing valueFromState _ = Nothing
mbValToOptions mbVal = toOption <$> maybe [] getOptions mbVal mbValToOptions mbVal = toOption <$> maybe [] getOptions mbVal
...@@ -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,v,Nothing), onRefresh = \_ l (Just v) -> (l,v,Nothing)} editor @ snd = (interactR unitShare {onInit = const ((),mode), onEdit = \v l -> (l,Nothing), onRefresh = \_ l (Just v) -> (l,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
...@@ -93,7 +93,7 @@ testEditorWithShare editor model viewMode = (withShared model ...@@ -93,7 +93,7 @@ testEditorWithShare editor model viewMode = (withShared model
(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" @>> interactR smodel {onInit = \r -> ((),if viewMode View Update $ r)
,onEdit = \v l _ -> (l,v,Just (\_ -> v)) ,onEdit = \v l -> (l,Just (\_ -> v))
,onRefresh = \r l v -> (l,r,Nothing)} editor @ snd) ,onRefresh = \r l v -> (l,r,Nothing)} editor @ snd)
) <<@ ArrangeHorizontal ) <<@ ArrangeHorizontal
......
...@@ -75,7 +75,7 @@ instance toString OSException ...@@ -75,7 +75,7 @@ instance toString OSException
*/ */
:: InteractionHandlers l r w v = :: InteractionHandlers l r w v =
{ onInit :: !(r -> (l, EditMode v)) { onInit :: !(r -> (l, EditMode v))
, onEdit :: !(v l (Maybe v) -> (l, v, Maybe (r -> w))) , onEdit :: !(v l -> (l, Maybe (r -> w)))
, onRefresh :: !(r l (Maybe v) -> (l, v, Maybe (r -> w))) , onRefresh :: !(r l (Maybe v) -> (l, v, Maybe (r -> w)))
} }
......
...@@ -109,7 +109,7 @@ evalInteract l v st mode sds handlers editor writefun event=:(EditEvent eTaskId ...@@ -109,7 +109,7 @@ evalInteract l v st 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, v, mbf) = handlers.InteractionHandlers.onEdit nv l v # (l, mbf) = handlers.InteractionHandlers.onEdit nv l
= 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)
...@@ -118,19 +118,19 @@ evalInteract l v st mode sds handlers editor writefun event=:(EditEvent eTaskId ...@@ -118,19 +118,19 @@ evalInteract l v st mode sds handlers editor writefun event=:(EditEvent eTaskId
// 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, v) False) (Value (l, nv) False)
(mkTaskEvalInfo lastEval) (mkTaskEvalInfo lastEval)
change change
(Task (evalInteract l (Just v) st mode sds handlers editor writefun)) (Task (evalInteract l (Just nv) 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, v) False) (Value (l, nv) False)
(mkTaskEvalInfo lastEval) (mkTaskEvalInfo lastEval)
change change
(Task (evalInteract l (Just v) st mode sds handlers editor writefun)) (Task (evalInteract l (Just nv) st mode sds handlers editor writefun))
, iworld) , iworld)
Nothing Nothing
= (ValueResult = (ValueResult
...@@ -166,16 +166,17 @@ evalInteract l v st mode sds handlers editor writefun event=:(RefreshEvent taskI ...@@ -166,16 +166,17 @@ evalInteract l v st mode sds handlers editor writefun event=:(RefreshEvent taskI
= case withVSt taskId (editor.Editor.onRefresh [] v st) iworld of = case withVSt taskId (editor.Editor.onRefresh [] v st) iworld of
(Error e, iworld) = (ExceptionResult (exception e), iworld) (Error e, iworld) = (ExceptionResult (exception e), iworld)
(Ok (change, st), iworld) (Ok (change, st), iworld)
# 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 (Just v) st mode sds handlers editor writefun) (\_->evalInteract l v st mode sds handlers editor writefun)
event evalOpts iworld event evalOpts iworld
Nothing Nothing
= (ValueResult = (ValueResult
(Value (l, v) False) (maybe NoValue (\v -> Value (l, v) False) v)
(mkTaskEvalInfo lastEval) (mkTaskEvalInfo lastEval)
change change
(Task (evalInteract l (Just v) st mode sds handlers editor writefun)) (Task (evalInteract l v st mode sds handlers editor writefun))
, iworld) , iworld)
) )
event evalOpts iworld event evalOpts iworld
......
...@@ -97,40 +97,40 @@ enterInformation options = enterInformation` (enterEditor options) ...@@ -97,40 +97,40 @@ enterInformation options = enterInformation` (enterEditor options)
enterInformation` (EnterUsing fromf editor) enterInformation` (EnterUsing fromf editor)
= interactRW unitShare handlers editor @ (\((),v) -> fromf v) = interactRW unitShare handlers editor @ (\((),v) -> fromf v)
where where
handlers = {onInit = const ((), Enter), onEdit = \v l _ -> (l,v,Nothing), onRefresh = \r l _ -> (l,undef,Nothing)} handlers = {onInit = const ((), Enter), onEdit = \_ l -> (l, Nothing), onRefresh = \r l _ -> (l,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 = \v l _ -> (l,v,Nothing), onRefresh = \r l (Just v) -> (l,v,Nothing)} editor @! m = interactR unitShare {onInit = const ((),View $ tof m), onEdit = \_ l -> (l, Nothing), onRefresh = \r l (Just v) -> (l,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 = \v l _ -> (l,v,Nothing), onRefresh = \r l (Just v) -> (l,v,Nothing)} = interactRW unitShare {onInit = const ((), Update $ tof m), onEdit = \_ l -> (l, Nothing), onRefresh = \r l (Just v) -> (l,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,v,Just (\r -> fromf r v)), onRefresh = \r _ (Just v) -> (r,conflictf (tof r) v, Nothing)} = interactRW sds {onInit = \r -> (r, Update $ tof r), onEdit = \v l -> (l, Just (\r -> fromf r v)), onRefresh = \r _ (Just v) -> (r,conflictf (tof r) v, Nothing)}
editor @ fst editor @ fst
updateSharedInformation` (UpdateSharedUsingAuto tof fromf conflictf editor) sds updateSharedInformation` (UpdateSharedUsingAuto tof fromf conflictf editor) sds
= interactRW sds {onInit = \r -> (r, maybe Enter Update (tof r)), onEdit = \v l _ -> (l,v,Just (\r -> fromf r v)) = interactRW sds {onInit = \r -> (r, maybe Enter Update (tof r)), onEdit = \v l -> (l, Just (\r -> fromf r v))
, onRefresh = \r _ (Just v) -> (r, maybe v (\r` -> conflictf r` v) (tof r), Nothing)} , onRefresh = \r _ (Just v) -> (r, maybe v (\r` -> conflictf r` v) (tof r), Nothing)}
editor @ fst 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 = \v l _ -> (l,v,Nothing), onRefresh = \r _ _ -> (r,tof r,Nothing)} editor @ fst = interactR sds {onInit = \r -> (r, View $ tof r), onEdit = \_ l -> (l, Nothing), onRefresh = \r _ _ -> (r,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 = interactRW sds
{onInit = \r -> ((r,m), Update $ tof (r,m)) {onInit = \r -> ((r,m), Update $ tof (r,m))
,onEdit = \v (r,m) _ -> let nm = fromf (r,m) v in ((r,nm),v,Nothing) ,onEdit = \v (r,m) -> let nm = fromf (r,m) v in ((r,nm),Nothing)
,onRefresh = \r (_,m) _ -> ((r,m),tof (r,m),Nothing) ,onRefresh = \r (_,m) _ -> ((r,m),tof (r,m),Nothing)
} gEditor{|*|} @ (snd o fst) } gEditor{|*|} @ (snd o fst)
...@@ -139,7 +139,7 @@ editSelection options container sel = editSelection` (selectAttributes options) ...@@ -139,7 +139,7 @@ editSelection options container sel = editSelection` (selectAttributes options)
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 = \v l _ -> (l,v,Nothing) ,onEdit = \_ l -> (l, Nothing)
,onRefresh = \_ l (Just v) -> (l,v,Nothing) ,onRefresh = \_ l (Just v) -> (l,v,Nothing)
} (attributes @>> editor) @ (\(_,(_,sel)) -> fromView container sel) } (attributes @>> editor) @ (\(_,(_,sel)) -> fromView container sel)
...@@ -148,7 +148,7 @@ editSelectionWithShared options sharedContainer initSel = editSelectionWithShare ...@@ -148,7 +148,7 @@ editSelectionWithShared options sharedContainer initSel = editSelectionWithShare
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 -> (r, Update(toView r, initSel r))
,onEdit = \v l _ -> (l,v,Nothing) ,onEdit = \_ l -> (l, Nothing)
,onRefresh = \r l (Just (v,sel)) -> (r,(toView r,sel),Nothing) ,onRefresh = \r l (Just (v,sel)) -> (r,(toView r,sel),Nothing)
} (attributes @>> editor) @ (\(container,(_,sel)) -> fromView container sel) } (attributes @>> editor) @ (\(container,(_,sel)) -> fromView container sel)
...@@ -157,7 +157,7 @@ editSharedSelection options container sharedSel = editSharedSelection` (selectAt ...@@ -157,7 +157,7 @@ editSharedSelection options container sharedSel = editSharedSelection` (selectAt
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 = \(vt,vs) l _ -> (l,(vt,vs),Just (const vs)) ,onEdit = \(_,vs) l -> (l, Just (const vs))
,onRefresh = \r l (Just (vt,vs)) -> (l,(vt,r),Nothing) ,onRefresh = \r l (Just (vt,vs)) -> (l,(vt,r),Nothing)
} (attributes @>> editor) @ (\(_,(_,sel)) -> fromView container sel) } (attributes @>> editor) @ (\(_,(_,sel)) -> fromView container sel)
...@@ -167,7 +167,7 @@ editSharedSelectionWithShared options sharedContainer sharedSel ...@@ -167,7 +167,7 @@ editSharedSelectionWithShared 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) -> (rc, Update (toView rc,rs))
,onEdit = \v=:(_, vs) l _ -> (l, v, Just (const vs)) ,onEdit = \(_, vs) l -> (l, Just (const vs))
,onRefresh = \(rc, rs) _ _ -> (rc, (toView rc, rs), Nothing) ,onRefresh = \(rc, rs) _ _ -> (rc, (toView rc, rs), Nothing)
} (attributes @>> editor) @ (\(container, (_, sel)) -> fromView container sel) } (attributes @>> editor) @ (\(container, (_, sel)) -> fromView container sel)
......
...@@ -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 v -> (l,fromJust v,Nothing), onRefresh = \_ l v -> (l,fromJust v,Nothing)} handlers = {onInit = \() -> ((),Update "Hello world"), onEdit = \_ l -> (l,Nothing), onRefresh = \_ l v -> (l,fromJust 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