implementation module InteractionTasks

from StdFunc import id, const, o, flip
from SystemData import null
from Tuple import appSnd
from List import isMemberGen, instance Functor []
from Shared import makeReadOnlyShared
from Time import :: Timestamp(..)
from SharedDataSource import constShare
import StdBool, StdList, StdMisc, StdTuple
import CoreTasks, CoreCombinators, CommonCombinators, LayoutCombinators, SystemData

enterInformation :: !d ![LocalViewOn m] -> Task m | descr d & iTask m
enterInformation d views
	=	modifyInformation d (\_ _ -> defaultValue) filteredViews  voidNull Nothing @ fst
where
	filteredViews	= filterViews filterInputViews defaultViews views
	defaultViews	= [EnterView (\l _ _ -> l)]
	
updateInformation :: !d ![LocalViewOn m] m -> Task m | descr d & iTask m
updateInformation d views m
	=	modifyInformation d (\_ _ -> m) filteredViews voidNull Nothing @ fst
where
	filteredViews	= filterViews noFilter defaultViews views
	defaultViews	= [UpdateView (GetLocal id) (\l _ _ -> l)]
	
viewInformation :: !d ![LocalViewOn m] !m -> Task m | descr d & iTask m
viewInformation d views m
	=	modifyInformation d (\(Just m) _ -> m) filteredViews  voidNull (Just m) @ fst
where
	filteredViews	= filterViews filterOutputViews defaultViews views
	defaultViews	= [DisplayView (GetLocal id)]
		
updateSharedInformation :: !d ![ViewOn w r] !(ReadWriteShared r w) -> Task w | descr d & iTask r & iTask w
updateSharedInformation d views shared
	=	(modifyInformation d initLocal filteredViews (toReadOnly shared) Nothing @ fst) @> (\mbw _ -> mbw, shared)
where
	filteredViews						= filterViews noFilter defaultViews views	
	//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
	defaultViews = case dynamic id :: A.a: (a -> a) of
		(rtow :: (r^ -> w^))			= [UpdateView  (GetShared id) (\r _ _ -> rtow r)]
		_								= [DisplayView (GetShared id), EnterView (\w _ _ -> w)]
	
	initLocal = \_ r -> (makeInitFun filteredViews) r
	
	makeInitFun :: [ViewOn w r] -> (r -> w)
	makeInitFun views = case [v \\ v=:(UpdateView _ _) <- views] of
		[UpdateView toV fromV]	= makeInitFun2 toV fromV
		_						= abort "Cannot do updateSharedInformation without update views!"
	where
		makeInitFun2 :: (GetFun w r v) (SetFun w r v) -> (r -> w)
		makeInitFun2 (GetShared toV) fromV	= \r -> fromV (toV r) undef r
		makeInitFun2 _ _					= abort "Cannot do updateSharedInformation with something other than GetShared"


viewSharedInformation :: !d ![SharedViewOn r] !(ReadWriteShared r w) -> Task r | descr d & iTask r
viewSharedInformation d views shared
	=	modifyInformation d (\_ _ -> Void) filteredViews (toReadOnly shared) (Just Void) @ snd
where
	filteredViews	= filterViews filterOutputViews defaultViews views
	defaultViews	= [DisplayView (GetShared id)]
	
filterViews filterF defaultViews views = addDefault (catMaybes (map filterF views))	
where	
	addDefault views
		//If all given views are About views, add the default views
		| all (\v -> case v of (About _) = True; _ = False) views	= views ++ defaultViews
		| otherwise													= views
	
filterInputViews view = case view of
	About a						= Just (About a)
	EnterView e					= Just (EnterView e)
	UpdateView _ e				= Just (EnterView e)
	DisplayView (GetShared get)	= Just (DisplayView (GetShared get))
	_							= Nothing
		
filterOutputViews view = case view of
	About a				= Just (About a)
	DisplayView s		= Just (DisplayView s)
	UpdateView s _		= Just (DisplayView s)
	_					= Nothing
		
noFilter = Just

enterChoice :: !d ![ChoiceView ChoiceType o] !(container o) -> Task o | descr d & OptionContainer container & iTask o & iTask (container o)
enterChoice d views choiceOpts
	=	modifyChoice d views (constShare choiceOpts) Nothing

updateChoice :: !d ![ChoiceView ChoiceType o] !(container o) o -> Task o | descr d & OptionContainer container & iTask o & iTask (container o)
updateChoice d views choiceOpts initC
	=	modifyChoice d views (constShare choiceOpts) (Just initC)
	
