{-# LANGUAGE CPP, ScopedTypeVariables #-}
module WeekDaze.Model.TimetableForWeek(
TimetableForWeek,
Booking,
GenericTimetableToMarkup,
GenericTimetableToMarkup',
GeneralisedLessonRunlengthByTimeslotIdByDay,
RunlengthsByTimeslotIdByLessonByDay,
observerViewTerminatorCSSIdentifier,
unavailableCSSIdentifier,
calculateAverageAbsoluteDeviationOfFreeLessonsPerDay,
calculateUtilisationRatio,
locateUnallocatedAvailableTimes,
findGeneralisedLessonRunlengthsByTimeslotIdByDay,
findSeparatedEqualLessonsWithinAnyDay,
findSeparatedEqualSubjectLessonsWithinAnyDay,
findSeparatedEqualLessonRunlengthsByStartingTimeslotIdByLessonByDay,
countSubjectWorkload,
countWorkloadByLesson,
countUnallocatedAvailableTimeslots,
extractLessons,
extractTimes,
extractDistinctLessons,
extractMaybeLessonsAt,
getFreePeriodCompliance,
mkFreeTimetableForWeek,
getMaybeLesson,
getBookedTime,
getBookedLesson,
defineTimeslot,
undefineTimeslots,
hasMatchingLessonAt,
isBookedWith,
areAllSpecifiedTimesBookable,
isBookedOnAdjacentDay,
isDefinedTimeslot,
isRunlengthReducibleAt,
toXHtml,
xpickle
) where
import Control.Arrow((&&&), (***))
import Data.Array.IArray((!), (//))
import qualified Control.Arrow
import qualified Data.Array.IArray
import qualified Data.Foldable
import qualified Data.List
import qualified Data.Map
import qualified Data.Maybe
import qualified Data.Set
import qualified Factory.Data.Interval
import qualified Factory.Math.Statistics
import qualified Text.XHtml.Strict
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified ToolShed.Data.List
import qualified ToolShed.Data.Pair
import qualified WeekDaze.Colour.HTMLColour as Colour.HTMLColour
import qualified WeekDaze.Colour.HTMLColourCode as Colour.HTMLColourCode
import qualified WeekDaze.Colour.RGB as Colour.RGB
import qualified WeekDaze.Data.Course as Data.Course
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.Model.GenerateLessonColourFrom as Model.GenerateLessonColourFrom
import qualified WeekDaze.Model.Lesson as Model.Lesson
import qualified WeekDaze.Model.Meeting as Model.Meeting
import qualified WeekDaze.Model.TimetableForDay as Model.TimetableForDay
import qualified WeekDaze.Size as Size
import qualified WeekDaze.Temporal.Availability as Temporal.Availability
import qualified WeekDaze.Temporal.Day as Temporal.Day
import qualified WeekDaze.Temporal.FreePeriodPreference as Temporal.FreePeriodPreference
import qualified WeekDaze.Temporal.Time as Temporal.Time
import qualified WeekDaze.Temporal.TimeAxes as Temporal.TimeAxes
import qualified WeekDaze.Temporal.TimeslotRequest as Temporal.TimeslotRequest
import qualified WeekDaze.Text.CSS as Text.CSS
import Text.XHtml.Strict((+++), (<<))
meetingsCSSIdentifier :: Text.CSS.CSSIdentifier
meetingsCSSIdentifier = "meetings"
observerViewTerminatorCSSIdentifier :: Text.CSS.CSSIdentifier
observerViewTerminatorCSSIdentifier = "observerViewTerminator"
originCSSIdentifier :: Text.CSS.CSSIdentifier
originCSSIdentifier = "origin"
unallocatedTimeslotCSSIdentifier :: Text.CSS.CSSIdentifier
unallocatedTimeslotCSSIdentifier = "unallocatedTimeslot"
unavailableCSSIdentifier :: Text.CSS.CSSIdentifier
unavailableCSSIdentifier = "unavailable"
weekendCSSIdentifier :: Text.CSS.CSSIdentifier
weekendCSSIdentifier = "weekend"
workdayCSSIdentifier :: Text.CSS.CSSIdentifier
workdayCSSIdentifier = "workday"
tag :: String
tag = "timetableForWeek"
dayToTimetableAssociationTag :: String
dayToTimetableAssociationTag = "dayToTimetableAssociation"
type TimetableForWeek timeslotId resourceIds level = Data.Array.IArray.Array Temporal.Day.Day (Model.TimetableForDay.TimetableForDay timeslotId resourceIds level)
type Association timeslotId resourceIds level = (Temporal.Day.Day, Model.TimetableForDay.TimetableForDay timeslotId resourceIds level)
getDay :: Association timeslotId resourceIds level -> Temporal.Day.Day
getDay = fst
getTimetableForDay :: Association timeslotId resourceIds level -> Model.TimetableForDay.TimetableForDay timeslotId resourceIds level
getTimetableForDay = snd
getMaybeLesson
:: Data.Array.IArray.Ix timeslotId
=> Temporal.Time.Time timeslotId
-> TimetableForWeek timeslotId resourceIds level
-> Model.Lesson.GeneralisedLesson resourceIds level
getMaybeLesson time = (! Temporal.Time.getTimeslotId time) . (! Temporal.Time.getDay time)
isDefinedTimeslot
:: Data.Array.IArray.Ix timeslotId
=> Temporal.Time.Time timeslotId
-> TimetableForWeek timeslotId resourceIds level
-> Bool
isDefinedTimeslot time = Data.Maybe.isJust . getMaybeLesson time
extractMaybeLessonsAt
:: Data.Array.IArray.Ix timeslotId
=> timeslotId
-> TimetableForWeek timeslotId resourceIds level
-> Data.Array.IArray.Array Temporal.Day.Day (Model.Lesson.GeneralisedLesson resourceIds level)
extractMaybeLessonsAt timeslotId = Data.Array.IArray.amap (! timeslotId)
extractDistinctLessons :: (
Data.Array.IArray.Ix timeslotId,
Ord resourceIds,
Ord level
) => TimetableForWeek timeslotId resourceIds level -> Data.Set.Set (Model.Lesson.Lesson resourceIds level)
extractDistinctLessons = Data.Set.fromList . extractLessons
calculateAverageAbsoluteDeviationOfFreeLessonsPerDay :: (
Data.Array.IArray.Ix timeslotId,
Data.Resource.Resource resource,
Fractional average
)
=> resource
-> TimetableForWeek timeslotId resourceIds level
-> average
calculateAverageAbsoluteDeviationOfFreeLessonsPerDay resource = Factory.Math.Statistics.getAverageAbsoluteDeviation . map (
Model.TimetableForDay.countUnallocatedTimeslots . getTimetableForDay
) . filter (
(`Data.Resource.isAvailableOn` resource) . getDay
) . Data.Array.IArray.assocs
countWorkload :: Data.Array.IArray.Ix timeslotId => TimetableForWeek timeslotId resourceIds level -> Size.NTimeslots
countWorkload = length . extractLessons
countSubjectWorkload
:: (Data.Array.IArray.Ix timeslotId, Ord level)
=> Data.Subject.Subject level
-> TimetableForWeek timeslotId resourceIds level
-> Size.NTimeslots
countSubjectWorkload subject = length . filter ((== subject) . Model.Lesson.getSubject) . extractLessons
countWorkloadByLesson :: (
Data.Array.IArray.Ix timeslotId,
Ord level,
Ord resourceIds
) => TimetableForWeek timeslotId resourceIds level -> Data.Map.Map (Model.Lesson.Lesson resourceIds level) Size.NTimeslots
countWorkloadByLesson = foldr (
flip (Data.Map.insertWith $ const succ) 1
) Data.Map.empty . extractLessons
calculateUtilisationRatio :: (
Data.Array.IArray.Ix timeslotId,
Data.HumanResource.HumanResource humanResource,
Fractional teachingRatio
)
=> Size.NTimeslots
-> humanResource
-> TimetableForWeek timeslotId resourceIds level
-> teachingRatio
calculateUtilisationRatio nTimeslotsPerDay humanResource timetableForWeek
| denominator == 0 = if numerator == 0
then 1
else error "WeekDaze.Model.TimetableForWeek.calculateUtilisationRatio:\tattempt to divide by zero (time-slots per week of teaching)."
| otherwise = fromIntegral numerator / fromIntegral denominator
where
numerator = countWorkload timetableForWeek
denominator = Data.HumanResource.getNTimeslotsPerWeekOfTeaching nTimeslotsPerDay humanResource
defineTimeslot
:: Data.Array.IArray.Ix timeslotId
=> (Temporal.Time.Time timeslotId, Model.Lesson.GeneralisedLesson resourceIds level)
-> TimetableForWeek timeslotId resourceIds level
-> TimetableForWeek timeslotId resourceIds level
defineTimeslot (time, maybeLesson) timetableForWeek = timetableForWeek // [
(
day,
Model.TimetableForDay.defineTimeslot (Temporal.Time.getTimeslotId time, maybeLesson) $ timetableForWeek ! day
)
] where
day = Temporal.Time.getDay time
undefineTimeslots
:: (Data.Array.IArray.Ix timeslotId, Data.Foldable.Foldable foldable)
=> TimetableForWeek timeslotId resourceIds level
-> foldable (Temporal.Time.Time timeslotId)
-> TimetableForWeek timeslotId resourceIds level
undefineTimeslots = Data.Foldable.foldr $ defineTimeslot . flip (,) Nothing
getFreePeriodCompliance :: (
Data.Array.IArray.Ix timeslotId,
Data.Resource.Resource resource,
Fractional ratio
)
=> Temporal.FreePeriodPreference.FreePeriodPreference
-> Temporal.Time.TimesByDay timeslotId
-> resource
-> TimetableForWeek timeslotId resourceIds level
-> [ratio]
getFreePeriodCompliance freePeriodPreference meetingTimesByDay resource timetableForWeek = map (
uncurry (
Model.TimetableForDay.measureFreePeriodCompliance freePeriodPreference
) . (
Data.Maybe.fromMaybe Data.Set.empty . (`Data.Map.lookup` meetingTimesByDay) &&& (timetableForWeek !)
)
) . Data.Set.elems . Temporal.Availability.deconstruct $ Data.Resource.getAvailability resource
type GenericTimetableToMarkup minimumContrastRatio timetable
= Temporal.TimeAxes.TimeAxes Bool
-> Temporal.TimeAxes.TimeAxes Bool
-> Temporal.Day.Weekend
-> Maybe (
Model.GenerateLessonColourFrom.GenerateLessonColourFrom,
minimumContrastRatio
)
-> timetable
-> Text.XHtml.Strict.Html
type GenericTimetableToMarkup' locationId minimumContrastRatio teacherId timeslotId timetable
= Model.Meeting.MeetingsByTime timeslotId locationId teacherId
-> GenericTimetableToMarkup minimumContrastRatio timetable
toXHtml :: forall level locationId minimumContrastRatio resource resourceIds synchronisationId teacherId timeslotId. (
Data.Array.IArray.Ix timeslotId,
Data.Resource.Resource resource,
Eq level,
Eq resourceIds,
Fractional minimumContrastRatio,
Ord minimumContrastRatio,
#if !MIN_VERSION_containers(0,5,2)
Ord locationId,
Ord teacherId,
#endif
Show level,
Show resourceIds,
Text.XHtml.Strict.HTML level,
Text.XHtml.Strict.HTML locationId,
Text.XHtml.Strict.HTML resourceIds,
Text.XHtml.Strict.HTML synchronisationId,
Text.XHtml.Strict.HTML teacherId,
Text.XHtml.Strict.HTML timeslotId
)
=> (Model.Lesson.Lesson resourceIds level -> Data.Course.Course synchronisationId level timeslotId)
-> resource
-> GenericTimetableToMarkup' locationId minimumContrastRatio teacherId timeslotId (TimetableForWeek timeslotId resourceIds level)
toXHtml findCourseFor resource meetingsByTime mergeDuplicateTimeslots displayAxisLabels weekend maybeGenerateLessonColourFrom timetableForWeek = (
Text.XHtml.Strict.table Text.XHtml.Strict.! [
Text.XHtml.Strict.theclass tag,
Text.XHtml.Strict.title "Timetable for Week"
] <<
) . (
if Temporal.TimeAxes.getByDay displayAxisLabels
then (
Text.XHtml.Strict.tr << (
if Temporal.TimeAxes.getByTimeslotId displayAxisLabels
then (
(
Text.XHtml.Strict.th Text.XHtml.Strict.! [Text.XHtml.Strict.theclass originCSSIdentifier]
) << Text.XHtml.Strict.noHtml :
)
else id
) (
map (
\day -> (
Text.XHtml.Strict.th Text.XHtml.Strict.! if Data.Set.member day weekend
then [
Text.XHtml.Strict.theclass weekendCSSIdentifier,
Text.XHtml.Strict.title weekendCSSIdentifier
]
else [
Text.XHtml.Strict.theclass workdayCSSIdentifier,
Text.XHtml.Strict.title "Work-day"
]
) << day
) Temporal.Day.range
) :
)
else id
) . map (
(Text.XHtml.Strict.tr <<) . (
if Temporal.TimeAxes.getByDay mergeDuplicateTimeslots
then map (
uncurry (Text.XHtml.Strict.!) . (head &&& return . Text.XHtml.Strict.colspan . length)
) . Data.List.groupBy (ToolShed.Data.List.equalityBy show)
else id
)
) . Data.List.transpose . (
if Temporal.TimeAxes.getByTimeslotId displayAxisLabels
then (
map (
Text.XHtml.Strict.th <<
) (
Data.Array.IArray.indices $ timetableForWeek ! minBound
) :
)
else id
) . map (
\(day, timetableForDay) -> let
isAvailable :: Bool
isAvailable = Data.Resource.isAvailableOn day resource
toXHtmlLesson :: Size.NTimeslots -> timeslotId -> Model.Lesson.GeneralisedLesson resourceIds level -> Text.XHtml.Strict.Html
toXHtmlLesson rowspan timeslotId = Data.Maybe.maybe (
if isAvailable
then Data.Maybe.maybe (
Text.XHtml.Strict.td Text.XHtml.Strict.! [
Text.XHtml.Strict.rowspan rowspan,
Text.XHtml.Strict.theclass unallocatedTimeslotCSSIdentifier,
Text.XHtml.Strict.title "Not booked for teaching, but possibly kept free for another activity."
] << "Unallocated"
) (
(
(
Text.XHtml.Strict.td Text.XHtml.Strict.! [
Text.XHtml.Strict.rowspan rowspan,
Text.XHtml.Strict.theclass meetingsCSSIdentifier,
Text.XHtml.Strict.title meetingsCSSIdentifier
]
) <<
) . Data.List.intersperse Text.XHtml.Strict.hr . map Text.XHtml.Strict.toHtml . Data.Set.toList
) $ Data.Map.lookup (Temporal.Time.mkTime day timeslotId) meetingsByTime
else Text.XHtml.Strict.td Text.XHtml.Strict.! [
Text.XHtml.Strict.rowspan rowspan,
Text.XHtml.Strict.theclass unavailableCSSIdentifier,
Text.XHtml.Strict.title "Not scheduled to be available today."
] << "N/A"
) $ \lesson -> Text.XHtml.Strict.td Text.XHtml.Strict.! (Text.XHtml.Strict.rowspan rowspan :) (
Data.Maybe.maybe [
Text.XHtml.Strict.theclass . Text.CSS.mkIdentifier . (
(Data.Subject.topicTag ++ "_") ++
) . Data.Subject.getTopic $ Model.Lesson.getSubject lesson
] (
\(dataSource, minimumContrastRatio) -> (
\s -> let
htmlColourCode, complementaryHTMLColourCode :: Colour.HTMLColourCode.HTMLColourCode
htmlColourCode = Colour.HTMLColourCode.generateHTMLColourCodeFrom s
complementaryHTMLColourCode = Colour.HTMLColourCode.deriveComplementaryHTMLColourCode htmlColourCode
(red, green, blue) = Colour.RGB.toTriple . (
Colour.RGB.toRGBUnitInterval :: Colour.RGB.RGB Int -> Colour.RGB.RGB Rational
) $ Colour.HTMLColour.htmlColourCodeToRGB htmlColourCode `Colour.RGB.absDifference` Colour.HTMLColour.htmlColourCodeToRGB complementaryHTMLColourCode
in if Factory.Math.Statistics.getMean [red, green, blue] < minimumContrastRatio
then []
else [
Text.XHtml.Strict.thestyle $ "color: " ++ htmlColourCode ++ "; background-color: " ++ complementaryHTMLColourCode
]
) $ case dataSource of
Model.GenerateLessonColourFrom.Lesson -> show lesson
Model.GenerateLessonColourFrom.Subject -> show $ Model.Lesson.getSubject lesson
Model.GenerateLessonColourFrom.Topic -> Data.Subject.getTopic $ Model.Lesson.getSubject lesson
Model.GenerateLessonColourFrom.Level -> show . Data.Subject.getLevel $ Model.Lesson.getSubject lesson
Model.GenerateLessonColourFrom.ResourceIds -> show $ Model.Lesson.getResourceIds lesson
) maybeGenerateLessonColourFrom
) << (
Data.Maybe.maybe Text.XHtml.Strict.noHtml Text.XHtml.Strict.toHtml (
Data.Course.getMaybeSynchronisationId $ findCourseFor lesson
) +++ lesson
)
in (
if Temporal.TimeAxes.getByTimeslotId mergeDuplicateTimeslots
then concatMap (
\equalsByGeneralisedLesson -> let
nDuplicates = length equalsByGeneralisedLesson
in uncurry (toXHtmlLesson nDuplicates ) (
head equalsByGeneralisedLesson
) : replicate (pred nDuplicates) Text.XHtml.Strict.noHtml
) . Data.List.groupBy (
if isAvailable
then ToolShed.Data.List.equalityBy (
Control.Arrow.first $ (
Data.Set.map Model.Meeting.getGroupId `fmap`
) . (
`Data.Map.lookup` meetingsByTime
) . Temporal.Time.mkTime day
)
else ToolShed.Data.List.equalityBy Model.TimetableForDay.getMaybeLesson
)
else map (uncurry $ toXHtmlLesson 1 )
) $ Data.Array.IArray.assocs timetableForDay
) $ Data.Array.IArray.assocs timetableForWeek
extractLessons :: Data.Array.IArray.Ix timeslotId => TimetableForWeek timeslotId resourceIds level -> [Model.Lesson.Lesson resourceIds level]
extractLessons timetableForWeek = [
lesson |
timetableForDay <- Data.Array.IArray.elems timetableForWeek,
Just lesson <- Data.Array.IArray.elems timetableForDay
]
extractTimes :: Data.Array.IArray.Ix timeslotId => TimetableForWeek timeslotId resourceIds level -> [Temporal.Time.Time timeslotId]
extractTimes timetableForWeek = [
Temporal.Time.mkTime day timeslotId |
(day, timetableForDay) <- Data.Array.IArray.assocs timetableForWeek,
timeslotId <- Data.Array.IArray.indices timetableForDay
]
locateUnallocatedAvailableTimes
:: (Data.Array.IArray.Ix timeslotId, Data.Resource.Resource resource)
=> resource
-> TimetableForWeek timeslotId resourceIds level
-> [Temporal.Time.Time timeslotId]
locateUnallocatedAvailableTimes resource timetableForWeek = [
Temporal.Time.mkTime day unallocatedAvailableTimeslotId |
(day, timetableForDay) <- Data.Array.IArray.assocs timetableForWeek,
Data.Resource.isAvailableOn day resource,
unallocatedAvailableTimeslotId <- Model.TimetableForDay.locateUnallocatedTimeslots timetableForDay
]
countUnallocatedAvailableTimeslots
:: (Data.Array.IArray.Ix timeslotId, Data.Resource.Resource resource)
=> resource
-> TimetableForWeek timeslotId resourceIds level
-> Size.NTimeslots
countUnallocatedAvailableTimeslots resource = length . locateUnallocatedAvailableTimes resource
xpickle :: (
Data.Array.IArray.Ix timeslotId,
HXT.XmlPickler level,
HXT.XmlPickler resourceIds,
HXT.XmlPickler timeslotId,
Show level
) => HXT.PU (TimetableForWeek timeslotId resourceIds level)
xpickle = HXT.xpElem tag . HXT.xpWrap (
Data.Array.IArray.array (minBound, maxBound),
Data.Array.IArray.assocs
) . HXT.xpList1 . HXT.xpElem dayToTimetableAssociationTag $ HXT.xpPair HXT.xpickle Model.TimetableForDay.xpickle
type Booking timeslotId resourceIds level = (Temporal.Time.Time timeslotId, Model.Lesson.Lesson resourceIds level)
getBookedTime :: Booking timeslotId resourceIds level -> Temporal.Time.Time timeslotId
getBookedTime = fst
getBookedLesson :: Booking timeslotId resourceIds level -> Model.Lesson.Lesson resourceIds level
getBookedLesson = snd
hasMatchingLessonAt
:: Data.Array.IArray.Ix timeslotId
=> (Model.Lesson.Lesson resourceIds level -> Bool)
-> Temporal.Time.Time timeslotId
-> TimetableForWeek timeslotId resourceIds level
-> Bool
hasMatchingLessonAt lessonPredicate time = Data.Maybe.maybe False lessonPredicate . getMaybeLesson time
isBookedWith :: (
Data.Array.IArray.Ix timeslotId,
Eq level,
Eq resourceIds
)
=> Booking timeslotId resourceIds level
-> TimetableForWeek timeslotId resourceIds level
-> Bool
isBookedWith booking = hasMatchingLessonAt (== getBookedLesson booking) (getBookedTime booking)
mkFreeTimetableForWeek :: (Data.Array.IArray.Ix timeslotId, Enum timeslotId) => Factory.Data.Interval.Interval timeslotId -> TimetableForWeek timeslotId resourceIds level
mkFreeTimetableForWeek = Data.Array.IArray.array (minBound, maxBound) . zip [minBound .. maxBound] . repeat . Model.TimetableForDay.mkFreeTimetableForDay
type GeneralisedLessonRunlengthByTimeslotIdByDay timeslotId resourceIds level = Data.Array.IArray.Array Temporal.Day.Day (Model.TimetableForDay.GeneralisedLessonRunlengthByTimeslotId timeslotId resourceIds level)
findGeneralisedLessonRunlengthsByTimeslotIdByDay :: (
Data.Array.IArray.Ix timeslotId,
Enum timeslotId,
Eq resourceIds,
Eq level
) => TimetableForWeek timeslotId resourceIds level -> GeneralisedLessonRunlengthByTimeslotIdByDay timeslotId resourceIds level
findGeneralisedLessonRunlengthsByTimeslotIdByDay = Data.Array.IArray.amap Model.TimetableForDay.findGeneralisedLessonRunlengthsByTimeslotId
findSeparatedEqualLessonsWithinAnyDay :: (
Data.Array.IArray.Ix timeslotId,
Ord resourceIds,
Ord level
) => TimetableForWeek timeslotId resourceIds level -> Model.TimetableForDay.LessonRunlengths resourceIds level
findSeparatedEqualLessonsWithinAnyDay = Data.Foldable.concatMap Model.TimetableForDay.findSeparatedEqualLessons
findSeparatedEqualSubjectLessonsWithinAnyDay :: (
Data.Array.IArray.Ix timeslotId,
Eq resourceIds,
Ord level
) => TimetableForWeek timeslotId resourceIds level -> Model.TimetableForDay.LessonRunlengths resourceIds level
findSeparatedEqualSubjectLessonsWithinAnyDay = Data.Foldable.concatMap Model.TimetableForDay.findSeparatedEqualSubjectLessons
type RunlengthsByTimeslotIdByLessonByDay resourceIds level timeslotId = Data.Array.IArray.Array Temporal.Day.Day (Model.TimetableForDay.RunlengthsByTimeslotIdByLesson resourceIds level timeslotId)
findSeparatedEqualLessonRunlengthsByStartingTimeslotIdByLessonByDay :: (
Data.Array.IArray.Ix timeslotId,
Ord resourceIds,
Ord level
) => TimetableForWeek timeslotId resourceIds level -> RunlengthsByTimeslotIdByLessonByDay resourceIds level timeslotId
findSeparatedEqualLessonRunlengthsByStartingTimeslotIdByLessonByDay = Data.Array.IArray.amap Model.TimetableForDay.findSeparatedEqualLessonRunlengthsByStartingTimeslotIdByLesson
areAllSpecifiedTimesBookable
:: (Data.Resource.Resource resource, Data.Array.IArray.Ix timeslotId)
=> resource
-> TimetableForWeek timeslotId resourceIds level
-> Data.Course.Course synchronisationId level timeslotId
-> Bool
areAllSpecifiedTimesBookable resource timetableForWeek = Data.Foldable.all (
uncurry (&&) . (
not . (`isDefinedTimeslot` timetableForWeek) &&& (`Data.Resource.isAvailableOn` resource) . Temporal.Time.getDay
)
) . Temporal.TimeslotRequest.getSpecifiedTimes . Data.Course.getTimeslotRequest
isBookedOnAdjacentDay :: (
#if !MIN_VERSION_array(0,5,2)
Data.Array.IArray.Ix timeslotId,
#endif /* CAVEAT: constraint unnecessary from "Data.Array.IArray-0.5.1.1" */
Eq level,
Eq resourceIds
)
=> TimetableForWeek timeslotId resourceIds level
-> Model.Lesson.Lesson resourceIds level
-> Temporal.Day.Day
-> Bool
isBookedOnAdjacentDay timetableForWeek lesson = uncurry (||) . ToolShed.Data.Pair.mirror (
Data.Foldable.elem (Just lesson) . (timetableForWeek !)
) . Temporal.Day.getAdjacentDays
isRunlengthReducibleAt :: (
Data.Array.IArray.Ix timeslotId,
Enum timeslotId,
Eq level,
Eq resourceIds
)
=> TimetableForWeek timeslotId resourceIds level
-> Temporal.Time.Time timeslotId
-> Data.Course.Course synchronisationId level timeslotId
-> Bool
isRunlengthReducibleAt timetableForWeek time course
| minimumConsecutiveLessons == 1 = True
| otherwise = uncurry (&&) . (
uncurry (||) . ToolShed.Data.Pair.mirror (
== timeslotId
) *** (
> minimumConsecutiveLessons
)
) . Model.TimetableForDay.measureRunlengthAt timeslotId . (
timetableForWeek !
) $ Temporal.Time.getDay time
where
timeslotId = Temporal.Time.getTimeslotId time
minimumConsecutiveLessons = Data.Course.getMinimumConsecutiveLessons course