{-
	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@]

	* Defines the /timetable/ for any week, for all /teacher/s.

	* It contains identical information to 'StudentView.Timetable.Timetable',
	but the data has been re-indexed to present it in a form relevant to a /teacher/ rather than a /student/.
-}

module WeekDaze.TeacherView.Timetable(
-- * Types
-- ** Type-synonyms
        Timetable,
--	Booking,
        InterCampusMigrationsByTeacherId,
        TimesByTeacherId,
-- * Functions
        findStudentClassesByLocationId,
        calculateMeanStudentClassSize,
        countLocationChangesByTeacherId,
-- ** Mutators
        bookStudentViewLesson,
--	bookTeacherViewLesson,
-- ** Translation
        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()

-- | An association-list of the timetables for all /teachers/.
type Timetable teacherId timeslotId locationId level    = Model.Timetable.Timetable teacherId timeslotId (TeacherView.LessonResourceIds.LessonResourceIds locationId) level

{- |
	* Builds a 'Timetable' by inverting a 'StudentView.Timetable.Timetable'.

	* CAVEAT: in the original 'StudentView.Timetable.Timetable', different /student-bodies/ may simultaneously reference a single /teacher/.
	This is normal behaviour, provided the /teacher/ can cope with the class-size,
	& is implemented seemlessly, as a /map/-structure with one or more /key/s referencing a /value/, containing the same /teacher/.

	* When inverting such a /timetable/, this many-to-one relationship becomes a one-to-many, & a single /teacher-id/ must now reference many /student-bodies/.
	The simple /map/-structure, unlike a /multi-map/, can't directly accommodate multiple identical keys, with different values,
	so this is achieved by merging /student-bodies/ into /student-class/es.
-}
fromStudentViewTimetable :: (
        Data.Array.IArray.Ix    timeslotId,
        Enum                    timeslotId,
        Eq                      level,
        Eq                      locationId,
        Ord                     teacherId,
        Show                    level,
        Show                    locationId,
        Show                    teacherId,
        Show                    timeslotId
 )
        => Bool                                                 -- ^ Permit a temporary /student-body/ merger.
        -> Timetable teacherId timeslotId locationId level      -- ^ An unallocated /timetable/, supplied for efficiency.
        -> StudentView.Timetable.Timetable timeslotId locationId teacherId level
        -> Timetable teacherId timeslotId locationId level
fromStudentViewTimetable permitTemporaryStudentBodyMerger       = Data.Map.foldrWithKey (
        \studentBody studentViewTimetableForWeek teacherViewTimetable   -> snd {-timetable-} $ Data.Foldable.foldr (
                \studentViewTimetableForDay (day, teacherViewTimetable')        -> (
                        pred day,       -- Because of the use of 'foldr'.
                        snd {-timetable-} $ Data.Foldable.foldr (
                                \maybeStudentViewLesson (timeslotId, teacherViewTimetable'')    -> (
                                        pred timeslotId,        -- Because of the use of 'foldr'.
                                        Data.Maybe.maybe teacherViewTimetable'' (
                                                (
                                                        $ teacherViewTimetable''
                                                ) . bookStudentViewLesson permitTemporaryStudentBodyMerger {-partially apply-} . (,) (
                                                        studentBody,
                                                        Temporal.Time.mkTime day timeslotId
                                                ) {-construct a booking-}
                                        ) maybeStudentViewLesson
                                )
                        ) (
                                snd {-maximum timeslotId-} $ Data.Array.IArray.bounds studentViewTimetableForDay,
                                teacherViewTimetable'
                        ) studentViewTimetableForDay
                ) {-CAVEAT: performance-hotspot-}
        ) (
                snd {-maximum day-} $ Data.Array.IArray.bounds studentViewTimetableForWeek,
                teacherViewTimetable
        ) studentViewTimetableForWeek
 )

{- |
	* Build a 'StudentView.Timetable.Timetable', by inverting a 'Timetable'.

	* Each /lesson/ in the /timetable/ seen from the /teacher/'s perspective, contains a /student-class/.
	This /student-class/ must be broken into /student-bodies/, before inserting repeatedly into the required /timetable/ as seen from the /student-body/'s perpective.
-}
toStudentViewTimetable
        :: (Data.Array.IArray.Ix timeslotId, Enum timeslotId)
        => StudentView.Timetable.Timetable timeslotId locationId teacherId level        -- ^ An unallocated /timetable/, supplied for efficiency.
        -> Timetable teacherId timeslotId locationId level
        -> StudentView.Timetable.Timetable timeslotId locationId teacherId level
toStudentViewTimetable  = Data.Map.foldrWithKey (
        \teacherId teacherViewTimetableForWeek studentViewTimetable     -> snd {-timetable-} $ Data.Foldable.foldr (
                \teacherViewTimetableForDay (day, studentViewTimetable')        -> (
                        pred day,       -- Because of the use of 'foldr'.
                        snd {-timetable-} $ Data.Foldable.foldr (
                                \maybeTeacherViewLesson (timeslotId, studentViewTimetable'')    -> (
                                        pred timeslotId,        -- Because of the use of 'foldr'.
                                        Data.Maybe.maybe studentViewTimetable'' (
                                                (
                                                        $ studentViewTimetable''
                                                ) . bookTeacherViewLesson {-partially apply-} . (,) (
                                                        teacherId,
                                                        Temporal.Time.mkTime day timeslotId
                                                ) {-construct a booking-}
                                        ) maybeTeacherViewLesson
                                )
                        ) (
                                snd {-maximum timeslotId-} $ Data.Array.IArray.bounds teacherViewTimetableForDay,
                                studentViewTimetable'
                        ) teacherViewTimetableForDay
                )
        ) (
                snd {-maximum day-} $ Data.Array.IArray.bounds teacherViewTimetableForWeek,
                studentViewTimetable
        ) teacherViewTimetableForWeek
 )

-- | Apply a 'StudentView.Timetable.Booking' to a /TeacherView-timetable/.
bookStudentViewLesson :: (
        Data.Array.IArray.Ix    timeslotId,
        Eq                      locationId,
        Eq                      level,
        Ord                     teacherId,
        Show                    level,
        Show                    locationId,
        Show                    teacherId,
        Show                    timeslotId
 )
        => Bool                                                                 -- ^ Permit a temporary /student-body/ merger.
        -> StudentView.Timetable.Booking timeslotId locationId teacherId level  -- ^ The /coordinates/ & /lesson/ from the perspective of the /student/-view of the /timetable/.
        -> Timetable teacherId timeslotId locationId level                      -- ^ The /timetable/ as seen from the /teacher/'s perspective.
        -> 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       -- Start a new student-class.
                        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
        } -- Mutate.
 ) teacherViewTimetable where
        studentViewResourceIds          = Model.Lesson.getResourceIds studentViewLesson
        locationId                      = StudentView.LessonResourceIds.getLocationId studentViewResourceIds
        teacherViewTimetableCoordinates = (StudentView.LessonResourceIds.getTeacherId studentViewResourceIds, time)

