{-# LANGUAGE CPP, FlexibleContexts #-}
{-
	Copyright (C) 2013-2015 Dr. Alistair Ward

	This file is part of WeekDaze.

	WeekDaze 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.

	WeekDaze 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 WeekDaze.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	Describes all the /teacher/s available to be booked in the timetable, in terms of their name & their attributes.
-}

module WeekDaze.Aggregate.TeacherRegister(
-- * Types
-- ** Type-synonyms
	TeacherRegister,
	CoursesByTeacherId,
	CoursesByTeacherIdBySynchronisationId,
	NTimeslotsByTeacherIdBySubject,
-- * Constants
	tag,
-- * Functions
	calculateWorkloadBoundsBySubject,
	countAvailableTeacherDays,
	extractDistinctCourses,
	extractDistinctOwnLocationIds,
	extractDistinctSubjects,
--	extractDistinctRequiredFacilityNames,
	findSuitableCourseByTeacherId,
	findCoursesByTeacherIdBySynchronisationId,
	findDistinctCoursesBySynchronisationId,
	findSpecifiedTimes,
	findSubjectsOfferedInMultipleCoursesRequiringDifferentLessonsPerWeek,
	mergeConstraintsOnSynchronisedCourses,
	countLessonsPerWeekByFacilityName,
-- ** Accessors
	getTeacherIds,
	getTeacherProfiles,
#ifdef USE_HDBC
-- ** Constructor
	fromDatabase,
#endif
-- ** Predicates
	hasAnyFreePeriodPreference,
	hasAnySynchronisedCourses,
	hasAnyIdealTimeslotRequests,
	hasAnyCourseMaximumClassSizes,
	hasAnySpecificTimeRequests,
	hasAnyTimeslotRequests,
	hasAnySpecialists,
	isInhabited
) where

import qualified	Control.Arrow
import			Control.Arrow((&&&), (***))
import qualified	Data.Foldable
import qualified	Data.Map
import			Data.Map((!))
import qualified	Data.Maybe
import qualified	Data.Set
import qualified	WeekDaze.Data.Course			as Data.Course
import qualified	WeekDaze.Data.HumanResource		as Data.HumanResource
import qualified	WeekDaze.Data.Location			as Data.Location
import qualified	WeekDaze.Data.Resource			as Data.Resource
import qualified	WeekDaze.Data.Subject			as Data.Subject
import qualified	WeekDaze.Data.Teacher			as Data.Teacher
import qualified	WeekDaze.Size				as Size
import qualified	WeekDaze.Temporal.Time			as Temporal.Time
import qualified	WeekDaze.Temporal.TimeslotRequest	as Temporal.TimeslotRequest
import qualified	WeekDaze.Temporal.Workload		as Temporal.Workload

#ifdef USE_HDBC
import qualified	Database.HDBC
import qualified	Data.Convertible
import qualified	Data.IntMap
import qualified	Data.Typeable
import qualified	WeekDaze.Database.Selector		as Database.Selector
import qualified	WeekDaze.Data.Group			as Data.Group
import qualified	WeekDaze.Temporal.Availability		as Temporal.Availability
import qualified	WeekDaze.Temporal.Day			as Temporal.Day
import qualified	WeekDaze.Temporal.FreePeriodPreference	as Temporal.FreePeriodPreference

{- |
	* Construct from the specified database-connection.

	* CAVEAT: though the database may not permit a null value for many fields (applying its own default value when the value is unspecified),
	default values are applied here should the SQL-query return one.
-}
fromDatabase :: (
	Database.HDBC.IConnection	connection,
	Data.Convertible.Convertible	Database.HDBC.SqlValue level,			-- Flexible context.
	Data.Convertible.Convertible	Database.HDBC.SqlValue locationId,		-- Flexible context.
	Data.Convertible.Convertible	Database.HDBC.SqlValue synchronisationId,	-- Flexible context.
	Data.Convertible.Convertible	Database.HDBC.SqlValue teacherId,		-- Flexible context.
	Data.Convertible.Convertible	Database.HDBC.SqlValue teachingRatio,		-- Flexible context.
	Data.Convertible.Convertible	Database.HDBC.SqlValue timeslotId,		-- Flexible context.
	Data.Typeable.Typeable		teachingRatio,
	Ord				level,
	Ord				synchronisationId,
	Ord				teacherId,
	Ord				timeslotId,
	RealFrac			teachingRatio,
	Show				level,
	Show				synchronisationId,
	Show				timeslotId
 )
	=> connection			-- ^ An abstract database-connection.
	-> Database.HDBC.SqlValue	-- ^ The project-id.
	-> IO (TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio)
fromDatabase connection	projectIdSql	= let
	idealTimeslotRequestColumnName, teacherRegisterIdColumnName :: Database.Selector.ColumnName
	idealTimeslotRequestColumnName	= "idealTimeslotRequest"
	teacherRegisterIdColumnName	= showString tag "Id";

	requiredFacilityTableName, serviceTableName, specialtyTopicTableName, specificTimeRequestsTableName, teacherGroupMembershipTableName, teacherRegisterTableName :: Database.Selector.TableName
	[requiredFacilityTableName, serviceTableName, specialtyTopicTableName, specificTimeRequestsTableName, teacherGroupMembershipTableName, teacherRegisterTableName]	= map (showString Database.Selector.tablePrefix) ["requiredFacility", Data.Teacher.serviceTag, Data.Teacher.specialtyTopicTag, "specificTimeRequest", "teacherGroupMembership", tag]
 in do
	facilityNameByFacilityTypeId	<- Data.Location.findFacilityNameByFacilityTypeId connection projectIdSql

#ifdef USE_HDBC_ODBC
	[
		selectRequiredFacilitiesForTeacherRegisterId,
		selectSpecificTimeRequestsForTeacherRegisterId,
		selectServiceForTeacherRegisterId,
		selectGroupIdsForTeacherRegisterId,
		selectSpecialtyTopicForTeacherRegisterId
	 ] <- mapM (
		\(columnNames, tableName)	-> Database.Selector.prepare connection columnNames [tableName] [teacherRegisterIdColumnName]
	 ) [
		(
			[
				Data.Subject.topicTag,
				Data.Subject.levelTag,
				Data.Location.facilityTypeIdTag
			],
			requiredFacilityTableName
		), (
			[
				Data.Subject.topicTag,
				Data.Subject.levelTag,
				Temporal.Day.tag,
				Database.Selector.timeslotIdColumnName
			],
			specificTimeRequestsTableName
		), (
			[
				Data.Subject.topicTag,
				Data.Subject.levelTag,
				Data.Course.requiredLessonsPerWeekTag,
				Data.Course.minimumConsecutiveLessonsTag,
				Data.Course.maximumClassSizeTag,
				Database.Selector.synchronisationIdColumnName,
				idealTimeslotRequestColumnName
			],
			serviceTableName
		), (
			[Data.Group.groupIdTag],
			teacherGroupMembershipTableName
		), (
			[Data.Subject.topicTag],
			specialtyTopicTableName
		)
	 ] -- Prepare statements for execution with each teacherRegisterId.
#endif /* USE_HDBC_ODBC */
	Database.Selector.select connection [
		teacherRegisterIdColumnName,
		Database.Selector.teacherIdColumnName,
		Temporal.Availability.tag,
		Database.Selector.locationIdColumnName,
		Data.Teacher.maximumTeachingRatioTag,
		Temporal.FreePeriodPreference.tag
	 ] [teacherRegisterTableName] [(Database.Selector.projectIdColumnName, projectIdSql)] >>= fmap Data.Map.fromList . mapM (
		\teacherRow -> case teacherRow of
			[
				teacherRegisterIdSql,
				teacherIdSql,
				availabilitySql,
				locationIdSql,
				maximumTeachingRatioSql,
				freePeriodPreferenceSql
			 ] -> do
#ifndef USE_HDBC_ODBC
				let primaryKey	= [(teacherRegisterIdColumnName, teacherRegisterIdSql)]
#endif
				requiredFacilityNamesBySubject	<- (
					Data.Map.fromListWith Data.Set.union . map (
						\requiredFacilityRow -> case requiredFacilityRow of
							[topicSql, levelSql, facilityTypeIdSql]	-> let
								facilityTypeId	= Data.Maybe.fromMaybe (
									error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tnull " $ shows Data.Location.facilityTypeIdTag "."
								 ) . either (
									error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tfailed to parse the value for " . shows Data.Location.facilityTypeIdTag . showString " read from the database; " . show
								 ) id $ Database.HDBC.safeFromSql facilityTypeIdSql
							 in (
								(,) (Data.Subject.mkSubjectFromSql topicSql levelSql) . Data.Set.singleton
							 ) . Data.Maybe.fromMaybe (
								error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tunknown " . showString Data.Location.facilityTypeIdTag . showChar '=' $ shows facilityTypeId "."
							 ) $ Data.IntMap.lookup facilityTypeId facilityNameByFacilityTypeId
							_					-> error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tunexpected number of columns=" . shows (length requiredFacilityRow) . showString " in row of table " $ shows requiredFacilityTableName "."
					)
#ifdef USE_HDBC_ODBC
				 ) `fmap` (
					Database.HDBC.execute selectRequiredFacilitiesForTeacherRegisterId [teacherRegisterIdSql] >> Database.HDBC.fetchAllRows' selectRequiredFacilitiesForTeacherRegisterId
				 )
#else
				 ) `fmap` Database.Selector.select connection [
					Data.Subject.topicTag,
					Data.Subject.levelTag,
					Data.Location.facilityTypeIdTag
				 ] [requiredFacilityTableName] primaryKey
#endif
				specificTimeRequestsBySubject	<- (
					Data.Map.fromListWith Data.Set.union . map (
						\specificTimeRow -> case specificTimeRow of
							[topic, level, day, timeslotId]	-> (
								Data.Subject.mkSubjectFromSql topic level,
								Data.Set.singleton $ Temporal.Time.mkTimeFromSql day timeslotId
							 ) -- Pair
							_				-> error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tunexpected number of columns=" . shows (length specificTimeRow) . showString " in row of table " $ shows specificTimeRequestsTableName "."
					)
#ifdef USE_HDBC_ODBC
				 ) `fmap` (
					Database.HDBC.execute selectSpecificTimeRequestsForTeacherRegisterId [teacherRegisterIdSql] >> Database.HDBC.fetchAllRows' selectSpecificTimeRequestsForTeacherRegisterId
				 )
#else
				 ) `fmap` Database.Selector.select connection [
					Data.Subject.topicTag,
					Data.Subject.levelTag,
					Temporal.Day.tag,
					Database.Selector.timeslotIdColumnName
				 ] [specificTimeRequestsTableName] primaryKey
