{-# LANGUAGE CPP #-}
module WeekDaze.Data.Teacher(
Service,
Profile(
getService,
getMaybeOwnLocationId,
getMaybeSpecialtyTopic,
getMaybeFreePeriodPreference
),
maximumTeachingRatioTag,
serviceTag,
specialtyTopicTag,
lookupCourseIn,
lookupSuitableCourse,
findSpecifiedTimes,
unsubscribe,
mkProfile,
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
tag :: String
tag = "teacherProfile"
maximumTeachingRatioTag :: String
maximumTeachingRatioTag = "maximumTeachingRatio"
serviceTag :: String
serviceTag = "service"
specialtyTopicTag :: String
specialtyTopicTag = "specialtyTopic"
type Service synchronisationId level timeslotId = Data.Set.Set (Data.Course.Course synchronisationId level timeslotId)
defaultService :: Service synchronisationId level timeslotId
defaultService = Data.Set.empty
data Profile synchronisationId level timeslotId locationId teachingRatio = MkProfile {
getService :: Service synchronisationId level timeslotId,
getMaybeOwnLocationId :: Maybe locationId,
getWorkingWeek :: Temporal.Availability.Availability,
getMaximumTeachingRatio :: teachingRatio,
getGroupMembership :: Data.Group.Membership,
getMaybeSpecialtyTopic :: Maybe Data.Subject.Topic,
getMaybeFreePeriodPreference :: Maybe Temporal.FreePeriodPreference.FreePeriodPreference
} 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 ) ++ " must be within the closed unit-interval '[0,1]'"
), (
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 ) ++ " 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
)
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,
\MkProfile {
getService = service,
getMaybeOwnLocationId = maybeOwnLocationId,
getWorkingWeek = workingWeek,
getMaximumTeachingRatio = maximumTeachingRatio,
getGroupMembership = groupMembership,
getMaybeSpecialtyTopic = maybeSpecialtyTopic,
getMaybeFreePeriodPreference = maybeFreePeriodPreference
} -> (
service,
maybeOwnLocationId,
workingWeek,
maximumTeachingRatio,
groupMembership,
maybeSpecialtyTopic,
maybeFreePeriodPreference
)
) $ HXT.xp7Tuple (
HXT.xpDefault defaultService . HXT.xpElem serviceTag . HXT.xpWrap (
Data.Set.fromList,
Data.Set.toList
) $ HXT.xpList1 HXT.xpickle
) (
HXT.xpOption HXT.xpickle
) HXT.xpickle (
HXT.xpAttr maximumTeachingRatioTag HXT.xpickle
) (
HXT.xpDefault Data.HumanResource.defaultGroupMembership . HXT.xpElem Data.HumanResource.groupMembershipTag . HXT.xpWrap (
Data.Set.fromList,
Data.Set.toList
) . HXT.xpList1 . HXT.xpElem Data.Group.memberTag $ HXT.xpTextAttr Data.Group.groupIdTag
) (
HXT.xpOption $ HXT.xpTextAttr specialtyTopicTag
) (
HXT.xpOption HXT.xpickle
)
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)
mkProfile :: (
Ord level,
Ord timeslotId,
Real teachingRatio,
Show level,
Show synchronisationId,
Show timeslotId
)
=> Service synchronisationId level timeslotId
-> Maybe locationId
-> Temporal.Availability.Availability
-> teachingRatio
-> Data.Group.Membership
-> Maybe Data.Subject.Topic
-> Maybe Temporal.FreePeriodPreference.FreePeriodPreference
-> 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
}
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
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
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
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
hasAnyIdealTimeslotRequest :: Profile synchronisationId level timeslotId locationId teachingRatio -> Bool
hasAnyIdealTimeslotRequest = Data.Foldable.any (Temporal.TimeslotRequest.isIdeally . Data.Course.getTimeslotRequest) . getService
hasAnySpecificTimeRequest :: Profile synchronisationId level timeslotId locationId teachingRatio -> Bool
hasAnySpecificTimeRequest = Data.Foldable.any Data.Course.specifiesTimes . getService
hasSpecialtyTopic :: Profile synchronisationId level timeslotId locationId teachingRatio -> Bool
hasSpecialtyTopic = Data.Maybe.isJust . getMaybeSpecialtyTopic
inhabits :: Eq locationId => locationId -> Profile synchronisationId level timeslotId locationId teachingRatio -> Bool
inhabits locationId = (== Just locationId) . getMaybeOwnLocationId
isSpecialistIn :: Data.Subject.Topic -> Profile synchronisationId level timeslotId locationId teachingRatio -> Bool
isSpecialistIn topic = (== Just topic) . getMaybeSpecialtyTopic
offersAnySynchronisedCourse :: Profile synchronisationId level timeslotId locationId teachingRatio -> Bool
offersAnySynchronisedCourse = Data.Foldable.any Data.Course.isSynchronised . getService
offersService :: Profile synchronisationId level timeslotId locationId teachingRatio -> Bool
offersService = not . Data.Set.null . getService
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
}