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

Resolve "editSharedSelectionWithShared not working as intended"

Closes #253

See merge request !305

Libraries/iTasks/UI/Editor/Controls.icl

@@ -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

Libraries/iTasks/Util/Testing.icl

@@ -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
 

Libraries/iTasks/WF/Tasks/Core.dcl

@@ -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)))
 	}
 

Libraries/iTasks/WF/Tasks/Core.icl

@@ -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

Libraries/iTasks/WF/Tasks/Interaction.icl

@@ -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)
 

Tests/Unit/iTasks/WF/Tasks/Core/UnitTests.icl

@@ -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)]