module WeekDaze.TeacherView.Timetable(
Timetable,
InterCampusMigrationsByTeacherId,
TimesByTeacherId,
findStudentClassesByLocationId,
calculateMeanStudentClassSize,
countLocationChangesByTeacherId,
bookStudentViewLesson,
fromStudentViewTimetable,
toStudentViewTimetable,
toXHtml
) where
import Control.Arrow((&&&))
import Data.Map((!))
import qualified Control.Arrow
import qualified Data.Array.IArray
import qualified Data.Foldable
import qualified Data.Map
import qualified Data.Maybe
import qualified Data.Set
import qualified Data.Tuple
import qualified Factory.Math.Statistics
import qualified Text.XHtml.Strict
import qualified WeekDaze.Aggregate.StudentClass as Aggregate.StudentClass
import qualified WeekDaze.Aggregate.TeacherRegister as Aggregate.TeacherRegister
import qualified WeekDaze.Data.Course as Data.Course
import qualified WeekDaze.Data.HumanResource as Data.HumanResource
import qualified WeekDaze.Model.Lesson as Model.Lesson
import qualified WeekDaze.Model.Meeting as Model.Meeting
import qualified WeekDaze.Model.Timetable as Model.Timetable
import qualified WeekDaze.Model.TimetableForWeek as Model.TimetableForWeek
import qualified WeekDaze.Size as Size
import qualified WeekDaze.StudentView.LessonResourceIds as StudentView.LessonResourceIds
import qualified WeekDaze.StudentView.Timetable as StudentView.Timetable
import qualified WeekDaze.TeacherView.Lesson as TeacherView.Lesson
import qualified WeekDaze.TeacherView.LessonResourceIds as TeacherView.LessonResourceIds
import qualified WeekDaze.TeacherView.TimetableForWeek as TeacherView.TimetableForWeek
import qualified WeekDaze.Temporal.Time as Temporal.Time
import qualified WeekDaze.Text.CSS as Text.CSS
import Text.XHtml.Strict((+++), (<<))
import WeekDaze.Text.XHTML()
type Timetable teacherId timeslotId locationId level = Model.Timetable.Timetable teacherId timeslotId (TeacherView.LessonResourceIds.LessonResourceIds locationId) level
fromStudentViewTimetable :: (
Data.Array.IArray.Ix timeslotId,
Enum timeslotId,
Eq level,
Eq locationId,
Ord teacherId,
Show level,
Show locationId,
Show teacherId,
Show timeslotId
)
=> Bool
-> Timetable teacherId timeslotId locationId level
-> StudentView.Timetable.Timetable timeslotId locationId teacherId level
-> Timetable teacherId timeslotId locationId level
fromStudentViewTimetable permitTemporaryStudentBodyMerger = Data.Map.foldrWithKey (
\studentBody studentViewTimetableForWeek teacherViewTimetable -> snd $ Data.Foldable.foldr (
\studentViewTimetableForDay (day, teacherViewTimetable') -> (
pred day,
snd $ Data.Foldable.foldr (
\maybeStudentViewLesson (timeslotId, teacherViewTimetable'') -> (
pred timeslotId,
Data.Maybe.maybe teacherViewTimetable'' (
(
$ teacherViewTimetable''
) . bookStudentViewLesson permitTemporaryStudentBodyMerger . (,) (
studentBody,
Temporal.Time.mkTime day timeslotId
)
) maybeStudentViewLesson
)
) (
snd $ Data.Array.IArray.bounds studentViewTimetableForDay,
teacherViewTimetable'
) studentViewTimetableForDay
)
) (
snd $ Data.Array.IArray.bounds studentViewTimetableForWeek,
teacherViewTimetable
) studentViewTimetableForWeek
)
toStudentViewTimetable
:: (Data.Array.IArray.Ix timeslotId, Enum timeslotId)
=> StudentView.Timetable.Timetable timeslotId locationId teacherId level
-> Timetable teacherId timeslotId locationId level
-> StudentView.Timetable.Timetable timeslotId locationId teacherId level
toStudentViewTimetable = Data.Map.foldrWithKey (
\teacherId teacherViewTimetableForWeek studentViewTimetable -> snd $ Data.Foldable.foldr (
\teacherViewTimetableForDay (day, studentViewTimetable') -> (
pred day,
snd $ Data.Foldable.foldr (
\maybeTeacherViewLesson (timeslotId, studentViewTimetable'') -> (
pred timeslotId,
Data.Maybe.maybe studentViewTimetable'' (
(
$ studentViewTimetable''
) . bookTeacherViewLesson . (,) (
teacherId,
Temporal.Time.mkTime day timeslotId
)
) maybeTeacherViewLesson
)
) (
snd $ Data.Array.IArray.bounds teacherViewTimetableForDay,
studentViewTimetable'
) teacherViewTimetableForDay
)
) (
snd $ Data.Array.IArray.bounds teacherViewTimetableForWeek,
studentViewTimetable
) teacherViewTimetableForWeek
)
bookStudentViewLesson :: (
Data.Array.IArray.Ix timeslotId,
Eq locationId,
Eq level,
Ord teacherId,
Show level,
Show locationId,
Show teacherId,
Show timeslotId
)
=> Bool
-> StudentView.Timetable.Booking timeslotId locationId teacherId level
-> Timetable teacherId timeslotId locationId level
-> Timetable teacherId timeslotId locationId level
bookStudentViewLesson permitTemporaryStudentBodyMerger ((studentBody, time), studentViewLesson) teacherViewTimetable = Model.Timetable.defineTimeslot (
teacherViewTimetableCoordinates,
Just studentViewLesson {
Model.Lesson.getResourceIds = TeacherView.LessonResourceIds.mkLessonResourceIds locationId . Data.Set.insert studentBody $ case Model.Timetable.getMaybeLesson teacherViewTimetableCoordinates teacherViewTimetable of
Nothing -> Data.Set.empty
Just teacherViewLesson
| and [
permitTemporaryStudentBodyMerger,
TeacherView.LessonResourceIds.getLocationId teacherViewResourceIds == locationId,
Model.Lesson.getSubject teacherViewLesson == Model.Lesson.getSubject studentViewLesson
] -> TeacherView.LessonResourceIds.getStudentClass teacherViewResourceIds
| otherwise -> error $ "WeekDaze.TeacherView.Timetable.bookStudentViewLesson:\tlesson at coordinates=" ++ show teacherViewTimetableCoordinates ++ " has already been booked in either a different subject or location; " ++ show (studentViewLesson, teacherViewLesson) ++ "."
where
teacherViewResourceIds = Model.Lesson.getResourceIds teacherViewLesson
}
) teacherViewTimetable where
studentViewResourceIds = Model.Lesson.getResourceIds studentViewLesson
locationId = StudentView.LessonResourceIds.getLocationId studentViewResourceIds
teacherViewTimetableCoordinates = (StudentView.LessonResourceIds.getTeacherId studentViewResourceIds, time)
findStudentClassesByLocationId
:: (Data.Array.IArray.Ix timeslotId, Ord locationId)
=> Timetable teacherId timeslotId locationId level
-> Data.Map.Map locationId [Aggregate.StudentClass.StudentClass]
findStudentClassesByLocationId = Data.Map.fromListWith (++) . map (
(TeacherView.LessonResourceIds.getLocationId &&& return . TeacherView.LessonResourceIds.getStudentClass) . Model.Lesson.getResourceIds
) . Model.Timetable.extractLessons
calculateMeanStudentClassSize :: (
Data.Array.IArray.Ix timeslotId,
Fractional meanValue
) => Timetable teacherId timeslotId locationId level -> meanValue
calculateMeanStudentClassSize teacherViewTimetable
| null lessons = 0
| otherwise = Factory.Math.Statistics.getMean $ map (
Aggregate.StudentClass.getSize . TeacherView.LessonResourceIds.getStudentClass . Model.Lesson.getResourceIds
) lessons
where
lessons = Model.Timetable.extractLessons teacherViewTimetable
countLocationChangesByTeacherId :: (
Data.Array.IArray.Ix timeslotId,
Eq locationId
) => Timetable teacherId timeslotId locationId level -> Data.Map.Map teacherId Int
countLocationChangesByTeacherId = Data.Map.map TeacherView.TimetableForWeek.countLocationChanges
type Booking teacherId timeslotId locationId level = Model.Timetable.Booking teacherId timeslotId (TeacherView.LessonResourceIds.LessonResourceIds locationId) level
bookTeacherViewLesson
:: Data.Array.IArray.Ix timeslotId
=> Booking teacherId timeslotId locationId level
-> StudentView.Timetable.Timetable timeslotId locationId teacherId level
-> StudentView.Timetable.Timetable timeslotId locationId teacherId level
bookTeacherViewLesson ((teacherId, time), teacherViewLesson) studentViewTimetable = Data.Set.foldr (
Model.Timetable.defineTimeslot . flip (,) (
Just $ TeacherView.Lesson.toStudentView teacherId teacherViewLesson
) . flip (,) time
) studentViewTimetable $ TeacherView.LessonResourceIds.getStudentClass teacherViewResourceIds where
teacherViewResourceIds = Model.Lesson.getResourceIds teacherViewLesson
type InterCampusMigrationsByTeacherId teacherId = Data.Map.Map teacherId Size.NTimeslots
type TimesByTeacherId teacherId timeslotId = Data.Map.Map teacherId (Temporal.Time.TimeSet timeslotId)
toXHtml :: (
Data.Array.IArray.Ix timeslotId,
Fractional minimumContrastRatio,
Ord level,
Ord locationId,
Ord minimumContrastRatio,
Ord teacherId,
RealFrac teachingRatio,
Show level,
Show locationId,
Text.XHtml.Strict.HTML level,
Text.XHtml.Strict.HTML locationId,
Text.XHtml.Strict.HTML synchronisationId,
Text.XHtml.Strict.HTML teacherId,
Text.XHtml.Strict.HTML timeslotId
)
=> InterCampusMigrationsByTeacherId teacherId
-> TimesByTeacherId teacherId timeslotId
-> Size.NTimeslots
-> (teacherId -> TeacherView.Lesson.Lesson locationId level -> Data.Course.Course synchronisationId level timeslotId)
-> Aggregate.TeacherRegister.TeacherRegister teacherId synchronisationId level timeslotId locationId teachingRatio
-> Model.Timetable.GenericTimetableToMarkup locationId minimumContrastRatio teacherId timeslotId (Timetable teacherId timeslotId locationId level)
toXHtml interCampusMigrationsByTeacherId unbookedSpecifiedTimesByTeacherId nTimeslotsPerDay findCourseFor teacherRegister displaySupplementaryInformation meetingsByTime htmlMergeDuplicateTimeslots displayAxisLabels weekend maybeGenerateLessonColourFrom = Text.XHtml.Strict.defList . map (
\(teacherId, timetableForWeek) -> let
teacherProfile = teacherRegister ! teacherId
in (
Text.XHtml.Strict.unordList (
Text.XHtml.Strict.toHtml teacherId : if displaySupplementaryInformation
then Data.Maybe.catMaybes [
let
nInterCampusMigrations = interCampusMigrationsByTeacherId ! teacherId
in if nInterCampusMigrations == 0
then Nothing
else Just $ Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.warningCSSIdentifier,
Text.XHtml.Strict.title "The number of inter-campus migrations required of this teacher."
] << (
"Inter-campus migrations" +++ Text.XHtml.Strict.spaceHtml +++ '=' +++ Text.XHtml.Strict.spaceHtml +++ Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.numericDataCSSIdentifier
] << nInterCampusMigrations
),
if Data.HumanResource.getNTimeslotsPerWeekOfTeaching nTimeslotsPerDay teacherProfile == 0
then Nothing
else Just $ Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.infoCSSIdentifier,
Text.XHtml.Strict.title "Time allocated to teaching / time available for teaching."
] << (
"Utilisation-ratio" +++ Text.XHtml.Strict.spaceHtml +++ '=' +++ Text.XHtml.Strict.spaceHtml +++ Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.numericDataCSSIdentifier
] << (
round $ 100 * (
Model.TimetableForWeek.calculateUtilisationRatio nTimeslotsPerDay teacherProfile timetableForWeek ::Rational
) :: Int
) +++ '%'
),
let
nFreePeriods = Model.TimetableForWeek.countUnallocatedAvailableTimeslots teacherProfile timetableForWeek - Data.HumanResource.getNTimeslotsPerWeekOfNonTeaching nTimeslotsPerDay teacherProfile
in if nFreePeriods == 0
then Nothing
else Just $ Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.warningCSSIdentifier,
Text.XHtml.Strict.title "The number of available but unallocated time-slots, excluding those allocated to administration & meetings."
] << (
"Free-periods" +++ Text.XHtml.Strict.spaceHtml +++ '=' +++ Text.XHtml.Strict.spaceHtml +++ Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.numericDataCSSIdentifier
] << nFreePeriods
),
let
separatedEqualLessons = Model.TimetableForWeek.findSeparatedEqualLessonsWithinAnyDay timetableForWeek
in if null separatedEqualLessons
then Nothing
else Just $ Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.warningCSSIdentifier,
Text.XHtml.Strict.title "The number of instances of separated sessions of identical lessons, in any single day."
] << (
"Split sessions:" +++ Text.XHtml.Strict.defList (
map (
Data.Tuple.swap . Control.Arrow.first (
(
Text.XHtml.Strict.thespan Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.numericDataCSSIdentifier
] <<
) . pred
)
) separatedEqualLessons
)
),
let
unbookedSpecifiedTimes = unbookedSpecifiedTimesByTeacherId ! teacherId
in if Data.Set.null unbookedSpecifiedTimes
then Nothing
else Just $ Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.warningCSSIdentifier,
Text.XHtml.Strict.title "Times specified by courses, which haven't been booked, for courses which have."
] << (
"Unbooked times:" +++ (
Text.XHtml.Strict.thediv Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass Text.CSS.dataCSSIdentifier
] << Text.XHtml.Strict.unordList (
Data.Set.toAscList unbookedSpecifiedTimes
)
)
)
]
else []
) Text.XHtml.Strict.! [Text.XHtml.Strict.theclass Text.CSS.observerSummaryCSSIdentifier],
Model.TimetableForWeek.toXHtml (
findCourseFor teacherId
) teacherProfile (
Model.Meeting.deleteTeacherId teacherId meetingsByTime
) htmlMergeDuplicateTimeslots displayAxisLabels weekend maybeGenerateLessonColourFrom timetableForWeek
)
) . Data.Map.toList