weekdaze-0.0.0.1: src-lib/WeekDaze/Data/Teacher.hs
{-# 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
}