implementation module iTasks.API.Common.InteractionTasks from StdFunc import id, const, o, flip from iTasks.API.Core.SDSs import null from Data.Tuple import appSnd from Data.List import isMemberGen, findIndex, instance Functor [] from System.Time import :: Timestamp(..) from Data.Map import qualified get, put import StdBool, StdList, StdMisc, StdTuple, Data.Functor import iTasks.API.Core.Tasks, iTasks.API.Core.OptimizedCoreTasks, iTasks.API.Core.TaskCombinators import iTasks.API.Common.TaskCombinators, iTasks.API.Core.LayoutCombinators, iTasks.API.Core.SDSs import iTasks._Framework.Generic.Interaction, iTasks.API.Common.SDSCombinators import iTasks._Framework.Tonic /* editInformation :: !d ![UpdateOption m m] (Maybe m) -> Task m | descr d & iTask m editInformation d [UpdateWith tof fromf:_] m = interact d null (\r -> let v = tof m in (m,(v,Untouched))) (\l r (v,m) rCh vCh vOk -> if vOk (let nl = fromf l v in (let nv = tof nl in (nl,(nv,m)))) (l,(v,m))) where initialValue Nothing = (defaultValue,Untouched) initialValue (Just value) = (value,Touched) editInformation d _ m = editInformation d [UpdateWith (\l -> l) (\_ v -> v)] m */ enterInformation :: !d ![EnterOption m] -> Task m | descr d & iTask m enterInformation d [EnterWith fromf:_] /* = interact d null // (\r -> (defaultValue,defaultValue,Untouched)) (\r -> let v = defaultValue in (fromf v,v,Untouched)) (\l r v m ok -> if ok (fromf v,v,m) (l,v,m)) */ = interactNullEnter d defaultValue fromf enterInformation d _ = enterInformation d [EnterWith id] updateInformation :: !d ![UpdateOption m m] m -> Task m | descr d & iTask m updateInformation d [UpdateWith tof fromf:_] m = interact d null (\r -> let v = tof m in (m,(v,Touched))) (\l r (v,m) rCh vCh vOk -> if vOk (let nl = fromf l v in (let nv = tof nl in (nl,(nv,m)))) (l,(v,m))) //TODO: THIS OPTIMIZATION IS WRONG! // = interactNullUpdate d tof fromf m updateInformation d _ m = updateInformation d [UpdateWith (\l -> l) (\_ v -> v)] m viewInformation :: !d ![ViewOption m] !m -> Task m | descr d & iTask m viewInformation d [ViewWith tof:_] m /* = interact d null (\r -> let v = Display (tof m) in (m,v,defaultMask v)) (\l r v m ok -> (l,v,m)) */ = interactNullView d tof m viewInformation d _ m = viewInformation d [ViewWith id] m updateSharedInformation :: !d ![UpdateOption r w] !(ReadWriteShared r w) -> Task w | descr d & iTask r & iTask w updateSharedInformation d [UpdateWith tof fromf:_] shared = interact d (toReadOnly shared) (\r -> let v = tof r in (fromf r v,(v,Touched))) (\l r (v,m) rCh vCh vOk -> if vOk (if rCh //If the share changed, refresh the view (let nv = tof r in (fromf r nv,(nv,Touched))) (fromf r v,(v,m)) ) (l,(v,m)) ) @> (mapval,shared) updateSharedInformation d [UpdateWithShared tof fromf conflictf:_] shared = interact d (toReadOnly shared) (\r -> let v = tof r in (fromf r v,(v,Touched))) (\l r (v,m) rCh vCh vOk -> if vOk (if rCh (if vCh //Both the share changed and the view changed -> resolve conflict (let nv = conflictf v (tof r) in (fromf r nv,(nv,Touched))) //Only the share changed, refresh the view (let nv = tof r in (fromf r nv,(nv,Touched))) ) (fromf r v,(v,m)) ) (l,(v,m)) ) @> (mapval,shared) updateSharedInformation d _ shared //Use dynamics to test if r == w, if so we can use an update view //If different types are used we can only resort to a display of type r and an enter of type w = case dynamic id :: A.a: (a -> a) of (rtow :: (r^ -> w^)) = interact d (toReadOnly shared) (\r -> let v = rtow r in (rtow r,(v,Touched))) (\l r (v,m) rCh vCh vOk -> if vOk (if (rtow r =!= l) (let nv = rtow r in (nv,(nv,Touched))) (v,(v,m))) (l,(v,m))) @> (mapval,shared) _ = interact d (toReadOnly shared) (\r -> let v = (Display r,defaultValue) in (defaultValue,(v,CompoundMask [Touched,Untouched]))) (\l r ((_,v),(CompoundMask [_,m])) rCh vCh vOk -> let nl = if vOk v l in (let nv = (Display r,nl) in (nl,(nv,CompoundMask [Touched,m])))) @> (mapval,shared) mapval (Value w _) _ = Just w mapval _ _ = Nothing viewSharedInformation :: !d ![ViewOption r] !(ReadWriteShared r w) -> Task r | descr d & iTask r viewSharedInformation d [ViewWith tof:_] shared /* = interact d (toReadOnly shared) (\r -> let v = Display (tof r) in (r,v,defaultMask v)) (\l r v m ok -> let v = Display (tof r) in (r,v,defaultMask v)) */ = interactSharedInformation d (toReadOnly shared) (\r -> Display (tof r)) viewSharedInformation d _ shared = viewSharedInformation d [ViewWith id] shared updateInformationWithShared :: !d ![UpdateOption (r,m) m] !(ReadWriteShared r w) m -> Task m | descr d & iTask r & iTask m updateInformationWithShared d [UpdateWith tof fromf:_] shared m = interact d (toReadOnly shared) (\r -> let v = tof (r,m) in (m,(v,Touched))) (\l r (v,msk) rCh vCh vOk -> let nl = if vOk (fromf (r,l) v) l in (let v = tof (r,nl) in (nl,(v,Touched)))) updateInformationWithShared d _ shared m = interact d (toReadOnly shared) (\r -> let v = (Display r,m) in (m,(v,CompoundMask [Touched,Untouched]))) (\l r ((_,v),(CompoundMask [_,msk])) rCh vCh vOk -> let nl = if vOk v l in (let nv = (Display r,nl) in (nl,(nv,CompoundMask [Touched,msk])))) //Core choice tasks editChoiceAs :: !d [ChoiceOption o] ![o] !(o -> a) (Maybe a) -> Task a | descr d & iTask o & iTask a editChoiceAs d [ChooseWith type:_] container target mbSel = interactLocalExposed d (initFun type container target mbSel) updateFun @? choiceRes where initFun :: (ChoiceType o v) [o] (o -> a) (Maybe a) -> ([a], (DynamicChoice v,InteractionMask)) | iTask o & iTask a & iTask v initFun type container target mbSel = (map target container, initChoiceView type container target mbSel) updateFun :: [a] (DynamicChoice v,InteractionMask) Bool -> ([a], (DynamicChoice v,InteractionMask)) updateFun targets (view,mask) viewOk = (targets,(view,mask)) editChoiceAs d _ container target mbSel = editChoiceAs d [ChooseWith (AutoChoice id)] container target mbSel editChoiceSimple :: !d ![o] (Maybe o) -> Task o | descr d & iTask o editChoiceSimple d container mbSel = interactLocalViewOnly d (initSimpleChoiceView container mbSel) updateFun @? simpleChoiceRes where updateFun :: (DynamicChoice o,InteractionMask) Bool -> (DynamicChoice o,InteractionMask) updateFun (view,mask) viewOk = (view,mask) editChoiceWithSharedAs :: !d ![ChoiceOption o] !(ReadWriteShared [o] w) (o -> a) (Maybe a) -> Task a | descr d & iTask o & iTask w & iTask a editChoiceWithSharedAs d [ChooseWith type:_] sharedContainer target mbSel = interactExposed d (toReadOnly sharedContainer) (initFun type target mbSel) (updateFun type target) @? choiceRes where initFun :: (ChoiceType o v) (o -> a) (Maybe a) [o] -> ([a], (DynamicChoice v, InteractionMask)) | iTask o & iTask v & iTask a initFun type target mbSel container = (map target container,initChoiceView type container target mbSel) updateFun :: (ChoiceType o v) (o -> a) [a] [o] (DynamicChoice v,InteractionMask) Bool Bool Bool -> ([a], (DynamicChoice v,InteractionMask)) | iTask o & iTask v & iTask a updateFun type target targets container (view,mask) shareChanged viewChanged viewOk //First check if we changed the selection, then update the view | shareChanged # (view,mask) = updateChoiceView type container target (selectionFromChoiceView targets view) targets (view,mask) # targets = map target container = (targets,(view,mask)) | otherwise = (targets,(view,mask)) editChoiceWithSharedAs d _ container target mbSel = editChoiceWithSharedAs d [ChooseWith (AutoChoice id)] container target mbSel editChoiceWithSharedSimple :: !d !(ReadWriteShared [o] w) (Maybe o) -> Task o | descr d & iTask o & iTask w editChoiceWithSharedSimple d sharedContainer mbSel = interactViewOnly d (toReadOnly sharedContainer) (initFun mbSel) updateFun @? simpleChoiceRes where initFun :: (Maybe o) [o] -> (DynamicChoice o,InteractionMask) | iTask o initFun mbSel container = initSimpleChoiceView container mbSel updateFun :: [o] (DynamicChoice o,InteractionMask) Bool Bool Bool -> (DynamicChoice o,InteractionMask) | iTask o updateFun container (view,mask) shareChanged viewChanged viewOk | shareChanged = updateSimpleChoiceView container (getSelectionView view) (view,mask) | otherwise = (view,mask) editSharedChoiceAs :: !d [ChoiceOption o] ![o] !(o -> a) (Shared (Maybe a)) -> Task a | descr d & iTask o & iTask a editSharedChoiceAs d [ChooseWith type:_] container target sharedSel = interactExposed d (toReadOnly sharedSel) (initFun type container target) updateFun @> (mapSharedSel,sharedSel) @? choiceRes where initFun :: (ChoiceType o v) [o] (o -> a) (Maybe a) -> ([a], (DynamicChoice v,InteractionMask)) | iTask o & iTask v & iTask a initFun type container target mbSel = (map target container, initChoiceView type container target mbSel) updateFun :: [a] (Maybe a) (DynamicChoice v,InteractionMask) Bool Bool Bool -> ([a], (DynamicChoice v,InteractionMask)) | iTask v & iTask a updateFun targets mbSel (view,mask) shareChanged viewChanged viewOk # mbSel = if (viewChanged && viewOk) (selectionFromChoiceView targets view) mbSel # (view,mask) = if (shareChanged && not (viewChanged && viewOk)) (updateChoiceSelection mbSel targets (view,mask)) (view,mask) = (targets,(view,mask)) editSharedChoiceAs d _ container target sharedSel = editSharedChoiceAs d [ChooseWith (AutoChoice id)] container target sharedSel editSharedChoiceSimple :: !d ![o] (Shared (Maybe o)) -> Task o | descr d & iTask o editSharedChoiceSimple d container sharedSel = interactViewOnly d (toReadOnly sharedSel) (initSimpleChoiceView container) (updateFun container) @> (mapSimpleSharedSel,sharedSel) @? simpleChoiceRes where updateFun :: [o] (Maybe o) (DynamicChoice o,InteractionMask) Bool Bool Bool -> (DynamicChoice o,InteractionMask) | iTask o updateFun container mbSel (view,mask) shareChanged viewChanged viewOk # mbSel = if (viewChanged && viewOk) (getSelectionView view) mbSel = if (shareChanged && not (viewChanged && viewOk)) (updateSimpleChoiceSelection mbSel (view,mask)) (view,mask) editSharedChoiceWithSharedAs :: !d ![ChoiceOption o] !(ReadWriteShared [o] w) (o -> a) (Shared (Maybe a)) -> Task a | descr d & iTask o & iTask w & iTask a editSharedChoiceWithSharedAs d [ChooseWith type:_] sharedContainer target sharedSel = interactExposed d (sharedContainer |+| sharedSel) (initFun type target) (updateFun type target) @> (mapSharedSel,sharedSel) @? choiceRes where initFun :: (ChoiceType o v) (o -> a) ([o], Maybe a) -> ([a], (DynamicChoice v, InteractionMask)) | iTask o & iTask v & iTask a initFun type target (container,mbSel) = (map target container,initChoiceView type container target mbSel) updateFun :: (ChoiceType o v) (o -> a) [a] ([o], Maybe a) (DynamicChoice v,InteractionMask) Bool Bool Bool -> ([a], (DynamicChoice v,InteractionMask)) | iTask o & iTask v & iTask a updateFun type target targets (container,mbSel) (view,mask) shareChanged viewChanged viewOk # mbSel = if (viewChanged && viewOk) (selectionFromChoiceView targets view) mbSel # (view,mask) = if shareChanged (updateChoiceView type container target mbSel targets (view,mask)) (view,mask) # targets = if shareChanged (map target container) targets = (targets,(view,mask)) editSharedChoiceWithSharedAs d _ sharedContainer target sharedSel = editSharedChoiceWithSharedAs d [ChooseWith (AutoChoice id)] sharedContainer target sharedSel editSharedChoiceWithSharedSimple :: !d !(ReadWriteShared [o] w) (Shared (Maybe o)) -> Task o | descr d & iTask o & iTask w editSharedChoiceWithSharedSimple d sharedContainer sharedSel = interactViewOnly d (sharedContainer |+| sharedSel) initFun updateFun @> (mapSimpleSharedSel,sharedSel) @? simpleChoiceRes where initFun :: ([o], Maybe o) -> (DynamicChoice o, InteractionMask) | iTask o initFun (container,mbSel) = initSimpleChoiceView container mbSel updateFun :: ([o], Maybe o) (DynamicChoice o,InteractionMask) Bool Bool Bool -> (DynamicChoice o,InteractionMask) | iTask o updateFun (container,mbSel) (view,mask) shareChanged viewChanged viewOk # mbSel = if (viewChanged && viewOk) (getSelectionView view) mbSel # (view,mask) = if shareChanged (updateSimpleChoiceView container mbSel (view,mask)) (view,mask) = (view,mask) initChoiceView :: (ChoiceType o v) [o] (o -> a) (Maybe a) -> (DynamicChoice v,InteractionMask) | iTask o & iTask v & iTask a initChoiceView type container target mbSel = updateChoiceSelection mbSel (map target container) (mkDynChoice type container,Untouched) where mkDynChoice (AutoChoice view) container = mkDynChoice (autoChoiceType view container) container mkDynChoice (ChooseFromComboBox view) container = DCCombo (ComboChoice [view o \\ o <- container] Nothing) mkDynChoice (ChooseFromRadioButtons view) container = DCRadio (RadioChoice [view o \\ o <- container] Nothing) mkDynChoice (ChooseFromList view) container = DCList (ListChoice [view o \\ o <- container] Nothing) mkDynChoice (ChooseFromTree view) container = DCTree (TreeChoice (view [(i,o) \\ i <- [0..] & o <- container] []) Nothing) mkDynChoice (ChooseFromGrid view) container = DCGrid (GridChoice [view o \\ o <- container] Nothing) autoChoiceType f l = case headers l undef of [] = ChooseFromComboBox f [""] = ChooseFromComboBox f _ = ChooseFromGrid f where headers :: [a] a -> [String] | gEditMeta{|*|} a headers _ a = [fromMaybe "" label \\{EditMeta|label} <- gEditMeta{|*|} a] //When we don't have an (o -> a) transformation and no view transformation, we don't need to keep //the choice options in the interact's state (which saves space and time) initSimpleChoiceView :: [o] (Maybe o) -> (DynamicChoice o, InteractionMask) | iTask o initSimpleChoiceView container mbSel = updateChoiceSelection mbSel container (mkDynChoice container,Untouched) where mkDynChoice l = case headers l undef of [] = DCCombo (ComboChoice container Nothing) [""] = DCCombo (ComboChoice container Nothing) _ = DCGrid (GridChoice container Nothing) where headers :: [a] a -> [String] | gEditMeta{|*|} a headers _ a = [fromMaybe "" label \\{EditMeta|label} <- gEditMeta{|*|} a] updateChoiceView :: (ChoiceType o v) [o] (o -> a) (Maybe a) [a] (DynamicChoice v,InteractionMask) -> (DynamicChoice v,InteractionMask) | iTask o & iTask v & iTask a //updateChoiceView type container target mbSel targets (view,mask) //Crude solution, just rebuild view and update (will do for now) // = initChoiceView type container target mbSel updateChoiceView type container target mbSel targets (view,mask) = updateChoiceSelection mbSel (map target container) (updDynChoice type targets view,mask) where updDynChoice (AutoChoice view) _ (DCCombo _) = DCCombo (ComboChoice [view o \\ o <- container] Nothing) updDynChoice (AutoChoice view) _ (DCGrid _) = DCGrid (GridChoice [view o \\ o <- container] Nothing) updDynChoice (ChooseFromComboBox view) _ _ = DCCombo (ComboChoice [view o \\ o <- container] Nothing) updDynChoice (ChooseFromRadioButtons view) _ _ = DCRadio (RadioChoice [view o \\ o <- container] Nothing) updDynChoice (ChooseFromTree view) targets (DCTree (TreeChoice tree _)) = DCTree (TreeChoice (view [(i,o) \\ i <- [0..] & o <- container] (expanded tree targets container)) Nothing) updDynChoice (ChooseFromTree view) _ _ = DCTree (TreeChoice (view [(i,o) \\ i <- [0..] & o <- container] []) Nothing) updDynChoice (ChooseFromGrid view) _ _ = DCGrid (GridChoice [view o \\ o <- container] Nothing) updDynChoice (ChooseFromList view) _ _ = DCList (ListChoice [view o \\ o <- container] Nothing) expanded tree targets container = remapChoiceIndices targets (map target container) (expandedFromTreeChoiceView tree) updateSimpleChoiceView :: [o] (Maybe o) (DynamicChoice o,InteractionMask) -> (DynamicChoice o,InteractionMask) | iTask o updateSimpleChoiceView container mbSel (view,mask) = initSimpleChoiceView container mbSel updateChoiceSelection :: (Maybe a) [a] (DynamicChoice v, InteractionMask) -> (DynamicChoice v, InteractionMask) | iTask v & iTask a updateChoiceSelection Nothing targets (dynChoice,_) = (setSelectionIndex Nothing dynChoice, Untouched) updateChoiceSelection (Just sel) targets (dynChoice,_) = (setSelectionIndex (findIndex ((===) sel) targets) dynChoice, Touched) updateSimpleChoiceSelection :: (Maybe o) (DynamicChoice o, InteractionMask) -> (DynamicChoice o, InteractionMask) | iTask o updateSimpleChoiceSelection mbSel (dynChoice,_) = (setSelectionView mbSel dynChoice, if (isJust mbSel) Touched Untouched) choiceRes :: (TaskValue ([a],DynamicChoice v)) -> TaskValue a choiceRes (Value (targets,view) _) = case selectionFromChoiceView targets view of Just x = Value x False _ = NoValue choiceRes _ = NoValue simpleChoiceRes :: (TaskValue (DynamicChoice a)) -> TaskValue a simpleChoiceRes (Value view _) = case getSelectionView view of Just x = Value x False _ = NoValue simpleChoiceRes _ = NoValue mapSharedSel :: (TaskValue ([a],DynamicChoice v)) (Maybe a) -> (Maybe (Maybe a)) | gEq{|*|} a mapSharedSel (Value (targets,view) _) (Just ov) = maybe Nothing (\idx -> let nv = targets !! idx in if (nv =!= ov) (Just (Just nv)) Nothing) (getSelectionIndex view) mapSharedSel (Value (targets,view) _) _ = fmap (\idx -> Just (targets !! idx)) (getSelectionIndex view) mapSharedSel _ _ = Nothing mapSimpleSharedSel :: (TaskValue (DynamicChoice a)) (Maybe a) -> (Maybe (Maybe a)) | gEq{|*|} a mapSimpleSharedSel (Value view _) (Just ov) = maybe Nothing (\nv -> if (nv =!= ov) (Just (Just nv)) Nothing) (getSelectionView view) mapSimpleSharedSel (Value view _) _ = fmap Just (getSelectionView view) mapSimpleSharedSel _ _ = Nothing selectionFromChoiceView :: [a] (DynamicChoice v) -> (Maybe a) selectionFromChoiceView targets dynChoice = fmap (\idx -> targets !! idx) (getSelectionIndex dynChoice) expandedFromTreeChoiceView :: [ChoiceTree a] -> [ChoiceTreeValue] expandedFromTreeChoiceView nodes = foldr add [] nodes where add {ChoiceTree|value,type=ExpandedNode children} expanded = [value:expandedFromTreeChoiceView children ++ expanded] add {ChoiceTree|value,type=CollapsedNode children} expanded = expandedFromTreeChoiceView children ++ expanded add _ expanded = expanded //When the list of things to choose from changes, the old indices have to be remapped to the list to choose from remapChoiceIndices :: [a] [a] [ChoiceTreeValue] -> [ChoiceTreeValue] | gEq{|*|} a //TODO: This should be possible in linear time remapChoiceIndices old new [] = [] remapChoiceIndices old new [ChoiceNode i:ns] = let ns` = remapChoiceIndices old new ns in maybe ns` (\i` -> [ChoiceNode i`:ns`]) (findIndex ((===) (old !! i)) new) remapChoiceIndices old new [GroupNode l:ns] = [GroupNode l:remapChoiceIndices old new ns] editChoice :: !d ![ChoiceOption a] ![a] (Maybe a) -> Task a | descr d & iTask a editChoice d [] container mbSel = editChoiceSimple d container mbSel editChoice d options container mbSel = editChoiceAs d options container id mbSel enterChoice :: !d ![ChoiceOption a] ![a] -> Task a | descr d & iTask a enterChoice d options container = editChoice d options container Nothing enterChoiceAs :: !d [ChoiceOption o] ![o] !(o -> a) -> Task a | descr d & iTask o & iTask a enterChoiceAs d options container targetFun = editChoiceAs d options container targetFun Nothing updateChoice :: !d ![ChoiceOption a] ![a] a -> Task a | descr d & iTask a updateChoice d options container sel = editChoice d options container (Just sel) updateChoiceAs :: !d ![ChoiceOption o] ![o] !(o -> a) a -> Task a | descr d & iTask o & iTask a updateChoiceAs d options container targetFun sel = editChoiceAs d options container targetFun (Just sel) editChoiceWithShared :: !d ![ChoiceOption a] !(ReadWriteShared [a] w) (Maybe a) -> Task a | descr d & iTask a & iTask w editChoiceWithShared d [] container mbSel = editChoiceWithSharedSimple d container mbSel editChoiceWithShared d options container mbSel = editChoiceWithSharedAs d options container id mbSel enterChoiceWithShared :: !d ![ChoiceOption a] !(ReadWriteShared [a] w) -> Task a | descr d & iTask a & iTask w enterChoiceWithShared d options container = editChoiceWithShared d options container Nothing enterChoiceWithSharedAs :: !d ![ChoiceOption o] !(ReadWriteShared [o] w) (o -> a) -> Task a | descr d & iTask o & iTask w & iTask a enterChoiceWithSharedAs d options container targetFun = editChoiceWithSharedAs d options container targetFun Nothing updateChoiceWithShared :: !d ![ChoiceOption a] !(ReadWriteShared [a] w) a -> Task a | descr d & iTask a & iTask w updateChoiceWithShared d options container sel = editChoiceWithShared d options container (Just sel) updateChoiceWithSharedAs :: !d ![ChoiceOption o] !(ReadWriteShared [o] w) (o -> a) a -> Task a | descr d & iTask o & iTask w & iTask a updateChoiceWithSharedAs d options container targetFun sel = editChoiceWithSharedAs d options container targetFun (Just sel) editSharedChoice :: !d ![ChoiceOption a] ![a] (Shared (Maybe a)) -> Task a | descr d & iTask a editSharedChoice d [] container sharedSel = editSharedChoiceSimple d container sharedSel editSharedChoice d options container sharedSel = editSharedChoiceAs d options container id sharedSel editSharedChoiceWithShared :: !d ![ChoiceOption a] !(ReadWriteShared [a] w) (Shared (Maybe a)) -> Task a | descr d & iTask a & iTask w editSharedChoiceWithShared d [] sharedContainer sharedSel = editSharedChoiceWithSharedSimple d sharedContainer sharedSel editSharedChoiceWithShared d options sharedContainer sharedSel = editSharedChoiceWithSharedAs d options sharedContainer id sharedSel enterMultipleChoice :: !d ![MultiChoiceOption o] ![o] -> Task [o] | descr d & iTask o enterMultipleChoice d options container = updateInformation d (multiChoiceToUpdate options) (container,[]) @ snd updateMultipleChoice :: !d ![MultiChoiceOption o] ![o] [o] -> Task [o] | descr d & iTask o updateMultipleChoice d options container sel = updateInformation d (multiChoiceToUpdate options) (container,sel) @ snd enterSharedMultipleChoice :: !d ![MultiChoiceOption o] !(ReadWriteShared [o] w) -> Task [o] | descr d & iTask o & iTask w enterSharedMultipleChoice d options shared = updateInformationWithShared d (sharedMultiChoiceToUpdate options) shared [] updateSharedMultipleChoice :: !d ![MultiChoiceOption o] !(ReadWriteShared [o] w) [o] -> Task [o] | descr d & iTask o & iTask w updateSharedMultipleChoice d options shared sel = updateInformationWithShared d (sharedMultiChoiceToUpdate options) shared sel wait :: !d (r -> Bool) !(ReadWriteShared r w) -> Task r | descr d & iTask r wait desc pred shared = viewSharedInformation desc [ViewWith (const "Waiting for information update")] shared >>* [OnValue (ifValue pred return)] waitForTime :: !Time -> Task Time waitForTime time = viewSharedInformation ("Wait for time", ("Wait until " +++ toString time)) [] currentTime >>* [OnValue (ifValue (\now -> time < now) return)] waitForDate :: !Date -> Task Date waitForDate date = viewSharedInformation ("Wait for date", ("Wait until " +++ toString date)) [] currentDate >>* [OnValue (ifValue (\now -> date < now) return)] waitForDateTime :: !DateTime -> Task DateTime waitForDateTime datetime = viewSharedInformation ("Wait for date and time", ("Wait until " +++ toString datetime)) [] currentDateTime >>* [OnValue (ifValue (\now -> datetime < now) return)] waitForTimer :: !Time -> Task Time waitForTimer time = get currentTime >>- \now -> waitForTime (now + time) chooseAction :: ![(!Action,a)] -> Task a | iTask a chooseAction actions = viewInformation Void [] Void >>* [OnAction action (always (return val)) \\ (action,val) <- actions] multiChoiceToUpdate :: [MultiChoiceOption o] -> [UpdateOption ([o], [o]) ([o],[o])] | iTask o multiChoiceToUpdate [ChooseMultipleWith type view:_] = [UpdateWith (toView type) fromView] where toView type (options,sel) = selectOptions sel (initChoice type options) initChoice AutoMultiChoice options = initChoice ChooseFromCheckBoxes options initChoice ChooseFromCheckBoxes options = CheckMultiChoice [(view o,o) \\ o <- options] [] fromView (options,_) choice = (options,getSelections choice) multiChoiceToUpdate _ = multiChoiceToUpdate [ChooseMultipleWith AutoMultiChoice id] sharedMultiChoiceToUpdate :: [MultiChoiceOption o] -> [UpdateOption ([o], [o]) [o]] | iTask o sharedMultiChoiceToUpdate options = case multiChoiceToUpdate options of [UpdateWith fromf tof] = [UpdateWith fromf (\m v -> snd (tof m v))] _ = [] viewTitle :: !a -> Task a | iTask a viewTitle a = viewInformation (Title title) [ViewWith view] a <<@ InContainer //<<@ AfterLayout (tweakAttr titleFromValue) where title = toSingleLineText a view a = DivTag [] [SpanTag [StyleAttr "font-size: 30px"] [Text title]] viewSharedTitle :: !(ReadWriteShared r w) -> Task r | iTask r viewSharedTitle s = whileUnchanged s viewTitle