implementation module CommonCombinators
/**
* This module contains a collection of useful iTasks combinators defined in terms of the basic iTask combinators
*/
import StdBool, StdList,StdOrdList, StdTuple, StdGeneric, StdMisc, StdInt, StdClass, GenRecord, Text, Time, Tuple, List
import Util, Either, GenVisualize, GenUpdate
from StdFunc			import id, const, o
from SystemTypes		import :: User(..), :: Note(..)
from TaskContext		import :: TaskState(..), :: ParallelMeta, :: ParallelItem
from SystemData			import randomInt, topLevelTasks

import CoreTasks, CoreCombinators, InteractionTasks, LayoutCombinators

(>>*) infixl 1 :: !(Task a) ![TaskStep a b] -> Task b | iTask a & iTask b
(>>*) task steps = step task steps 

(>>=) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>=) taska taskbf = step taska [WithResult ActionContinue (const True) taskbf, WhenStable taskbf]

(>>!) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iTask a & iTask b
(>>!) taska taskbf = step taska [WithResult ActionContinue (const True) taskbf]

(>>|) infixl 1 :: !(Task a) (Task b) -> Task b | iTask a & iTask b
(>>|) taska taskb = step taska [WhenStable (const taskb)]

(>>^) infixl 1 :: !(Task a) (Task b) -> Task a | iTask a & iTask b
(>>^) taska taskb = taska >>= \x -> taskb >>| return x

(@?) infixl 1 :: !(Task a) !((Maybe a) -> Maybe b) -> Task b | iTask a & iTask b
(@?) task f = transform f task

(@) infixl 1 :: !(Task a) !(a -> b) -> Task b | iTask a & iTask b
(@) task f = transform (fmap f) task

(@>) infixl 1 :: !(Task a) !((Maybe a) r -> Maybe w, ReadWriteShared r w) -> Task a | iTask a
(@>) task (f,share) = project f share task

(<<@) infixl 2 :: !(Task a) !b	-> Task a | tune b
(<<@) t a = tune a t

(@>>) infixr 2 :: !b !(Task a)	-> Task a | tune b
(@>>) a t = tune a t

try :: !(Task a) (e -> Task a) -> Task a | iTask a & iTask, toString e
try task handler = step task [WhenStable return, Catch handler]

catchAll :: !(Task a) (String -> Task a) -> Task a | iTask a
catchAll task handler = step task [WhenStable return, CatchAll handler]

//Helper functions for projections
projectJust :: (Maybe a) r -> Maybe (Maybe a)
projectJust mba _ = Just mba
/*
* When a task is assigned to a user a synchronous task instance process is created.
* It is created once and loaded and evaluated on later runs.
*/
assign :: !ManagementMeta !(Task a) -> Task a | iTask a
assign props task
	=	parallel Void
			[(Embedded, \s -> processControl s),(Detached props, \_ -> task)]
	@?	justResult
where
	processControl tlist =
		(enterSharedChoice ("Waiting","Waiting for " <+++ task) [] (taskListMeta tlist))
		@? const Nothing
					
	toView [_,{TaskListItem|progressMeta=Just p,managementMeta=Just m}]=
		{ assignedTo	= m.ManagementMeta.worker
		, priority		= m.ManagementMeta.priority
		, issuedAt		= Display (Just p.ProgressMeta.issuedAt)
		, issuedBy		= Display (Just p.ProgressMeta.issuedBy)
		, firstWorkedOn	= Display p.ProgressMeta.firstEvent
		, lastWorkedOn	= Display p.ProgressMeta.latestEvent
		}
	toView [_,_]=
		{ assignedTo	= Nothing
		, priority		= NormalPriority
		, issuedAt		= Display Nothing
		, issuedBy		= Display Nothing
		, firstWorkedOn	= Display Nothing
		, lastWorkedOn	= Display Nothing
		}	
	fromView view=:{ProcessControlView|assignedTo} _ _
		= []// [UpdateProperties 1 {mapRecord view & worker = assignedTo}]
		
	formatTimestamp timestamp = timestampToGmDateTime timestamp
	
	justResult (Just [_,Just a])	= Just a
	justResult _					= Nothing
	
	
:: ProcessControlView =	{ assignedTo	:: !Maybe User
						, priority		:: !TaskPriority
						, issuedAt		:: !Display (Maybe DateTime)
						, issuedBy		:: !Display (Maybe User)
						, firstWorkedOn	:: !Display (Maybe DateTime)
						, lastWorkedOn	:: !Display (Maybe DateTime)
						}
derive class iTask ProcessControlView
derive class GenRecord ProcessControlView, ManagementMeta, TaskPriority

(@:) infix 3 :: !User !(Task a) -> Task a | iTask a
(@:) user task = assign {noMeta & worker = Just user} task

justdo :: !(Task (Maybe a)) -> Task a | iTask a
justdo task
= task >>= \r -> case r of
	Just x	= return x
	Nothing	= throw ("The task returned nothing.")

sequence :: !String ![Task a]  -> Task [a] | iTask a
sequence label tasks = Title label @>> (seqTasks tasks)
where
	seqTasks []		= return []
	seqTasks [t:ts]	= t >>= \a -> seqTasks ts >>= \as -> return [a:as]

//Repeat task until the predicate holds (loops if the predicate is false)
(<!) infixl 6 :: !(Task a) !(a -> .Bool) -> Task a | iTask a
(<!) task pred
	= parallel Void [(Embedded, checked pred task)] @? res
where
	checked pred task tlist
		=	task
		>>* [WhenStable (\a -> if (pred a) (return (Just a)) (restart (checked pred task) tlist))]
		
	res (Just [Just (Just a)])	= Just a
	res _						= Nothing
	
	restart task tlist
		=	get (taskListMeta tlist)
		>>= \[{TaskListItem|taskId}:_] ->
			removeTask taskId tlist -&&- appendTask Embedded task tlist
		@	const Nothing 

