Commit 16d89539 authored by Bas Lijnse's avatar Bas Lijnse

Simplified API of 'interact' core task. It now uses a record with event handler

functions like tcpconnect and externalProcess do and the editor is no longer optional
parent c2b815c6
......@@ -101,7 +101,7 @@ where
//UTILITY TASKS
testEditor :: (Editor a) a EditMode -> Task a | iTask a
testEditor editor model mode
= (interact "Editor test" mode unitShare (const ((),model)) (\v l _ -> (l,v,Nothing)) (\_ l v -> (l,v,Nothing)) (Just editor) @ snd
= (interact "Editor test" mode unitShare {onInit = const ((),model), onEdit = \v l _ -> (l,v,Nothing), onRefresh = \_ l v -> (l,v,Nothing)} editor @ snd
>&> viewSharedInformation "Editor value" [ViewAs (toString o toJSON)] @? tvFromMaybe
) <<@ ApplyLayout (setUIAttributes (directionAttr Horizontal) )
......@@ -110,9 +110,9 @@ testEditorWithShare editor model mode = (withShared model
\smodel ->
updateSharedInformation "Edit the shared source" [] smodel
||-
interact "Editor under test" mode smodel (\r -> ((),r))
(\v l _ -> (l,v,Just (\_ -> v)))
(\r l v -> (l,r,Nothing)) (Just editor) @ snd
interact "Editor under test" mode smodel {onInit = \r -> ((),r)
,onEdit = \v l _ -> (l,v,Just (\_ -> v))
,onRefresh = \r l v -> (l,r,Nothing)} editor @ snd
) <<@ ApplyLayout (setUIAttributes (directionAttr Horizontal))
testCommonInteractions :: String -> Task a | iTask a
......
......@@ -7,7 +7,7 @@ from Data.Error import :: MaybeError
from System.OSError import :: MaybeOSError, :: OSError, :: OSErrorCode, :: OSErrorMessage
from iTasks.UI.Editor import :: EditMode
from iTasks.UI.Prompt import class toPrompt
from iTasks.SDS.Definition import :: SDS, :: RWShared
from iTasks.SDS.Definition import :: SDS
/**
* Lifts a value to the task domain. The task finishes immediately and yields its parameter
......@@ -83,23 +83,11 @@ instance toString OSException
/**
* Core interaction task. All other interaction tasks are derived from this one.
*
* An interaction tasks works on a local state and has read-only access to shared data.
*
* @param Description: A description of the task to display to the user
* @param Edit mode: The type of interaction: viewing, entering or updating information
* @param ReadOnlyShared: A reference to shared data the task has access to
* @param Initialization function: Computes the initial local state and view
* @param Refresh function: Recomputes the local state and view when either the view is edited or the shared data changes.
* @param Custom editor: Optional custom editor for the interaction
*
* @return The local state
*
* @gin False
*/
interact :: !d !EditMode !(RWShared () r w)
(r -> (l, v)) //On init
(v l v -> (l, v, Maybe (r -> w))) //On edit
(r l v -> (l, v, Maybe (r -> w))) //On refresh
(Maybe (Editor v)) -> Task (l,v) | toPrompt d & iTask l & iTask r & iTask v & TC w
:: InteractionHandlers l r w v =
{ onInit :: !(r -> (l,v))
, onEdit :: !(v l v -> (l, v, Maybe (r -> w)))
, onRefresh :: !(r l v -> (l, v, Maybe (r -> w)))
}
interact :: !d !EditMode !(SDS () r w) (InteractionHandlers l r w v) (Editor v) -> Task (l,v) | toPrompt d & iTask l & iTask r & iTask v & TC w
......@@ -52,12 +52,8 @@ instance toString OSException
where
toString (OSException (_,err)) = "Error performing OS operation: " +++ err
interact :: !d !EditMode !(RWShared () r w)
(r -> (l, v)) //On init
(v l v -> (l, v, Maybe (r -> w))) //On edit
(r l v -> (l, v, Maybe (r -> w))) //On refresh
(Maybe (Editor v)) -> Task (l,v) | toPrompt d & iTask l & iTask r & iTask v & TC w
interact prompt mode shared initFun editFun refreshFun mbEditor = Task eval
interact :: !d !EditMode !(SDS () r w) (InteractionHandlers l r w v) (Editor v) -> Task (l,v) | toPrompt d & iTask l & iTask r & iTask v & TC w
interact prompt mode shared {onInit,onEdit,onRefresh} editor = Task eval
where
eval event evalOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
......@@ -67,8 +63,8 @@ where
(TCInit taskId ts)
= case 'SDS'.readRegister taskId shared iworld of
(Ok r,iworld)
# (l,v) = initFun r
= case initMask taskId mode mbEditor v iworld of
# (l,v) = onInit r
= case initMask taskId mode editor v iworld of
(Ok m,iworld) = (Ok (taskId,ts,l,v,m),iworld)
(Error e,iworld) = (Error e,iworld)
(Error e,iworld) = (Error e,iworld)
......@@ -81,14 +77,13 @@ where
# (taskId,ts,l,v,m) = fromOk mbd
# (mbRes, iworld) = case event of
EditEvent eTaskId name edit | eTaskId == taskId =
applyEditEvent_ name edit taskId mode mbEditor taskTime shared editFun l v m iworld
applyEditEvent_ name edit taskId mode editor taskTime shared onEdit l v m iworld
ResetEvent
# editor = fromMaybe gEditor{|*|} mbEditor
# vst = {VSt| taskId = toString taskId, mode = mode, optional = False, selectedConsIndex = -1, iworld = iworld}
= case editor.Editor.genUI [] v vst of
(Ok (ui,m),{VSt|iworld}) = (Ok (l,v,ReplaceUI (uic UIInteract [toPrompt prompt,ui]),m,taskTime),iworld)
(Error e,{VSt|iworld}) = (Error (exception e),iworld)
RefreshEvent _ = refreshView_ taskId mode mbEditor shared refreshFun l v m taskTime iworld
RefreshEvent _ = refreshView_ taskId mode editor shared onRefresh l v m taskTime iworld
FocusEvent fTaskId | fTaskId == taskId = (Ok (l,v,NoChange,m,taskTime),iworld)
_ = (Ok (l,v,NoChange,m,ts),iworld)
= case mbRes of
......@@ -100,23 +95,21 @@ where
# info = {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True}
= (ValueResult value info change (TCInteract taskId ts (toJSON l) (toJSON v) m), iworld)
initMask :: TaskId EditMode (Maybe (Editor v)) v !*IWorld -> (MaybeError TaskException EditMask, !*IWorld) | gEditor{|*|} v
initMask taskId mode mbEditor v iworld
# editor = fromMaybe gEditor{|*|} mbEditor
initMask :: TaskId EditMode (Editor v) v !*IWorld -> (MaybeError TaskException EditMask, !*IWorld)
initMask taskId mode editor v iworld
# vst = {VSt| taskId = toString taskId, mode = mode, optional = False, selectedConsIndex = -1, iworld = iworld}
= case editor.Editor.genUI [] v vst of
(Ok (_,mask),{VSt|iworld}) = (Ok mask, iworld)
(Error e, {VSt|iworld}) = (Error (exception e), iworld)
applyEditEvent_ :: String JSONNode TaskId EditMode (Maybe (Editor v)) TaskTime (RWShared () r w) (v l v -> (l, v, Maybe (r -> w))) l v EditMask !*IWorld
applyEditEvent_ :: String JSONNode TaskId EditMode (Editor v) TaskTime (SDS () r w) (v l v -> (l, v, Maybe (r -> w))) l v EditMask !*IWorld
-> (!MaybeError TaskException (!l, !v, !UIChange, !EditMask, !TaskTime), !*IWorld)
| gEditor{|*|} v & TC r & TC w
applyEditEvent_ name edit taskId mode mbEditor taskTime shared editFun l ov m iworld
# editor = fromMaybe gEditor{|*|} mbEditor
| TC r & TC w
applyEditEvent_ name edit taskId mode editor taskTime shared onEdit l ov m iworld
# vst = {VSt| taskId = toString taskId, mode = mode, optional = False, selectedConsIndex = -1, iworld = iworld}
= case editor.Editor.onEdit [] (s2dp name,edit) ov m vst of
(Ok (change,m),v,{VSt|iworld})
# (l,v,mbf) = editFun v l ov
# (l,v,mbf) = onEdit v l ov
# change = case change of NoChange = NoChange; _ = ChangeUI [] [(1,ChangeChild change)]
# valid = not (containsInvalidFields m)
= case mbf of
......@@ -127,16 +120,15 @@ applyEditEvent_ name edit taskId mode mbEditor taskTime shared editFun l ov m iw
= (Ok (l,v,change,m,taskTime),iworld)
(Error e,_,{VSt|iworld}) = (Error (exception e),iworld)
refreshView_ :: TaskId EditMode (Maybe (Editor v)) (RWShared () r w) (r l v -> (l, v, Maybe (r -> w))) l v EditMask TaskTime !*IWorld
refreshView_ :: TaskId EditMode (Editor v) (SDS () r w) (r l v -> (l, v, Maybe (r -> w))) l v EditMask TaskTime !*IWorld
-> (!MaybeError TaskException (!l, !v, !UIChange, !EditMask, !TaskTime), !*IWorld)
| gEditor{|*|} v & TC r & TC w
refreshView_ taskId mode mbEditor shared refreshFun l ov m taskTime iworld
| TC r & TC w
refreshView_ taskId mode editor shared onRefresh l ov m taskTime iworld
//Read the shared source and refresh the editor
= case 'SDS'.readRegister taskId shared iworld of
(Error e,iworld) = (Error e,iworld)
(Ok r,iworld)
# (l,v,mbf) = refreshFun r l ov
# editor = fromMaybe gEditor{|*|} mbEditor
# (l,v,mbf) = onRefresh r l ov
# vst = {VSt| taskId = toString taskId, mode = mode, optional = False, selectedConsIndex = -1, iworld = iworld}
= case editor.Editor.onRefresh [] v ov m vst of
(Ok (change,m),_,vst=:{VSt|iworld})
......
......@@ -25,45 +25,39 @@ unitShare = nullShare
enterInformation :: !d ![EnterOption m] -> Task m | toPrompt d & iTask m
enterInformation d [EnterAs fromf:_]
= interact d Enter unitShare (const ((),defaultValue)) (\v l _ -> (l,v,Nothing)) (\r l v -> (l,v,Nothing)) Nothing @ (\((),v) -> fromf v)
= interact d Enter unitShare {onInit = const ((),defaultValue), onEdit = \v l _ -> (l,v,Nothing), onRefresh = \r l v -> (l,v,Nothing)} gEditor{|*|} @ (\((),v) -> fromf v)
enterInformation d opts=:[EnterUsing fromf editor:_]
= interact d Enter unitShare (const ((),defaultValue)) (\v l _ -> (l,v,Nothing)) (\r l v -> (l,v,Nothing)) (Just editor) @ (\((),v) -> fromf v)
= interact d Enter unitShare {onInit = const ((),defaultValue), onEdit = \v l _ -> (l,v,Nothing), onRefresh = \r l v -> (l,v,Nothing)} editor @ (\((),v) -> fromf v)
enterInformation d _ = enterInformation d [EnterAs id]
updateInformation :: !d ![UpdateOption m m] m -> Task m | toPrompt d & iTask m
updateInformation d [UpdateAs tof fromf:_] m
= interact d Update unitShare (const ((),tof m)) (\v l _ -> (l,v,Nothing)) (\r l v -> (l,v,Nothing))
Nothing @ (\((),v) -> fromf m v)
= interact d Update unitShare {onInit = const ((),tof m), onEdit = \v l _ -> (l,v,Nothing), onRefresh = \r l v -> (l,v,Nothing)}
gEditor{|*|} @ (\((),v) -> fromf m v)
updateInformation d [UpdateUsing tof fromf editor:_] m
= interact d Update unitShare (const ((),tof m)) (\v l _ -> (l,v,Nothing)) (\r l v -> (l,v,Nothing))
(Just editor) @ (\((),v) -> fromf m v)
= interact d Update unitShare {onInit = const ((),tof m), onEdit = \v l _ -> (l,v,Nothing), onRefresh = \r l v -> (l,v,Nothing)}
editor @ (\((),v) -> fromf m v)
updateInformation d _ m = updateInformation d [UpdateAs (\l -> l) (\_ v -> v)] m
viewInformation :: !d ![ViewOption m] !m -> Task m | toPrompt d & iTask m
viewInformation d [ViewAs tof:_] m
= interact d View unitShare (const ((),tof m)) (\v l _ -> (l,v,Nothing)) (\r l v -> (l,v,Nothing)) Nothing @! m
= interact d View unitShare {onInit = const ((),tof m), onEdit = \v l _ -> (l,v,Nothing), onRefresh = \r l v -> (l,v,Nothing)} gEditor{|*|} @! m
viewInformation d [ViewUsing tof editor:_] m
= interact d View unitShare (const ((),tof m)) (\v l _ -> (l,v,Nothing)) (\r l v -> (l,v,Nothing)) (Just editor) @! m
= interact d View unitShare {onInit = const ((),tof m), onEdit = \v l _ -> (l,v,Nothing), onRefresh = \r l v -> (l,v,Nothing)} editor @! m
viewInformation d _ m = viewInformation d [ViewAs id] m
updateSharedInformation :: !d ![UpdateOption r w] !(ReadWriteShared r w) -> Task r | toPrompt d & iTask r & iTask w
updateSharedInformation d [UpdateAs tof fromf:_] shared
= interact d Update shared (\r -> (r, tof r))
(\v l _ -> (l,v,Just (\r -> fromf r v)))
(\r _ v -> (r,tof r,Nothing))
Nothing @ fst
= interact d Update shared {onInit = \r -> (r, tof r), onEdit = \v l _ -> (l,v,Just (\r -> fromf r v)), onRefresh = \r _ v -> (r,tof r,Nothing)}
gEditor{|*|} @ fst
updateSharedInformation d [UpdateUsing tof fromf editor:_] shared
= interact d Update shared (\r -> (r,tof r))
(\v l _ -> (l,v,Just (\r -> fromf r v)))
(\r _ v -> (r,tof r,Nothing))
(Just editor) @ fst
= interact d Update shared {onInit = \r -> (r,tof r), onEdit = \v l _ -> (l,v,Just (\r -> fromf r v)), onRefresh = \r _ v -> (r,tof r,Nothing)}
editor @ fst
updateSharedInformation d [UpdateSharedAs tof fromf conflictf:_] shared
= interact d Update shared (\r -> (r,tof r))
(\v l _ -> (l,v,Just (\r -> fromf r v)))
(\r _ v -> (r,conflictf (tof r) v, Nothing))
Nothing @ fst
= interact d Update shared {onInit = \r -> (r,tof r), onEdit = \v l _ -> (l,v,Just (\r -> fromf r v)), onRefresh = \r _ v -> (r,conflictf (tof r) v, Nothing)}
gEditor{|*|} @ fst
updateSharedInformation d _ shared
//Use dynamics to test if r == w, if so we can use an update view
......@@ -74,28 +68,27 @@ updateSharedInformation d _ shared
viewSharedInformation :: !d ![ViewOption r] !(ReadWriteShared r w) -> Task r | toPrompt d & iTask r & TC w
viewSharedInformation d [ViewAs tof:_] shared
= interact d View shared (\r -> (r,tof r))
(\v l _ -> (l,v,Nothing))
(\r _ v -> (r,tof r,Nothing))
Nothing @ fst
= interact d View shared {onInit = \r -> (r,tof r), onEdit = \v l _ -> (l,v,Nothing), onRefresh = \r _ v -> (r,tof r,Nothing)} gEditor{|*|} @ fst
viewSharedInformation d [ViewUsing tof editor:_] shared
= interact d View shared (\r -> (r,tof r))
(\v l _ -> (l,v,Nothing))
(\r _ v -> (r,tof r,Nothing))
(Just editor) @ fst
= interact d View shared {onInit = \r -> (r,tof r), onEdit = \v l _ -> (l,v,Nothing), onRefresh = \r _ v -> (r,tof r,Nothing)} editor @ fst
viewSharedInformation d _ shared = viewSharedInformation d [ViewAs id] shared
updateInformationWithShared :: !d ![UpdateOption (r,m) m] !(ReadWriteShared r w) m -> Task m | toPrompt d & iTask r & iTask m & TC w
updateInformationWithShared d [UpdateAs tof fromf:_] shared m
= interact d Update shared (\r -> ((r,m),tof (r,m)))
(\v (r,m) _ -> let nm = fromf (r,m) v in ((r,nm),v,Nothing))
(\r (_,m) v -> ((r,m),tof (r,m),Nothing))
Nothing @ (snd o fst)
= interact d Update shared
{onInit = \r -> ((r,m),tof (r,m))
,onEdit = \v (r,m) _ -> let nm = fromf (r,m) v in ((r,nm),v,Nothing)
,onRefresh = \r (_,m) v -> ((r,m),tof (r,m),Nothing)
} gEditor{|*|} @ (snd o fst)
updateInformationWithShared d [UpdateUsing tof fromf editor:_] shared m
= interact d Update shared (\r -> ((r,m),tof (r,m)))
(\v (r,m) _ -> let nm = fromf (r,m) v in ((r,nm),v,Nothing))
(\r (_,m) v -> ((r,m),tof (r,m),Nothing))
(Just editor) @ (snd o fst)
= interact d Update shared
{onInit = \r -> ((r,m),tof (r,m))
,onEdit = \v (r,m) _ -> let nm = fromf (r,m) v in ((r,nm),v,Nothing)
,onRefresh = \r (_,m) v -> ((r,m),tof (r,m),Nothing)
} editor @ (snd o fst)
updateInformationWithShared d _ shared m
= updateInformation d [] m
......@@ -107,10 +100,10 @@ editSelection d multi (SelectInGrid toView fromView) container sel = editSelecti
editSelection d multi (SelectInTree toView fromView) container sel = editSelection` d (tree <<@ multipleAttr multi) toView fromView container sel
editSelection` d editor toView fromView container sel
= interact d (if (isEmpty sel) Enter Update) unitShare
(\r -> ((),(toView container,sel)))
(\v l _ -> (l,v,Nothing))
(\_ l v -> (l,v,Nothing))
(Just editor) @ (\(_,(_,sel)) -> fromView container sel)
{onInit = \r -> ((),(toView container,sel))
,onEdit = \v l _ -> (l,v,Nothing)
,onRefresh = \_ l v -> (l,v,Nothing)
} editor @ (\(_,(_,sel)) -> fromView container sel)
editSelectionWithShared :: !d !Bool !(SelectOption c a) (ReadWriteShared c w) (c -> [Int]) -> Task [a] | toPrompt d & iTask c & iTask a & TC w
editSelectionWithShared d multi (SelectInDropdown toView fromView) sharedContainer initSel = editSelectionWithShared` d (dropdown <<@ multipleAttr multi) toView fromView sharedContainer initSel
......@@ -120,10 +113,10 @@ editSelectionWithShared d multi (SelectInGrid toView fromView) sharedContainer i
editSelectionWithShared d multi (SelectInTree toView fromView) sharedContainer initSel = editSelectionWithShared` d (tree <<@ multipleAttr multi) toView fromView sharedContainer initSel
editSelectionWithShared` d editor toView fromView sharedContainer initSel
= interact d Update sharedContainer
(\r -> (r,(toView r, initSel r)))
(\v l _ -> (l,v,Nothing))
(\r l (v,sel) -> (r,(toView r,sel),Nothing))
(Just editor) @ (\(container,(_,sel)) -> fromView container sel)
{onInit = \r -> (r,(toView r, initSel r))
,onEdit = \v l _ -> (l,v,Nothing)
,onRefresh = \r l (v,sel) -> (r,(toView r,sel),Nothing)
} editor @ (\(container,(_,sel)) -> fromView container sel)
editSharedSelection :: !d !Bool !(SelectOption c a) c (Shared [Int]) -> Task [a] | toPrompt d & iTask c & iTask a
editSharedSelection d multi (SelectInDropdown toView fromView) container sharedSel = editSharedSelection` d (dropdown <<@ multipleAttr multi) toView fromView container sharedSel
......@@ -133,10 +126,10 @@ editSharedSelection d multi (SelectInGrid toView fromView) container sharedSel =
editSharedSelection d multi (SelectInTree toView fromView) container sharedSel = editSharedSelection` d (tree <<@ multipleAttr multi) toView fromView container sharedSel
editSharedSelection` d editor toView fromView container sharedSel
= interact d Update sharedSel
(\r -> ((),(toView container,r)))
(\(vt,vs) l _ -> (l,(vt,vs),Just (const vs)))
(\r l (vt,vs) -> (l,(vt,r),Nothing))
(Just editor) @ (\(_,(_,sel)) -> fromView container sel)
{onInit = \r -> ((),(toView container,r))
,onEdit = \(vt,vs) l _ -> (l,(vt,vs),Just (const vs))
,onRefresh = \r l (vt,vs) -> (l,(vt,r),Nothing)
} editor @ (\(_,(_,sel)) -> fromView container sel)
editSharedSelectionWithShared :: !d !Bool !(SelectOption c a) (ReadWriteShared c w) (Shared [Int]) -> Task [a] | toPrompt d & iTask c & iTask a & TC w
editSharedSelectionWithShared d multi (SelectInDropdown toView fromView) sharedContainer sharedSel
......@@ -151,10 +144,10 @@ editSharedSelectionWithShared d multi (SelectInTree toView fromView) sharedConta
= editSharedSelectionWithShared` d (tree <<@ multipleAttr multi) toView fromView sharedContainer sharedSel
editSharedSelectionWithShared` d editor toView fromView sharedContainer sharedSel
= interact d Update (sharedContainer |+< sharedSel)
(\(rc, rs) -> (rc, (toView rc,rs)))
(\v=:(_, vs) l _ -> (l, v, Just (const vs)))
(\(rc, rs) _ _ -> (rc, (toView rc, rs), Nothing))
(Just editor) @ (\(container, (_, sel)) -> fromView container sel)
{onInit = \(rc, rs) -> (rc, (toView rc,rs))
,onEdit = \v=:(_, vs) l _ -> (l, v, Just (const vs))
,onRefresh = \(rc, rs) _ _ -> (rc, (toView rc, rs), Nothing)
} editor @ (\(container, (_, sel)) -> fromView container sel)
//Core choice tasks
editChoice :: !d ![ChoiceOption a] ![a] (Maybe a) -> Task a | toPrompt d & iTask a
......
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