#endif
				service	<- (
					Data.Set.fromList . map (
						\courseRow -> case courseRow of
							[topicSql, levelSql, requiredLessonsPerWeekSql, minimumConsecutiveLessonsSql, maximumClassSizeSql, synchronisationIdSql, idealTimeslotRequestSql]	-> let
								subject	= Data.Subject.mkSubjectFromSql topicSql levelSql
							 in Data.Course.mkCourse subject (
								Data.Maybe.fromMaybe (
									error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tnull " $ shows Data.Course.requiredLessonsPerWeekTag "."
								) . either (
									error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tfailed to parse the value for " . shows Data.Course.requiredLessonsPerWeekTag . showString " read from the database; " . show
								) id $ Database.HDBC.safeFromSql requiredLessonsPerWeekSql
							 ) (
								Data.Maybe.fromMaybe Data.Set.empty $ Data.Map.lookup subject requiredFacilityNamesBySubject
							 ) (
								Data.Maybe.maybe (
									Temporal.TimeslotRequest.Specifically . Data.Maybe.fromMaybe Data.Set.empty $ Data.Map.lookup subject specificTimeRequestsBySubject
								) Temporal.TimeslotRequest.Ideally $ Database.HDBC.fromSql idealTimeslotRequestSql
							 ) (
								Data.Maybe.fromMaybe Data.Course.defaultMinimumConsecutiveLessons . either (
									error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tfailed to parse the value for " . shows Data.Course.minimumConsecutiveLessonsTag . showString " read from the database; " . show
								) id $ Database.HDBC.safeFromSql minimumConsecutiveLessonsSql
							 ) (
								either (
									error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tfailed to parse the value for " . shows Data.Course.maximumClassSizeTag . showString " read from the database; " . show
								) id $ Database.HDBC.safeFromSql maximumClassSizeSql	-- Returns Nothing for SqlNull.
							 ) $ Database.HDBC.fromSql synchronisationIdSql	-- Returns Nothing for SqlNull.
							_	-> error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tunexpected number of columns=" . shows (length courseRow) . showString " in row of table " $ shows serviceTableName "."
					)
#ifdef USE_HDBC_ODBC
				 ) `fmap` (
					Database.HDBC.execute selectServiceForTeacherRegisterId [teacherRegisterIdSql] >> Database.HDBC.fetchAllRows' selectServiceForTeacherRegisterId
				 )
