--
--  Copyright 2014 Alessandro Gerlinger Romero
--
--  This file is part of Hybrid fUML.
--
--  Hybrid fUML is free software: you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation, either version 3 of the License, or
--  (at your option) any later version.
--  
--  Hybrid fUML is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--  
--  You should have received a copy of the GNU General Public License
--  along with Hybrid fUML. If not, see <http://www.gnu.org/licenses/>.
--

------------------------------------------------------------------------------------------------------------------------------------------------------------
-- DISCRETE DOMAIN 
--
-- APPROACH
-- instantiate a new agent with the activity when discrete domain is satisfied
-- if it is satisfied each evaluation multiple activities will be created
-- this inclusive allows activities with pause that can continue in the next macrostep

------------------------------------------------------------------------------------------------------------------------------------------------------------
-- RULES

-- rule called from the main block to check all discrete domains and start agents
rule_fUML_evaluateDiscreteDomains :: Rule()
rule_fUML_evaluateDiscreteDomains = if (function_fUML_objectsWithStereotypeForEvaluation DiscreteDomain) /= {} then do
										-- for all active objects, retrieve all its constraints, and evaluate
										forall (ao,c) <- function_fUML_retrieveDiscreteObjectAndConstraintEnabled do
																					rule_fUML_evaluateDomainAndStartAgent ao c 
									else
										skip

-- TODO LOW PRIORITY ONLY one activity is activated when a discrete domain is satisfied 
-- for now it is not possible starts two activities for the same constraint
rule_fUML_evaluateDomainAndStartAgent :: FUML_Semantics_Classes_Kernel_Value -> FUML_Syntax_Extensions_Classes_Kernel_Constraint -> Rule ()
rule_fUML_evaluateDomainAndStartAgent vl c = if (length el) /= 0 && function_Classifier_type(elact) == FUML_Syntax_Activities_IntermediateActivities_Activity && (function_fUML_evaluateBooleanExpression vl strspec) then do
												-- create an agent for the discrete domain
												ex <- (operatio_ExecutionFactory_createExecution f elact vl)
					 							-- create agent
												function_fUML_Agents(ex):= operatio_Value_Execution_execute
												-- setting mode 
												function_fUML_Agents_mode(ex) := FUML_Status_NotInitialized
												-- it has no parent
												skip
											else
												skip
						where
							f = (function_Locus_factory (function_Value_ExtensionalValue_locus vl))
							spec = function_Constraint_specification c
							strspec = function_ValueSpecification_LiteralString_value spec
							el = expr2list $ function_Constraint_constrainedElement_Classifier(c)
							elact = head $ el 
							
------------------------------------------------------------------------------------------------------------------------------------------------------------
-- GENERAL FUNCTIONS

-- check if this instance is a instance of an classifier marked with the stereotype 
function_fUML_objectStereotypeConstraint :: FUML_Semantics_Classes_Kernel_Value -> Stereotype -> {FUML_Syntax_Extensions_Classes_Kernel_Constraint}
function_fUML_objectStereotypeConstraint v s
								| function_Value_type(v) == FUML_Semantics_Classes_Kernel_Object = mkSet ddc 
								| otherwise = error( "function_fUML_objectStereotypeConstraint - unsupported valuetype " ++ show (function_Value_type v))
						where
							cl = function_fUML_oneClassifierType v
							ddc = filter (\c -> ((function_Constraint_AppliedStereotype(c) `intersect` {s}) /= {})) (expr2list $ function_Namespace_ownedRule cl)

-- get all active objects 
function_fUML_parentActiveObject :: FUML_Semantics_Classes_Kernel_Value -> FUML_Semantics_Classes_Kernel_Value 
function_fUML_parentActiveObject v = if length aos == 0 then FUML_Semantics_Classes_Kernel_ValueEmpty else head aos
						where
							aos = filter (\a -> (function_fUML_getAllPassiveObjectChilds a) `intersect` {v} /= {}) (expr2list function_fUML_activeObjects)

-- get all childs for a given object
-- it is a recursive function, all features in cascade (assumes acyclic dependency)
-- it does not retrieve active objects as childs
function_fUML_getAllPassiveObjectChilds :: FUML_Semantics_Classes_Kernel_Value -> {FUML_Semantics_Classes_Kernel_Value}
function_fUML_getAllPassiveObjectChilds o 
								| function_Value_type(o) == FUML_Semantics_Classes_Kernel_Object = mkSet $ map (\(v,f) -> v) $ expr2list $ function_fUML_getAllPassiveObjectChildsWithFeature o  
								| otherwise = error( "function_fUML_getAllPassiveObjectChilds - unsupported valuetype " ++ show (function_Value_type o))

-- look in all extensionals values of type object, classifier behavior running and it has discrete domain or its childs 
function_fUML_objectsWithStereotypeForEvaluation :: Stereotype -> {FUML_Semantics_Classes_Kernel_Value}
function_fUML_objectsWithStereotypeForEvaluation s = mkSet os 
						where
							ddao = function_fUML_activeObjects
							allo = ddao `union` (bigUnion $ mkSet (map (\v -> function_fUML_getAllPassiveObjectChilds v) (expr2list  ddao)))
							os = filter (\v -> (function_fUML_objectStereotypeConstraint v s) /= {}) (expr2list $ allo)

------------------------------------------------------------------------------------------------------------------------------------------------------------
-- DISCRETE DOMAIN FUNCTIONS

-- look in all extensionals values of type object, classifier behavior running and it has continuous domain 
function_fUML_retrieveDiscreteObjectAndConstraintEnabled :: [(FUML_Semantics_Classes_Kernel_Value,FUML_Syntax_Extensions_Classes_Kernel_Constraint)]
function_fUML_retrieveDiscreteObjectAndConstraintEnabled =  [(ao,c)| ao <- (expr2list $ function_fUML_objectsWithStereotypeForEvaluation DiscreteDomain), c <- (expr2list $ function_fUML_objectStereotypeConstraint ao DiscreteDomain), (function_fUML_discreteDomainIsEnabled ao c)]

-- look in all extensionals values of type object, classifier behavior running and it has continuous domain 
function_fUML_existsDiscreteDomainEnabled :: Bool
function_fUML_existsDiscreteDomainEnabled = length function_fUML_retrieveDiscreteObjectAndConstraintEnabled /= 0

-- TODO LOW PRIORITY ONLY one activity is activated when a discrete domain is satisfied 
-- for now it is not possible starts two activities for the same constraint
function_fUML_discreteDomainIsEnabled :: FUML_Semantics_Classes_Kernel_Value -> FUML_Syntax_Extensions_Classes_Kernel_Constraint -> Bool
function_fUML_discreteDomainIsEnabled vl c = if (length el) /= 0 && function_Classifier_type(elact) == FUML_Syntax_Activities_IntermediateActivities_Activity && (function_fUML_evaluateBooleanExpression vl strspec) then True	else False
						where
							spec = function_Constraint_specification c
							strspec = function_ValueSpecification_LiteralString_value spec
							el = expr2list $ function_Constraint_constrainedElement_Classifier(c)
							elact = head $ el