{-# LANGUAGE CPP #-}
module WeekDaze.Data.Course(
Course(
getSubject,
getRequiredLessonsPerWeek,
getRequiredFacilityNames,
getTimeslotRequest,
getMinimumConsecutiveLessons,
getMaybeMaximumClassSize,
getMaybeSynchronisationId
),
maximumClassSizeTag,
minimumConsecutiveLessonsTag,
requiredFacilitiesTag,
requiredLessonsPerWeekTag,
defaultMinimumConsecutiveLessons,
countStudentPlaces,
calculateIdealConsecutiveLessons,
mkCourse,
isSuitable,
specifiesTimes,
isASpecifiedTime,
isASpecifiedDay,
isFluid,
isRigid,
hasRigidlySpecifiedDays,
requiresConsecutiveLessons,
requestsSeparatedTimelotsWithinAnyDay,
isSynchronised
) where
import Control.Arrow((&&&))
import qualified Control.DeepSeq
import qualified Data.Foldable
import qualified Data.List
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.Location as Data.Location
import qualified WeekDaze.Data.Subject as Data.Subject
import qualified WeekDaze.Size as Size
import qualified WeekDaze.Temporal.Day as Temporal.Day
import qualified WeekDaze.Temporal.Time as Temporal.Time
import qualified WeekDaze.Temporal.TimeslotRequest as Temporal.TimeslotRequest
tag :: String
tag = "course"
minimumConsecutiveLessonsTag :: String
minimumConsecutiveLessonsTag = "minimumConsecutiveLessons"
maximumClassSizeTag :: String
maximumClassSizeTag = "maximumClassSize"
requiredFacilitiesTag :: String
requiredFacilitiesTag = "requiredFacilities"
requiredLessonsPerWeekTag :: String
requiredLessonsPerWeekTag = "requiredLessonsPerWeek"
defaultMinimumConsecutiveLessons :: Size.NTimeslots
defaultMinimumConsecutiveLessons = 1
data Course synchronisationId level timeslotId = MkCourse {
getSubject :: Data.Subject.Subject level,
getRequiredLessonsPerWeek :: Size.NTimeslots,
getRequiredFacilityNames :: Data.Location.FacilityNames,
getTimeslotRequest :: Temporal.TimeslotRequest.TimeslotRequest timeslotId,
getMinimumConsecutiveLessons :: Size.NTimeslots,
getMaybeMaximumClassSize :: Maybe Size.NStudents,
getMaybeSynchronisationId :: Maybe synchronisationId
} deriving (Eq, Ord)
instance (Show synchronisationId, Show level, Show timeslotId) => Show (Course synchronisationId level timeslotId) where
showsPrec _ MkCourse {
getSubject = subject,
getRequiredLessonsPerWeek = requiredLessonsPerWeek,
getRequiredFacilityNames = requiredFacilityNames,
getTimeslotRequest = timeslotRequest,
getMinimumConsecutiveLessons = minimumConsecutiveLessons,
getMaybeMaximumClassSize = maybeMaximumClassSize,
getMaybeSynchronisationId = maybeSynchronisationId
} = foldr (.) (
showChar '}'
) . (
showString (tag ++ "={") :
) . Data.List.intersperse (
showString ", "
) $ [
showString Data.Subject.tag . showChar '=' . shows subject,
showString requiredLessonsPerWeekTag . showChar '=' . shows requiredLessonsPerWeek,
showString requiredFacilitiesTag . showChar '=' . shows (Data.Set.toList requiredFacilityNames),
shows timeslotRequest,
showString minimumConsecutiveLessonsTag . showChar '=' . shows minimumConsecutiveLessons
] ++ Data.Maybe.catMaybes [
fmap (\s -> showString maximumClassSizeTag . showChar '=' . shows s) maybeMaximumClassSize,
fmap shows maybeSynchronisationId
]
instance (
#if !MIN_VERSION_containers(0,5,2)
Ord timeslotId,
#endif
Show level,
Show synchronisationId,
Show timeslotId
) => ToolShed.SelfValidate.SelfValidator (Course synchronisationId level timeslotId) where
getErrors course@MkCourse {
getRequiredLessonsPerWeek = requiredLessonsPerWeek,
getTimeslotRequest = timeslotRequest,
getMinimumConsecutiveLessons = minimumConsecutiveLessons,
getMaybeMaximumClassSize = maybeMaximumClassSize
} = ToolShed.SelfValidate.extractErrors [
(
requiredLessonsPerWeek <= 0,
show requiredLessonsPerWeekTag ++ " must exceed zero; " ++ show course
), (
minimumConsecutiveLessons <= 0,
show minimumConsecutiveLessonsTag ++ " must exceed zero; " ++ show course
), (
requiredLessonsPerWeek < max minimumConsecutiveLessons (Temporal.TimeslotRequest.countSpecifiedTimes timeslotRequest),
show requiredLessonsPerWeekTag ++ " must be greater than or equal to both, '" ++ minimumConsecutiveLessonsTag ++ "', & the number of specified times; " ++ show course
), (
requiredLessonsPerWeek < Temporal.TimeslotRequest.countSpecifiedDays timeslotRequest * minimumConsecutiveLessons,
show requiredLessonsPerWeekTag ++ " must be greater than or equal to '" ++ minimumConsecutiveLessonsTag ++ "' multiplied by the number of distinct days on which times are specified; " ++ show course
), (
Data.Maybe.maybe False (<= 0) maybeMaximumClassSize,
show maximumClassSizeTag ++ " must exceed zero; " ++ show course
)
]
instance (
HXT.XmlPickler level,
HXT.XmlPickler synchronisationId,
HXT.XmlPickler timeslotId,
Ord timeslotId,
Show level,
Show synchronisationId,
Show timeslotId
) => HXT.XmlPickler (Course synchronisationId level timeslotId) where
xpickle = HXT.xpElem tag . HXT.xpWrap (
\(a, b, c, d, e, f, g) -> mkCourse a b c d e f g,
\MkCourse {
getSubject = subject,
getRequiredLessonsPerWeek = requiredLessonsPerWeek,
getRequiredFacilityNames = requiredFacilityNames,
getTimeslotRequest = timeslotRequest,
getMinimumConsecutiveLessons = minimumConsecutiveLessons,
getMaybeMaximumClassSize = maybeMaximumClassSize,
getMaybeSynchronisationId = maybeSynchronisationId
} -> (
subject,
requiredLessonsPerWeek,
requiredFacilityNames,
timeslotRequest,
minimumConsecutiveLessons,
maybeMaximumClassSize,
maybeSynchronisationId
)
) $ HXT.xp7Tuple HXT.xpickle (
HXT.xpAttr requiredLessonsPerWeekTag HXT.xpInt
) (
HXT.xpDefault Data.Location.defaultFacilityNames . HXT.xpElem requiredFacilitiesTag . HXT.xpWrap (
Data.Set.fromList,
Data.Set.toList
) . HXT.xpList1 . HXT.xpElem Data.Location.facilityNameTag $ HXT.xpTextAttr Data.Location.facilityValueTag
) HXT.xpickle (
defaultMinimumConsecutiveLessons `HXT.xpDefault` HXT.xpAttr minimumConsecutiveLessonsTag HXT.xpInt
) (
HXT.xpAttrImplied maximumClassSizeTag HXT.xpInt
) (
HXT.xpOption HXT.xpickle
)
instance (
Control.DeepSeq.NFData level,
Control.DeepSeq.NFData synchronisationId,
Control.DeepSeq.NFData timeslotId
) => Control.DeepSeq.NFData (Course synchronisationId level timeslotId) where
rnf (MkCourse x0 x1 x2 x3 x4 x5 x6) = Control.DeepSeq.rnf (x0, x1, x2, x3, x4, x5, x6)
mkCourse :: (
Show level,
Show synchronisationId,
Show timeslotId
)
=> Data.Subject.Subject level
-> Size.NTimeslots
-> Data.Location.FacilityNames
-> Temporal.TimeslotRequest.TimeslotRequest timeslotId
-> Size.NTimeslots
-> Maybe Size.NStudents
-> Maybe synchronisationId
-> Course synchronisationId level timeslotId
mkCourse subject requiredLessonsPerWeek facilityNames timeslotRequest minimumConsecutiveLessons maybeMaximumClassSize maybeSynchronisationId
| ToolShed.SelfValidate.isValid course = course
| otherwise = error $ "WeekDaze.Data.Course.mkCourse:\t" ++ ToolShed.SelfValidate.getFirstError course ++ "."
where
course = MkCourse {
getSubject = subject,
getRequiredLessonsPerWeek = requiredLessonsPerWeek,
getRequiredFacilityNames = facilityNames,
getTimeslotRequest = timeslotRequest,
getMinimumConsecutiveLessons = minimumConsecutiveLessons,
getMaybeMaximumClassSize = maybeMaximumClassSize,
getMaybeSynchronisationId = maybeSynchronisationId
}
countStudentPlaces :: Course synchronisationId level timeslotId -> Data.Location.Profile campus -> Size.NStudents
countStudentPlaces course = (\locationCapacity -> Data.Maybe.maybe locationCapacity (min locationCapacity) $ getMaybeMaximumClassSize course) . Data.Location.getCapacity
calculateIdealConsecutiveLessons :: Fractional f => Course synchronisationId level timeslotId -> f
calculateIdealConsecutiveLessons course
| minimumConsecutiveLessons == 1 = 1
| maximumSeparateSessions == 0 = error "WeekDaze.Data.Course.calculateIdealConsecutiveLessons:\tattempt to divide by zero (maximum separate sessions)."
| otherwise = fromIntegral requiredLessonsPerWeek / fromIntegral maximumSeparateSessions
where
(requiredLessonsPerWeek, minimumConsecutiveLessons) = getRequiredLessonsPerWeek &&& getMinimumConsecutiveLessons $ course
maximumSeparateSessions = requiredLessonsPerWeek `div` minimumConsecutiveLessons
isSuitable :: Eq level
=> Size.NStudents
-> Data.Subject.Subject level
-> Course synchronisationId level timeslotId
-> Bool
isSuitable requiredClassSize requiredSubject course = getSubject course == requiredSubject && Data.Maybe.maybe True (>= requiredClassSize) (getMaybeMaximumClassSize course)
specifiesTimes :: Course synchronisationId level timeslotId -> Bool
specifiesTimes = not . Temporal.TimeslotRequest.isNull . getTimeslotRequest
isASpecifiedTime :: Ord timeslotId => Temporal.Time.Time timeslotId -> Course synchronisationId level timeslotId -> Bool
isASpecifiedTime time = Temporal.TimeslotRequest.isASpecifiedTime time . getTimeslotRequest
isASpecifiedDay :: Temporal.Day.Day -> Course synchronisationId level timeslotId -> Bool
isASpecifiedDay day = Temporal.TimeslotRequest.isASpecifiedDay day . getTimeslotRequest
isFluid :: Course synchronisationId level timeslotId -> Bool
isFluid = Temporal.TimeslotRequest.isNull . getTimeslotRequest
isRigid :: Course synchronisationId level timeslotId -> Bool
isRigid = uncurry (==) . (getRequiredLessonsPerWeek &&& Temporal.TimeslotRequest.countSpecifiedTimes . getTimeslotRequest)
hasRigidlySpecifiedDays ::
#if !MIN_VERSION_containers(0,5,2)
Ord timeslotId =>
#endif
Course synchronisationId level timeslotId -> Bool
hasRigidlySpecifiedDays course = isRigid course || getRequiredLessonsPerWeek course == Temporal.TimeslotRequest.countSpecifiedDays (getTimeslotRequest course) * getMinimumConsecutiveLessons course
requiresConsecutiveLessons :: Course synchronisationId level timeslotId -> Bool
requiresConsecutiveLessons = (> 1) . getMinimumConsecutiveLessons
countImplicitlySpecifiedLessons :: (Enum timeslotId, Ord timeslotId) => Course synchronisationId level timeslotId -> Size.NTimeslots
countImplicitlySpecifiedLessons course = Data.Foldable.foldr (
(+) . max (
getMinimumConsecutiveLessons course
) . succ . uncurry Temporal.Time.calculateAbsoluteDistance . (
Data.Set.findMax &&& Data.Set.findMin
)
) 0 . Temporal.Time.categoriseByDay . Temporal.TimeslotRequest.getSpecifiedTimes $ getTimeslotRequest course
requestsSeparatedTimelotsWithinAnyDay :: (Enum timeslotId, Ord timeslotId) => Course synchronisationId level timeslotId -> Bool
requestsSeparatedTimelotsWithinAnyDay = uncurry (>) . (
countImplicitlySpecifiedLessons &&& getRequiredLessonsPerWeek
)
isSynchronised :: Course synchronisationId level timeslotId -> Bool
isSynchronised = Data.Maybe.isJust . getMaybeSynchronisationId