#else
				 ) `fmap` Database.Selector.select connection [
					Data.Subject.topicTag,
					Data.Subject.levelTag,
					Data.Course.requiredLessonsPerWeekTag,
					Data.Course.minimumConsecutiveLessonsTag,
					Data.Course.maximumClassSizeTag,
					Database.Selector.synchronisationIdColumnName,
					idealTimeslotRequestColumnName
				 ] [serviceTableName] primaryKey
#endif
				groupMembership	<- (
					Data.Set.fromList . map (
						Data.Maybe.fromMaybe (
							error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tnull " $ shows Data.Group.groupIdTag "."
						) . Database.HDBC.fromSql . head {-select the only column-}
					)
#ifdef USE_HDBC_ODBC
				 ) `fmap` (
					Database.HDBC.execute selectGroupIdsForTeacherRegisterId [teacherRegisterIdSql] >> Database.HDBC.fetchAllRows' selectGroupIdsForTeacherRegisterId
				 )
#else
				 ) `fmap` Database.Selector.select connection [Data.Group.groupIdTag] [teacherGroupMembershipTableName] primaryKey
#endif
				maybeSpecialtyTopic	<- (
					Data.Maybe.listToMaybe . map (
						Database.HDBC.fromSql . head {-select the only column-}
					)
#ifdef USE_HDBC_ODBC
				 ) `fmap` (
					Database.HDBC.execute selectSpecialtyTopicForTeacherRegisterId [teacherRegisterIdSql] >> Database.HDBC.fetchAllRows' selectSpecialtyTopicForTeacherRegisterId
				 )
