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
onRefresh dp (newVal, newSel) (mbOldVal, oldSel, multiple) vst
//Check options
# oldOpts = mbValToOptions mbOldVal
# newOpts = mbValToOptions $ Just newVal
# cOptions = if (newOpts =!= oldOpts)
(ChangeUI [SetAttribute "options" (JSONArray newOpts)] [])
# oldOptsJson = mbValToOptions mbOldVal
# newOpts = getOptions newVal
# newOptsJson = toOption <$> newOpts
# cOptions = if (newOptsJson =!= oldOptsJson)
(ChangeUI [SetAttribute "options" (JSONArray newOptsJson)] [])
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
= (Ok (mergeUIChanges cOptions cSel, (Just newVal, newSel, multiple)),vst)
valueFromState (Just val, sel, multiple)
//The selection is only allowed to be empty when multiselect is enabled
| not multiple && isEmpty sel = Nothing
| otherwise = Just (val, sel)
| not multiple && lengthSel <> 0 && lengthSel <> 1 = Nothing
| otherwise = Just (val, sel)
where
lengthSel = length sel
valueFromState _ = Nothing
mbValToOptions mbVal = toOption <$> maybe [] getOptions mbVal
......@@ -83,7 +83,7 @@ filterTestsByName pattern tests = filter (\{UnitTest|name} -> indexOf pattern na
//UTILITY TASKS
testEditor :: (Editor a) (EditMode a) -> Task a | iTask a
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
) <<@ ArrangeHorizontal
......@@ -93,7 +93,7 @@ testEditorWithShare editor model viewMode = (withShared model
(Hint "Edit the shared source" @>> updateSharedInformation [] smodel)
||-
(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)
) <<@ ArrangeHorizontal
......
......@@ -75,7 +75,7 @@ instance toString OSException
*/
:: InteractionHandlers l r w 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)))
}
......
......@@ -109,7 +109,7 @@ evalInteract l v st mode sds handlers editor writefun event=:(EditEvent eTaskId
Ok (change, st)
= case editor.Editor.valueFromState st of
Just nv
# (l, v, mbf) = handlers.InteractionHandlers.onEdit nv l v
# (l, mbf) = handlers.InteractionHandlers.onEdit nv l
= case mbf of
//We have an update function
Just f = writefun f sds NoValue (\_->change)
......@@ -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:
(\w event {TaskEvalOpts|lastEval} iworld->
(ValueResult
(Value (l, v) False)
(Value (l, nv) False)
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract l (Just v) st mode sds handlers editor writefun))
(Task (evalInteract l (Just nv) st mode sds handlers editor writefun))
, iworld))
event evalOpts iworld
//There is no update function
Nothing
= (ValueResult
(Value (l, v) False)
(Value (l, nv) False)
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract l (Just v) st mode sds handlers editor writefun))
(Task (evalInteract l (Just nv) st mode sds handlers editor writefun))
, iworld)
Nothing
= (ValueResult
......@@ -165,17 +165,18 @@ evalInteract l v st mode sds handlers editor writefun event=:(RefreshEvent taskI
# (l, v, mbf) = handlers.InteractionHandlers.onRefresh r l v
= case withVSt taskId (editor.Editor.onRefresh [] v st) iworld of
(Error e, iworld) = (ExceptionResult (exception e), iworld)
(Ok (change, st), iworld)
(Ok (change, st), iworld)
# v = editor.Editor.valueFromState st
= case mbf of
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
Nothing
= (ValueResult
(Value (l, v) False)
(maybe NoValue (\v -> Value (l, v) False) v)
(mkTaskEvalInfo lastEval)
change
(Task (evalInteract l (Just v) st mode sds handlers editor writefun))
(Task (evalInteract l v st mode sds handlers editor writefun))
, iworld)
)
event evalOpts iworld
......
......@@ -97,40 +97,40 @@ enterInformation options = enterInformation` (enterEditor options)
enterInformation` (EnterUsing fromf editor)
= interactRW unitShare handlers editor @ (\((),v) -> fromf v)
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 options m = viewInformation` (viewEditor options) 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 options m = updateInformation` (updateEditor options) 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)
updateSharedInformation :: ![UpdateSharedOption r w] !(sds () r w) -> Task r | iTask r & iTask w & RWShared sds
updateSharedInformation options sds = updateSharedInformation` (updateSharedEditor options) 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
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)}
editor @ fst
viewSharedInformation :: ![ViewOption r] !(sds () r w) -> Task r | iTask r & TC w & Registrable sds
viewSharedInformation options sds = viewSharedInformation` (viewEditor options) 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 options sds m = updateInformationWithShared` (updateSharedEditor options) sds m
updateInformationWithShared` (UpdateSharedUsing tof fromf conflictf editor) sds m
= interactRW sds
{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)
} gEditor{|*|} @ (snd o fst)
......@@ -138,8 +138,8 @@ editSelection :: ![SelectOption c a] c [Int] -> Task [a] | iTask a
editSelection options container sel = editSelection` (selectAttributes options) (selectEditor options) container sel
editSelection` attributes (SelectUsing toView fromView editor) container sel
= interactRW unitShare
{onInit = \r -> ((), Update (toView container,sel))
,onEdit = \v l _ -> (l,v,Nothing)
{onInit = \r -> ((), Update (toView container,sel))
,onEdit = \_ l -> (l, Nothing)
,onRefresh = \_ l (Just v) -> (l,v,Nothing)
} (attributes @>> editor) @ (\(_,(_,sel)) -> fromView container sel)
......@@ -148,7 +148,7 @@ editSelectionWithShared options sharedContainer initSel = editSelectionWithShare
editSelectionWithShared` attributes (SelectUsing toView fromView editor) sharedContainer initSel
= interactRW sharedContainer
{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)
} (attributes @>> editor) @ (\(container,(_,sel)) -> fromView container sel)
......@@ -156,8 +156,8 @@ editSharedSelection :: ![SelectOption c a] c (Shared sds [Int]) -> Task [a] | iT
editSharedSelection options container sharedSel = editSharedSelection` (selectAttributes options) (selectEditor options) container sharedSel
editSharedSelection` attributes (SelectUsing toView fromView editor) container sharedSel
= interactRW sharedSel
{onInit = \r -> ((), Update (toView container,r))
,onEdit = \(vt,vs) l _ -> (l,(vt,vs),Just (const vs))
{onInit = \r -> ((), Update (toView container,r))
,onEdit = \(_,vs) l -> (l, Just (const vs))
,onRefresh = \r l (Just (vt,vs)) -> (l,(vt,r),Nothing)
} (attributes @>> editor) @ (\(_,(_,sel)) -> fromView container sel)
......@@ -166,8 +166,8 @@ editSharedSelectionWithShared options sharedContainer sharedSel
= editSharedSelectionWithShared` (selectAttributes options) (selectEditor options) sharedContainer sharedSel
editSharedSelectionWithShared` attributes (SelectUsing toView fromView editor) sharedContainer sharedSel
= interactRW (sharedContainer |*< sharedSel)
{onInit = \(rc, rs) -> (rc, Update (toView rc,rs))
,onEdit = \v=:(_, vs) l _ -> (l, v, Just (const vs))
{onInit = \(rc, rs) -> (rc, Update (toView rc,rs))
,onEdit = \(_, vs) l -> (l, Just (const vs))
,onRefresh = \(rc, rs) _ _ -> (rc, (toView rc, rs), Nothing)
} (attributes @>> editor) @ (\(container, (_, sel)) -> fromView container sel)
......
......@@ -11,7 +11,7 @@ minimalInteractUI = skip (testTaskOutput "Initial UI of minimal interaction task
where
task :: Task ((),String)
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]
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