enterSharedChoice :: !d ![ChoiceView ChoiceType o] !(ReadWriteShared (container o) w) -> Task o | descr d & OptionContainer container & iTask o & iTask w & iTask (container o)
enterSharedChoice d views shared
	=	modifyChoice d views shared Nothing

updateSharedChoice :: !d ![ChoiceView ChoiceType o] !(ReadWriteShared (container o) w) o -> Task o | descr d & OptionContainer container & iTask o & iTask w & iTask (container o)
updateSharedChoice d views shared initC
	=	modifyChoice d views shared (Just initC)

modifyChoice :: !d ![ChoiceView ChoiceType o] !(ReadWriteShared (container o) w) (Maybe o) -> Task o | descr d & OptionContainer container & iTask o & iTask w & iTask (container o)
modifyChoice d views shared mbInitSel = 
	transform justValid (modifyInformation d  (\_ _ -> mbInitSel) (toChoiceViews (addDefault views)) (toReadOnly shared) Nothing)
where
	toChoiceViews views = map toChoiceView views
	where
		toChoiceView view = case view of
			ChoiceContext v			= About v
			ChoiceView (type,viewF)	= choiceView type viewF
		
		choiceView type viewF = case type of
			//TEMPORARY TRICK. WE WOULD LIKE TO USE THE ACTUAL OPTIONS INSTEAD OF DEFAULT VALUE
			//NOT POSSIBLE ATM
			AutoChoiceView				= choiceView (determineAutoChoice shared defaultValue) viewF
			ChooseFromRadioButtons		= choiceView` mkRadioChoice
			ChooseFromComboBox			= choiceView` mkComboChoice
			ChooseFromGrid				= choiceView` mkGridChoice
			ChooseFromTree				= choiceView` mkTreeChoice
		where
			choiceView` mkF				= UpdateView (GetCombined (toChoice mkF viewF)) fromChoice
			
			determineAutoChoice :: (ReadWriteShared (container o) w) (container o) -> ChoiceType | OptionContainer container & iTask o & iTask (container o)
			determineAutoChoice _ options = suggestedChoiceType options
	 
		toChoice mkF viewF mbSel options
			= mkF (fmap (\o -> (viewF o, o)) options) mbSel
		
		fromChoice choice _ _		= getMbSelection choice
	
	addDefault views
		| any (\v -> case v of (ChoiceContext _) = False; _ = True) views	= views
		| otherwise															= views ++ [ChoiceView (AutoChoiceView, id)]

	justValid (Just (Just sel,_))	= Just sel
	justValid _						= Nothing

enterMultipleChoice :: !d ![ChoiceView MultiChoiceType o] !(container o) -> Task [o] | descr d & OptionContainer container & iTask o & iTask (container o)
enterMultipleChoice d views choiceOpts
	=	modifyMultipleChoice d views (constShare choiceOpts) []

updateMultipleChoice :: !d ![ChoiceView MultiChoiceType o] !(container o) [o] -> Task [o] | descr d & OptionContainer container & iTask o & iTask (container o)
updateMultipleChoice d views choiceOpts initC
	=	modifyMultipleChoice d views (constShare choiceOpts) initC

enterSharedMultipleChoice :: !d ![ChoiceView MultiChoiceType o] !(ReadWriteShared (container o) w) -> Task [o] | descr d & OptionContainer container & iTask o & iTask w & iTask (container o)
enterSharedMultipleChoice d views shared
	=	modifyMultipleChoice d views shared []

updateSharedMultipleChoice :: !d ![ChoiceView MultiChoiceType o] !(ReadWriteShared (container o) w) [o] -> Task [o] | descr d & OptionContainer container & iTask o & iTask w & iTask (container o)
updateSharedMultipleChoice d views shared sel 
	=	modifyMultipleChoice d views shared sel

modifyMultipleChoice d views shared initSels =
	(modifyInformation d (\_ _ -> initSels) (toChoiceViews (addDefault views))  (toReadOnly shared) Nothing @ fst)
where
	toChoiceViews views = map toChoiceView views
	where
		toChoiceView view = case view of
			ChoiceContext v			= About v
			ChoiceView (type,viewF)	= choiceView type viewF
		
		choiceView type viewF = case type of
			AutoMultiChoiceView			= choiceView (determineAutoChoice shared defaultValue) viewF
			ChooseFromCheckBoxes		= choiceView` mkCheckMultiChoice
		where
			choiceView` mkF				= UpdateView (GetCombined (toChoice mkF viewF)) fromChoice
			
			determineAutoChoice :: (ReadWriteShared (container o) w) (container o) -> MultiChoiceType | OptionContainer container & iTask o & iTask (container o)
			determineAutoChoice _ options = suggestedMultiChoiceType options

	choiceView mkF viewF				= UpdateView (GetCombined (toChoice mkF viewF), fromChoice)
	toChoice mkF viewF mbSel options	= mkF (fmap (\o -> (viewF o, o)) options) mbSel
	fromChoice choice _ _				= getSelections choice
	
	addDefault views
		| any (\v -> case v of (ChoiceContext _) = False; _ = True) views	= views
		| otherwise															= views ++ [ChoiceView (AutoMultiChoiceView, id)]

modifyInformation :: !d !((Maybe l) r -> l) ![ViewOn l r] !(ReadOnlyShared r) (Maybe l) -> Task (l,r) | descr d & iTask l & iTask r
modifyInformation d initl views shared mbl = interact d initl [part v \\ v <- views] mbl shared
where
	part (About a)						= DisplayPart (\_ _ -> a)
	part (DisplayLocal getfun)			= DisplayPart (viewLocal getfun)
	part (EnterLocal setfun)			= FormPart blankInit ignoreShareUpdate (whenValidViewUpdate (\v _ _ -> setfun v))
	part (UpdateLocal getfun setfun)	= undef
	part (DisplayShared getfun)			= DisplayPart (viewShared getfun)
	part (UpdateShared getfun setfun)	= undef

	part (EnterView setfun)				= FormPart blankInit ignoreShareUpdate (whenValidViewUpdate setfun)
	part (UpdateView getfun setfun)		= FormPart (filledInit getfun) (onChangedShareUpdate getfun) (whenValidViewUpdate setfun)
	part (DisplayView getfun)			= DisplayPart (viewVal getfun)

	blankInit :: FormInitFun l r v
	blankInit = \l r -> BlankForm
	
	filledInit :: (GetFun l r v) -> FormInitFun l r v
	filledInit getfun = \l r -> FilledForm (viewVal getfun l r) 
	
	//Ignore changes in the share completely
	ignoreShareUpdate :: FormShareUpdateFun l r v
	ignoreShareUpdate = \mbl r mbv dirty -> (mbl,Nothing) //Don't change the result, don't change the view
	
	//Refresh the view if the share has changed
	onChangedShareUpdate :: (GetFun l r v) -> FormShareUpdateFun l r v
	onChangedShareUpdate getfun = \l r mbv _ -> (l, Just (FilledForm (viewVal getfun l r)))
	
	//Refresh the view if it hasn't been touched by the user yet
	whenCleanShareUpdate :: (GetFun l r v) -> FormShareUpdateFun l r v
	whenCleanShareUpdate getfun = \l r mbv dirty -> (l, if dirty Nothing (Just (FilledForm (viewVal getfun l r))))
	
	
	viewLocal :: (l -> v) l r -> v | iTask l
	viewLocal f l r = f l
	
	viewShared :: (r -> v) l r -> v
	viewShared f l r = f r
	
	viewVal :: (GetFun l r v) l r -> v
	viewVal (GetLocal f) l _ 	= f l
	viewVal (GetShared f) _ r	= f r
	viewVal (GetCombined f) l r	= f l r
	
	whenValidViewUpdate :: (SetFun l r v) -> FormViewUpdateFun l r v
	whenValidViewUpdate f = \l r mbv -> case mbv of
		Just v	= (f v l r, Nothing)
		Nothing	= (l, Nothing)
		
wait :: !d (r -> Bool) !(ReadWriteShared r w) -> Task r | descr d & iTask r
wait desc pred shared
	=	viewSharedInformation desc [DisplayView (GetLocal id)] shared
	>>* [WhenValid pred return]
	
waitForTime :: !Time -> Task Time
waitForTime time =
	viewSharedInformation ("Wait for time", ("Wait until " +++ toString time)) [] currentTime >>* [WhenValid (\now -> time < now) return]

waitForDate :: !Date -> Task Date
waitForDate date =
	viewSharedInformation ("Wait for date", ("Wait until " +++ toString date)) [] currentDate >>* [WhenValid (\now -> date < now) return]
	
waitForDateTime :: !DateTime -> Task DateTime
waitForDateTime datetime =
	viewSharedInformation ("Wait for date and time", ("Wait until " +++ toString datetime)) [] currentDateTime >>* [WhenValid (\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
	=	SetLayout hideLayout 
	@>> interact "Choose an action" (\_ _ -> Void) [] Nothing voidNull
	>>* [AnyTime action (\_ -> return val) \\ (action,val) <- actions]
	
voidNull :: Shared Void
voidNull = null