#else
				 ) `fmap` Database.Selector.select connection [Data.Subject.topicTag] [specialtyTopicTableName] primaryKey
#endif
				return {-to IO-monad-} (
					Data.Maybe.fromMaybe (
						error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tnull " $ shows Database.Selector.teacherIdColumnName "."
					) $ Database.HDBC.fromSql teacherIdSql,
					Data.Teacher.mkProfile service (
						Database.HDBC.fromSql locationIdSql	-- Returns 'Nothing' for SqlNull.
					) (
						Data.Maybe.fromMaybe (
							error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tnull " $ shows Temporal.Availability.tag "."
						) $ Database.HDBC.fromSql availabilitySql
					) (
						Database.Selector.fromSqlFractional (
							error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tnull " $ shows Data.Teacher.maximumTeachingRatioTag "."
						) maximumTeachingRatioSql
					) groupMembership maybeSpecialtyTopic $ Database.HDBC.fromSql freePeriodPreferenceSql	-- Returns Nothing for SqlNull.
				 ) -- Pair.
			_ -> error . showString "WeekDaze.Aggregate.TeacherRegister.fromDatabase:\tunexpected number of columns=" . shows (length teacherRow) . showString " in row of table " $ shows teacherRegisterTableName "."
	 )
#endif /* USE_HDBC */

-- | Used to qualify XML.
tag :: String
tag	= "teacherRegister"

-- | The complete set of 'Data.Teacher.Profile', indexed by 'teacherId'.
type TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio	= Data.Resource.ResourceMap teacherId (Data.Teacher.Profile synchronisationId level timeslotId locationId teachingRatio)

-- | Accessor.
getTeacherIds :: TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> [teacherId]
getTeacherIds	= Data.Map.keys

-- | Accessor.
getTeacherProfiles :: TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> [Data.Teacher.Profile synchronisationId level timeslotId locationId teachingRatio]
getTeacherProfiles	= Data.Map.elems

