Interaction.icl 20.5 KB
Newer Older
1
implementation module iTasks.WF.Tasks.Interaction
2 3

from StdFunc import id, const, o, flip
Steffen Michels's avatar
Steffen Michels committed
4
import Data.Func
5
from Data.Tuple import appSnd
6
from Data.List import isMemberGen, findIndex, instance Functor [], getItems
7
from Data.Map import qualified get, put
8
import qualified Data.Map as DM
9

10
import StdBool, StdList, StdMisc, StdTuple, Data.Functor, Data.Maybe, StdString
Mart Lubbers's avatar
Mart Lubbers committed
11
import iTasks.WF.Derives
12 13 14 15 16 17 18
import iTasks.WF.Tasks.Core
import iTasks.WF.Tasks.SDS
import iTasks.WF.Combinators.Overloaded
import iTasks.WF.Combinators.Common
import iTasks.SDS.Sources.Core
import iTasks.SDS.Sources.System
import iTasks.SDS.Combinators.Common
19
import iTasks.Internal.Util
20
import iTasks.Internal.SDS
21
import iTasks.UI.Layout, iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.Editor.Controls, iTasks.UI.Editor.Modifiers
22 23 24 25
import Text.HTML

derive class iTask ChoiceText, ChoiceGrid, ChoiceRow, ChoiceNode

26
//Boilerplate access functions
27 28 29 30 31 32
selectAttributes :: [SelectOption a b] -> UIAttributes
selectAttributes options = foldr addOption 'DM'.newMap options
where
	addOption (SelectMultiple multiple) attr = 'DM'.union (multipleAttr multiple) attr
	addOption _ attr = attr

33 34 35 36 37 38 39 40 41 42 43 44
viewEditor :: [ViewOption m] -> ViewOption m | iTask m
viewEditor [ViewUsing tof editor:_] = ViewUsing tof editor
viewEditor [ViewAs tof:_] = ViewUsing tof gEditor{|*|}
viewEditor [_:es] = viewEditor es
viewEditor [] =  ViewUsing id gEditor{|*|}

enterEditor :: [EnterOption m] -> EnterOption m | iTask m
enterEditor [EnterUsing fromf editor:_] = EnterUsing fromf editor
enterEditor [EnterAs fromf:_] = EnterUsing fromf gEditor{|*|}
enterEditor [_:es] = enterEditor es
enterEditor [] =  EnterUsing id gEditor{|*|}

45 46 47 48 49 50 51 52 53 54
updateEditor :: [UpdateOption m] -> UpdateOption m | iTask m
updateEditor [UpdateUsing tof fromf editor:_] = UpdateUsing tof fromf editor
updateEditor [UpdateAs tof fromf:_] = UpdateUsing tof fromf gEditor{|*|}
updateEditor [_:es] = updateEditor es
updateEditor [] =  UpdateUsing id (flip const) gEditor{|*|}

updateSharedEditor :: [UpdateSharedOption r w] -> UpdateSharedOption r w | iTask r & iTask w
updateSharedEditor [UpdateSharedUsing tof fromf conflictf editor:_] = UpdateSharedUsing tof fromf conflictf editor
updateSharedEditor [UpdateSharedAs tof fromf conflictf:_] = UpdateSharedUsing tof fromf conflictf gEditor{|*|}
updateSharedEditor [_:es] = updateSharedEditor es
55
updateSharedEditor [] =  UpdateSharedUsingAuto dynid (flip const) const gEditor{|*|}
56 57 58
where
	//If r == w then this is just the identity, otherwise the editor will use a default value
	dynid x = case dynamic id :: A.a: (a -> a) of
59 60
		(rtow :: r^ -> w^) = Just (rtow x)
		_                  = Nothing
61 62 63 64 65 66 67

