Courselist for all courses
This commit is contained in:
SJost
parent
aec528d94c
commit
e9b504473c
@ -29,6 +29,7 @@ TermPlaceholder: W/S + vierstellige Jahreszahl
|
||||
LectureStart: Beginn Vorlesungen
|
||||
|
||||
Course: Kurs
|
||||
CourseShort: Kürzel
|
||||
CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
|
||||
CourseRegisterOk: Sie wurden angemeldet
|
||||
CourseDeregisterOk: Sie wurden abgemeldet
|
||||
@ -40,6 +41,7 @@ CourseNewDupShort tid@TermId courseShortHand@CourseShorthand: Kurs #{display ti
|
||||
CourseEditDupShort tid@TermId courseShortHand@CourseShorthand: Kurs #{display tid}-#{courseShortHand} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester.
|
||||
FFSheetName: Name
|
||||
TermCourseListHeading tid@TermId: Kursübersicht #{display tid}
|
||||
CourseListTitle: Alle Kurse
|
||||
TermCourseListTitle tid@TermId: Kurse #{display tid}
|
||||
CourseNewHeading: Neuen Kurs anlegen
|
||||
CourseEditHeading tid@TermId courseShortHand@CourseShorthand: Kurs #{display tid}-#{courseShortHand} editieren
|
||||
|
||||
@ -668,7 +668,7 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb (TermEditExistR tid) = return ("Editieren" , Just $ TermCourseListR tid)
|
||||
breadcrumb (TermCourseListR (unTermKey -> tid)) = getMessageRender <&> \mr -> (mr $ ShortTermIdentifier tid, Just TermShowR)
|
||||
|
||||
breadcrumb CourseListR = return ("Kurs" , Just HomeR)
|
||||
breadcrumb CourseListR = return ("Kurse" , Just HomeR)
|
||||
breadcrumb CourseNewR = return ("Neu" , Just CourseListR)
|
||||
breadcrumb (CourseR tid csh CShowR) = return (CI.original csh, Just $ TermCourseListR tid)
|
||||
-- (CourseR tid csh CRegisterR) -- is POST only
|
||||
@ -744,7 +744,7 @@ defaultLinks = -- Define the menu items of the header.
|
||||
, NavbarAside $ MenuItem
|
||||
{ menuItemLabel = "Kurse"
|
||||
, menuItemIcon = Just "calendar-alt"
|
||||
, menuItemRoute = TermCurrentR -- should be CourseListActiveR or similar in the future
|
||||
, menuItemRoute = CourseListR
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, NavbarAside $ MenuItem
|
||||
@ -964,7 +964,8 @@ pageHeading (TermEditExistR tid)
|
||||
pageHeading (TermCourseListR tid)
|
||||
= Just . i18nHeading . MsgTermCourseListHeading $ tid
|
||||
|
||||
-- CourseListR -- just a redirect to TermCurrentR
|
||||
pageHeading (CourseListR)
|
||||
= Just $ i18nHeading $ MsgCourseListTitle
|
||||
pageHeading CourseNewR
|
||||
= Just $ i18nHeading MsgCourseNewHeading
|
||||
pageHeading (CourseR tid csh CShowR)
|
||||
|
||||
@ -1,7 +1,12 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
@ -18,6 +23,7 @@ import qualified Data.Text as T
|
||||
import Data.Function ((&))
|
||||
-- import Yesod.Form.Bootstrap3
|
||||
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Colonnade hiding (fromMaybe,bool)
|
||||
@ -28,8 +34,77 @@ import qualified Database.Esqueleto as E
|
||||
import qualified Data.UUID.Cryptographic as UUID
|
||||
|
||||
|
||||
getCourseListR :: Handler TypedContent
|
||||
getCourseListR = redirect TermCurrentR
|
||||
type CourseTableData = DBRow (Entity Course, Int64)
|
||||
|
||||
colCourse :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colCourse = sortable (Just "course") (i18nCell MsgCourse)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _) } ->
|
||||
anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseName}|]
|
||||
|
||||
colCShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _) } ->
|
||||
anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseShorthand}|]
|
||||
|
||||
colTerm :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colTerm = sortable (Just "term") (i18nCell MsgTerm)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, _) } ->
|
||||
anchorCell (TermCourseListR courseTerm) [whamlet|#{display courseTerm}|]
|
||||
|
||||
type CourseTableExpr = E.SqlExpr (Entity Course)
|
||||
|
||||
makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h )
|
||||
=> _ -> Colonnade h CourseTableData (DBCell m x) -> PSValidator m x -> Handler (DBResult m x)
|
||||
makeCourseTable whereClause colChoices psValidator = do
|
||||
let dbtSQLQuery :: CourseTableExpr -> E.SqlQuery _
|
||||
dbtSQLQuery course = do
|
||||
let participants = E.sub_select . E.from $ \courseParticipant -> do
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||
return (E.countRows :: E.SqlExpr (E.Value Int64))
|
||||
E.where_ $ whereClause (course,participants)
|
||||
return (course, participants)
|
||||
dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData
|
||||
dbtProj = traverse $ \(course, E.Value participants) -> return (course, participants)
|
||||
dbTable psValidator $ DBTable
|
||||
{ dbtSQLQuery
|
||||
, dbtColonnade = colChoices
|
||||
, dbtProj
|
||||
, dbtSorting =
|
||||
[ ( "course", SortColumn $ \course -> course E.^. CourseName)
|
||||
, ( "cshort", SortColumn $ \course -> course E.^. CourseShorthand)
|
||||
, ( "term" , SortColumn $ \course -> course E.^. CourseTerm)
|
||||
]
|
||||
, dbtFilter =
|
||||
[ ( "course", FilterColumn $ \(course :: 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
|
||||
| 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
|
||||
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
|
||||
| otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList criterias)
|
||||
)
|
||||
]
|
||||
, dbtStyle = def
|
||||
, dbtIdent = "courses" :: Text
|
||||
}
|
||||
|
||||
getCourseListR :: Handler Html
|
||||
getCourseListR = do -- TODO: KurseList aller Kurse mit Suchfunktion!
|
||||
let colonnade = widgetColonnade $ mconcat
|
||||
[ colCourse
|
||||
, colCShort
|
||||
, colTerm
|
||||
]
|
||||
validator = def
|
||||
whereClause = const $ E.val True
|
||||
ctable <- makeCourseTable whereClause colonnade validator
|
||||
defaultLayout $ do
|
||||
setTitleI MsgCourseListTitle
|
||||
ctable
|
||||
|
||||
getTermCurrentR :: Handler Html
|
||||
getTermCurrentR = do
|
||||
@ -37,8 +112,7 @@ getTermCurrentR = do
|
||||
case fromNullable termIds of
|
||||
Nothing -> notFound
|
||||
(Just (maximum -> tid)) -> -- getTermCourseListR tid
|
||||
redirect $ TermCourseListR tid -- redirect avids problematic breadcrumbs, headings, etc.
|
||||
|
||||
redirect $ TermCourseListR tid -- redirect avoids problematic breadcrumbs, headings, etc.
|
||||
|
||||
getTermCourseListR :: TermId -> Handler Html
|
||||
getTermCourseListR tid = do
|
||||
|
||||
@ -182,7 +182,7 @@ getSheetListR tid csh = do
|
||||
$ \(Entity _ Sheet{..}, _, _) -> cell $ formatTime SelFormatDateTime sheetActiveTo >>= toWidget
|
||||
, sortable Nothing (i18nCell MsgSheetType)
|
||||
$ \(Entity _ Sheet{..}, _, _) -> textCell $ display sheetType
|
||||
, sortable (Just "submitted") (i18nCell MsgSubmission)
|
||||
, sortable Nothing (i18nCell MsgSubmission)
|
||||
$ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of
|
||||
Nothing -> mempty
|
||||
(Just (Entity sid Submission{..})) ->
|
||||
@ -210,17 +210,20 @@ getSheetListR tid csh = do
|
||||
-> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid csh sheetName SShowR) False)
|
||||
, dbtSorting = Map.fromList
|
||||
[ ( "name"
|
||||
, SortColumn $ \(sheet `E.LeftOuterJoin` submission) -> sheet E.^. SheetName
|
||||
, SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName
|
||||
)
|
||||
, ( "last-edit"
|
||||
, SortColumn $ \(sheet `E.LeftOuterJoin` submission) -> E.sub_select . E.from $ \sheetEdit -> E.distinctOnOrderBy [E.desc $ sheetEdit E.?. SheetEditTime] $ do
|
||||
, SortColumn $ \(sheet `E.LeftOuterJoin` _) -> E.sub_select . E.from $ \sheetEdit -> E.distinctOnOrderBy [E.desc $ sheetEdit E.?. SheetEditTime] $ do
|
||||
return $ sheetEdit E.?. SheetEditTime
|
||||
)
|
||||
, ( "submission-since"
|
||||
, SortColumn $ \(sheet `E.LeftOuterJoin` submission) -> sheet E.^. SheetActiveFrom
|
||||
, SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveFrom
|
||||
)
|
||||
, ( "submission-until"
|
||||
, SortColumn $ \(sheet `E.LeftOuterJoin` submission) -> sheet E.^. SheetActiveTo
|
||||
, SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetActiveTo
|
||||
)
|
||||
, ( "rating"
|
||||
, SortColumn $ \(_ `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) -> submission E.?. SubmissionRatingPoints
|
||||
)
|
||||
]
|
||||
, dbtFilter = Map.fromList
|
||||
|
||||
Loading…
Reference in New Issue
Block a user