-- | Extracts the set of all 'Data.Course.Course's, from the /teacher-register/.
extractDistinctCourses :: (
	Ord	level,
	Ord	synchronisationId,
	Ord	timeslotId
 ) => TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Data.Teacher.Service synchronisationId level timeslotId
extractDistinctCourses	= Data.Map.foldr (Data.Set.union . Data.Teacher.getService) Data.Set.empty

-- | Extracts the set of distinct 'locationId's, from the /teacher-register/.
extractDistinctOwnLocationIds :: Ord locationId => TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Data.Location.Locus locationId
extractDistinctOwnLocationIds	= Data.Map.foldr (\profile locus -> Data.Maybe.maybe locus (`Data.Set.insert` locus) $ Data.Teacher.getMaybeOwnLocationId profile) Data.Set.empty

-- | Extracts the set of all 'Data.Subject.Subject's, from the /teacher-register/.
extractDistinctSubjects :: (
	Ord	level,
	Ord	synchronisationId,
	Ord	timeslotId
 ) => TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Data.Subject.Knowledge level
extractDistinctSubjects	= Data.Set.map Data.Course.getSubject . extractDistinctCourses

-- | Extracts the set of distinct required 'Data.Location.Facility's, from the /teacher-register/.
extractDistinctRequiredFacilityNames :: (
	Ord	level,
	Ord	synchronisationId,
	Ord	timeslotId
 ) => TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Data.Location.FacilityNames
extractDistinctRequiredFacilityNames	= Data.Set.foldr (Data.Set.union . Data.Course.getRequiredFacilityNames) Data.Set.empty . extractDistinctCourses

{- |
	* Determine the total number of /lesson/s required for each /subject/, according to the 'Data.Course.Course's offered.

	* Since each /course/ may be offered by more than one 'teacherId', the actual workload can only be constrained within bounds.
-}
calculateWorkloadBoundsBySubject :: (
	Ord	level,
	Ord	synchronisationId,
	Ord	timeslotId
 ) => TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Data.Map.Map (Data.Subject.Subject level) Temporal.Workload.Bounds
calculateWorkloadBoundsBySubject	= Data.Map.map (minimum &&& maximum) . Data.Map.fromListWith (++) . map (Data.Course.getSubject &&& return {-to List-monad-} . Data.Course.getRequiredLessonsPerWeek) . Data.Set.toList . extractDistinctCourses

-- | Find those /teacher/s offering a /course/ in the specified /subject/.
findSuitableCourseByTeacherId
	:: Eq level
	=> Size.NStudents	-- ^ The number of /student/s, who need to be placed.
	-> Data.Subject.Subject level
	-> TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio
	-> Data.Map.Map teacherId (Data.Course.Course synchronisationId level timeslotId)
findSuitableCourseByTeacherId nStudents subject	= Data.Map.mapMaybe (Data.Teacher.lookupSuitableCourse nStudents subject)

-- | The sum of the number of /day/s worked by each /teacher/.
countAvailableTeacherDays :: TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Size.NDays
countAvailableTeacherDays	= Data.Map.foldr ((+) . Data.Resource.countDaysPerWeekAvailable) 0

{- |
	* The total number of /lesson/s per week, required by all those /course/s requiring each /facility/.

	* CAVEAT: all /course/s are counted, not just those for which there's some demand from /student/s.
-}
countLessonsPerWeekByFacilityName :: TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Data.Map.Map Data.Location.FacilityName Size.NTimeslots
countLessonsPerWeekByFacilityName	= Data.Map.foldr (
	\profile m	-> Data.Set.foldr (
		\course m'	-> Data.Set.foldr (
			Data.Map.insertWith (+) `flip` Data.Course.getRequiredLessonsPerWeek course
		) m' $ Data.Course.getRequiredFacilityNames course
	) m $ Data.Teacher.getService profile
 ) Data.Map.empty

-- | True if a /teacher/ typically inhabits the specified 'locationId'.
isInhabited :: Eq locationId => locationId -> TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Bool
isInhabited locationId	= Data.Foldable.any (Data.Teacher.inhabits locationId)

-- | A map indexed by /teacherId/, of /course/s.
type CoursesByTeacherId synchronisationId teacherId level timeslotId	= Data.Map.Map teacherId (Data.Course.Course synchronisationId level timeslotId)

