{-# LANGUAGE CPP #-}
{-
	Copyright (C) 2013-2016 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 the attributes of a /teacher/.

 [@TODO@]	Some teachers work half days, or even just specific /time-slot/s; so 'getWorkingWeek' is an inadequate description.
-}

module WeekDaze.Data.Teacher(
-- * Types
-- ** Type-synonyms
	Service,
-- ** Data-types
	Profile(
--		MkProfile,
		getService,
		getMaybeOwnLocationId,
--		getWorkingWeek,
--		getMaximumTeachingRatio,
		getMaybeSpecialtyTopic,
--		getGroupMembership,
		getMaybeFreePeriodPreference
	),
-- * Constants
--	tag,
	maximumTeachingRatioTag,
	serviceTag,
	specialtyTopicTag,
--	defaultService,
-- * Functions
	lookupCourseIn,
	lookupSuitableCourse,
	findSpecifiedTimes,
	unsubscribe,
-- ** Constructor
	mkProfile,
-- ** Predicates
	offersSuitableCourse,
	hasAnyIdealTimeslotRequest,
	hasAnySpecificTimeRequest,
	hasSpecialtyTopic,
	inhabits,
	isSpecialistIn,
	offersAnySynchronisedCourse,
	offersService
) where

import			Control.Arrow((&&&))
import qualified	Control.DeepSeq
import qualified	Data.Foldable
import qualified	Data.List.Extra
import qualified	Data.Maybe
import qualified	Data.Set
import qualified	Text.XML.HXT.Arrow.Pickle		as HXT
import qualified	ToolShed.SelfValidate
import qualified	WeekDaze.Data.Course			as Data.Course
import qualified	WeekDaze.Data.Group			as Data.Group
import qualified	WeekDaze.Data.HumanResource		as Data.HumanResource
import qualified	WeekDaze.Data.Resource			as Data.Resource
import qualified	WeekDaze.Data.Subject			as Data.Subject
import qualified	WeekDaze.Size				as Size
import qualified	WeekDaze.Temporal.Availability		as Temporal.Availability
import qualified	WeekDaze.Temporal.FreePeriodPreference	as Temporal.FreePeriodPreference
import qualified	WeekDaze.Temporal.Time			as Temporal.Time
import qualified	WeekDaze.Temporal.TimeslotRequest	as Temporal.TimeslotRequest

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

-- | Used to qualify SQL & XML.
maximumTeachingRatioTag :: String
maximumTeachingRatioTag	= "maximumTeachingRatio"

-- | Used to qualify XML.
serviceTag :: String
serviceTag		= "service"

-- | Used to qualify XML.
specialtyTopicTag :: String
specialtyTopicTag	= "specialtyTopic"

{- |
	* A /teacher/ offers a set of /course/s.

	* Whilst they may perform a reserve-role in some additional /subject/, this isn't going to affect the /timetable/.
-}
type Service synchronisationId level timeslotId	= Data.Set.Set (Data.Course.Course synchronisationId level timeslotId)

-- | The default value for 'getService'.
defaultService :: Service synchronisationId level timeslotId
defaultService	= Data.Set.empty

-- | The service offered by a /teacher/.
data Profile synchronisationId level timeslotId locationId teachingRatio	= MkProfile {
	getService			:: Service synchronisationId level timeslotId,			-- ^ The set of /course/s offered.

{- |
	* A /teacher/ may have their own personal /location/ (i.e. a /form-room/).

	* Absence of this field implies that they're nomadic, & may use any free 'locationId', appropriate for the /course/; however inconveniently located.

	* A personal /location/ can't be assumed to have all the /facilities/ required for the /service/ offered.

	* CAVEAT: it's conceivable that some /teacher/s share a /location/, but each one still only uses that /location/.
-}
	getMaybeOwnLocationId		:: Maybe locationId,						-- ^ A /teacher/ may have a fixed abode.
	getWorkingWeek			:: Temporal.Availability.Availability,				-- ^ A /teacher/ may be part-time.
{- |
	* The maximum ratio, in the closed unit-interval [0,1], of a /teacher/'s working week (rather than the whole week), which is devoted to teaching.
	The remainder may be administration or attendance at /meetings/.
	This concept may also be required, to allow ad-hoc re-scheduling, to compensate for absentees.

	* This concept differs from a /part-time teacher/, who teaches for a static /contractually specified/ portion of the week.

	* When the type-parameter is a /Rational/ & the denominator is the number of /lesson/s per week, specification is in the basic time-units of the timetable.

	* The value can't be exceeded, but may not be reached, thus allowing at least the required time for the administration.
-}
	getMaximumTeachingRatio		:: teachingRatio,
	getGroupMembership		:: Data.Group.Membership,					-- ^ A /teacher/ may meet regularly with various /group/s.
	getMaybeSpecialtyTopic		:: Maybe Data.Subject.Topic,					-- ^ A /teacher/ may specialise in a specific /topic/, rather than being a generalist.
	getMaybeFreePeriodPreference	:: Maybe Temporal.FreePeriodPreference.FreePeriodPreference	-- ^ A /teacher/ may have a preference for the position within each /day/, of unallocated /time-slot/s.
} deriving (Eq, Ord)

instance (Show synchronisationId, Show level, Show timeslotId, Show locationId, Show teachingRatio) => Show (Profile synchronisationId level timeslotId locationId teachingRatio) where
	showsPrec _ MkProfile {
		getService			= service,
		getMaybeOwnLocationId		= maybeOwnLocationId,
		getWorkingWeek			= workingWeek,
		getMaximumTeachingRatio		= maximumTeachingRatio,
		getGroupMembership		= groupMembership,
		getMaybeSpecialtyTopic		= maybeSpecialtyTopic,
		getMaybeFreePeriodPreference	= maybeFreePeriodPreference
	} = showString tag . showString "={" . showString serviceTag . showChar '=' . shows (
		Data.Set.toList service
	 ) . showString ",locationId=" . showString (
		Data.Maybe.maybe "<none>" show maybeOwnLocationId
	 ) . showChar ',' . showString Temporal.Availability.tag . showChar '=' . shows workingWeek . showChar ',' . showString maximumTeachingRatioTag . showChar '=' . shows maximumTeachingRatio . showChar ',' . showString Data.HumanResource.groupMembershipTag . showChar '=' . shows (
		Data.Set.toList groupMembership
	 ) . showChar ',' . showString specialtyTopicTag . showChar '=' . showString (
		Data.Maybe.maybe "<none>" show maybeSpecialtyTopic
	 ) . showChar ',' . showString Temporal.FreePeriodPreference.tag . showChar '=' . showString (
		Data.Maybe.maybe "<none>" show maybeFreePeriodPreference
	 ) . showChar '}'

instance (
	Ord	level,
#if !MIN_VERSION_containers(0,5,2)
	Ord	synchronisationId,
#endif
	Ord	timeslotId,
	Real	teachingRatio,
	Show	level,
	Show	synchronisationId,
	Show	timeslotId
 ) => ToolShed.SelfValidate.SelfValidator (Profile synchronisationId level timeslotId locationId teachingRatio) where
	getErrors profile@MkProfile {
		getService		= service,
		getWorkingWeek		= workingWeek,
		getMaximumTeachingRatio	= maximumTeachingRatio,
		getMaybeSpecialtyTopic	= maybeSpecialtyTopic
	}
		| not $ ToolShed.SelfValidate.isValid service		= ToolShed.SelfValidate.getErrors service
		| not $ ToolShed.SelfValidate.isValid workingWeek	= ToolShed.SelfValidate.getErrors workingWeek
		| otherwise						= ToolShed.SelfValidate.extractErrors [
			(
				Data.List.Extra.anySame . map Data.Course.getSubject $ Data.Set.toList service,
				"multiple courses in the same " ++ show Data.Subject.tag ++ " have been offered in this teacher's " ++ show serviceTag ++ "; " ++ show (Data.Set.toList service)
			), (
				any ($ maximumTeachingRatio) [(< 0), (> 1)],
				maximumTeachingRatioTag ++ "=" ++ show (realToFrac maximumTeachingRatio :: Double {-hide the actual type-}) ++ " must be within the closed unit-interval '[0,1]'"	-- A staff-member can be purely administrative, since they could be a member of a group.
			), (
				maybeSpecialtyTopic == Just "",
				"explicitly null " ++ show specialtyTopicTag
			), (
				Data.Maybe.maybe False (`Data.Set.notMember` Data.Set.map (Data.Subject.getTopic . Data.Course.getSubject) service) maybeSpecialtyTopic,
				"a teacher's " ++ show specialtyTopicTag ++ " " ++ show (Data.Maybe.fromJust maybeSpecialtyTopic) ++ " must be offered as a " ++ show serviceTag ++ "; " ++ show (Data.Set.toList service)
			), (
				Data.List.Extra.anySame $ Data.Foldable.concatMap (Data.Set.toList . Temporal.TimeslotRequest.getSpecifiedTimes . Data.Course.getTimeslotRequest) service,
				"there's an overlap in the " ++ show Temporal.TimeslotRequest.specificallyTag ++ " requested booking-times, of the courses offered in the " ++ show serviceTag ++ "; " ++ show (Data.Set.toList service)
			), (
				uncurry (&&) $ (offersService &&& (== 0) . getMaximumTeachingRatio) profile,
				"a portion of the working week must be allocated to teaching " ++ show (Data.Set.toList service)
			), (
				uncurry (&&) $ (not . offersService &&& (> 0) . getMaximumTeachingRatio) profile,
				maximumTeachingRatioTag ++ "=" ++ show (realToFrac maximumTeachingRatio :: Double {-hide the actual type-}) ++ " of " ++ Temporal.Availability.tag ++ "=" ++ show workingWeek ++ " can't be filled without offering a service"
			)
		]

instance Data.Resource.Resource (Profile synchronisationId level timeslotId locationId teachingRatio) where
	getAvailability	= getWorkingWeek

instance RealFrac teachingRatio => Data.HumanResource.HumanResource (Profile synchronisationId level timeslotId locationId teachingRatio) where
	getNTimeslotsPerWeekOfTeaching nTimeslotsPerDay		= round . uncurry (*) . (getMaximumTeachingRatio &&& fromIntegral . Data.HumanResource.calculateNTimeslotsPerWeekAvailable nTimeslotsPerDay)
	getNTimeslotsPerWeekOfNonTeaching nTimeslotsPerDay	= uncurry (-) . (
		Data.HumanResource.calculateNTimeslotsPerWeekAvailable nTimeslotsPerDay &&& Data.HumanResource.getNTimeslotsPerWeekOfTeaching nTimeslotsPerDay
	 ) -- Derivation from 'getNTimeslotsPerWeekOfTeaching' ensures they are compatible in the face of rounding.
	getGroupMembership					= getGroupMembership
	getMaybeFreePeriodPreference				= getMaybeFreePeriodPreference

instance (
	HXT.XmlPickler	level,
	HXT.XmlPickler	locationId,
	HXT.XmlPickler	synchronisationId,
	HXT.XmlPickler	teachingRatio,
	HXT.XmlPickler	timeslotId,
	Ord		level,
	Ord		synchronisationId,
	Ord		timeslotId,
	Real		teachingRatio,
	Show		level,
	Show		synchronisationId,
	Show		timeslotId
 ) => HXT.XmlPickler (Profile synchronisationId level timeslotId locationId teachingRatio) where
	xpickle	= HXT.xpElem tag . HXT.xpWrap (
		\(a, b, c, d, e, f, g)	-> mkProfile a b c d e f g,	-- Construct from a tuple.
		\MkProfile {
			getService			= service,
			getMaybeOwnLocationId		= maybeOwnLocationId,
			getWorkingWeek			= workingWeek,
			getMaximumTeachingRatio		= maximumTeachingRatio,
			getGroupMembership		= groupMembership,
			getMaybeSpecialtyTopic		= maybeSpecialtyTopic,
			getMaybeFreePeriodPreference	= maybeFreePeriodPreference
		} -> (
			service,
			maybeOwnLocationId,
			workingWeek,
			maximumTeachingRatio,
			groupMembership,
			maybeSpecialtyTopic,
			maybeFreePeriodPreference
		) -- Deconstruct to a tuple.
	 ) $ HXT.xp7Tuple (
		HXT.xpDefault defaultService . HXT.xpElem serviceTag . HXT.xpWrap (
			Data.Set.fromList,	-- Construct from a List.
			Data.Set.toList		-- Deconstruct to a List.
		) $ HXT.xpList1 {-the default is null-} HXT.xpickle
	 ) (
		HXT.xpOption HXT.xpickle	-- maybeOwnLocationId.
	 ) HXT.xpickle {-workingWeek-} (
		HXT.xpAttr maximumTeachingRatioTag HXT.xpickle
	 ) (
		HXT.xpDefault Data.HumanResource.defaultGroupMembership . HXT.xpElem Data.HumanResource.groupMembershipTag . HXT.xpWrap (
			Data.Set.fromList,	-- Construct from a List.
			Data.Set.toList		-- Deconstruct to a List.
		) . HXT.xpList1 {-the default is null-} . HXT.xpElem Data.Group.memberTag $ HXT.xpTextAttr Data.Group.groupIdTag
	 ) (
		HXT.xpOption $ HXT.xpTextAttr specialtyTopicTag {-can't be null-}
	 ) (
		HXT.xpOption HXT.xpickle	-- maybeFreePeriodPreference.
	 )

instance (
	Control.DeepSeq.NFData	level,
	Control.DeepSeq.NFData	locationId,
	Control.DeepSeq.NFData	synchronisationId,
	Control.DeepSeq.NFData	teachingRatio,
	Control.DeepSeq.NFData	timeslotId
 ) => Control.DeepSeq.NFData (Profile synchronisationId level timeslotId locationId teachingRatio) where
	rnf (MkProfile x0 x1 x2 x3 x4 x5 x6)	= Control.DeepSeq.rnf (x0, x1, x2, x3, x4, x5, x6)

-- | Smart constructor.
mkProfile :: (
	Ord	level,
	Ord	timeslotId,
	Real	teachingRatio,
	Show	level,
	Show	synchronisationId,
	Show	timeslotId
 )
	=> Service synchronisationId level timeslotId			-- ^ The set of /course/s offered.
	-> Maybe locationId						-- ^ Personal classroom.
	-> Temporal.Availability.Availability				-- ^ The /day/s on which the /teacher/ is contracted to work.
	-> teachingRatio						-- ^ The maximum ratio of a working-week actually devoted to teaching.
	-> Data.Group.Membership					-- ^ The /group/s of which this /teacher/ is a member.
	-> Maybe Data.Subject.Topic					-- ^ Specialty topic.
	-> Maybe Temporal.FreePeriodPreference.FreePeriodPreference	-- ^ Any preference for the position within each /day/, of free /time-slot/s.
	-> Profile synchronisationId level timeslotId locationId teachingRatio
mkProfile service maybeOwnLocationId workingWeek maximumTeachingRatio groupMembership maybeSpecialtyTopic maybeFreePeriodPreference
	| ToolShed.SelfValidate.isValid profile	= profile
	| otherwise				= error $ "WeekDaze.Data.Teacher.mkProfile:\t" ++ ToolShed.SelfValidate.getFirstError profile ++ "."
	where
		profile	= MkProfile {
			getService			= service,
			getMaybeOwnLocationId		= maybeOwnLocationId,
			getWorkingWeek			= workingWeek,
			getMaximumTeachingRatio		= maximumTeachingRatio,
			getGroupMembership		= groupMembership,
			getMaybeSpecialtyTopic		= maybeSpecialtyTopic,
			getMaybeFreePeriodPreference	= maybeFreePeriodPreference
		}

-- | Extract any /course/ from the specified /profile/, which matches the specified /subject/.
lookupCourseIn
	:: Eq level
	=> Data.Subject.Subject level
	-> Profile synchronisationId level timeslotId locationId teachingRatio
	-> Maybe (Data.Course.Course synchronisationId level timeslotId)
lookupCourseIn subject	= Data.Foldable.find ((== subject) . Data.Course.getSubject) . getService

-- | Extract any /course/ from the specified /profile/, which matches the specified /subject/ & caters for the required number of /student/s.
lookupSuitableCourse
	:: Eq level
	=> Size.NStudents
	-> Data.Subject.Subject level
	-> Profile synchronisationId level timeslotId locationId teachingRatio
	-> Maybe (Data.Course.Course synchronisationId level timeslotId)
lookupSuitableCourse nStudents subject	= Data.Foldable.find (Data.Course.isSuitable nStudents subject) . getService

-- | Find the set of all specified /time/s, for any of the /course/s offered.
findSpecifiedTimes :: Ord timeslotId => Profile synchronisationId level timeslotId locationId teachingRatio -> Temporal.Time.TimeSet timeslotId
findSpecifiedTimes	= Data.Set.foldr (Data.Set.union . Temporal.TimeslotRequest.getSpecifiedTimes . Data.Course.getTimeslotRequest) Data.Set.empty . getService

-- | True if the /teacher/ offers a /course/ in the required /subject/ & can cater for the required number of /student/s.
offersSuitableCourse
	:: Eq level
	=> Size.NStudents
	-> Data.Subject.Subject level
	-> Profile synchronisationId level timeslotId locationId teachingRatio
	-> Bool
offersSuitableCourse nStudents subject	= Data.Foldable.any (Data.Course.isSuitable nStudents subject) . getService

-- | True if the specified /teacher/ makes any /ideal timeslot-request/ amongst the /course/s offered in their /service/.
hasAnyIdealTimeslotRequest :: Profile synchronisationId level timeslotId locationId teachingRatio -> Bool
hasAnyIdealTimeslotRequest	= Data.Foldable.any (Temporal.TimeslotRequest.isIdeally . Data.Course.getTimeslotRequest) . getService

-- | True if the specified /teacher/ makes any /specific time-request/ amongst the /course/s offered in their /service/.
hasAnySpecificTimeRequest :: Profile synchronisationId level timeslotId locationId teachingRatio -> Bool
hasAnySpecificTimeRequest	= Data.Foldable.any Data.Course.specifiesTimes . getService

-- | True if the specified /teacher/ claims any /topic/ as their specialty.
hasSpecialtyTopic :: Profile synchronisationId level timeslotId locationId teachingRatio -> Bool
hasSpecialtyTopic	= Data.Maybe.isJust . getMaybeSpecialtyTopic

-- | True if the specified /teacher/ claims the specified /location/ as their own.
inhabits :: Eq locationId => locationId -> Profile synchronisationId level timeslotId locationId teachingRatio -> Bool
inhabits locationId	= (== Just locationId) . getMaybeOwnLocationId

-- | True if the /teacher/ specializes in the specified /topic/.
isSpecialistIn :: Data.Subject.Topic -> Profile synchronisationId level timeslotId locationId teachingRatio -> Bool
isSpecialistIn topic	= (== Just topic) . getMaybeSpecialtyTopic

-- | True if the specified /teacher/ offers any synchronised /course/.
offersAnySynchronisedCourse :: Profile synchronisationId level timeslotId locationId teachingRatio -> Bool
offersAnySynchronisedCourse	= Data.Foldable.any Data.Course.isSynchronised . getService

-- | True if the /teacher/ offers one or more /course/s in their /service/.
offersService :: Profile synchronisationId level timeslotId locationId teachingRatio -> Bool
offersService	= not . Data.Set.null . getService

-- | Unsubscribe from the specified set of /groups/.
unsubscribe
	:: Data.Group.Membership
	-> Profile synchronisationId level timeslotId locationId teachingRatio
	-> Profile synchronisationId level timeslotId locationId teachingRatio
unsubscribe groupMembership profile	= profile {
	getGroupMembership	= Data.Set.filter (`Data.Set.notMember` groupMembership) $ getGroupMembership profile
}