module WeekDaze.Data.Student(
Id,
KnowledgeRequirements,
Profile(
getStream,
getKnowledgeRequirements,
getTeachingRatio,
getMaybeFreePeriodPreference
),
knowledgeRequirementsTag,
teachingRatioTag,
defaultTeachingRatio,
amalgamateKnowledgeRequirements,
deriveAmalgamatedKnowledgeRequirement,
unsubscribe,
mkProfile,
hasAnyCoreKnowledgeRequirements,
hasAnyOptionalKnowledgeRequirements,
requiresAnySubjectBy
) where
import Control.Arrow((&&&), (***))
import qualified Control.DeepSeq
import qualified Data.Default
import qualified Data.Foldable
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.Group as Data.Group
import qualified WeekDaze.Data.HumanResource as Data.HumanResource
import qualified WeekDaze.Data.Requirements as Data.Requirements
import qualified WeekDaze.Data.Resource as Data.Resource
import qualified WeekDaze.Data.Subject as Data.Subject
import qualified WeekDaze.Temporal.Availability as Temporal.Availability
import qualified WeekDaze.Temporal.FreePeriodPreference as Temporal.FreePeriodPreference
tag :: String
tag = "studentProfile"
streamTag :: String
streamTag = "stream"
knowledgeRequirementsTag :: String
knowledgeRequirementsTag = "knowledgeRequirements"
teachingRatioTag :: String
teachingRatioTag = "teachingRatio"
defaultTeachingRatio :: Num teachingRatio => teachingRatio
defaultTeachingRatio = 1
type Id = String
type KnowledgeRequirements level = Data.Requirements.Requirements (Data.Subject.Knowledge level)
amalgamateKnowledgeRequirements :: Ord level => KnowledgeRequirements level -> Data.Subject.Knowledge level
amalgamateKnowledgeRequirements = uncurry Data.Set.union
data Profile level stream teachingRatio = MkProfile {
getStream :: stream,
getKnowledgeRequirements :: KnowledgeRequirements level,
getWorkingWeek :: Temporal.Availability.Availability,
getTeachingRatio :: teachingRatio,
getGroupMembership :: Data.Group.Membership,
getMaybeFreePeriodPreference :: Maybe Temporal.FreePeriodPreference.FreePeriodPreference
} deriving (Eq, Ord)
instance (Show level, Show stream, Show teachingRatio) => Show (Profile level stream teachingRatio) where
showsPrec _ MkProfile {
getStream = stream,
getKnowledgeRequirements = knowledgeRequirements,
getWorkingWeek = workingWeek,
getTeachingRatio = teachingRatio,
getGroupMembership = groupMembership,
getMaybeFreePeriodPreference = maybeFreePeriodPreference
} = showString tag . showString "={" . showString streamTag . showChar '=' . shows stream . showChar ',' . showString knowledgeRequirementsTag . showChar '=' . shows (
Data.Set.toList *** Data.Set.toList $ knowledgeRequirements
) . showChar ',' . showString Temporal.Availability.tag . showChar '=' . shows workingWeek . showChar ',' . showString teachingRatioTag . showChar '=' . shows teachingRatio . showChar ',' . showString Data.HumanResource.groupMembershipTag . showChar '=' . shows (
Data.Set.toList groupMembership
) . showChar ',' . showString Temporal.FreePeriodPreference.tag . showChar '=' . showString (
Data.Maybe.maybe "<none>" show maybeFreePeriodPreference
) . showChar '}'
instance (
Ord level,
Real teachingRatio,
Show level
) => ToolShed.SelfValidate.SelfValidator (Profile level stream teachingRatio) where
getErrors MkProfile {
getKnowledgeRequirements = knowledgeRequirements,
getWorkingWeek = workingWeek,
getTeachingRatio = teachingRatio
}
| not $ ToolShed.SelfValidate.isValid workingWeek = ToolShed.SelfValidate.getErrors workingWeek
| otherwise = ToolShed.SelfValidate.extractErrors [
let
duplicateKnowledgeRequirements = uncurry Data.Set.intersection knowledgeRequirements
in (
not $ Data.Set.null duplicateKnowledgeRequirements,
"overlapping " ++ show knowledgeRequirementsTag ++ "; " ++ show duplicateKnowledgeRequirements
), (
any ($ teachingRatio) [(<= 0), (> 1)],
show teachingRatioTag ++ " '" ++ show (realToFrac teachingRatio :: Double ) ++ "' must be within the semi-closed unit-interval '(0,1]'"
)
]
instance Data.Resource.Resource (Profile level stream teachingRatio) where
getAvailability = getWorkingWeek
instance RealFrac teachingRatio => Data.HumanResource.HumanResource (Profile level stream teachingRatio) where
getNTimeslotsPerWeekOfTeaching nTimeslotsPerDay = round . uncurry (*) . (getTeachingRatio &&& fromIntegral . Data.HumanResource.calculateNTimeslotsPerWeekAvailable nTimeslotsPerDay)
getNTimeslotsPerWeekOfNonTeaching nTimeslotsPerDay = uncurry (-) . (
Data.HumanResource.calculateNTimeslotsPerWeekAvailable nTimeslotsPerDay &&& Data.HumanResource.getNTimeslotsPerWeekOfTeaching nTimeslotsPerDay
)
getGroupMembership = getGroupMembership
getMaybeFreePeriodPreference = getMaybeFreePeriodPreference
instance (
Data.Default.Default stream,
Eq stream,
HXT.XmlPickler level,
HXT.XmlPickler stream,
HXT.XmlPickler teachingRatio,
Ord level,
Real teachingRatio,
Show level
) => HXT.XmlPickler (Profile level stream teachingRatio) where
xpickle = HXT.xpElem tag . HXT.xpWrap (
\(a, b, c, d, e, f) -> mkProfile a b c d e f,
\MkProfile {
getStream = stream,
getKnowledgeRequirements = knowledgeRequirements,
getWorkingWeek = workingWeek,
getTeachingRatio = teachingRatio,
getGroupMembership = groupMembership,
getMaybeFreePeriodPreference = maybeFreePeriodPreference
} -> (
stream,
knowledgeRequirements,
workingWeek,
teachingRatio,
groupMembership,
maybeFreePeriodPreference
)
) $ HXT.xp6Tuple (
HXT.xpDefault Data.Default.def HXT.xpickle
) (
HXT.xpElem knowledgeRequirementsTag $ HXT.xpElem Data.Requirements.coreTag (
HXT.xpWrap (
Data.Set.fromList,
Data.Set.toList
) $ HXT.xpList1 HXT.xpickle
) `HXT.xpPair` HXT.xpDefault Data.Set.empty (
HXT.xpElem Data.Requirements.optionalTag . HXT.xpWrap (
Data.Set.fromList,
Data.Set.toList
) $ HXT.xpList1 HXT.xpickle
)
) HXT.xpickle (
HXT.xpDefault defaultTeachingRatio $ HXT.xpAttr teachingRatioTag 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.xpickle
)
instance (
Control.DeepSeq.NFData level,
Control.DeepSeq.NFData stream,
Control.DeepSeq.NFData teachingRatio
) => Control.DeepSeq.NFData (Profile level stream teachingRatio) where
rnf (MkProfile x0 x1 x2 x3 x4 x5) = Control.DeepSeq.rnf (x0, x1, x2, x3, x4, x5)
mkProfile :: (
Ord level,
Real teachingRatio,
Show level
)
=> stream
-> KnowledgeRequirements level
-> Temporal.Availability.Availability
-> teachingRatio
-> Data.Group.Membership
-> Maybe Temporal.FreePeriodPreference.FreePeriodPreference
-> Profile level stream teachingRatio
mkProfile stream knowledgeRequirements workingWeek teachingRatio groupMembership maybeFreePeriodPreference
| ToolShed.SelfValidate.isValid profile = profile
| otherwise = error $ "WeekDaze.Data.Student.mkProfile:\t" ++ ToolShed.SelfValidate.getFirstError profile ++ "."
where
profile = MkProfile {
getStream = stream,
getKnowledgeRequirements = knowledgeRequirements,
getWorkingWeek = workingWeek,
getTeachingRatio = teachingRatio,
getGroupMembership = groupMembership,
getMaybeFreePeriodPreference = maybeFreePeriodPreference
}
deriveAmalgamatedKnowledgeRequirement :: Ord level => Profile level stream teachingRatio -> Data.Subject.Knowledge level
deriveAmalgamatedKnowledgeRequirement = amalgamateKnowledgeRequirements . getKnowledgeRequirements
hasAnyCoreKnowledgeRequirements :: Profile level stream teachingRatio -> Bool
hasAnyCoreKnowledgeRequirements = not . Data.Set.null . Data.Requirements.getCore . getKnowledgeRequirements
hasAnyOptionalKnowledgeRequirements :: Profile level stream teachingRatio -> Bool
hasAnyOptionalKnowledgeRequirements = not . Data.Set.null . Data.Requirements.getOptional . getKnowledgeRequirements
requiresAnySubjectBy
:: Ord level
=> (Data.Subject.Subject level -> Bool)
-> Profile level stream teachingRatio
-> Bool
requiresAnySubjectBy predicate = Data.Foldable.any predicate . deriveAmalgamatedKnowledgeRequirement
unsubscribe
:: Data.Group.Membership
-> Profile level stream teachingRatio
-> Profile level stream teachingRatio
unsubscribe groupMembership profile = profile {
getGroupMembership = Data.Set.filter (`Data.Set.notMember` groupMembership) $ getGroupMembership profile
}