-- | A map indexed by /synchronisationId/, of 'CoursesByTeacherId'.
type CoursesByTeacherIdBySynchronisationId synchronisationId teacherId level timeslotId	= Data.Map.Map synchronisationId (CoursesByTeacherId synchronisationId teacherId level timeslotId)

{- |
	* Returns /course/s which reference a /synchronisationId/, indexed by that /synchronisationId/, sub-indexed by the /teacher-Id/ who offers them.

	* CAVEAT: If a /teacher/ erroneously offers two /course/s with the same /synchronisationId/, then the second will overwrite the first.

	* CAVEAT: /course/s are returned irrespective of whether any /student/ requires them.
-}
findCoursesByTeacherIdBySynchronisationId :: (
	Ord	level,
	Ord	synchronisationId,
	Ord	teacherId,
	Ord	timeslotId
 ) => TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> CoursesByTeacherIdBySynchronisationId synchronisationId teacherId level timeslotId
findCoursesByTeacherIdBySynchronisationId	= Data.Map.foldrWithKey (
	\teacherId -> flip $ Data.Set.foldr (
		uncurry (Data.Map.insertWith Data.Map.union) . Control.Arrow.second (Data.Map.singleton teacherId)
	)
 ) Data.Map.empty . Data.Map.map (
	Data.Set.map (
		Data.Maybe.fromJust . Data.Course.getMaybeSynchronisationId &&& id
	) . Data.Set.filter Data.Course.isSynchronised . Data.Teacher.getService
 )

-- | Returns the set of /course/s corresponding to each /synchronisationId/, irrespective of whether they're required by any /student/.
findDistinctCoursesBySynchronisationId :: (
	Ord	level,
	Ord	synchronisationId,
	Ord	timeslotId
 ) => CoursesByTeacherIdBySynchronisationId synchronisationId teacherId level timeslotId -> Data.Map.Map synchronisationId (Data.Set.Set (Data.Course.Course synchronisationId level timeslotId))
findDistinctCoursesBySynchronisationId	= Data.Map.map $ Data.Set.fromList . Data.Map.elems

-- | True if any /teacher/ has specified a /free-period preference/.
hasAnyFreePeriodPreference :: RealFrac teachingRatio => TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Bool
hasAnyFreePeriodPreference	= Data.Foldable.any Data.HumanResource.hasFreePeriodPreference

-- | True if any /teacher/ has offered a /synchronised course/ in their /service/.
hasAnySynchronisedCourses :: TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Bool
hasAnySynchronisedCourses	= Data.Foldable.any Data.Teacher.offersAnySynchronisedCourse

-- | True if any /teacher/ has requested an /ideal timeslot/ in their /service/.
hasAnyIdealTimeslotRequests :: TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Bool
hasAnyIdealTimeslotRequests	= Data.Foldable.any Data.Teacher.hasAnyIdealTimeslotRequest

-- | True if any /teacher/ has specified a /maximum class-size/ in their /service/.
hasAnyCourseMaximumClassSizes :: (
	Ord	level,
	Ord	synchronisationId,
	Ord	timeslotId
 ) => TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Bool
hasAnyCourseMaximumClassSizes	= Data.Foldable.any (Data.Maybe.isJust . Data.Course.getMaybeMaximumClassSize) . extractDistinctCourses

-- | True if any /teacher/ has requested a /specific time/ in their /service/.
hasAnySpecificTimeRequests :: TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Bool
hasAnySpecificTimeRequests	= Data.Foldable.any Data.Teacher.hasAnySpecificTimeRequest

-- | True if any /teacher/ has requested a /specific time/ in their /service/.
hasAnyTimeslotRequests :: TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Bool
hasAnyTimeslotRequests	= Data.Foldable.any (uncurry (||) . (Data.Teacher.hasAnyIdealTimeslotRequest &&& Data.Teacher.hasAnySpecificTimeRequest))

-- | True if any /teacher/ has requested an /ideal timeslot/ in their /service/.
hasAnySpecialists :: TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Bool
hasAnySpecialists	= Data.Foldable.any Data.Teacher.hasSpecialtyTopic

