implementation module Collection

import iTasks
/*
* General purpose management task for a collection of data
*/
manageCollection :: !d !String (c -> i) (Shared [c]) -> Task (Maybe i) | descr d & iTask c & iTask i
manageCollection desc itemname identify collection
	= manageCollectionWith desc (selectItem ("Select " +++ itemname)) (viewItem ("Details of " +++ itemname))
		[AnyTime ActionNew (\_ -> addItem ("Add " +++ itemname) collection identify)
		,WithResult ActionEdit (const True) (editItem ("Edit " +++ itemname) collection (itemShare identify) identify)
		,WithResult ActionDelete (const True) (deleteItem ("Delete " +++ itemname,"Are you sure you want to delete the following " +++ itemname +++ "?") collection (itemShare identify) identify)
		]
		identify
		(itemShare identify)
		collection
/*
* Customizable management task for a collection of data
*/
manageCollectionWith ::
	!d																			//Description
	((Shared [c]) (ReadOnlyShared (Maybe i)) (c -> i) -> Task i)				//Make selection
	((Shared [c]) ((Shared [c]) i -> Shared (Maybe c)) (Maybe i) -> Task a)		//Use selection
	[TaskStep i (Maybe i)]														//Actions
	(c -> i)																	//Identification function
	((Shared [c]) i -> Shared (Maybe c))										//Item share function
	(Shared [c])																//Shared collection
	-> Task (Maybe i) | descr d & iTask c & iTask i & iTask a
manageCollectionWith desc makeSelection useSelection selectionActions identify itemShare collection
	= withShared Nothing (
		\selection ->
			parallel desc
				[(Embedded, \_ -> (makeSelection collection (toReadOnly selection) identify) @> (\i _ -> Just i,selection)	@ Just)
				,(Embedded, \l -> forever ((watch selection @? onlyJust) >>* actions l)										@ const Nothing)
				,(Embedded, \_ -> forever (whileUnchanged selection (useSelection collection itemShare))					@ const Nothing)
				] @? firstJust
	)
where
	selShare l = mapRead hd (taskListState l)

	actions list = [inParallel step \\ step <- selectionActions]
	where
		inParallel (AnyTime action taskf)
			= AnyTime action (\mbi -> (appendTask Embedded (\_ -> (taskf mbi) <<@ Window)) list)
		inParallel (WithResult action pred taskf)
			= WithResult action (const True) (\i -> appendTask Embedded (\_ -> (taskf i) <<@ Window) list)

	
	onlyJust (Just (Just x))	= Just x
	onlyJust _					= Nothing
	
	firstJust (Just [Just x:_])	= Just x
	firstJust _					= Nothing

itemShare :: (c -> i) (Shared [c]) i -> Shared (Maybe c) | gEq{|*|} i & gEq{|*|} c
itemShare identify collection i = mapReadWrite (toItem,fromItem) collection
where
	toItem l	= case [c \\ c <- l | identify c === i] of
		[c]		= Just c
		_		= Nothing
	
	fromItem Nothing l 		= Just l
	fromItem (Just c`) l	= Just [if (identify c === i) c` c \\ c <- l]

selectItem :: !d (Shared [c]) (ReadOnlyShared (Maybe i)) (c -> i) -> Task i | descr d & iTask c & iTask i
selectItem desc collection selection identify
	=	enterSharedChoice desc [] collection
	@	identify

viewItem :: !d (Shared [c]) ((Shared [c]) i -> Shared (Maybe c)) (Maybe i) -> Task (Maybe i) | descr d & iTask c & iTask i
viewItem desc collection itemShare Nothing	= viewInformation desc [] "Make a selection first..." @ const Nothing
viewItem desc collection itemShare (Just i)	= viewSharedInformation desc [] (itemShare collection i) @ const (Just i)

addItem :: !d (Shared [c]) (c -> i) -> Task (Maybe i) | descr d & iTask i & iTask c
addItem desc collection identify
	=	enterInformation desc []
	>>*	[AnyTime ActionCancel (\_ -> return Nothing)
		,WithResult ActionOk (const True) (\item -> update (\l -> l ++ [item]) collection >>| return (Just (identify item)))
		]

editItem :: !d (Shared [c]) ((Shared [c]) i -> Shared (Maybe c)) (c -> i) i -> Task (Maybe i) | descr d & iTask c & iTask i
editItem desc collection itemShare identify i
	=	get (itemShare collection i)
	>>= \mbItem -> case mbItem of
			Nothing		= (return Nothing)
			(Just item)	=	updateInformation desc [] item
						>>*	[AnyTime ActionCancel (\_ -> return Nothing)
							,WithResult ActionOk (const True) (\item` -> 
													update (\l -> [if (identify c === i) item` c \\ c <- l ]) collection
													>>| return (Just i)
												 )
							]

deleteItem :: !d (Shared [c]) ((Shared [c]) i -> Shared (Maybe c)) (c -> i) i -> Task (Maybe i) | descr d & iTask c & iTask i
deleteItem desc collection itemShare identify i
	=	viewSharedInformation desc [] (itemShare collection i)
	>>*	[AnyTime ActionNo (\_ -> return Nothing)
		,AnyTime ActionYes (\_ -> update (\l -> [c \\ c <- l | identify c =!= i]) collection >>| return Nothing)
		]

narrowDown :: !d (a -> b) (Shared [a]) (Shared (Maybe b)) -> Task (Maybe b) | descr d & iTask a & iTask b
narrowDown desc f options selection =
	updateSharedInformation desc [UpdateView (GetShared toView) fromView] (options |+< selection)
where
	//Use a grid choice type to indicate the choice to make the 
	toView (opts,sel)	= GridChoice [(a,a) \\ a <- opts] (selIndex 0 opts sel)

	//Write the selection to the shared
	fromView choice _ _ = fmap f (getMbSelection choice)

	selIndex i _ Nothing	= Nothing
	selIndex i [] _			= Nothing
	selIndex i [o:os] (Just sel) = if (f o === sel) (Just i) (selIndex (inc i) os (Just sel))