forever :: !(Task a) -> Task a | iTask a	
forever	t = (t <! (const False))

(-||-) infixr 3 :: !(Task a) !(Task a) -> (Task a) | iTask a
(-||-) taska taskb
	= parallel Void
		[(Embedded, \_ -> taska),(Embedded, \_ -> taskb)] @? res
where
	res (Just [Just a,_]) 		= Just a
	res (Just [Nothing,Just a])	= Just a
	res _						= Nothing
	
(||-) infixr 3 :: !(Task a) !(Task b) -> Task b | iTask a & iTask b
(||-) taska taskb
	= parallel Void
		[(Embedded, \_ -> taska @ Left),(Embedded, \_ -> taskb @ Right)] @? res
where
	res	(Just [_,Just (Right b)])	= Just b
	res _							= Nothing
	
(-||) infixl 3 :: !(Task a) !(Task b) -> Task a | iTask a & iTask b
(-||) taska taskb
	= parallel Void
		[(Embedded, \_ -> taska @ Left),(Embedded, \_ -> taskb @ Right)] @? res			
where
	res	(Just [Just (Left a),_])	= Just a
	res _							= Nothing
	
(-&&-) infixr 4 :: !(Task a) !(Task b) -> (Task (a,b)) | iTask a & iTask b
(-&&-) taska taskb
	= parallel Void
		[(Embedded, \_ -> taska @ Left),(Embedded, \_ -> taskb @ Right)] @? res
where
	res (Just [Just (Left a),Just (Right b)])	= Just (a,b)
	res _										= Nothing

(>&>) infixl 1  :: (Task a) ((ReadOnlyShared (Maybe a)) -> Task b) -> Task b | iTask a & iTask b
(>&>) taska taskbf = parallel Void
		[(Embedded, \s -> taska @ Left)
		,(Embedded, \s -> taskbf (mapRead prj (toReadOnly (taskListState s))) @ Right)
		]
	@? res
where
	prj [Just (Left a),_]			= Just a
	prj _							= Nothing
	
	res (Just [_,Just (Right b)])	= Just b
	res _							= Nothing
				
:: ProcessOverviewView =	{ index			:: !Hidden Int
							, subject		:: !Display String
							, assignedTo	:: !User
							}

derive class iTask ProcessOverviewView

anyTask :: ![Task a] -> Task a | iTask a
anyTask tasks
	= parallel Void [(Embedded,const t) \\ t <- tasks] @? res
where	
	res (Just ([Just a:_]))		= Just a
	res (Just ([Nothing:as]))	= res (Just as)
	res _ 						= Nothing

allTasks :: ![Task a] -> Task [a] | iTask a
allTasks tasks
	= parallel Void
		[(Embedded,const t) \\ t <- tasks] @? res
where
	res (Just [])				= Just []
	res (Just [Just a:mbas])	= case res (Just mbas) of
		Just as = Just [a:as]
		Nothing	= Nothing
	res _						= Nothing
				
eitherTask :: !(Task a) !(Task b) -> Task (Either a b) | iTask a & iTask b
eitherTask taska taskb
	= parallel Void
		[(Embedded, \s -> (taska @ Left))
		,(Embedded, \s -> (taskb @ Right))
		] @? res
where
	res (Just [Just la,_])	= Just la
	res (Just [_,Just rb])	= Just rb
	res _					= Nothing 

randomChoice :: ![a] -> Task a | iTask a
randomChoice [] = throw "Cannot make a choice from an empty list"
randomChoice list = get randomInt >>= \i -> return (list !! ((abs i) rem (length list)))

repeatTask :: !(a -> Task a) !(a -> Bool) a -> Task a | iTask a
repeatTask task pred a =
	task a >>= \na -> if (pred na) (return na) (repeatTask task pred na)

whileUnchanged :: !(ReadWriteShared r w) (r -> Task b) -> Task b | iTask r & iTask w & iTask b
whileUnchanged share task
	= ((	get share	
		>>= \val ->
			(task val @ Just) -||- (wait "watching share change" ((=!=) val) share >>| return Nothing)
		)
	<! isJust) @ fromJust
	
appendTopLevelTask :: !ManagementMeta !(Task a) -> Task TaskId | iTask a
appendTopLevelTask props task = appendTask (Detached props) (\_ -> task @ const Void) topLevelTasks @ \topNo -> (TaskId topNo 0)

appendTopLevelTaskFor :: !User !(Task a) -> Task TaskId | iTask a
appendTopLevelTaskFor user task = appendTopLevelTask {noMeta & worker = Just user} task

instance tune BeforeLayout
where tune (BeforeLayout f) task = tune (ModifyLayout (\l t0 pa0 ac0 at0 -> let (t1,pa1,ac1,at1) = f (t0,pa0,ac0,at0) in l t1 pa1 ac1 at1)) task
		
instance tune AfterLayout
where tune (AfterLayout f) task	= tune (ModifyLayout (\l -> (\t pa ac at -> (f (l t pa ac at))))) task

instance tune Title
where tune (Title title) task = tune (BeforeLayout (\(t,pa,ac,at) -> (t,pa,ac,kvSet TITLE_ATTRIBUTE title at))) task
instance tune Icon 
where tune (Icon icon) task = tune (BeforeLayout (\(t,pa,ac,at) -> (t,pa,ac,kvSet ICON_ATTRIBUTE icon at))) task
instance tune Attribute
where tune (Attribute k v) task = tune (BeforeLayout (\(t,pa,ac,at) -> (t,pa,ac,kvSet k v at))) task
instance tune Window
where tune Window task = task