-- | Find the set of all specified /time/s, for any /course/, offered by any /teacher/.
findSpecifiedTimes :: Ord timeslotId => TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> Temporal.Time.TimeSet timeslotId
findSpecifiedTimes	= Data.Map.foldr (Data.Set.union . Data.Teacher.findSpecifiedTimes) Data.Set.empty

-- | The type returned by 'subjectsOfferedInMultipleCoursesRequiringDifferentLessonsPerWeek'.
type NTimeslotsByTeacherIdBySubject level teacherId	= Data.Map.Map (Data.Subject.Subject level) (Data.Map.Map teacherId Size.NTimeslots)

-- | Finds /subject/s offered by more than one /teacher/, but as /course/s requiring different /lesson/s per week.
findSubjectsOfferedInMultipleCoursesRequiringDifferentLessonsPerWeek
	:: (Ord level, Ord teacherId)
	=> TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio
	-> NTimeslotsByTeacherIdBySubject level teacherId
findSubjectsOfferedInMultipleCoursesRequiringDifferentLessonsPerWeek	= Data.Map.filter (
	(> 1) . Data.Set.size . Data.Set.fromList . Data.Map.elems {-lessonsPerWeek-}
 ) . Data.Map.foldrWithKey (
	\teacherId teacherProfile m	-> Data.Set.foldr (
		\course -> uncurry (
			Data.Map.insertWith Data.Map.union
		) (
			Data.Course.getSubject &&& Data.Map.singleton teacherId . Data.Course.getRequiredLessonsPerWeek $ course
		)
	) m $ Data.Teacher.getService teacherProfile
 ) Data.Map.empty

-- | Tightens the constraints on each member of a set of synchronised /course/s, to a level compatible with the requirements of other members.
mergeConstraintsOnSynchronisedCourses :: (
	Ord	level,
	Ord	synchronisationId,
	Ord	teacherId,
	Ord	timeslotId,
	Show	synchronisationId,
	Show	timeslotId
 ) => TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio -> TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio
mergeConstraintsOnSynchronisedCourses teacherRegister	= Data.Map.map (
	\profile -> profile {
		Data.Teacher.getService	= Data.Set.map (
			\course -> Data.Maybe.maybe course (
				\synchronisationId -> let
					distinctCourses	= findDistinctCoursesBySynchronisationId (findCoursesByTeacherIdBySynchronisationId teacherRegister) ! synchronisationId
				in course {
					Data.Course.getMinimumConsecutiveLessons	= Data.Set.findMax $ Data.Set.map Data.Course.getMinimumConsecutiveLessons distinctCourses,
					Data.Course.getTimeslotRequest			= let
						timeslotRequests			= Data.Set.map Data.Course.getTimeslotRequest distinctCourses
						(idealTimeslotIds, specifiedTimes)	= (
							Data.Set.map (Data.Maybe.fromJust . Temporal.TimeslotRequest.getMaybeIdealTimeslotId) *** Data.Set.unions . map Temporal.TimeslotRequest.getSpecifiedTimes . Data.Set.toList
						 ) $ Data.Set.partition Temporal.TimeslotRequest.isIdeally timeslotRequests

						hasZeroIdealTimeslotIds, hasZeroSpecifiedTimes :: Bool
						hasZeroIdealTimeslotIds	= Data.Set.null idealTimeslotIds
						hasZeroSpecifiedTimes	= Data.Set.null specifiedTimes
					in if hasZeroIdealTimeslotIds && hasZeroSpecifiedTimes
						then Data.Course.getTimeslotRequest course	-- Unchanged.
						else if Data.Set.size idealTimeslotIds == 1 && hasZeroSpecifiedTimes
							then Temporal.TimeslotRequest.Ideally $ Data.Set.findMin idealTimeslotIds
							else if hasZeroIdealTimeslotIds && not hasZeroSpecifiedTimes
								then Temporal.TimeslotRequest.Specifically specifiedTimes
								else error . showString "WeekDaze.Aggregate.TeacherRegister.mergeConstraintsOnSynchronisedCourses:\tincompatible TimeslotRequests; " $ shows (synchronisationId, Data.Set.toList timeslotRequests) "."
				}
			 ) $ Data.Course.getMaybeSynchronisationId course
		) $ Data.Teacher.getService profile
	}
 ) teacherRegister