implementation module FlowData
 
import 	iTasks, TaskContainer
from FormFlowStorage import findValue, findFlow

// import get_dictionary

derive class iTask	Flow, FlowShape, AssignInfo, CleanExpr			
derive bimap	Maybe, (,)

:: Flow			= 	{ flowShape :: ![FlowShape]
			  		, flowDyn 	:: !Dynamic
			  		}
:: FlowShape	= 	Editor 			!String	
				| 	DisplayIt		!String 		
				| 	Return
				|	Assign			!AssignInfo ![FlowShape]
				| 	Or  !([FlowShape], ![FlowShape])
				| 	And !([FlowShape], ![FlowShape])
				|	FormFromStore 	!String
				|	FlowFromStore 	!String
				|	CleanExpr		!CleanExpr
				| 	First
				| 	Second
:: AssignInfo	= 	{ nameOfUser:: !User
			  		, taskName 	:: !String
			  		}
:: CleanExpr	=	CI Int
				|	CR Real
				|	CB Bool
				|	CS String
				|	VoidVal
				|	CE String

emptyFlow :: Flow
emptyFlow 		= 	{ flowShape = []
					, flowDyn = dynamic "Flow not initialized" :: String
					}

flowShapeToFlow :: ![FlowShape] -> Task Flow
flowShapeToFlow flowShape 
	=					flowShapeToFlowDyn flowShape
		>>= \flowDyn ->	if (validTask flowDyn || validTaskFun flowDyn) 
							(return {flowShape = flowShape, flowDyn = flowDyn}) 
							(throw (typeErrorMess "not a legal workflow, " flowDyn))
		>>|				return {flowShape = flowShape, flowDyn = flowDyn}

		
flowShapeToFlowDyn :: ![FlowShape] -> Task Dynamic  
flowShapeToFlowDyn [] 		= throw "A list in a flow has to be non empty."
flowShapeToFlowDyn flows 	= mapMonad translate flows >>= \[d:ds] -> return (applyFlows d ds)
where
	mapMonad :: (FlowShape -> Task Dynamic) [FlowShape] -> Task [Dynamic]	
	mapMonad fun [] 	= return []
	mapMonad fun [d:ds] = fun d >>= \nd -> mapMonad fun ds >>= \nds -> return [nd:nds] 

translate :: !FlowShape -> Task Dynamic
translate (Editor prompt)		= return (dynamic DF0 (updateInformation "Edit" prompt)	:: A.a: DF0 a a 	| iTask a)

translate (DisplayIt prompt)	= return (dynamic DF0 (\v -> showMessageAbout "Display" prompt v >>| return Void)	:: A.a: DF0 a Void 	| iTask a)
translate Return			  	= return (dynamic DF0 (\v -> return v) 				:: A.a: DF0 a a 	| iTask a)

translate (Or (left, right))	= flowShapeToFlowDyn left >>= \leftflow -> flowShapeToFlowDyn right >>= \rightflow -> checkOr leftflow rightflow
where
	checkOr :: Dynamic Dynamic -> Task Dynamic
	checkOr (ta1 :: DF0 a b | iTask a) (ta2 :: DF0 a b | iTask a)  
		= return (dynamic (case (ta1,ta2) of
								(DF0 ta1, DF0 ta2) -> DF0 (\a -> ta1 a -||- ta2 a)) :: DF0 a b | iTask a)
	checkOr d1 d2
		= throw (typeErrorMess2 "Or" d1 d2)

translate (And (left, right))	= flowShapeToFlowDyn left >>= \leftflow -> flowShapeToFlowDyn right >>= \rightflow -> checkAnd leftflow rightflow
where
	checkAnd :: Dynamic Dynamic -> Task Dynamic					
	checkAnd (atb :: DF0 a b | iTask a) (tac :: DF0 a c | iTask a)  
		= return (dynamic (case (atb,tac) of
								(DF0 atb, DF0 tac) -> DF0 (\a -> atb a -&&- tac a)) :: DF0 a (b,c) | iTask a)
	checkAnd d1 d2	
		= throw (typeErrorMess2 "And" d1 d2)

translate (Assign info flow)	= flowShapeToFlowDyn flow >>= assignTask info
where
	assignTask :: !AssignInfo !Dynamic -> Task Dynamic
	assignTask info (e :: DF0 a b | iTask a) 	
		= return (dynamic (case e of
							(DF0 e) ->  DF0 (\v -> assign info.nameOfUser (e v <<@ Subject info.taskName))) :: DF0 a b | iTask a)
	assignTask info d 									
		= throw (typeErrorMess "Assign" d)