-- | Catalogue the /student-class/es booked in the specified /timetable/, indexed by /location-Id/.
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 {-to List-monad-} . TeacherView.LessonResourceIds.getStudentClass) . Model.Lesson.getResourceIds
 ) . Model.Timetable.extractLessons

-- | Calculates the mean over all /booking/s, of the size of the /student-class/.
calculateMeanStudentClassSize :: (
        Data.Array.IArray.Ix    timeslotId,
        Fractional              meanValue
 ) => Timetable teacherId timeslotId locationId level -> meanValue
calculateMeanStudentClassSize teacherViewTimetable
        | null lessons  = 0     -- The timetable is completely unpopulated.
        | otherwise     = Factory.Math.Statistics.getMean $ map (
                Aggregate.StudentClass.getSize . TeacherView.LessonResourceIds.getStudentClass . Model.Lesson.getResourceIds
        ) lessons
        where
                lessons = Model.Timetable.extractLessons teacherViewTimetable

{- |
	* Counts the /location/-changes made by each /teacher/.

	* The minimum value of zero can be achieved either by a completely unbooked /timetable/,
	or one completely booked by the /lesson/s in the same /location/.

	* CAVEAT: doesn't account for the /location/ of any /meeting/s.
-}
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

-- | A /lesson/ qualified by the /coordinates/ at which it is booked.
type Booking teacherId timeslotId locationId level      = Model.Timetable.Booking teacherId timeslotId (TeacherView.LessonResourceIds.LessonResourceIds locationId) level

-- | Books a /TeacherView-booking/ in a /StudentView-timetable/.
bookTeacherViewLesson
        :: Data.Array.IArray.Ix timeslotId
        => Booking teacherId timeslotId locationId level                                -- ^ The /coordinates/ & /lesson/ from the perspective of the /teacher/-view of the /timetable/.
        -> StudentView.Timetable.Timetable timeslotId locationId teacherId level        -- ^ The /timetable/ as seen from the /student/'s perspective.
        -> 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

-- | The type of a map passed to 'toXHtml'.
type InterCampusMigrationsByTeacherId teacherId = Data.Map.Map teacherId Size.NTimeslots

-- | A map indexed by /teacherId/, of sets of /times/.
type TimesByTeacherId teacherId timeslotId      = Data.Map.Map teacherId (Temporal.Time.TimeSet timeslotId)

-- | Render in /XHTML/, as a /definition-list/.
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                                                                           -- ^ The number of inter-/campus/ /teacher/-migrations, indexed by /teacherId/.
        -> TimesByTeacherId teacherId timeslotId                                                                                -- ^ Unbooked but specified times, by /teacherId/.
        -> Size.NTimeslots                                                                                                      -- ^ The number of /time-slot/s per /day/.
        -> (teacherId -> TeacherView.Lesson.Lesson locationId level -> Data.Course.Course synchronisationId level timeslotId)   -- ^ Find the /course/ to which the specified /lesson/ belongs.
        -> 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 {-which includes the time for meetings-}
                                        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 {-count those exceeding one-}
                                                                        )
                                                                ) 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],       -- CAVEAT: xhtml only permits inline elements to be nested inside a 'dt' element, & 'ul' is a block element.
                Model.TimetableForWeek.toXHtml (
                        findCourseFor teacherId -- Partially apply.
                ) teacherProfile (
                        Model.Meeting.deleteTeacherId teacherId meetingsByTime
                ) htmlMergeDuplicateTimeslots displayAxisLabels weekend maybeGenerateLessonColourFrom timetableForWeek
        ) -- Pair.
 ) . Data.Map.toList