module WeekDaze.LocationView.LessonResourceIds(
LessonResourceIds(
getStudentClass,
getTeacherId
),
mkLessonResourceIds,
fromStudentView,
toStudentView
) where
import Control.Arrow((&&&))
import qualified Data.Set
import qualified Text.XHtml.Strict
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified ToolShed.SelfValidate
import qualified WeekDaze.Aggregate.StudentClass as Aggregate.StudentClass
import qualified WeekDaze.Model.ResourceUser as Model.ResourceUser
import qualified WeekDaze.StudentView.LessonResourceIds as StudentView.LessonResourceIds
import Text.XHtml.Strict((+++), (<<))
tag :: String
tag = "locationViewLessonResourceIds"
data LessonResourceIds teacherId = MkLessonResourceIds {
getStudentClass :: Aggregate.StudentClass.StudentClass,
getTeacherId :: teacherId
} deriving (Eq, Show)
instance Text.XHtml.Strict.HTML teacherId => Text.XHtml.Strict.HTML (LessonResourceIds teacherId) where
toHtml = (
\(studentClass, teacherId) -> Text.XHtml.Strict.li << (studentClass +++ '.') +++ Text.XHtml.Strict.li << (teacherId +++ '.')
) . (
Aggregate.StudentClass.toHtml . getStudentClass &&& getTeacherId
)
instance HXT.XmlPickler teacherId => HXT.XmlPickler (LessonResourceIds teacherId) where
xpickle = HXT.xpElem tag . HXT.xpWrap (
uncurry MkLessonResourceIds,
getStudentClass &&& getTeacherId
) $ (
HXT.xpElem Aggregate.StudentClass.tag . HXT.xpWrap (
Data.Set.fromList,
Data.Set.toList
) $ HXT.xpList1 HXT.xpickle
) `HXT.xpPair` HXT.xpickle
instance Eq teacherId => Model.ResourceUser.ResourceUser (LessonResourceIds teacherId) where
areIndependent l r = Model.ResourceUser.areIndependent (getStudentClass l) (getStudentClass r) && getTeacherId l /= getTeacherId r
instance Show teacherId => ToolShed.SelfValidate.SelfValidator (LessonResourceIds teacherId) where
getErrors lessonResourceIds = ToolShed.SelfValidate.extractErrors [
(
Data.Set.null $ getStudentClass lessonResourceIds,
"a class should be composed from one or more student-bodies; " ++ show lessonResourceIds
)
]
mkLessonResourceIds
:: Show teacherId
=> Aggregate.StudentClass.StudentClass
-> teacherId
-> LessonResourceIds teacherId
mkLessonResourceIds studentClass teacherId
| ToolShed.SelfValidate.isValid lessonResourceIds = lessonResourceIds
| otherwise = error $ "WeekDaze.LocationView.LessonResourceIds.mkLessonResourceIds:\t" ++ ToolShed.SelfValidate.getFirstError lessonResourceIds ++ "."
where
lessonResourceIds = MkLessonResourceIds studentClass teacherId
fromStudentView :: Show teacherId => Aggregate.StudentClass.StudentClass -> StudentView.LessonResourceIds.LessonResourceIds locationId teacherId -> LessonResourceIds teacherId
fromStudentView studentClass = mkLessonResourceIds studentClass . StudentView.LessonResourceIds.getTeacherId
toStudentView :: locationId -> LessonResourceIds teacherId -> StudentView.LessonResourceIds.LessonResourceIds locationId teacherId
toStudentView locationId resourceIds = StudentView.LessonResourceIds.MkLessonResourceIds {
StudentView.LessonResourceIds.getLocationId = locationId,
StudentView.LessonResourceIds.getTeacherId = getTeacherId resourceIds
}