SJost
parent
2820588913
commit
c8d6e72194
@ -59,7 +59,7 @@ CourseHomepage: Homepage
|
||||
CourseShorthand: Kürzel
|
||||
CourseShorthandUnique: Muss innerhalb des Semesters eindeutig sein
|
||||
CourseSemester: Semester
|
||||
CourseSchool: Institut
|
||||
CourseSchool: Fachbereich
|
||||
CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gesetzt
|
||||
CourseRegisterFromTip: Ohne Datum ist keine Anmeldung möglich
|
||||
CourseRegisterToTip: Anmeldung darf auch ohne Begrenzung möglich sein
|
||||
|
||||
@ -10,6 +10,7 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
|
||||
module Handler.Course where
|
||||
@ -33,17 +34,17 @@ import qualified Database.Esqueleto as E
|
||||
import qualified Data.UUID.Cryptographic as UUID
|
||||
|
||||
|
||||
type CourseTableData = DBRow (Entity Course, Int64, Bool)
|
||||
type CourseTableData = DBRow (Entity Course, Int64, Bool, Entity School)
|
||||
|
||||
colCourse :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colCourse = sortable (Just "course") (i18nCell MsgCourse)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } ->
|
||||
anchorCell (CourseR courseTerm courseShorthand CShowR)
|
||||
[whamlet|#{display courseName}|]
|
||||
|
||||
colCourseDescr :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colCourseDescr = sortable (Just "course") (i18nCell MsgCourse)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } -> mappend
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } -> mappend
|
||||
( anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseName}|] )
|
||||
( case courseDescription of
|
||||
Nothing -> mempty
|
||||
@ -52,19 +53,19 @@ colCourseDescr = sortable (Just "course") (i18nCell MsgCourse)
|
||||
|
||||
colDescription :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colDescription = sortable Nothing (i18nCell MsgCourseDescription)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } ->
|
||||
case courseDescription of
|
||||
Nothing -> mempty
|
||||
(Just descr) -> cell $ modalStatic descr
|
||||
|
||||
colCShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } ->
|
||||
anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseShorthand}|]
|
||||
|
||||
colCShortDescr :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colCShortDescr = sortable (Just "cshort") (i18nCell MsgCourseShort)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } -> mappend
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } -> mappend
|
||||
( anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseShorthand}|] )
|
||||
( case courseDescription of
|
||||
Nothing -> mempty
|
||||
@ -74,43 +75,48 @@ colCShortDescr = sortable (Just "cshort") (i18nCell MsgCourseShort)
|
||||
|
||||
colTerm :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colTerm = sortable (Just "term") (i18nCell MsgTerm)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } ->
|
||||
anchorCell (TermCourseListR courseTerm) [whamlet|#{display courseTerm}|]
|
||||
|
||||
colSchool :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colSchool = sortable (Just "school") (i18nCell MsgCourseSchool)
|
||||
$ \DBRow{ dbrOutput=(_, _, _, Entity _ School{..}) } ->
|
||||
cell [whamlet|#{display schoolName}|]
|
||||
|
||||
colSchoolShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgCourseSchool)
|
||||
$ \DBRow{ dbrOutput=(_, _, _, Entity _ School{..}) } ->
|
||||
cell [whamlet|#{display schoolShorthand}|]
|
||||
|
||||
colRegFrom :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colRegFrom = sortable (Just "register-from") (i18nCell MsgRegisterFrom)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } ->
|
||||
cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget
|
||||
|
||||
colRegTo :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colRegTo = sortable (Just "register-to") (i18nCell MsgRegisterTo)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _) } ->
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } ->
|
||||
cell $ traverse (formatTime SelFormatDateTime) courseRegisterTo >>= maybe mempty toWidget
|
||||
|
||||
colParticipants :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colParticipants = sortable (Just "participants") (i18nCell MsgCourseMembers)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, currentParticipants, _) } -> textCell $ case courseCapacity of
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, currentParticipants, _, _) } -> textCell $ case courseCapacity of
|
||||
Nothing -> MsgCourseMembersCount currentParticipants
|
||||
Just max -> MsgCourseMembersCountLimited currentParticipants max
|
||||
|
||||
colRegistered :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colRegistered = sortable (Just "registered") (i18nCell MsgRegistered)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, registered) } -> tickmarkCell registered
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _, registered, _) } -> tickmarkCell registered
|
||||
|
||||
type CourseTableExpr = E.SqlExpr (Entity Course)
|
||||
type CourseTableExpr = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity School)
|
||||
|
||||
course2Participants :: CourseTableExpr -> E.SqlExpr (E.Value Int64)
|
||||
course2Participants course = E.sub_select . E.from $ \courseParticipant -> do
|
||||
course2Participants (course `E.InnerJoin` _school) = E.sub_select . E.from $ \courseParticipant -> do
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
return (E.countRows :: E.SqlExpr (E.Value Int64))
|
||||
|
||||
course2School :: CourseTableExpr -> E.SqlExpr _ -- this is a bad hack, change to proper innerjoin
|
||||
course2School course = E.subList_select . E.from $ \school -> do
|
||||
E.where_ $ course E.^. CourseSchool E.==. school E.^. SchoolId
|
||||
return (school E.^. SchoolShorthand)
|
||||
|
||||
course2Registered :: Maybe UserId -> CourseTableExpr -> E.SqlExpr (E.Value Bool)
|
||||
course2Registered muid course = E.exists . E.from $ \courseParticipant -> do
|
||||
course2Registered muid (course `E.InnerJoin` _school) = E.exists . E.from $ \courseParticipant -> do
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
E.&&. E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid
|
||||
|
||||
@ -119,41 +125,52 @@ makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h )
|
||||
makeCourseTable whereClause colChoices psValidator = do
|
||||
muid <- maybeAuthId
|
||||
let dbtSQLQuery :: CourseTableExpr -> E.SqlQuery _
|
||||
dbtSQLQuery course = do
|
||||
let participants = course2Participants course
|
||||
let registered = course2Registered muid course
|
||||
dbtSQLQuery qin@(course `E.InnerJoin` school) = do
|
||||
E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
|
||||
let participants = course2Participants qin
|
||||
let registered = course2Registered muid qin
|
||||
E.where_ $ whereClause (course, participants, registered)
|
||||
return (course, participants, registered)
|
||||
return (course, participants, registered, school)
|
||||
dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData
|
||||
dbtProj = traverse $ \(course, E.Value participants, E.Value registered) -> return (course, participants, registered)
|
||||
dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> return (course, participants, registered, school)
|
||||
dbTable psValidator $ DBTable
|
||||
{ dbtSQLQuery
|
||||
, dbtColonnade = colChoices
|
||||
, dbtProj
|
||||
, dbtSorting = Map.fromList -- OverloadedLists does not work with the templates here
|
||||
[ ( "course", SortColumn $ \course -> course E.^. CourseName)
|
||||
, ( "cshort", SortColumn $ \course -> course E.^. CourseShorthand)
|
||||
, ( "term" , SortColumn $ \course -> course E.^. CourseTerm)
|
||||
, ( "register-from", SortColumn $ \course -> course E.^. CourseRegisterFrom)
|
||||
, ( "register-to", SortColumn $ \course -> course E.^. CourseRegisterTo)
|
||||
[ ( "course", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseName)
|
||||
, ( "cshort", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseShorthand)
|
||||
, ( "term" , SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseTerm)
|
||||
, ( "school", SortColumn $ \(_course `E.InnerJoin` school) -> school E.^. SchoolName)
|
||||
, ( "schoolshort", SortColumn $ \(_course `E.InnerJoin` school) -> school E.^. SchoolShorthand)
|
||||
, ( "register-from", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterFrom)
|
||||
, ( "register-to", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterTo)
|
||||
, ( "participants", SortColumn $ course2Participants
|
||||
)
|
||||
, ( "registered", SortColumn $ course2Registered muid
|
||||
)
|
||||
]
|
||||
, dbtFilter = Map.fromList -- OverloadedLists does not work with the templates here
|
||||
[ ( "course", FilterColumn $ \(course :: CourseTableExpr) criterias -> if
|
||||
[ ( "course", FilterColumn $ \(course `E.InnerJoin` _school:: CourseTableExpr) criterias -> if
|
||||
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
| otherwise -> course E.^. CourseName `E.in_` E.valList (Set.toList criterias)
|
||||
)
|
||||
, ( "cshort", FilterColumn $ \(course :: CourseTableExpr) criterias -> if
|
||||
, ( "cshort", FilterColumn $ \(course `E.InnerJoin` _school :: CourseTableExpr) criterias -> if
|
||||
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
| otherwise -> course E.^. CourseShorthand `E.in_` E.valList (Set.toList criterias)
|
||||
)
|
||||
, ( "term" , FilterColumn $ \(course :: CourseTableExpr) criterias -> if
|
||||
, ( "term" , FilterColumn $ \(course `E.InnerJoin` _school :: CourseTableExpr) criterias -> if
|
||||
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
| otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList criterias)
|
||||
)
|
||||
, ( "school", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if
|
||||
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
| otherwise -> school E.^. SchoolName `E.in_` E.valList (Set.toList criterias)
|
||||
)
|
||||
, ( "schoolshort", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if
|
||||
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
| otherwise -> school E.^. SchoolShorthand `E.in_` E.valList (Set.toList criterias)
|
||||
)
|
||||
]
|
||||
, dbtStyle = def
|
||||
, dbtIdent = "courses" :: Text
|
||||
@ -167,6 +184,7 @@ getCourseListR = do -- TODO: Suchfunktion für Kurse und Kürzel!!!
|
||||
, colCShort
|
||||
, colTerm
|
||||
, maybe mempty (const colRegistered) muid
|
||||
, colSchool
|
||||
]
|
||||
whereClause = const $ E.val True
|
||||
validator = def
|
||||
@ -192,6 +210,7 @@ getTermCourseListR tid = do
|
||||
let colonnade = widgetColonnade $ mconcat
|
||||
[ dbRow
|
||||
, colCShortDescr
|
||||
, colSchoolShort
|
||||
, colRegFrom
|
||||
, colRegTo
|
||||
, colParticipants
|
||||
|
||||
Loading…
Reference in New Issue
Block a user