selectEditor :: [SelectOption c a] -> SelectOption c a
selectEditor [SelectInDropdown toView fromView:_] = SelectUsing toView fromView dropdown
selectEditor [SelectInCheckGroup toView fromView:_] = SelectUsing toView fromView checkGroup
selectEditor [SelectInList toView fromView:_] = SelectUsing toView fromView choiceList
selectEditor [SelectInGrid toView fromView:_] = SelectUsing toView fromView grid
selectEditor [SelectInTree toView fromView:_] = SelectUsing toView fromView tree
68
selectEditor [SelectInTabs toView fromView:_] = SelectUsing toView fromView tabBar
69 70 71 72 73 74 75 76 77 78 79 80
selectEditor [_:es] = selectEditor es
selectEditor [] = SelectUsing (const []) (\_ _ -> []) dropdown //Empty dropdown


//Convert choice options to select options
selectOptions :: (o -> s) [ChoiceOption o] -> [SelectOption [o] s] | gText{|*|} o
selectOptions target options = selectOptions` False options 
where
	selectOptions` _ [ChooseFromDropdown f:os] = [SelectInDropdown (toTexts f) (findSelection target):selectOptions` True os]
	selectOptions` _ [ChooseFromCheckGroup f:os] = [SelectInCheckGroup (toTexts f)  (findSelection target):selectOptions` True os]
	selectOptions` _ [ChooseFromList f:os] = [SelectInList (toTexts f) (findSelection target):selectOptions` True os]
	selectOptions` _ [ChooseFromGrid f:os] = [SelectInGrid (toGrid f) (findSelection target):selectOptions` True os]
81
	selectOptions` _ [ChooseFromTabs f:os] = [SelectInTabs (toTexts f) (findSelection target):selectOptions` True os]
82 83 84 85 86 87 88 89 90 91 92 93 94
	selectOptions` True [] = []
	selectOptions` False [] = [SelectInDropdown (toTexts id) (findSelection target)]

	toTexts f options = [{ChoiceText|id=i,text=toSingleLineText (f o)} \\ o <- options & i <- [0..]]
	toGrid f options = {ChoiceGrid|header=gText{|*|} AsHeader (fixtype vals),rows = [{ChoiceRow|id=i,cells=map Text (gText{|*|} AsRow (Just v))} \\ v <- vals & i <- [0..]]}
	where
		vals = map f options
		fixtype :: [a] -> Maybe a
		fixtype _ = Nothing

findSelection :: (o -> s) [o] [Int] -> [s]
findSelection target options idxs = target <$> getItems options idxs

95
enterInformation :: ![EnterOption m] -> Task m | iTask m
96 97 98
enterInformation options = enterInformation` (enterEditor options)
enterInformation` (EnterUsing fromf editor)
	= interactRW unitShare handlers editor @ (\((),v) -> fromf v)
99
where
100
	handlers = {onInit = const ((), Enter), onEdit = \_ l -> (l, Nothing), onRefresh = \r l _ -> (l,undef,Nothing)}
101

102
viewInformation :: ![ViewOption m] !m -> Task m | iTask m
103 104
viewInformation options m = viewInformation`  (viewEditor options) m
viewInformation` (ViewUsing tof editor) m
105
	= interactR unitShare {onInit = const ((),View $ tof m), onEdit = \_ l -> (l, Nothing), onRefresh = \r l (Just v) -> (l,v,Nothing)} editor @! m
106

107
updateInformation :: ![UpdateOption m] m -> Task m | iTask m
108 109
updateInformation options m = updateInformation` (updateEditor options) m
updateInformation` (UpdateUsing tof fromf editor) m
110
	= interactRW unitShare {onInit = const ((), Update $ tof m), onEdit = \_ l -> (l, Nothing), onRefresh = \r l (Just v) -> (l,v,Nothing)}
111
		editor @ (\((),v) -> fromf m v)
112

113
updateSharedInformation :: ![UpdateSharedOption r w] !(sds () r w) -> Task r | iTask r & iTask w & RWShared sds
114 115
updateSharedInformation options sds = updateSharedInformation` (updateSharedEditor options) sds
updateSharedInformation` (UpdateSharedUsing tof fromf conflictf editor) sds
116
	= 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)}
117
		editor @ fst
118
updateSharedInformation` (UpdateSharedUsingAuto tof fromf conflictf editor) sds
119
	= interactRW sds {onInit = \r -> (r, maybe Enter Update (tof r)), onEdit = \v l -> (l, Just (\r -> fromf r v))
120 121
			, onRefresh = \r _ (Just v) -> (r, maybe v (\r` -> conflictf r` v) (tof r), Nothing)}
		editor @ fst
122

123
viewSharedInformation :: ![ViewOption r] !(sds () r w) -> Task r | iTask r & TC w & Registrable sds
124 125
viewSharedInformation options sds = viewSharedInformation` (viewEditor options) sds
viewSharedInformation` (ViewUsing tof editor) sds
126
	= interactR sds {onInit = \r -> (r, View $ tof r), onEdit = \_ l -> (l, Nothing), onRefresh = \r _ _ -> (r,tof r,Nothing)} editor @ fst
127

128
updateInformationWithShared :: ![UpdateSharedOption (r,m) m] !(sds () r w) m -> Task m | iTask r & iTask m & TC w & RWShared sds
129 130 131
updateInformationWithShared options sds m = updateInformationWithShared` (updateSharedEditor options) sds m
updateInformationWithShared` (UpdateSharedUsing tof fromf conflictf editor) sds m
	= interactRW sds
Steffen Michels's avatar
Steffen Michels committed
132
		{onInit = \r -> ((r,m), Update $ tof (r,m))
133
		,onEdit = \v (r,m)      -> let nm = fromf (r,m) v in ((r,nm),Nothing)
Steffen Michels's avatar
Steffen Michels committed
134
		,onRefresh = \r (_,m) _ -> ((r,m),tof (r,m),Nothing)
135 136
		} gEditor{|*|} @ (snd o fst)

137 138 139
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
140
	= interactRW unitShare
141 142
		{onInit = \r   -> ((), Update (toView container,sel))
		,onEdit = \_ l -> (l, Nothing)
Steffen Michels's avatar
Steffen Michels committed
143
		,onRefresh = \_ l (Just v) -> (l,v,Nothing)
144
		} (attributes @>> editor) @ (\(_,(_,sel)) -> fromView container sel)
145

146 147 148
editSelectionWithShared :: ![SelectOption c a] (sds () c w) (c -> [Int]) -> Task [a] | iTask c & iTask a & TC w & RWShared sds
editSelectionWithShared options sharedContainer initSel = editSelectionWithShared` (selectAttributes options) (selectEditor options) sharedContainer initSel
editSelectionWithShared` attributes (SelectUsing toView fromView editor) sharedContainer initSel
149
	= interactRW sharedContainer
Steffen Michels's avatar
Steffen Michels committed
150
		{onInit = \r     -> (r, Update(toView r, initSel r))
151
		,onEdit = \_ l -> (l, Nothing)
Steffen Michels's avatar
Steffen Michels committed
152
		,onRefresh = \r l (Just (v,sel)) -> (r,(toView r,sel),Nothing)
153
		} (attributes @>> editor) @ (\(container,(_,sel)) -> fromView container sel)
154

155 156 157
editSharedSelection :: ![SelectOption c a] c (Shared sds [Int]) -> Task [a] | iTask c & iTask a & RWShared sds
editSharedSelection options container sharedSel = editSharedSelection` (selectAttributes options) (selectEditor options) container sharedSel
editSharedSelection` attributes (SelectUsing toView fromView editor) container sharedSel
158
	= interactRW sharedSel
159 160
		{onInit = \r        -> ((), Update (toView container,r))
		,onEdit = \(_,vs) l -> (l, Just (const vs))
Steffen Michels's avatar
Steffen Michels committed
161
		,onRefresh = \r l (Just (vt,vs)) -> (l,(vt,r),Nothing)
162
		} (attributes @>> editor) @ (\(_,(_,sel)) -> fromView container sel)
163

164 165 166 167
editSharedSelectionWithShared :: ![SelectOption c a] (sds1 () c w) (Shared sds2 [Int]) -> Task [a] | iTask c & iTask a & TC w & RWShared sds1 & RWShared sds2
editSharedSelectionWithShared options sharedContainer sharedSel
	= editSharedSelectionWithShared` (selectAttributes options) (selectEditor options) sharedContainer sharedSel
editSharedSelectionWithShared` attributes (SelectUsing toView fromView editor) sharedContainer sharedSel
168
	= interactRW (sharedContainer |*< sharedSel)
169 170
		{onInit = \(rc, rs)  -> (rc, Update (toView rc,rs))
		,onEdit = \(_, vs) l -> (l, Just (const vs))
171
		,onRefresh = \(rc, rs)   _ _ -> (rc, (toView rc, rs), Nothing)
172
		} (attributes @>> editor) @ (\(container, (_, sel)) -> fromView container sel)
173 174

//Core choice tasks
175 176
editChoice :: ![ChoiceOption a] ![a] (Maybe a) -> Task a | iTask a
editChoice options container mbSel = editChoiceAs options container id mbSel
177

178 179
editChoiceAs :: ![ChoiceOption o] ![o] !(o -> a) (Maybe a) -> Task a | iTask o & iTask a
editChoiceAs vopts container target mbSel = editSelection [SelectMultiple False:selectOptions target vopts] container (findIndex target mbSel container) @? tvHd
180

181 182
editMultipleChoice :: ![ChoiceOption a] ![a] [a] -> Task [a] | iTask a
editMultipleChoice options container mbSel = editMultipleChoiceAs options container id mbSel
183

184 185
editMultipleChoiceAs :: ![ChoiceOption o] ![o] !(o -> a) [a] -> Task [a] | iTask o & iTask a
editMultipleChoiceAs vopts container target sel = editSelection [SelectMultiple True:selectOptions target vopts] container (findIndices target sel container)
186

187 188
enterChoice :: ![ChoiceOption a] ![a] -> Task a | iTask a
enterChoice options container = editChoice options container Nothing
189

190 191
enterChoiceAs :: ![ChoiceOption o] ![o] !(o -> a) -> Task a | iTask o & iTask a
enterChoiceAs options container targetFun = editChoiceAs options container targetFun Nothing
192

193 194
enterMultipleChoice :: ![ChoiceOption a] ![a] -> Task [a] | iTask a
enterMultipleChoice options container = editMultipleChoice options container []
195

196 197
enterMultipleChoiceAs :: ![ChoiceOption o] ![o] !(o -> a) -> Task [a] | iTask o & iTask a
enterMultipleChoiceAs options container targetFun = editMultipleChoiceAs options container targetFun []
198

199 200
updateChoice :: ![ChoiceOption a] ![a] a -> Task a | iTask a
updateChoice options container sel = editChoice options container (Just sel)
201

202 203
updateChoiceAs :: ![ChoiceOption o] ![o] !(o -> a) a -> Task a | iTask o & iTask a
updateChoiceAs options container targetFun sel = editChoiceAs options container targetFun (Just sel)
204

205 206
updateMultipleChoice :: ![ChoiceOption a] ![a] [a] -> Task [a] | iTask a
updateMultipleChoice options container sel = editMultipleChoice options container sel
207

208 209
updateMultipleChoiceAs :: ![ChoiceOption o] ![o] !(o -> a) [a] -> Task [a] | iTask o & iTask a
updateMultipleChoiceAs options container targetFun sel = editMultipleChoiceAs options container targetFun sel
210

211 212
editChoiceWithShared :: ![ChoiceOption a] !(sds () [a] w) (Maybe a) -> Task a | iTask a & TC w & RWShared sds
editChoiceWithShared options container mbSel = editChoiceWithSharedAs options container id mbSel
213

214 215 216
editChoiceWithSharedAs :: ![ChoiceOption o] !(sds () [o] w) (o -> a) (Maybe a) -> Task a | iTask o & TC w & iTask a & RWShared sds
editChoiceWithSharedAs vopts sharedContainer target mbSel
	= editSelectionWithShared [SelectMultiple False:selectOptions target vopts] sharedContainer (findIndex target mbSel) @? tvHd
217

218 219
editMultipleChoiceWithShared :: ![ChoiceOption a] !(sds () [a] w) [a] -> Task [a] | iTask a & TC w & RWShared sds
editMultipleChoiceWithShared options container sel = editMultipleChoiceWithSharedAs options container id sel
220

221 222 223
editMultipleChoiceWithSharedAs :: ![ChoiceOption o] !(sds () [o] w) (o -> a) [a] -> Task [a] | iTask o & TC w & iTask a & RWShared sds
editMultipleChoiceWithSharedAs vopts sharedContainer target sel
	= editSelectionWithShared [SelectMultiple True:selectOptions target vopts] sharedContainer (findIndices target sel)
224

225 226
enterChoiceWithShared :: ![ChoiceOption a] !(sds () [a] w) -> Task a | iTask a & TC w & RWShared sds
enterChoiceWithShared options container = editChoiceWithShared options container Nothing
227

228 229
enterChoiceWithSharedAs :: ![ChoiceOption o] !(sds () [o] w) (o -> a) -> Task a | iTask o & TC w & iTask a & RWShared sds
enterChoiceWithSharedAs options container targetFun = editChoiceWithSharedAs options container targetFun Nothing
230

231 232
enterMultipleChoiceWithShared :: ![ChoiceOption a] !(sds () [a] w) -> Task [a] | iTask a & TC w & RWShared sds
enterMultipleChoiceWithShared options container = editMultipleChoiceWithShared options container []
233

234 235
enterMultipleChoiceWithSharedAs :: ![ChoiceOption o] !(sds () [o] w) (o -> a) -> Task [a] | iTask o & TC w & iTask a & RWShared sds
enterMultipleChoiceWithSharedAs options container targetFun = editMultipleChoiceWithSharedAs options container targetFun []
236

237 238
updateChoiceWithShared :: ![ChoiceOption a] !(sds () [a] w) a -> Task a | iTask a & TC w & RWShared sds
updateChoiceWithShared options container sel = editChoiceWithShared options container (Just sel)
239

240 241
updateChoiceWithSharedAs :: ![ChoiceOption o] !(sds () [o] w) (o -> a) a -> Task a | iTask o & TC w & iTask a & RWShared sds
updateChoiceWithSharedAs options container targetFun sel = editChoiceWithSharedAs options container targetFun (Just sel)
242

243 244
updateMultipleChoiceWithShared :: ![ChoiceOption a] !(sds () [a] w) [a] -> Task [a] | iTask a & TC w & RWShared sds
updateMultipleChoiceWithShared options container sel = editMultipleChoiceWithShared options container sel
245

246 247
updateMultipleChoiceWithSharedAs :: ![ChoiceOption o] !(sds () [o] w) (o -> a) [a] -> Task [a] | iTask o & TC w & iTask a & RWShared sds
updateMultipleChoiceWithSharedAs options container targetFun sel = editMultipleChoiceWithSharedAs options container targetFun sel
248

249 250
editSharedChoice :: ![ChoiceOption a] ![a] (Shared sds (Maybe a)) -> Task a | iTask a & RWShared sds
editSharedChoice options container sharedSel = editSharedChoiceAs options container id sharedSel
251

252 253 254
editSharedChoiceAs :: ![ChoiceOption o] ![o] !(o -> a) (Shared sds (Maybe a)) -> Task a | iTask o & iTask a & RWShared sds
editSharedChoiceAs vopts container target sharedSel
	= editSharedSelection [SelectMultiple False:selectOptions target vopts] container (findIndexShare target container sharedSel) @? tvHd
255

256 257
editSharedMultipleChoice :: ![ChoiceOption a] ![a] (Shared sds [a]) -> Task [a] | iTask a & RWShared sds
editSharedMultipleChoice options container sharedSel = editSharedMultipleChoiceAs options container id sharedSel
258

259 260 261
editSharedMultipleChoiceAs :: ![ChoiceOption o] ![o] !(o -> a) (Shared sds [a]) -> Task [a] | iTask o & iTask a & RWShared sds
editSharedMultipleChoiceAs vopts container target sharedSel
	= editSharedSelection [SelectMultiple True:selectOptions target vopts] container (findIndicesShare target container sharedSel)
262

263 264
editSharedChoiceWithShared :: ![ChoiceOption a] !(sds1 () [a] w) (Shared sds2 (Maybe a)) -> Task a | iTask a & TC w & RWShared sds1 & RWShared sds2
editSharedChoiceWithShared options sharedContainer sharedSel = editSharedChoiceWithSharedAs options sharedContainer id sharedSel
265

266 267 268
editSharedChoiceWithSharedAs :: ![ChoiceOption o] !(sds1 () [o] w) (o -> a) (Shared sds2 (Maybe a)) -> Task a | iTask o & TC w & iTask a & RWShared sds1 & RWShared sds2
editSharedChoiceWithSharedAs vopts sharedContainer target sharedSel
	= editSharedSelectionWithShared [SelectMultiple False:selectOptions target vopts] sharedContainer (findIndexShareWithShared target (sharedContainer |*< sharedSel)) @? tvHd
269

270 271
editSharedMultipleChoiceWithShared :: ![ChoiceOption a] !(sds1 () [a] w) (Shared sds2 [a]) -> Task [a] | iTask a & TC w & RWShared sds1 & RWShared sds2
editSharedMultipleChoiceWithShared options sharedContainer sharedSel = editSharedMultipleChoiceWithSharedAs options sharedContainer id sharedSel
272

273 274 275
editSharedMultipleChoiceWithSharedAs :: ![ChoiceOption o] !(sds1 () [o] w) (o -> a) (Shared sds2 [a]) -> Task [a] | iTask o & TC w & iTask a & RWShared sds1 & RWShared sds2
editSharedMultipleChoiceWithSharedAs vopts sharedContainer target sharedSel
	= editSharedSelectionWithShared [SelectMultiple True:selectOptions target vopts] sharedContainer (findIndicesShareWithShared target (sharedContainer |*< sharedSel))
276

277
findIndex :: (o -> a) (Maybe a) [o] -> [Int] | gEq{|*|} a
278 279 280
findIndex target Nothing options = []
findIndex target (Just val) options = [i \\ o <- options & i <- [0..] | target o === val]

281
findIndices :: (o -> a) [a] [o] -> [Int] | gEq{|*|} a
282 283
findIndices target vals options = [i \\ o <- options & i <- [0..] | isMemberGen (target o) vals]

284
findIndexShare :: (o -> a) [o] (Shared sds (Maybe a)) -> SimpleSDSLens [Int] | TC a & RWShared sds & gEq{|*|} a
Haye Böhm's avatar
Haye Böhm committed
285
findIndexShare target options sds = mapReadWrite (tof sds target options,fromf sds target options) Nothing sds
286
where
287
	tof :: (Shared sds (Maybe a)) (o -> a) [o] (Maybe a) -> [Int] |  gEq{|*|} a
288
	tof _ target options mbv = findIndex target mbv options
289

290
	fromf :: (Shared sds (Maybe a)) (o -> a) [o] [Int] (Maybe a) -> Maybe (Maybe a) |  gEq{|*|} a
Haye Böhm's avatar
Haye Böhm committed
291
	fromf _ target options w _ = Just (listToMaybe (findSelection target options w))
292

293
findIndicesShare :: (o -> a) [o] (Shared sds [a]) -> SimpleSDSLens [Int] | TC a & RWShared sds & gEq{|*|} a
Haye Böhm's avatar
Haye Böhm committed
294
findIndicesShare target options sds = mapReadWrite (tof,fromf) Nothing sds
295 296
where
	tof v = findIndices target v options
Haye Böhm's avatar
Haye Böhm committed
297
	fromf w _ = Just (findSelection target options w)
298

Haye Böhm's avatar
Haye Böhm committed
299
findIndexShareWithShared target sds = mapReadWrite (tof,fromf) Nothing sds
300 301 302
where
	tof (options,mbv) = findIndex target mbv options

Haye Böhm's avatar
Haye Böhm committed
303
	fromf w (options,_) = Just (listToMaybe (findSelection target options w))
304

Haye Böhm's avatar
Haye Böhm committed
305
findIndicesShareWithShared target sds = mapReadWrite (tof,fromf) Nothing sds
306 307
where
	tof (options,mbv) = findIndices target mbv options
Haye Böhm's avatar
Haye Böhm committed
308
	fromf w (options,_) = Just (findSelection target options w)
309

310 311 312
wait :: (r -> Bool) !(sds () r w) -> Task r | iTask r & TC w & Registrable sds
wait pred shared
	=	viewSharedInformation [ViewAs (const "Waiting for information update")] shared
313
	>>* [OnValue (ifValue pred return)]
Haye Böhm's avatar
Haye Böhm committed
314

315
chooseAction :: ![(Action,a)] -> Task a | iTask a
316
chooseAction actions
317
	=	viewInformation [] ()
318 319 320
	>>* [OnAction action (always (return val)) \\ (action,val) <- actions]

viewTitle :: !a -> Task a | iTask a
321
viewTitle a = Title title @>> viewInformation [ViewAs view] a
322 323 324 325
where
	title = toSingleLineText a
	view a	= DivTag [] [SpanTag [StyleAttr "font-size: 30px"] [Text title]]

326
viewSharedTitle :: !(sds () r w) -> Task r | iTask r & Registrable sds & TC w
327 328
viewSharedTitle s = whileUnchanged s viewTitle

329
crudWith :: ![ChoiceOption r] [EnterOption r] [ViewOption r] [UpdateOption r]
330
            !((f r) -> [r]) !(r (f r) -> f` w) !(r (f r) -> f` w)
331
            (sds () (f r) (f` w))
332 333
         -> Task r | iTask r & iTask (f r) & iTask w & iTask (f` w) & RWShared sds
crudWith choiceOpts enterOpts viewOpts updateOpts toList putItem delItem sh = goCRUD
334 335
  where
  goCRUD
336
    =   enterChoiceWithShared choiceOpts (mapRead toList sh)
337 338 339 340 341 342
    >>* [ OnAction (Action "New")    (always   newItem)
        , OnAction (Action "View")   (hasValue viewItem)
        , OnAction (Action "Edit")   (hasValue editItem)
        , OnAction (Action "Delete") (hasValue deleteItem)
        ]
  newItem
343
    =            Title "New item" @>> enterInformation enterOpts
344
    >>= \item -> upd (putItem item) sh
Mart Lubbers's avatar
Mart Lubbers committed
345
    >-|          goCRUD
346
  viewItem x
347
    =            Title "View item" @>> viewInformation viewOpts x
348 349
    >>|          goCRUD
  editItem x
350
    =            Title "Edit item" @>> updateInformation updateOpts x
351
    >>= \item -> upd (putItem item) sh
Mart Lubbers's avatar
Mart Lubbers committed
352
    >-|          goCRUD
353 354
  deleteItem x
    =            upd (delItem x) sh
Mart Lubbers's avatar
Mart Lubbers committed
355
    >-|          goCRUD
356

357
crud :: !((f r) -> [r]) !(r (f r) -> f` w) !(r (f r) -> f` w)
358
        (sds () (f r) (f` w))
359 360
     -> Task r | iTask r & iTask (f r) & iTask w & iTask (f` w) & RWShared sds
crud toList putItem delItem sh = crudWith [] [] [] [] toList putItem delItem sh