translate First	
	= return (dynamic DF0 (\(a,b) -> return a) :: A.a b: DF0 (a,b) a | iTask a)
translate Second
	= return (dynamic DF0 (\(a,b) -> return b) :: A.a b: DF0 (a,b) b | iTask b)

translate (FormFromStore name) 	= findValue name
translate (FlowFromStore name) 	= findFlow name

translate (CleanExpr VoidVal )	= return (dynamic DT (return Void) 	:: DT Void) 
translate (CleanExpr (CI i))	= return (dynamic DT (return i)		:: DT Int) 
translate (CleanExpr (CR r))	= return (dynamic DT (return r)		:: DT Real) 
translate (CleanExpr (CB b))	= return (dynamic DT (return b)		:: DT Bool) 
translate (CleanExpr (CS s))	= return (dynamic DT (return s)		:: DT String) 
translate (CleanExpr (CE s))	= return (dynamic "Not implemented")

applyDynFlows :: ![Dynamic] -> Dynamic 
applyDynFlows [] 		= dynamic "Cannot apply empty list of flows"
applyDynFlows [h:tl] 	= applyFlows h tl


applyFlows :: Dynamic [Dynamic] -> Dynamic 

// first simplify unnecessary context restrictions

applyFlows (atb:: DF0 a b | iTask a & iTask a) dyns 			
	=  applyFlows (dynamic atb :: DF0 a b | iTask a ) dyns 						
applyFlows dyn [] 
	= dyn

// dynamic apply on flow: val |> a -> Tb 

applyFlows (DV0 a::DV0 a) [(DF0 atb :: DF0 a b): dyns] 						// a |> atb -> atb a 			
	= applyFlows (dynamic DT (atb a) :: DT b) dyns

applyFlows (DV0 a::DV0 a) [(DF0 atb :: DF0 a b | iTask a): dyns] 			// a |> atb | iT a -> atb a		
	= applyFlows (dynamic DT (atb a) :: DT b) dyns

// dynamic apply on flow: task |> a -> Tb 

applyFlows (DT ta::DT a) [(atb :: DF0 a b): dyns]							// ta |> atb -> ta >>= atb				
	= applyFlows (dynamic (case atb of
				(DF0 atb) -> DT (ta >>= atb)) :: DT b) dyns

applyFlows (DT ta::DT a) [(atb :: DF0 a b | iTask a): dyns]					// ta |> atb | iT a -> ta >>= atb					
	= applyFlows (dynamic (case atb of
				(DF0 atb) -> DT (ta >>= atb)) :: DT b) dyns

applyFlows (DT ta::DT a) [(atb :: DF0 a b | iTask b): dyns]					// ta |> atb | iT b -> ta >>= atb					
	= applyFlows (dynamic (case atb of
				(DF0 atb) -> DT (ta >>= atb)) :: DT b | iTask b) dyns

// dynamic apply on flow: a -> Tb |> b -> Tc 

applyFlows (atb:: DF0 a b) [(btc :: DF0 b c): dyns]							// ftaskb |> ftaskc -> ftaskb >>= ftaskc	
	=  applyFlows (dynamic (case atb of
								(DF0 atb)->
										case btc of
												(DF0 btc)-> DF0 (\a -> atb a >>= btc)) :: DF0 a c) dyns 

applyFlows (atb:: DF0 a b | iTask a) [(btc :: DF0 b c): dyns]				// ftaskb |> ftaskc -> ftaskb >>= ftaskc	
	=  applyFlows (dynamic (case atb of
								(DF0 atb)->
										case btc of
												(DF0 btc)-> DF0 (\a -> atb a >>= btc)) :: DF0 a c | iTask a ) dyns 

applyFlows (atb:: DF0 a b | iTask a) [(btc :: DF0 b c | iTask b): dyns]		// ftaskb |> ftaskc -> ftaskb >>= ftaskc	
	=  applyFlows (dynamic (case atb of
								(DF0 atb)->
										case btc of
												(DF0 btc)-> DF0 (\a -> atb a >>= btc)) :: DF0 a c | iTask a ) dyns 


applyFlows (atb:: DF0 a b | iTask a) [(btc :: DF0 b c | iTask c): dyns]		// ftaskb |> ftaskc -> ftaskb >>= ftaskc	
	=  applyFlows (dynamic (case atb of
								(DF0 atb)->
										case btc of
												(DF0 btc)-> DF0 (\a -> atb a >>= btc)) :: DF0 a c | iTask a & iTask c) dyns 

applyFlows d [d1:_]																		
	= dynamic  (typeErrorMess2 "Cannot apply" d d1)