Halfway through with #162, still todo
This commit is contained in:
SJost
parent
a8328204f7
commit
a4dacc8d01
@ -47,7 +47,7 @@ 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
|
||||
CourseEditHeading tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{courseShortHand} editieren
|
||||
CourseEditTitle: Kurs editieren/anlegen
|
||||
CourseMembers: Teilnehmer
|
||||
CourseMembersCount num@Int64: #{display num}
|
||||
@ -68,17 +68,17 @@ CourseDeregisterUntilTip: Abmeldung darf auch ohne Begrenzung möglich sein
|
||||
|
||||
|
||||
Sheet: Blatt
|
||||
SheetList tid@TermId courseShortHand@CourseShorthand: #{display tid}-#{courseShortHand} Übersicht Übungsblätter
|
||||
SheetNewHeading tid@TermId courseShortHand@CourseShorthand: #{display tid}-#{courseShortHand} Neues Übungsblatt anlegen
|
||||
SheetNewOk tid@TermId courseShortHand@CourseShorthand sheetName@SheetName: Neues Übungsblatt #{sheetName} wurde im Kurs #{display tid}-#{courseShortHand} erfolgreich erstellt.
|
||||
SheetTitle tid@TermId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{courseShortHand} #{sheetName}
|
||||
SheetTitleNew tid@TermId courseShortHand@CourseShorthand : #{display tid}-#{courseShortHand}: Neues Übungsblatt
|
||||
SheetEditHead tid@TermId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{courseShortHand} #{sheetName} editieren
|
||||
SheetEditOk tid@TermId courseShortHand@CourseShorthand sheetName@SheetName: Übungsblatt #{sheetName} aus Kurs #{display tid}-#{courseShortHand} wurde gespeichert.
|
||||
SheetNameDup tid@TermId courseShortHand@CourseShorthand sheetName@SheetName: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{display tid}-#{courseShortHand}.
|
||||
SheetDelHead tid@TermId courseShortHand@CourseShorthand sheetName@SheetName: Übungsblatt #{sheetName} wirklich aus Kurs #{display tid}-#{courseShortHand} herauslöschen?
|
||||
SheetList tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: #{display tid}-#{display ssh}-#{courseShortHand} Übersicht Übungsblätter
|
||||
SheetNewHeading tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: #{display tid}-#{display ssh}-#{courseShortHand} Neues Übungsblatt anlegen
|
||||
SheetNewOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Neues Übungsblatt #{sheetName} wurde im Kurs #{display tid}-#{display ssh}-#{courseShortHand} erfolgreich erstellt.
|
||||
SheetTitle tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName}
|
||||
SheetTitleNew tid@TermId ssh@SchoolId courseShortHand@CourseShorthand : #{display tid}-#{display ssh}-#{courseShortHand}: Neues Übungsblatt
|
||||
SheetEditHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName} editieren
|
||||
SheetEditOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Übungsblatt #{sheetName} aus Kurs #{display tid}-#{display ssh}-#{courseShortHand} wurde gespeichert.
|
||||
SheetNameDup tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{display tid}-#{display ssh}-#{courseShortHand}.
|
||||
SheetDelHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Übungsblatt #{sheetName} wirklich aus Kurs #{display tid}-#{display ssh}-#{courseShortHand} herauslöschen?
|
||||
SheetDelText submissionNo@Int: Dies kann nicht mehr rückgängig gemacht werden! Alle Einreichungen gehen ebenfalls verloren! Es gibt #{display submissionNo} Abgaben.
|
||||
SheetDelOk tid@TermId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{courseShortHand}: Übungsblatt #{sheetName} gelöscht.
|
||||
SheetDelOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand}: Übungsblatt #{sheetName} gelöscht.
|
||||
|
||||
SheetExercise: Aufgabenstellung
|
||||
SheetHint: Hinweis
|
||||
@ -111,12 +111,12 @@ Deadline: Abgabe
|
||||
Done: Eingereicht
|
||||
|
||||
Submission: Abgabenummer
|
||||
SubmissionsCourse tid@TermId courseShortHand@CourseShorthand: Alle Abgaben Kurs #{display tid}-#{courseShortHand}
|
||||
SubmissionsCourse tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Alle Abgaben Kurs #{display tid}-#{display ssh}-#{courseShortHand}
|
||||
SubmissionsSheet sheetName@SheetName: Abgaben für Blatt #{sheetName}
|
||||
SubmissionWrongSheet: Abgabenummer gehört nicht zum angegebenen Übungsblatt.
|
||||
SubmissionAlreadyExists: Sie haben bereits eine Abgabe zu diesem Übungsblatt.
|
||||
SubmissionEditHead tid@TermId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{courseShortHand} #{sheetName}: Abgabe editieren/anlegen
|
||||
CorrectionHead tid@TermId courseShortHand@CourseShorthand sheetName@SheetName cid@CryptoFileNameSubmission: #{display tid}-#{courseShortHand} #{sheetName}: Korrektur
|
||||
SubmissionEditHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName}: Abgabe editieren/anlegen
|
||||
CorrectionHead tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName cid@CryptoFileNameSubmission: #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName}: Korrektur
|
||||
SubmissionMember g@Int: Mitabgebende(r) ##{display g}
|
||||
SubmissionArchive: Zip-Archiv der Abgabedatei(en)
|
||||
SubmissionFile: Datei zur Abgabe
|
||||
@ -156,7 +156,7 @@ TooManyParticipants: Es wurden zu viele Mitabgebende angegeben
|
||||
|
||||
AddCorrector: Zusätzlicher Korrektor
|
||||
CorrectorExists email@UserEmail: #{email} ist bereits als Korrektor eingetragen
|
||||
SheetCorrectorsTitle tid@TermId courseShortHand@CourseShorthand sheetName@SheetName: Korrektoren für #{display tid}-#{courseShortHand} #{sheetName}
|
||||
SheetCorrectorsTitle tid@TermId ssh@SchoolId courseShortHand@CourseShorthand sheetName@SheetName: Korrektoren für #{display tid}-#{display ssh}-#{courseShortHand} #{sheetName}
|
||||
CountTutProp: Tutorien zählen gegen Proportion
|
||||
Corrector: Korrektor
|
||||
Correctors: Korrektoren
|
||||
@ -268,4 +268,4 @@ DummyLoginTitle: Development-Login
|
||||
|
||||
CorrectorNormal: Normal
|
||||
CorrectorMissing: Abwesend
|
||||
CorrectorExcused: Entschuldigt
|
||||
CorrectorExcused: Entschuldigt
|
||||
|
||||
5
models
5
models
@ -53,6 +53,7 @@ School json
|
||||
shorthand (CI Text)
|
||||
UniqueSchool name
|
||||
UniqueSchoolShorthand shorthand
|
||||
Primary shorthand -- newtype Key School = School { unSchoolKey :: SchoolShorthand }
|
||||
deriving Eq
|
||||
DegreeCourse json
|
||||
course CourseId
|
||||
@ -73,8 +74,8 @@ Course
|
||||
deregisterUntil UTCTime Maybe
|
||||
registerSecret Text Maybe -- Falls ein Passwort erforderlich ist
|
||||
materialFree Bool
|
||||
CourseTermShort term shorthand
|
||||
CourseTermName term name
|
||||
CourseTermSchoolShort term school shorthand
|
||||
CourseTermSchoolName term school name
|
||||
CourseEdit
|
||||
user UserId
|
||||
time UTCTime
|
||||
|
||||
4
routes
4
routes
@ -46,11 +46,13 @@
|
||||
/terms/edit TermEditR GET POST
|
||||
/terms/#TermId/edit TermEditExistR GET
|
||||
!/terms/#TermId TermCourseListR GET !free
|
||||
!/terms/#TermId/#SchoolId SchoolCourseListR GET !free
|
||||
|
||||
|
||||
-- For Pattern Synonyms see Foundation
|
||||
/course/ CourseListR GET !free
|
||||
!/course/new CourseNewR GET POST !lecturer
|
||||
/course/#TermId/#CourseShorthand CourseR !lecturer:
|
||||
/course/#TermId/#SchoolId/#CourseShorthand CourseR !lecturer:
|
||||
/ CShowR GET !free
|
||||
/register CRegisterR POST !timeANDcapacity
|
||||
/edit CEditR GET POST
|
||||
|
||||
@ -27,35 +27,17 @@ import System.FilePath.Cryptographic.ImplicitNamespace
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import Data.UUID.Types
|
||||
-- import Data.UUID.Types
|
||||
import Web.PathPieces
|
||||
|
||||
import Data.CaseInsensitive (CI)
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
|
||||
instance PathPiece UUID where
|
||||
fromPathPiece = fromString . unpack
|
||||
toPathPiece = pack . toString
|
||||
|
||||
instance (CI.FoldCase s, PathPiece s) => PathPiece (CI s) where
|
||||
fromPathPiece = fmap CI.mk . fromPathPiece
|
||||
toPathPiece = toPathPiece . CI.original
|
||||
|
||||
instance {-# OVERLAPS #-} PathMultiPiece FilePath where
|
||||
fromPathMultiPiece = Just . unpack . intercalate "/"
|
||||
toPathMultiPiece = Text.splitOn "/" . pack
|
||||
|
||||
instance (CI.FoldCase s, PathMultiPiece s) => PathMultiPiece (CI s) where
|
||||
fromPathMultiPiece = fmap CI.mk . fromPathMultiPiece
|
||||
toPathMultiPiece = toPathMultiPiece . CI.foldedCase
|
||||
|
||||
|
||||
-- Generates CryptoUUID... and CryptoFileName... Datatypes
|
||||
decCryptoIDs [ ''SubmissionId
|
||||
, ''FileId
|
||||
, ''UserId
|
||||
, ''SchoolId
|
||||
]
|
||||
|
||||
instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => PathPiece (E.CryptoID namespace (CI FilePath)) where
|
||||
|
||||
@ -97,6 +97,8 @@ instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) Submission
|
||||
instance DisplayAble TermId where
|
||||
display = termToText . unTermKey
|
||||
|
||||
instance DisplayAble SchoolId where
|
||||
display = CI.original . unSchoolKey
|
||||
|
||||
-- infixl 9 :$:
|
||||
-- pattern a :$: b = a b
|
||||
@ -134,11 +136,11 @@ type Form x = Html -> MForm (HandlerT UniWorX IO) (FormResult x, Widget)
|
||||
type MsgRenderer = MsgRendererS UniWorX -- see Utils
|
||||
|
||||
-- Pattern Synonyms for convenience
|
||||
pattern CSheetR tid csh shn ptn
|
||||
= CourseR tid csh (SheetR shn ptn)
|
||||
pattern CSheetR tid ssh csh shn ptn
|
||||
= CourseR tid ssh csh (SheetR shn ptn)
|
||||
|
||||
pattern CSubmissionR tid csh shn cid ptn
|
||||
= CSheetR tid csh shn (SubmissionR cid ptn)
|
||||
pattern CSubmissionR tid ssh csh shn cid ptn
|
||||
= CSheetR tid ssh csh shn (SubmissionR cid ptn)
|
||||
|
||||
-- Menus and Favourites
|
||||
data MenuItem = MenuItem
|
||||
@ -267,12 +269,13 @@ falseAP = APPure . const . const $ Unauthorized . ($ MsgUnauthorized) . render <
|
||||
adminAP :: AccessPredicate -- access for admins (of appropriate school in case of course-routes)
|
||||
adminAP = APDB $ \route _ -> case route of
|
||||
-- Courses: access only to school admins
|
||||
CourseR tid csh _ -> exceptT return return $ do
|
||||
CourseR tid ssh csh _ -> exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
|
||||
[E.Value c] <- lift . E.select . E.from $ \(course `E.InnerJoin` userAdmin) -> do
|
||||
E.on $ course E.^. CourseSchool E.==. userAdmin E.^. UserAdminSchool
|
||||
E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val authId
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
return (E.countRows :: E.SqlExpr (E.Value Int64))
|
||||
guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedSchoolAdmin)
|
||||
@ -295,12 +298,13 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req
|
||||
return $ bool (Unauthorized "Deprecated Route") Authorized allow
|
||||
)
|
||||
,("lecturer", APDB $ \route _ -> case route of
|
||||
CourseR tid csh _ -> exceptT return return $ do
|
||||
CourseR tid ssh csh _ -> exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
|
||||
[E.Value c] <- lift . E.select . E.from $ \(course `E.InnerJoin` lecturer) -> do
|
||||
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
|
||||
E.where_ $ lecturer E.^. LecturerUser E.==. E.val authId
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
return (E.countRows :: E.SqlExpr (E.Value Int64))
|
||||
guardMExceptT (c>0) (unauthorizedI MsgUnauthorizedLecturer)
|
||||
@ -321,18 +325,18 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req
|
||||
resMap :: Map CourseId (Set SheetId)
|
||||
resMap = Map.fromListWith Set.union [ (cid, Set.singleton sid) | (E.Value cid, E.Value sid) <- resList ]
|
||||
case route of
|
||||
CSubmissionR _ _ _ cID _ -> maybeT (unauthorizedI MsgUnauthorizedSubmissionCorrector) $ do
|
||||
CSubmissionR _ _ _ _ cID _ -> maybeT (unauthorizedI MsgUnauthorizedSubmissionCorrector) $ do
|
||||
sid <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
Submission{..} <- MaybeT . lift $ get sid
|
||||
guard $ maybe False (== authId) submissionRatingBy
|
||||
return Authorized
|
||||
CSheetR tid csh shn _ -> maybeT (unauthorizedI MsgUnauthorizedSheetCorrector) $ do
|
||||
Entity cid _ <- MaybeT . lift . getBy $ CourseTermShort tid csh
|
||||
CSheetR tid ssh csh shn _ -> maybeT (unauthorizedI MsgUnauthorizedSheetCorrector) $ do
|
||||
Entity cid _ <- MaybeT . lift . getBy $ CourseTermSchoolShort tid ssh csh
|
||||
Entity sid _ <- MaybeT . lift . getBy $ CourseSheet cid shn
|
||||
guard $ sid `Set.member` fromMaybe Set.empty (resMap !? cid)
|
||||
return Authorized
|
||||
CourseR tid csh _ -> maybeT (unauthorizedI MsgUnauthorizedCorrector) $ do
|
||||
Entity cid _ <- MaybeT . lift . getBy $ CourseTermShort tid csh
|
||||
CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgUnauthorizedCorrector) $ do
|
||||
Entity cid _ <- MaybeT . lift . getBy $ CourseTermSchoolShort tid ssh csh
|
||||
guard $ cid `Set.member` Map.keysSet resMap
|
||||
return Authorized
|
||||
_ -> do
|
||||
@ -340,8 +344,8 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req
|
||||
return Authorized
|
||||
)
|
||||
,("time", APDB $ \route _ -> case route of
|
||||
CSheetR tid csh shn subRoute -> maybeT (unauthorizedI MsgUnauthorizedSheetTime) $ do
|
||||
Entity cid _ <- MaybeT . getBy $ CourseTermShort tid csh
|
||||
CSheetR tid ssh csh shn subRoute -> maybeT (unauthorizedI MsgUnauthorizedSheetTime) $ do
|
||||
Entity cid _ <- MaybeT . getBy $ CourseTermSchoolShort tid ssh csh
|
||||
Entity _sid Sheet{..} <- MaybeT . getBy $ CourseSheet cid shn
|
||||
cTime <- liftIO getCurrentTime
|
||||
let
|
||||
@ -360,8 +364,8 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req
|
||||
|
||||
return Authorized
|
||||
|
||||
CourseR tid csh CRegisterR -> maybeT (unauthorizedI MsgUnauthorizedCourseTime) $ do
|
||||
Entity cid Course{..} <- MaybeT . getBy $ CourseTermShort tid csh
|
||||
CourseR tid ssh csh CRegisterR -> maybeT (unauthorizedI MsgUnauthorizedCourseTime) $ do
|
||||
Entity cid Course{..} <- MaybeT . getBy $ CourseTermSchoolShort tid ssh csh
|
||||
cTime <- (NTop . Just) <$> liftIO getCurrentTime
|
||||
guard $ NTop courseRegisterFrom <= cTime
|
||||
&& NTop courseRegisterTo >= cTime
|
||||
@ -370,12 +374,13 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req
|
||||
r -> $unsupportedAuthPredicate "time" r
|
||||
)
|
||||
,("registered", APDB $ \route _ -> case route of
|
||||
CourseR tid csh _ -> exceptT return return $ do
|
||||
CourseR tid ssh csh _ -> exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
|
||||
[E.Value c] <- lift . E.select . E.from $ \(course `E.InnerJoin` courseParticipant) -> do
|
||||
E.on $ course E.^. CourseId E.==. courseParticipant E.^. CourseParticipantCourse
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val authId
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
return (E.countRows :: E.SqlExpr (E.Value Int64))
|
||||
guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedParticipant)
|
||||
@ -383,22 +388,22 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req
|
||||
r -> $unsupportedAuthPredicate "registered" r
|
||||
)
|
||||
,("capacity", APDB $ \route _ -> case route of
|
||||
CourseR tid csh _ -> maybeT (unauthorizedI MsgCourseNoCapacity) $ do
|
||||
Entity cid Course{..} <- MaybeT . getBy $ CourseTermShort tid csh
|
||||
CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNoCapacity) $ do
|
||||
Entity cid Course{..} <- MaybeT . getBy $ CourseTermSchoolShort tid ssh csh
|
||||
registered <- lift $ fromIntegral <$> count [ CourseParticipantCourse ==. cid ]
|
||||
guard $ NTop courseCapacity > NTop (Just registered)
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate "capacity" r
|
||||
)
|
||||
,("materials", APDB $ \route _ -> case route of
|
||||
CourseR tid csh _ -> maybeT (unauthorizedI MsgUnfreeMaterials) $ do
|
||||
Entity _ Course{..} <- MaybeT . getBy $ CourseTermShort tid csh
|
||||
CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgUnfreeMaterials) $ do
|
||||
Entity _ Course{..} <- MaybeT . getBy $ CourseTermSchoolShort tid ssh csh
|
||||
guard courseMaterialFree
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate "materials" r
|
||||
)
|
||||
,("owner", APDB $ \route _ -> case route of
|
||||
CSubmissionR _ _ _ cID _ -> exceptT return return $ do
|
||||
CSubmissionR _ _ _ _ cID _ -> exceptT return return $ do
|
||||
sid <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSubmissionOwner) (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
|
||||
void . maybeMExceptT (unauthorizedI MsgUnauthorizedSubmissionOwner) . getBy $ UniqueSubmissionUser authId sid
|
||||
@ -406,7 +411,7 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req
|
||||
r -> $unsupportedAuthPredicate "owner" r
|
||||
)
|
||||
,("rated", APDB $ \route _ -> case route of
|
||||
CSubmissionR _ _ _ cID _ -> maybeT (unauthorizedI MsgUnauthorizedSubmissionRated) $ do
|
||||
CSubmissionR _ _ _ _ cID _ -> maybeT (unauthorizedI MsgUnauthorizedSubmissionRated) $ do
|
||||
sid <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
sub <- MaybeT $ get sid
|
||||
guard $ submissionRatingDone sub
|
||||
@ -476,14 +481,14 @@ instance Yesod UniWorX where
|
||||
updateFavouritesMiddleware handler = (*> handler) . runMaybeT $ do
|
||||
route <- MaybeT getCurrentRoute
|
||||
case route of -- update Course Favourites here
|
||||
CourseR tid csh _ -> do
|
||||
CourseR tid ssh csh _ -> do
|
||||
void . lift . runDB . runMaybeT $ do
|
||||
guardM . lift $ (== Authorized) <$> evalAccessDB (CourseR tid csh CShowR) False
|
||||
guardM . lift $ (== Authorized) <$> evalAccessDB (CourseR tid ssh csh CShowR) False
|
||||
$logDebugS "updateFavourites" "Updating favourites"
|
||||
|
||||
now <- liftIO $ getCurrentTime
|
||||
uid <- MaybeT $ liftHandlerT maybeAuthId
|
||||
cid <- MaybeT . getKeyBy $ CourseTermShort tid csh
|
||||
cid <- MaybeT . getKeyBy $ CourseTermSchoolShort tid ssh csh
|
||||
user <- MaybeT $ get uid
|
||||
let courseFavourite = CourseFavourite uid now cid
|
||||
|
||||
@ -546,7 +551,7 @@ instance Yesod UniWorX where
|
||||
return (favs, userTheme user)
|
||||
favourites <- forM favourites' $ \(Entity _ c@Course{..})
|
||||
-> let
|
||||
courseRoute = CourseR courseTerm courseShorthand CShowR
|
||||
courseRoute = CourseR courseTerm courseSchool courseShorthand CShowR
|
||||
in (c, courseRoute, ) <$> filterM (menuItemAccessCallback . menuItem) (pageActions courseRoute)
|
||||
|
||||
let highlight :: Route UniWorX -> Bool -- highlight last route in breadcrumbs, favorites taking priority
|
||||
@ -666,27 +671,29 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb (TermEditExistR tid) = return ("Editieren" , Just $ TermCourseListR tid)
|
||||
breadcrumb (TermCourseListR (unTermKey -> tid)) = getMessageRender <&> \mr -> (mr $ ShortTermIdentifier tid, Just TermShowR)
|
||||
|
||||
breadcrumb (SchoolCourseListR tid ssh) = return (CI.original $ unSchoolKey ssh, Just $ TermCourseListR tid)
|
||||
|
||||
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
|
||||
breadcrumb (CourseR tid csh CEditR) = return ("Editieren", Just $ CourseR tid csh CShowR)
|
||||
breadcrumb (CourseR tid csh CCorrectionsR) = return ("Abgaben",Just $ CourseR tid csh CShowR)
|
||||
breadcrumb (CourseR tid csh SheetListR) = return ("Übungen" , Just $ CourseR tid csh CShowR)
|
||||
breadcrumb (CourseR tid csh SheetNewR ) = return ("Neu", Just $ CourseR tid csh SheetListR)
|
||||
breadcrumb (CourseR tid ssh csh CShowR) = return (CI.original csh, Just $ SchoolCourseListR tid ssh)
|
||||
-- (CourseR tid ssh csh CRegisterR) -- is POST only
|
||||
breadcrumb (CourseR tid ssh csh CEditR) = return ("Editieren", Just $ CourseR tid ssh csh CShowR)
|
||||
breadcrumb (CourseR tid ssh csh CCorrectionsR) = return ("Abgaben",Just $ CourseR tid ssh csh CShowR)
|
||||
breadcrumb (CourseR tid ssh csh SheetListR) = return ("Übungen" , Just $ CourseR tid ssh csh CShowR)
|
||||
breadcrumb (CourseR tid ssh csh SheetNewR ) = return ("Neu", Just $ CourseR tid ssh csh SheetListR)
|
||||
|
||||
breadcrumb (CSheetR tid csh shn SShowR) = return (CI.original shn, Just $ CourseR tid csh SheetListR)
|
||||
breadcrumb (CSheetR tid csh shn SEditR) = return ("Edit", Just $ CSheetR tid csh shn SShowR)
|
||||
breadcrumb (CSheetR tid csh shn SDelR ) = return ("DELETE", Just $ CSheetR tid csh shn SShowR)
|
||||
breadcrumb (CSheetR tid csh shn SSubsR) = return ("Abgaben", Just $ CSheetR tid csh shn SShowR)
|
||||
breadcrumb (CSheetR tid csh shn SubmissionNewR) = return ("Abgabe", Just $ CSheetR tid csh shn SShowR)
|
||||
breadcrumb (CSheetR tid csh shn SubmissionOwnR) = return ("Abgabe", Just $ CSheetR tid csh shn SShowR)
|
||||
breadcrumb (CSubmissionR tid csh shn _ SubShowR) = return ("Abgabe", Just $ CSheetR tid csh shn SShowR)
|
||||
-- (CSubmissionR tid csh shn _ SubArchiveR) -- just for Download
|
||||
breadcrumb (CSubmissionR tid csh shn cid CorrectionR) = return ("Korrektur", Just $ CSubmissionR tid csh shn cid SubShowR)
|
||||
-- (CSubmissionR tid csh shn _ SubDownloadR) -- just for Download
|
||||
breadcrumb (CSheetR tid csh shn SCorrR) = return ("Korrektoren", Just $ CSheetR tid csh shn SShowR)
|
||||
-- (CSheetR tid csh shn SFileR) -- just for Downloads
|
||||
breadcrumb (CSheetR tid ssh csh shn SShowR) = return (CI.original shn, Just $ CourseR tid ssh csh SheetListR)
|
||||
breadcrumb (CSheetR tid ssh csh shn SEditR) = return ("Edit", Just $ CSheetR tid ssh csh shn SShowR)
|
||||
breadcrumb (CSheetR tid ssh csh shn SDelR ) = return ("DELETE", Just $ CSheetR tid ssh csh shn SShowR)
|
||||
breadcrumb (CSheetR tid ssh csh shn SSubsR) = return ("Abgaben", Just $ CSheetR tid ssh csh shn SShowR)
|
||||
breadcrumb (CSheetR tid ssh csh shn SubmissionNewR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)
|
||||
breadcrumb (CSheetR tid ssh csh shn SubmissionOwnR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)
|
||||
breadcrumb (CSubmissionR tid ssh csh shn _ SubShowR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)
|
||||
-- (CSubmissionR tid ssh csh shn _ SubArchiveR) -- just for Download
|
||||
breadcrumb (CSubmissionR tid ssh csh shn cid CorrectionR) = return ("Korrektur", Just $ CSubmissionR tid ssh csh shn cid SubShowR)
|
||||
-- (CSubmissionR tid ssh csh shn _ SubDownloadR) -- just for Download
|
||||
breadcrumb (CSheetR tid ssh csh shn SCorrR) = return ("Korrektoren", Just $ CSheetR tid ssh csh shn SShowR)
|
||||
-- (CSheetR tid ssh csh shn SFileR) -- just for Downloads
|
||||
-- Others
|
||||
breadcrumb (CorrectionsR) = return ("Korrekturen", Just HomeR)
|
||||
breadcrumb (CorrectionsUploadR) = return ("Hochladen", Just CorrectionsR)
|
||||
@ -826,22 +833,22 @@ pageActions (CourseListR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CourseR tid csh CShowR) =
|
||||
pageActions (CourseR tid ssh csh CShowR) =
|
||||
[ PageActionPrime $ MenuItem
|
||||
{ menuItemLabel = "Kurs Editieren"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CourseR tid csh CEditR
|
||||
, menuItemRoute = CourseR tid ssh csh CEditR
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, PageActionPrime $ MenuItem
|
||||
{ menuItemLabel = "Übungsblätter"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CourseR tid csh SheetListR
|
||||
, menuItemRoute = CourseR tid ssh csh SheetListR
|
||||
, menuItemAccessCallback' = do --TODO always show for lecturer
|
||||
let sheetRouteAccess shn = (== Authorized) <$> (isAuthorized (CSheetR tid csh shn SShowR) False)
|
||||
let sheetRouteAccess shn = (== Authorized) <$> (isAuthorized (CSheetR tid ssh csh shn SShowR) False)
|
||||
muid <- maybeAuthId
|
||||
(sheets,lecturer) <- runDB $ do
|
||||
cid <- getKeyBy404 $ CourseTermShort tid csh
|
||||
cid <- getKeyBy404 $ CourseTermSchoolShort tid ssh csh
|
||||
sheets <- map (sheetName.entityVal) <$> selectList [SheetCourse ==. cid] [Desc SheetActiveFrom]
|
||||
lecturer <- case muid of
|
||||
Nothing -> return False
|
||||
@ -852,29 +859,29 @@ pageActions (CourseR tid csh CShowR) =
|
||||
, PageActionPrime $ MenuItem
|
||||
{ menuItemLabel = "Abgaben"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CourseR tid csh CCorrectionsR
|
||||
, menuItemRoute = CourseR tid ssh csh CCorrectionsR
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, PageActionSecondary $ MenuItem
|
||||
{ menuItemLabel = "Neues Übungsblatt anlegen"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CourseR tid csh SheetNewR
|
||||
, menuItemRoute = CourseR tid ssh csh SheetNewR
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CourseR tid csh SheetListR) =
|
||||
pageActions (CourseR tid ssh csh SheetListR) =
|
||||
[ PageActionPrime $ MenuItem
|
||||
{ menuItemLabel = "Neues Übungsblatt anlegen"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CourseR tid csh SheetNewR
|
||||
, menuItemRoute = CourseR tid ssh csh SheetNewR
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CSheetR tid csh shn SShowR) =
|
||||
pageActions (CSheetR tid ssh csh shn SShowR) =
|
||||
[ PageActionPrime $ MenuItem
|
||||
{ menuItemLabel = "Abgabe anlegen"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CSheetR tid csh shn SubmissionNewR
|
||||
, menuItemRoute = CSheetR tid ssh csh shn SubmissionNewR
|
||||
, menuItemAccessCallback' = runDB . maybeT (return False) $ do
|
||||
uid <- MaybeT $ liftHandlerT maybeAuthId
|
||||
submissions <- lift $ submissionList tid csh shn uid
|
||||
@ -884,7 +891,7 @@ pageActions (CSheetR tid csh shn SShowR) =
|
||||
, PageActionPrime $ MenuItem
|
||||
{ menuItemLabel = "Abgabe ansehen"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CSheetR tid csh shn SubmissionOwnR
|
||||
, menuItemRoute = CSheetR tid ssh csh shn SubmissionOwnR
|
||||
, menuItemAccessCallback' = runDB . maybeT (return False) $ do
|
||||
uid <- MaybeT $ liftHandlerT maybeAuthId
|
||||
submissions <- lift $ submissionList tid csh shn uid
|
||||
@ -894,43 +901,43 @@ pageActions (CSheetR tid csh shn SShowR) =
|
||||
, PageActionPrime $ MenuItem
|
||||
{ menuItemLabel = "Korrektoren"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CSheetR tid csh shn SCorrR
|
||||
, menuItemRoute = CSheetR tid ssh csh shn SCorrR
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, PageActionPrime $ MenuItem
|
||||
{ menuItemLabel = "Abgaben"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CSheetR tid csh shn SSubsR
|
||||
, menuItemRoute = CSheetR tid ssh csh shn SSubsR
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, PageActionPrime $ MenuItem
|
||||
{ menuItemLabel = "Blatt Editieren"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CSheetR tid csh shn SEditR
|
||||
, menuItemRoute = CSheetR tid ssh csh shn SEditR
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CSheetR tid csh shn SSubsR) =
|
||||
pageActions (CSheetR tid ssh csh shn SSubsR) =
|
||||
[ PageActionPrime $ MenuItem
|
||||
{ menuItemLabel = "Korrektoren"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CSheetR tid csh shn SCorrR
|
||||
, menuItemRoute = CSheetR tid ssh csh shn SCorrR
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CSubmissionR tid csh shn cid SubShowR) =
|
||||
pageActions (CSubmissionR tid ssh csh shn cid SubShowR) =
|
||||
[ PageActionPrime $ MenuItem
|
||||
{ menuItemLabel = "Korrektur"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CSubmissionR tid csh shn cid CorrectionR
|
||||
, menuItemRoute = CSubmissionR tid ssh csh shn cid CorrectionR
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CSheetR tid csh shn SCorrR) =
|
||||
pageActions (CSheetR tid ssh csh shn SCorrR) =
|
||||
[ PageActionPrime $ MenuItem
|
||||
{ menuItemLabel = "Abgaben"
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = CSheetR tid csh shn SSubsR
|
||||
, menuItemRoute = CSheetR tid ssh csh shn SSubsR
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
@ -982,40 +989,40 @@ pageHeading (CourseListR)
|
||||
= Just $ i18nHeading $ MsgCourseListTitle
|
||||
pageHeading CourseNewR
|
||||
= Just $ i18nHeading MsgCourseNewHeading
|
||||
pageHeading (CourseR tid csh CShowR)
|
||||
pageHeading (CourseR tid ssh csh CShowR)
|
||||
= Just $ do
|
||||
Entity _ Course{..} <- handlerToWidget . runDB . getBy404 $ CourseTermShort tid csh
|
||||
Entity _ Course{..} <- handlerToWidget . runDB . getBy404 $ CourseTermSchoolShort tid ssh csh
|
||||
toWidget courseName
|
||||
-- (CourseR tid csh CRegisterR) -- just for POST
|
||||
pageHeading (CourseR tid csh CEditR)
|
||||
= Just $ i18nHeading $ MsgCourseEditHeading tid csh
|
||||
pageHeading (CourseR tid csh CCorrectionsR)
|
||||
= Just $ i18nHeading $ MsgSubmissionsCourse tid csh
|
||||
pageHeading (CourseR tid csh SheetListR)
|
||||
= Just $ i18nHeading $ MsgSheetList tid csh
|
||||
pageHeading (CourseR tid csh SheetNewR)
|
||||
= Just $ i18nHeading $ MsgSheetNewHeading tid csh
|
||||
pageHeading (CSheetR tid csh shn SShowR)
|
||||
= Just $ i18nHeading $ MsgSheetTitle tid csh shn
|
||||
pageHeading (CSheetR tid csh shn SEditR)
|
||||
= Just $ i18nHeading $ MsgSheetEditHead tid csh shn
|
||||
pageHeading (CSheetR tid csh shn SDelR)
|
||||
= Just $ i18nHeading $ MsgSheetDelHead tid csh shn
|
||||
pageHeading (CSheetR tid csh shn SSubsR)
|
||||
pageHeading (CourseR tid ssh csh CEditR)
|
||||
= Just $ i18nHeading $ MsgCourseEditHeading tid ssh csh
|
||||
pageHeading (CourseR tid ssh csh CCorrectionsR)
|
||||
= Just $ i18nHeading $ MsgSubmissionsCourse tid ssh csh
|
||||
pageHeading (CourseR tid ssh csh SheetListR)
|
||||
= Just $ i18nHeading $ MsgSheetList tid ssh csh
|
||||
pageHeading (CourseR tid ssh csh SheetNewR)
|
||||
= Just $ i18nHeading $ MsgSheetNewHeading tid ssh csh
|
||||
pageHeading (CSheetR tid ssh csh shn SShowR)
|
||||
= Just $ i18nHeading $ MsgSheetTitle tid ssh csh shn
|
||||
pageHeading (CSheetR tid ssh csh shn SEditR)
|
||||
= Just $ i18nHeading $ MsgSheetEditHead tid ssh csh shn
|
||||
pageHeading (CSheetR tid ssh csh shn SDelR)
|
||||
= Just $ i18nHeading $ MsgSheetDelHead tid ssh csh shn
|
||||
pageHeading (CSheetR tid ssh csh shn SSubsR)
|
||||
= Just $ i18nHeading $ MsgSubmissionsSheet shn
|
||||
pageHeading (CSheetR tid csh shn SubmissionNewR)
|
||||
= Just $ i18nHeading $ MsgSubmissionEditHead tid csh shn
|
||||
pageHeading (CSheetR tid csh shn SubmissionOwnR)
|
||||
= Just $ i18nHeading $ MsgSubmissionEditHead tid csh shn
|
||||
pageHeading (CSubmissionR tid csh shn _ SubShowR) -- TODO: Rethink this one!
|
||||
= Just $ i18nHeading $ MsgSubmissionEditHead tid csh shn
|
||||
pageHeading (CSheetR tid ssh csh shn SubmissionNewR)
|
||||
= Just $ i18nHeading $ MsgSubmissionEditHead tid ssh csh shn
|
||||
pageHeading (CSheetR tid ssh csh shn SubmissionOwnR)
|
||||
= Just $ i18nHeading $ MsgSubmissionEditHead tid ssh csh shn
|
||||
pageHeading (CSubmissionR tid ssh csh shn _ SubShowR) -- TODO: Rethink this one!
|
||||
= Just $ i18nHeading $ MsgSubmissionEditHead tid ssh csh shn
|
||||
-- (CSubmissionR tid csh shn cid SubArchiveR) -- just a download
|
||||
pageHeading (CSubmissionR tid csh shn cid CorrectionR)
|
||||
= Just $ i18nHeading $ MsgCorrectionHead tid csh shn cid
|
||||
pageHeading (CSubmissionR tid ssh csh shn cid CorrectionR)
|
||||
= Just $ i18nHeading $ MsgCorrectionHead tid ssh csh shn cid
|
||||
-- (CSubmissionR tid csh shn cid SubDownloadR) -- just a download
|
||||
pageHeading (CSheetR tid csh shn SCorrR)
|
||||
pageHeading (CSheetR tid ssh csh shn SCorrR)
|
||||
= Just $ i18nHeading $ MsgCorrectorsHead shn
|
||||
-- (CSheetR tid csh shn SFileR) -- just for Downloads
|
||||
-- (CSheetR tid ssh csh shn SFileR) -- just for Downloads
|
||||
|
||||
pageHeading CorrectionsR
|
||||
= Just $ i18nHeading MsgCorrectionsTitle
|
||||
@ -1030,6 +1037,7 @@ pageHeading _
|
||||
routeNormalizers :: [Route UniWorX -> WriterT Any (ReaderT (YesodPersistBackend UniWorX) (HandlerT UniWorX IO)) (Route UniWorX)]
|
||||
routeNormalizers =
|
||||
[ normalizeRender
|
||||
, ncSchool
|
||||
, ncCourse
|
||||
, ncSheet
|
||||
]
|
||||
@ -1050,17 +1058,25 @@ routeNormalizers =
|
||||
$logDebugS "routeNormalizers" [st|#{tshow a} /= #{tshow b}|]
|
||||
tell $ Any True
|
||||
| otherwise = return ()
|
||||
ncSchool = maybeOrig $ \route -> do
|
||||
SchoolCourseListR tid ssh <- return route
|
||||
let schoolShort :: SchoolShorthand
|
||||
schoolShort = unSchoolKey ssh
|
||||
Entity ssh' _ <- MaybeT . lift . getBy $ UniqueSchoolShorthand schoolShort
|
||||
(hasChanged `on` unSchoolKey)ssh ssh'
|
||||
return $ SchoolCourseListR tid ssh'
|
||||
ncCourse = maybeOrig $ \route -> do
|
||||
CourseR tid csh subRoute <- return route
|
||||
Entity _ Course{..} <- MaybeT . lift . getBy $ CourseTermShort tid csh
|
||||
CourseR tid ssh csh subRoute <- return route
|
||||
Entity _ Course{..} <- MaybeT . lift . getBy $ CourseTermSchoolShort tid ssh csh
|
||||
hasChanged csh courseShorthand
|
||||
return $ CourseR tid courseShorthand subRoute
|
||||
(hasChanged `on` unSchoolKey) ssh courseSchool
|
||||
return $ CourseR tid courseSchool courseShorthand subRoute
|
||||
ncSheet = maybeOrig $ \route -> do
|
||||
CSheetR tid csh shn subRoute <- return route
|
||||
Entity cid _ <- MaybeT . lift . getBy $ CourseTermShort tid csh
|
||||
CSheetR tid ssh csh shn subRoute <- return route
|
||||
Entity cid _ <- MaybeT . lift . getBy $ CourseTermSchoolShort tid ssh csh
|
||||
Entity _ Sheet{..} <- MaybeT . lift . getBy $ CourseSheet cid shn
|
||||
hasChanged shn sheetName
|
||||
return $ CSheetR tid csh sheetName subRoute
|
||||
return $ CSheetR tid ssh csh sheetName subRoute
|
||||
|
||||
|
||||
-- How to run database actions.
|
||||
|
||||
@ -39,13 +39,13 @@ 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{..}, _, _, _) } ->
|
||||
anchorCell (CourseR courseTerm courseShorthand CShowR)
|
||||
anchorCell (CourseR courseTerm courseSchool 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
|
||||
( anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseName}|] )
|
||||
( anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseName}|] )
|
||||
( case courseDescription of
|
||||
Nothing -> mempty
|
||||
(Just descr) -> cell [whamlet| <span style="float:right"> ^{modalStatic descr} |]
|
||||
@ -61,12 +61,12 @@ colDescription = sortable Nothing (i18nCell MsgCourseDescription)
|
||||
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}|]
|
||||
anchorCell (CourseR courseTerm courseSchool 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
|
||||
( anchorCell (CourseR courseTerm courseShorthand CShowR) [whamlet|#{display courseShorthand}|] )
|
||||
( anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseShorthand}|] )
|
||||
( case courseDescription of
|
||||
Nothing -> mempty
|
||||
(Just descr) -> cell
|
||||
@ -81,12 +81,12 @@ colTerm = sortable (Just "term") (i18nCell MsgTerm)
|
||||
colSchool :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colSchool = sortable (Just "school") (i18nCell MsgCourseSchool)
|
||||
$ \DBRow{ dbrOutput=(_, _, _, Entity _ School{..}) } ->
|
||||
cell [whamlet|#{display schoolName}|]
|
||||
anchorCell (SchoolCourseListR courseTerm courseSchool) [whamlet|#{display schoolName}|]
|
||||
|
||||
colSchoolShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgCourseSchoolShort)
|
||||
$ \DBRow{ dbrOutput=(_, _, _, Entity _ School{..}) } ->
|
||||
cell [whamlet|#{display schoolShorthand}|]
|
||||
anchorCell (SchoolCourseListR courseTerm courseSchool) [whamlet|#{display schoolShorthand}|]
|
||||
|
||||
colRegFrom :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colRegFrom = sortable (Just "register-from") (i18nCell MsgRegisterFrom)
|
||||
@ -222,13 +222,13 @@ getTermCourseListR tid = do
|
||||
setTitleI . MsgTermCourseListTitle $ tid
|
||||
$(widgetFile "courses")
|
||||
|
||||
getCShowR :: TermId -> CourseShorthand -> Handler Html
|
||||
getCShowR tid csh = do
|
||||
getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCShowR tid ssh csh = do
|
||||
mbAid <- maybeAuthId
|
||||
(courseEnt,(schoolMB,participants,registered)) <- runDB $ do
|
||||
courseEnt@(Entity cid course) <- getBy404 $ CourseTermShort tid csh
|
||||
courseEnt@(Entity cid course) <- getBy404 $ CourseTermSchoolShort tid ssh csh
|
||||
dependent <- (,,)
|
||||
<$> get (courseSchool course) -- join
|
||||
<$> get (courseSchool course) -- join -- just fetch full school name here
|
||||
<*> count [CourseParticipantCourse ==. cid] -- join
|
||||
<*> (case mbAid of -- TODO: Someone please refactor this late-night mess here!
|
||||
Nothing -> return False
|
||||
@ -238,7 +238,7 @@ getCShowR tid csh = do
|
||||
return $ (courseEnt,dependent)
|
||||
let course = entityVal courseEnt
|
||||
(regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
|
||||
registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid csh CRegisterR) True
|
||||
registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True
|
||||
mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom course
|
||||
mRegTo <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course
|
||||
defaultLayout $ do
|
||||
@ -258,11 +258,11 @@ registerForm registered msecret extra = do
|
||||
return (btnRes *> ((==msecret) <$> msecretRes), widget) -- checks that correct button was pressed, and ignores result of btnRes
|
||||
|
||||
|
||||
postCRegisterR :: TermId -> CourseShorthand -> Handler Html
|
||||
postCRegisterR tid csh = do
|
||||
postCRegisterR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
postCRegisterR tid ssh csh = do
|
||||
aid <- requireAuthId
|
||||
(cid, course, registered) <- runDB $ do
|
||||
(Entity cid course) <- getBy404 $ CourseTermShort tid csh
|
||||
(Entity cid course) <- getBy404 $ CourseTermSchoolShort tid ssh csh
|
||||
registered <- isJust <$> (getBy $ UniqueParticipant aid cid)
|
||||
return (cid, course, registered)
|
||||
((regResult,_), _) <- runFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
|
||||
@ -277,7 +277,7 @@ postCRegisterR tid csh = do
|
||||
when (isJust regOk) $ addMessageI "success" MsgCourseRegisterOk
|
||||
| otherwise -> addMessageI "danger" MsgCourseSecretWrong
|
||||
(_other) -> return () -- TODO check this!
|
||||
redirect $ CourseR tid csh CShowR
|
||||
redirect $ CourseR tid ssh csh CShowR
|
||||
|
||||
getCourseNewR :: Handler Html
|
||||
getCourseNewR = do
|
||||
@ -287,14 +287,14 @@ getCourseNewR = do
|
||||
postCourseNewR :: Handler Html
|
||||
postCourseNewR = courseEditHandler False Nothing
|
||||
|
||||
getCEditR :: TermId -> CourseShorthand -> Handler Html
|
||||
getCEditR tid csh = do
|
||||
course <- runDB $ getBy $ CourseTermShort tid csh
|
||||
getCEditR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCEditR tid ssh csh = do
|
||||
course <- runDB $ getBy $ CourseTermShort tid ssh csh
|
||||
courseEditHandler True course
|
||||
|
||||
postCEditR :: TermId -> CourseShorthand -> Handler Html
|
||||
postCEditR tid csh = do
|
||||
course <- runDB $ getBy $ CourseTermShort tid csh
|
||||
postCEditR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
postCEditR tid ssh csh = do
|
||||
course <- runDB $ getBy $ CourseTermShort tid ssh csh
|
||||
courseEditHandler False course
|
||||
|
||||
|
||||
@ -317,6 +317,7 @@ courseEditHandler isGet course = do
|
||||
(FormSuccess res@(
|
||||
CourseForm { cfCourseId = Nothing
|
||||
, cfShort = csh
|
||||
, cfSchool = ssh
|
||||
, cfTerm = tid
|
||||
})) -> do -- create new course
|
||||
now <- liftIO getCurrentTime
|
||||
@ -339,14 +340,15 @@ courseEditHandler isGet course = do
|
||||
runDB $ do
|
||||
insert_ $ CourseEdit aid now cid
|
||||
insert_ $ Lecturer aid cid
|
||||
addMessageI "info" $ MsgCourseNewOk tid csh
|
||||
addMessageI "info" $ MsgCourseNewOk tid ssh csh
|
||||
redirect $ TermCourseListR tid
|
||||
Nothing ->
|
||||
addMessageI "danger" $ MsgCourseNewDupShort tid csh
|
||||
addMessageI "danger" $ MsgCourseNewDupShort tid ssh csh
|
||||
|
||||
(FormSuccess res@(
|
||||
CourseForm { cfCourseId = Just cid
|
||||
, cfShort = csh
|
||||
, cfSchool = ssh
|
||||
, cfTerm = tid
|
||||
})) -> do -- edit existing course
|
||||
now <- liftIO getCurrentTime
|
||||
@ -372,12 +374,12 @@ courseEditHandler isGet course = do
|
||||
}
|
||||
)
|
||||
case updOkay of
|
||||
(Just _) -> addMessageI "danger" (MsgCourseEditDupShort tid csh) $> False
|
||||
(Just _) -> addMessageI "danger" (MsgCourseEditDupShort tid ssh csh) $> False
|
||||
Nothing -> do
|
||||
insert_ $ CourseEdit aid now cid
|
||||
addMessageI "success" $ MsgCourseEditOk tid csh
|
||||
addMessageI "success" $ MsgCourseEditOk tid ssh csh
|
||||
return True
|
||||
when success $ redirect $ CourseR tid csh CShowR
|
||||
when success $ redirect $ CourseR tid ssh csh CShowR
|
||||
|
||||
(FormFailure _) -> addMessageI "warning" MsgInvalidInput
|
||||
(FormMissing) -> return ()
|
||||
|
||||
@ -38,23 +38,23 @@ instance CryptoRoute UUID SubmissionId where
|
||||
cryptoIDRoute _ (CryptoID -> cID) = do
|
||||
(smid :: SubmissionId) <- decrypt cID
|
||||
cID' <- encrypt smid
|
||||
(tid,csh,shn) <- runDB $ do
|
||||
(tid,ssh,csh,shn) <- runDB $ do
|
||||
shid <- submissionSheet <$> get404 smid
|
||||
Sheet{..} <- get404 shid
|
||||
Course{..} <- get404 sheetCourse
|
||||
return (courseTerm, courseShorthand, sheetName)
|
||||
return $ CSubmissionR tid csh shn cID' SubShowR
|
||||
return (courseTerm, courseSchool, courseShorthand, sheetName)
|
||||
return $ CSubmissionR tid ssh csh shn cID' SubShowR
|
||||
|
||||
instance CryptoRoute (CI FilePath) SubmissionId where
|
||||
cryptoIDRoute _ ciphertext
|
||||
| Just cID <- fromPathPiece . Text.pack $ CI.original ciphertext = do
|
||||
smid <- decrypt cID
|
||||
(tid,csh,shn) <- runDB $ do
|
||||
(tid,ssh,csh,shn) <- runDB $ do
|
||||
shid <- submissionSheet <$> get404 smid
|
||||
Sheet{..} <- get404 shid
|
||||
Course{..} <- get404 sheetCourse
|
||||
return (courseTerm, courseShorthand, sheetName)
|
||||
return $ CSubmissionR tid csh shn cID SubShowR
|
||||
return (courseTerm, courseSchool, courseShorthand, sheetName)
|
||||
return $ CSubmissionR tid ssh csh shn cID SubShowR
|
||||
| otherwise = notFound
|
||||
|
||||
instance CryptoRoute UUID UserId where
|
||||
|
||||
@ -68,12 +68,15 @@ homeAnonymous = do
|
||||
colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (HandlerT UniWorX IO) ())
|
||||
colonnade = mconcat
|
||||
[ -- dbRow
|
||||
sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
|
||||
let tid = courseTerm course
|
||||
csh = courseShorthand course
|
||||
cell [whamlet|<a href=@{CourseR tid csh CShowR}>#{display csh}|]
|
||||
, sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
|
||||
textCell $ display $ courseTerm course
|
||||
, sortable (Just "school") (textCell MsgCourseSchool) $ DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
|
||||
textCell $ display $ courseSchool course
|
||||
, sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
|
||||
let tid = courseTerm course
|
||||
ssh = courseSchool course
|
||||
csh = courseShorthand course
|
||||
anchorCell (CourseR tid ssh csh CShowR) (toWidget $ display csh)
|
||||
, sortable (Just "deadline") (textCell MsgRegisterTo) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
|
||||
cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget
|
||||
]
|
||||
@ -85,6 +88,9 @@ homeAnonymous = do
|
||||
[ ( "term"
|
||||
, SortColumn $ \(course) -> course E.^. CourseTerm
|
||||
)
|
||||
, ( "school"
|
||||
, SortColumn $ \(course) -> course E.^. CourseSchool
|
||||
)
|
||||
, ( "course"
|
||||
, SortColumn $ \(course) -> course E.^. CourseShorthand
|
||||
)
|
||||
@ -132,6 +138,7 @@ homeUser uid = do
|
||||
-- E.limit nrSheetDeadlines -- arbitrary limits are not intuitive
|
||||
return
|
||||
( course E.^. CourseTerm
|
||||
, course E.^. CourseSchool
|
||||
, course E.^. CourseShorthand
|
||||
, sheet E.^. SheetName
|
||||
, sheet E.^. SheetActiveTo
|
||||
@ -139,6 +146,7 @@ homeUser uid = do
|
||||
)
|
||||
|
||||
colonnade :: Colonnade Sortable (DBRow ( E.Value (Key Term)
|
||||
, E.Value SchoolId
|
||||
, E.Value CourseShorthand
|
||||
, E.Value SheetName
|
||||
, E.Value UTCTime
|
||||
@ -147,18 +155,21 @@ homeUser uid = do
|
||||
(DBCell (HandlerT UniWorX IO) ())
|
||||
colonnade = mconcat
|
||||
[ -- dbRow
|
||||
sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, _, _, _) } ->
|
||||
anchorCell (CourseR tid csh CShowR) (toWidget $ display csh)
|
||||
, sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(E.Value tid, _,_,_,_) } ->
|
||||
-- TOOD: sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(view _1 -> E.Value tid) } ->
|
||||
sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(E.Value tid,_,_,_,_,_) } ->
|
||||
textCell $ display tid
|
||||
, sortable (Just "sheet") (textCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _, _) } ->
|
||||
anchorCell (CSheetR tid csh shn SShowR) (toWidget $ display shn)
|
||||
, sortable (Just "deadline") (textCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, E.Value deadline, _) } ->
|
||||
, sortable (Just "school") (textCell MsgCourseSchool) $ \DBRow{ dbrOutput=(_,E.Value ssh,_,_,_,_) } ->
|
||||
textCell $ display ssh
|
||||
, sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, _, _, _) } ->
|
||||
anchorCell (CourseR tid ssh csh CShowR) (toWidget $ display csh)
|
||||
, sortable (Just "sheet") (textCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, _) } ->
|
||||
anchorCell (CSheetR tid ssh csh shn SShowR) (toWidget $ display shn)
|
||||
, sortable (Just "deadline") (textCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, _, E.Value deadline, _) } ->
|
||||
cell $ formatTime SelFormatDateTime deadline >>= toWidget
|
||||
, sortable (Just "done") (textCell MsgDone) $ \(DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _, E.Value mbsid) }) ->
|
||||
, sortable (Just "done") (textCell MsgDone) $ \(DBRow{ dbrOutput=(E.Value tid, E.Value, ssh, E.Value csh, E.Value shn, _, E.Value mbsid) }) ->
|
||||
case mbsid of
|
||||
Nothing -> mempty
|
||||
(Just sid) -> anchorCellM (CSubmissionR tid csh shn <$> encrypt sid <*> pure SubShowR)
|
||||
(Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR)
|
||||
tickmark
|
||||
]
|
||||
let validator = def & defaultSorting [("done",SortDesc), ("deadline",SortDesc)]
|
||||
@ -171,6 +182,9 @@ homeUser uid = do
|
||||
[ ( "term"
|
||||
, SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ `E.LeftOuterJoin` _) -> course E.^. CourseTerm
|
||||
)
|
||||
, ( "school"
|
||||
, SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ `E.LeftOuterJoin` _) -> course E.^. CourseSchool
|
||||
)
|
||||
, ( "course"
|
||||
, SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ `E.LeftOuterJoin` _) -> course E.^. CourseShorthand
|
||||
)
|
||||
|
||||
@ -99,7 +99,7 @@ getProfileR = do
|
||||
(E.select $ E.from $ \(lecturer `E.InnerJoin` course) -> do
|
||||
E.where_ $ lecturer ^. LecturerUser E.==. E.val uid
|
||||
E.on $ lecturer ^. LecturerCourse E.==. course ^. CourseId
|
||||
return (course ^. CourseShorthand, course ^. CourseTerm)
|
||||
return (course ^. CourseTerm, course ^.CourseSchool, course ^. CourseShorthand)
|
||||
)
|
||||
<*>
|
||||
(E.select $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
|
||||
@ -107,13 +107,13 @@ getProfileR = do
|
||||
E.on $ sheet ^. SheetId E.==. corrector ^. SheetCorrectorSheet
|
||||
E.where_ $ corrector ^. SheetCorrectorUser E.==. E.val uid
|
||||
|
||||
return (course ^. CourseShorthand, course ^. CourseTerm)
|
||||
return (course ^. CourseTerm, course ^. CourseSchool, course ^. CourseShorthand)
|
||||
)
|
||||
<*>
|
||||
(E.select $ E.from $ \(participant `E.InnerJoin` course) -> do
|
||||
E.where_ $ participant ^. CourseParticipantUser E.==. E.val uid
|
||||
E.on $ participant ^. CourseParticipantCourse E.==. course ^. CourseId
|
||||
return (course ^. CourseShorthand, course ^. CourseTerm, participant ^. CourseParticipantRegistration)
|
||||
return (course ^. CourseTerm, course ^. CourseSchool, course ^. CourseShorthand, participant ^. CourseParticipantRegistration)
|
||||
)
|
||||
<*>
|
||||
(E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
|
||||
|
||||
@ -156,10 +156,10 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
|
||||
, ( NTop sfSolutionFrom >= NTop (Just sfActiveTo) , render MsgSheetErrSolutionEarly)
|
||||
] ]
|
||||
|
||||
getSheetListR :: TermId -> CourseShorthand -> Handler Html
|
||||
getSheetListR tid csh = do
|
||||
getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getSheetListR tid ssh csh = do
|
||||
muid <- maybeAuthId
|
||||
Entity cid _ <- runDB . getBy404 $ CourseTermShort tid csh
|
||||
Entity cid _ <- runDB . getBy404 $ CourseTermSchoolShort tid ssh csh
|
||||
let
|
||||
sheetData :: E.SqlExpr (Entity Sheet) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity Submission)) `E.InnerJoin` (E.SqlExpr (Maybe (Entity SubmissionUser)))) -> E.SqlQuery (E.SqlExpr (Entity Sheet), E.SqlExpr (E.Value (Maybe UTCTime)),E.SqlExpr (Maybe (Entity Submission)))
|
||||
sheetData (sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) = do
|
||||
@ -221,7 +221,7 @@ getSheetListR tid csh = do
|
||||
{ dbtSQLQuery = sheetData
|
||||
, dbtColonnade = sheetCol
|
||||
, dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _, _) }
|
||||
-> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid csh sheetName SShowR) False)
|
||||
-> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False)
|
||||
, dbtSorting = Map.fromList
|
||||
[ ( "name"
|
||||
, SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName
|
||||
@ -256,9 +256,9 @@ getSheetListR tid csh = do
|
||||
$(widgetFile "widgets/sheetTypeSummary")
|
||||
|
||||
-- Show single sheet
|
||||
getSShowR :: TermId -> CourseShorthand -> SheetName -> Handler Html
|
||||
getSShowR tid csh shn = do
|
||||
entSheet <- runDB $ fetchSheet tid csh shn
|
||||
getSShowR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
|
||||
getSShowR tid ssh csh shn = do
|
||||
entSheet <- runDB $ fetchSheet tid ssh csh shn
|
||||
let sheet = entityVal entSheet
|
||||
sid = entityKey entSheet
|
||||
-- without Colonnade
|
||||
@ -285,7 +285,7 @@ getSShowR tid csh shn = do
|
||||
return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
|
||||
let colonnadeFiles = widgetColonnade $ mconcat
|
||||
[ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> stringCell ftype
|
||||
, sortable (Just "path") "Dateiname" $ anchorCell' (\(E.Value fName,_,E.Value fType) -> CSheetR tid csh shn (SFileR fType fName))
|
||||
, sortable (Just "path") "Dateiname" $ anchorCell' (\(E.Value fName,_,E.Value fType) -> CSheetR tid ssh csh shn (SFileR fType fName))
|
||||
(\(E.Value fName,_,_) -> str2widget fName)
|
||||
, sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> cell $ formatTime SelFormatDateTime (modified :: UTCTime) >>= toWidget
|
||||
]
|
||||
@ -326,12 +326,12 @@ getSShowR tid csh shn = do
|
||||
solutionFrom <- traverse (formatTime SelFormatDateTime) $ sheetSolutionFrom sheet
|
||||
$(widgetFile "sheetShow")
|
||||
|
||||
getSFileR :: TermId -> CourseShorthand -> SheetName -> SheetFileType -> FilePath -> Handler TypedContent
|
||||
getSFileR tid csh shn typ title = do
|
||||
getSFileR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> FilePath -> Handler TypedContent
|
||||
getSFileR tid ssh csh shn typ title = do
|
||||
results <- runDB $ E.select $ E.from $
|
||||
\(course `E.InnerJoin` sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> do
|
||||
-- Restrict to consistent rows that correspond to each other
|
||||
E.on (file E.^. FileId E.==. sheetFile E.^. SheetFileFile)
|
||||
E.on (file E.^. FileId E.==. sheetFile E.^. SheetFileFile)
|
||||
E.on (sheetFile E.^. SheetFileSheet E.==. sheet E.^. SheetId)
|
||||
E.on (sheet E.^. SheetCourse E.==. course E.^. CourseId)
|
||||
-- filter to requested file
|
||||
@ -339,7 +339,8 @@ getSFileR tid csh shn typ title = do
|
||||
E.&&. (sheetFile E.^. SheetFileType E.==. E.val typ )
|
||||
E.&&. (sheet E.^. SheetName E.==. E.val shn )
|
||||
E.&&. (course E.^. CourseShorthand E.==. E.val csh )
|
||||
E.&&. (course E.^. CourseTerm E.==. E.val tid )
|
||||
E.&&. (course E.^. CourseSchool E.==. E.val ssh )
|
||||
E.&&. (course E.^. CourseTerm E.==. E.val tid )
|
||||
)
|
||||
-- return desired columns
|
||||
return $ (file E.^. FileTitle, file E.^. FileContent)
|
||||
@ -356,21 +357,21 @@ getSFileR tid csh shn typ title = do
|
||||
$logErrorS "SFileR" $ "Multiple matching files: " <> tshow other
|
||||
error "Multiple matching files found."
|
||||
|
||||
getSheetNewR :: TermId -> CourseShorthand -> Handler Html
|
||||
getSheetNewR tid csh = do
|
||||
getSheetNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getSheetNewR tid ssh csh = do
|
||||
let template = Nothing -- TODO: provide convenience by interpolating name/nr/dates+7days
|
||||
let action newSheet = -- More specific error message for new sheet could go here, if insertUnique returns Nothing
|
||||
insertUnique $ newSheet
|
||||
handleSheetEdit tid csh Nothing template action
|
||||
handleSheetEdit tid ssh csh Nothing template action
|
||||
|
||||
postSheetNewR :: TermId -> CourseShorthand -> Handler Html
|
||||
postSheetNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
postSheetNewR = getSheetNewR
|
||||
|
||||
|
||||
getSEditR :: TermId -> CourseShorthand -> SheetName -> Handler Html
|
||||
getSEditR tid csh shn = do
|
||||
getSEditR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
|
||||
getSEditR tid ssh csh shn = do
|
||||
(sheetEnt, sheetFileIds) <- runDB $ do
|
||||
ent <- fetchSheet tid csh shn
|
||||
ent <- fetchSheet tid ssh csh shn
|
||||
fti <- getFtIdMap $ entityKey ent
|
||||
return (ent, fti)
|
||||
let sid = entityKey sheetEnt
|
||||
@ -396,13 +397,13 @@ getSEditR tid csh shn = do
|
||||
case replaceRes of
|
||||
Nothing -> return $ Just sid
|
||||
(Just _err) -> return $ Nothing -- More specific error message for edit old sheet could go here
|
||||
handleSheetEdit tid csh (Just sid) template action
|
||||
handleSheetEdit tid ssh csh (Just sid) template action
|
||||
|
||||
postSEditR :: TermId -> CourseShorthand -> SheetName -> Handler Html
|
||||
postSEditR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
|
||||
postSEditR = getSEditR
|
||||
|
||||
handleSheetEdit :: TermId -> CourseShorthand -> Maybe SheetId -> Maybe SheetForm -> (Sheet -> YesodDB UniWorX (Maybe SheetId)) -> Handler Html
|
||||
handleSheetEdit tid csh msId template dbAction = do
|
||||
handleSheetEdit :: TermId -> SchoolId -< CourseShorthand -> Maybe SheetId -> Maybe SheetForm -> (Sheet -> YesodDB UniWorX (Maybe SheetId)) -> Handler Html
|
||||
handleSheetEdit tid ssh csh msId template dbAction = do
|
||||
let mbshn = sfName <$> template
|
||||
aid <- requireAuthId
|
||||
((res,formWidget), formEnctype) <- runFormPost $ makeSheetForm msId template
|
||||
@ -410,7 +411,7 @@ handleSheetEdit tid csh msId template dbAction = do
|
||||
(FormSuccess SheetForm{..}) -> do
|
||||
saveOkay <- runDB $ do
|
||||
actTime <- liftIO getCurrentTime
|
||||
cid <- getKeyBy404 $ CourseTermShort tid csh
|
||||
cid <- getKeyBy404 $ CourseTermSchoolShort tid ssh csh
|
||||
let newSheet = Sheet
|
||||
{ sheetCourse = cid
|
||||
, sheetName = sfName
|
||||
@ -426,51 +427,51 @@ handleSheetEdit tid csh msId template dbAction = do
|
||||
}
|
||||
mbsid <- dbAction newSheet
|
||||
case mbsid of
|
||||
Nothing -> False <$ addMessageI "danger" (MsgSheetNameDup tid csh sfName)
|
||||
Nothing -> False <$ addMessageI "danger" (MsgSheetNameDup tid ssh csh sfName)
|
||||
(Just sid) -> do -- save files in DB:
|
||||
whenIsJust sfSheetF $ insertSheetFile' sid SheetExercise
|
||||
whenIsJust sfHintF $ insertSheetFile' sid SheetHint
|
||||
whenIsJust sfSolutionF $ insertSheetFile' sid SheetSolution
|
||||
whenIsJust sfMarkingF $ insertSheetFile' sid SheetMarking
|
||||
insert_ $ SheetEdit aid actTime sid
|
||||
addMessageI "info" $ MsgSheetEditOk tid csh sfName
|
||||
addMessageI "info" $ MsgSheetEditOk tid ssh csh sfName
|
||||
return True
|
||||
when saveOkay $ redirect $ CSheetR tid csh sfName SShowR -- redirect must happen outside of runDB
|
||||
when saveOkay $ redirect $ CSheetR tid ssh csh sfName SShowR -- redirect must happen outside of runDB
|
||||
(FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml
|
||||
_ -> return ()
|
||||
let pageTitle = maybe (MsgSheetTitleNew tid csh)
|
||||
(MsgSheetTitle tid csh) mbshn
|
||||
let pageTitle = maybe (MsgSheetTitleNew tid ssh csh)
|
||||
(MsgSheetTitle tid ssh csh) mbshn
|
||||
-- let formTitle = pageTitle -- no longer used in template
|
||||
let formText = Nothing :: Maybe UniWorXMessage
|
||||
actionUrl <- fromMaybe (CourseR tid csh SheetNewR) <$> getCurrentRoute
|
||||
actionUrl <- fromMaybe (CourseR tid ssh csh SheetNewR) <$> getCurrentRoute
|
||||
defaultLayout $ do
|
||||
setTitleI pageTitle
|
||||
$(widgetFile "formPageI18n")
|
||||
|
||||
|
||||
|
||||
getSDelR :: TermId -> CourseShorthand -> SheetName -> Handler Html
|
||||
getSDelR tid csh shn = do
|
||||
getSDelR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
|
||||
getSDelR tid ssh csh shn = do
|
||||
((result,formWidget), formEnctype) <- runFormPost (buttonForm :: Form BtnDelete)
|
||||
case result of
|
||||
(FormSuccess BtnAbort) -> redirectUltDest $ CSheetR tid csh shn SShowR
|
||||
(FormSuccess BtnAbort) -> redirectUltDest $ CSheetR tid ssh csh shn SShowR
|
||||
(FormSuccess BtnDelete) -> do
|
||||
runDB $ fetchSheetId tid csh shn >>= deleteCascade
|
||||
-- TODO: deleteCascade löscht aber nicht die hochgeladenen Dateien!!!
|
||||
addMessageI "info" $ MsgSheetDelOk tid csh shn
|
||||
redirect $ CourseR tid csh SheetListR
|
||||
addMessageI "info" $ MsgSheetDelOk tid ssh csh shn
|
||||
redirect $ CourseR tid ssh csh SheetListR
|
||||
_other -> do
|
||||
submissionno <- runDB $ do
|
||||
sid <- fetchSheetId tid csh shn
|
||||
sid <- fetchSheetId tid ssh csh shn
|
||||
count [SubmissionSheet ==. sid]
|
||||
let formTitle = MsgSheetDelHead tid csh shn
|
||||
let formText = Just $ MsgSheetDelText submissionno
|
||||
let actionUrl = CSheetR tid csh shn SDelR
|
||||
let actionUrl = CSheetR tid ssh csh shn SDelR
|
||||
defaultLayout $ do
|
||||
setTitleI $ MsgSheetTitle tid csh shn
|
||||
setTitleI $ MsgSheetTitle tid ssh csh shn
|
||||
$(widgetFile "formPageI18n")
|
||||
|
||||
postSDelR :: TermId -> CourseShorthand -> SheetName -> Handler Html
|
||||
postSDelR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
|
||||
postSDelR = getSDelR
|
||||
|
||||
|
||||
@ -671,10 +672,10 @@ correctorForm shid = do
|
||||
-- Eingabebox für Korrektor hinzufügen
|
||||
-- Eingabe für Korrekt ausgefüllt: FormMissing zurückschicken um dann Feld hinzuzufügen
|
||||
|
||||
getSCorrR, postSCorrR :: TermId -> CourseShorthand -> SheetName -> Handler Html
|
||||
getSCorrR, postSCorrR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
|
||||
postSCorrR = getSCorrR
|
||||
getSCorrR tid csh shn = do
|
||||
Entity shid Sheet{..} <- runDB $ fetchSheet tid csh shn
|
||||
getSCorrR tid ssh csh shn = do
|
||||
Entity shid Sheet{..} <- runDB $ fetchSheet tid ssh csh shn
|
||||
|
||||
((res,formWidget), formEnctype) <- runFormPost . identForm FIDcorrectors . renderAForm FormStandard $ formToAForm (correctorForm shid) <* submitButton
|
||||
|
||||
@ -689,8 +690,8 @@ getSCorrR tid csh shn = do
|
||||
let
|
||||
-- formTitle = MsgSheetCorrectorsTitle tid csh shn
|
||||
formText = Nothing :: Maybe (SomeMessage UniWorX)
|
||||
actionUrl = CSheetR tid csh shn SCorrR
|
||||
actionUrl = CSheetR tid ssh csh shn SCorrR
|
||||
-- actionUrl = CSheetR tid csh shn SShowR
|
||||
defaultLayout $ do
|
||||
setTitleI $ MsgSheetCorrectorsTitle tid csh shn
|
||||
setTitleI $ MsgSheetCorrectorsTitle tid ssh csh shn
|
||||
$(widgetFile "formPageI18n")
|
||||
|
||||
@ -87,11 +87,11 @@ getSubShowR, postSubShowR :: TermId -> CourseShorthand -> SheetName -> CryptoFil
|
||||
getSubShowR = postSubShowR
|
||||
postSubShowR tid csh shn cid = submissionHelper tid csh shn $ ExistingSubmission cid
|
||||
|
||||
getSubmissionOwnR :: TermId -> CourseShorthand -> SheetName -> Handler Html
|
||||
getSubmissionOwnR tid csh shn = do
|
||||
getSubmissionOwnR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
|
||||
getSubmissionOwnR tid ssh csh shn = do
|
||||
authId <- requireAuthId
|
||||
sid <- runDB $ do
|
||||
shid <- fetchSheetId tid csh shn
|
||||
shid <- fetchSheetId tid ssh csh shn
|
||||
submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
|
||||
E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission)
|
||||
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val authId
|
||||
@ -101,10 +101,10 @@ getSubmissionOwnR tid csh shn = do
|
||||
((E.Value sid):_) -> return sid
|
||||
[] -> notFound
|
||||
cID <- encrypt sid
|
||||
redirect $ CSubmissionR tid csh shn cID SubShowR
|
||||
redirect $ CSubmissionR tid ssh csh shn cID SubShowR
|
||||
|
||||
submissionHelper :: TermId -> CourseShorthand -> SheetName -> SubmissionMode -> Handler Html
|
||||
submissionHelper tid csh shn (SubmissionMode mcid) = do
|
||||
submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SubmissionMode -> Handler Html
|
||||
submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||
uid <- requireAuthId
|
||||
msmid <- traverse decrypt mcid
|
||||
(Entity shid Sheet{..}, buddies, lastEdits) <- runDB $ do
|
||||
@ -139,9 +139,9 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
|
||||
(E.Value smid:_) -> do
|
||||
cID <- encrypt smid
|
||||
addMessageI "info" $ MsgSubmissionAlreadyExists
|
||||
redirect $ CSubmissionR tid csh shn cID SubShowR
|
||||
redirect $ CSubmissionR tid ssh csh shn cID SubShowR
|
||||
(Just smid) -> do
|
||||
void $ submissionMatchesSheet tid csh shn (fromJust mcid)
|
||||
void $ submissionMatchesSheet tid ssh csh shn (fromJust mcid)
|
||||
|
||||
shid' <- submissionSheet <$> get404 smid
|
||||
-- fetch buddies from current submission
|
||||
|
||||
@ -17,8 +17,7 @@ import Handler.Utils
|
||||
|
||||
-- import qualified Data.Text as T
|
||||
import Yesod.Form.Bootstrap3
|
||||
|
||||
import Colonnade hiding (bool)
|
||||
-- import Colonnade hiding (bool)
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
|
||||
@ -24,29 +24,30 @@ fetchSheetAux :: ( BaseBackend backend ~ SqlBackend
|
||||
, PersistQueryRead backend, PersistUniqueRead backend
|
||||
)
|
||||
=> (E.SqlExpr (Entity Sheet) -> b)
|
||||
-> TermId -> CourseShorthand -> SheetName -> ReaderT backend m a
|
||||
fetchSheetAux prj tid csh shn =
|
||||
let cachId = encodeUtf8 $ tshow (tid,csh,shn)
|
||||
-> TermId -> SchoolId -> CourseShorthand -> SheetName -> ReaderT backend m a
|
||||
fetchSheetAux prj tid ssh csh shn =
|
||||
let cachId = encodeUtf8 $ tshow (tid,ssh,csh,shn)
|
||||
in cachedBy cachId $ do
|
||||
-- Mit Yesod:
|
||||
-- cid <- getKeyBy404 $ CourseTermShort tid csh
|
||||
-- cid <- getKeyBy404 $ CourseTermSchoolShort tid ssh csh
|
||||
-- getBy404 $ CourseSheet cid shn
|
||||
-- Mit Esqueleto:
|
||||
sheetList <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
|
||||
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
|
||||
E.where_ $ course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
E.&&. sheet E.^. SheetName E.==. E.val shn
|
||||
E.where_ $ course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
E.&&. sheet E.^. SheetName E.==. E.val shn
|
||||
return $ prj sheet
|
||||
case sheetList of
|
||||
[sheet] -> return sheet
|
||||
_other -> notFound
|
||||
|
||||
fetchSheet :: TermId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Entity Sheet)
|
||||
fetchSheet :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Entity Sheet)
|
||||
fetchSheet = fetchSheetAux id
|
||||
|
||||
fetchSheetId :: TermId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Key Sheet)
|
||||
fetchSheetId tid cid shn = E.unValue <$> fetchSheetAux (E.^. SheetId) tid cid shn
|
||||
fetchSheetId :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Key Sheet)
|
||||
fetchSheetId tid ssh cid shn = E.unValue <$> fetchSheetAux (E.^. SheetId) tid ssh cid shn
|
||||
|
||||
fetchSheetIdCourseId :: TermId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Key Sheet, Key Course)
|
||||
fetchSheetIdCourseId tid cid shn = bimap E.unValue E.unValue <$> fetchSheetAux ((,) <$> (E.^. SheetId) <*> (E.^. SheetCourse)) tid cid shn
|
||||
fetchSheetIdCourseId :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Key Sheet, Key Course)
|
||||
fetchSheetIdCourseId tid ssh cid shn = bimap E.unValue E.unValue <$> fetchSheetAux ((,) <$> (E.^. SheetId) <*> (E.^. SheetCourse)) tid ssh cid shn
|
||||
|
||||
@ -551,7 +551,7 @@ sinkMultiSubmission userId isUpdate = do
|
||||
Submission{..} <- get404 sId
|
||||
Sheet{..} <- get404 submissionSheet
|
||||
Course{..} <- get404 sheetCourse
|
||||
guardAuthResult =<< evalAccessDB (CSubmissionR courseTerm courseShorthand sheetName cID CorrectionR) True
|
||||
guardAuthResult =<< evalAccessDB (CSubmissionR courseTerm courseSchool courseShorthand sheetName cID CorrectionR) True
|
||||
return . newResumableSink $ sinkSubmission userId (Right sId) isUpdate
|
||||
sink' <- lift $ yield val ++$$ sink
|
||||
case sink' of
|
||||
@ -599,10 +599,10 @@ sinkMultiSubmission userId isUpdate = do
|
||||
handleCryptoID _ = return Nothing
|
||||
|
||||
|
||||
submissionMatchesSheet :: TermId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> DB SubmissionId
|
||||
submissionMatchesSheet tid csh shn cid = do
|
||||
submissionMatchesSheet :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> DB SubmissionId
|
||||
submissionMatchesSheet tid ssh csh shn cid = do
|
||||
sid <- decrypt cid
|
||||
shid <- fetchSheetId tid csh shn
|
||||
shid <- fetchSheetId tid ssh csh shn
|
||||
Submission{..} <- get404 sid
|
||||
when (shid /= submissionSheet) $ invalidArgsI [MsgSubmissionWrongSheet]
|
||||
return sid
|
||||
|
||||
@ -17,7 +17,7 @@ import Model.Migration.Version
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Data.Set (Set)
|
||||
import Data.Set ()
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Database.Persist.Sql
|
||||
@ -67,7 +67,7 @@ migrateAll = do
|
||||
doCustomMigration acc desc migration = acc <* do
|
||||
let AppliedMigrationKey appliedMigrationFrom appliedMigrationTo = desc
|
||||
appliedMigrationTime <- liftIO getCurrentTime
|
||||
migration
|
||||
_ <- migration
|
||||
insert AppliedMigration{..}
|
||||
-- Map.foldlWithKey traverses migrations in ascending order of AppliedMigrationKey
|
||||
Map.foldlWithKey doCustomMigration (return ()) missingMigrations
|
||||
|
||||
@ -8,6 +8,7 @@
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-- # LANGUAGE ExistentialQuantification #-} -- for DA type
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-} -- for instance PathPiece (CI Text)
|
||||
|
||||
module Model.Types where
|
||||
|
||||
@ -23,6 +24,7 @@ import Data.Monoid (Sum(..))
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Universe
|
||||
import Data.Universe.Helpers
|
||||
import Data.UUID.Types
|
||||
|
||||
import Text.Read (readMaybe)
|
||||
|
||||
@ -32,6 +34,7 @@ import Database.Persist.Class
|
||||
import Database.Persist.Sql
|
||||
|
||||
import Web.HttpApiData
|
||||
import Web.PathPieces
|
||||
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
@ -50,6 +53,30 @@ import Generics.Deriving.Monoid (gmemptydefault, gmappenddefault)
|
||||
import Data.Typeable (Typeable)
|
||||
|
||||
|
||||
instance PathPiece UUID where
|
||||
fromPathPiece = Data.UUID.Types.fromString . unpack
|
||||
toPathPiece = pack . toString
|
||||
|
||||
instance (CI.FoldCase s, PathPiece s) => PathPiece (CI s) where
|
||||
fromPathPiece = fmap CI.mk . fromPathPiece
|
||||
toPathPiece = toPathPiece . CI.original
|
||||
|
||||
instance {-# OVERLAPS #-} PathMultiPiece FilePath where
|
||||
fromPathMultiPiece = Just . unpack . intercalate "/"
|
||||
toPathMultiPiece = Text.splitOn "/" . pack
|
||||
|
||||
instance (CI.FoldCase s, PathMultiPiece s) => PathMultiPiece (CI s) where
|
||||
fromPathMultiPiece = fmap CI.mk . fromPathMultiPiece
|
||||
toPathMultiPiece = toPathMultiPiece . CI.foldedCase
|
||||
|
||||
instance ToHttpApiData (CI Text) where
|
||||
toUrlPiece = CI.original
|
||||
|
||||
instance FromHttpApiData (CI Text) where
|
||||
parseUrlPiece = return . CI.mk
|
||||
|
||||
|
||||
|
||||
type Points = Centi
|
||||
|
||||
toPoints :: Integral a => a -> Points -- deprecated
|
||||
@ -368,7 +395,9 @@ derivePersistField "CorrectorState"
|
||||
|
||||
-- Type synonyms
|
||||
|
||||
type SheetName = CI Text
|
||||
type SchoolName = CI Text
|
||||
type SchoolShorthand = CI Text
|
||||
type CourseName = CI Text
|
||||
type CourseShorthand = CI Text
|
||||
type CourseName = CI Text
|
||||
type UserEmail = CI Text
|
||||
type SheetName = CI Text
|
||||
type UserEmail = CI Text
|
||||
|
||||
@ -27,16 +27,16 @@
|
||||
<dt .deflist__dt> Eigene Kurse
|
||||
<dd .deflist__dd>
|
||||
<ul .list-ul>
|
||||
$forall (E.Value csh, E.Value tid) <- lecture_owner
|
||||
$forall (E.Value tid, E.Value ssh, E.Value csh) <- lecture_owner
|
||||
<li .list-ul__item>
|
||||
<a href=@{CourseR tid csh CShowR}>#{display tid} - #{csh}
|
||||
<a href=@{CourseR tid ssh csh CShowR}>#{display tid}-#{display ssh}-#{display csh}
|
||||
$if not $ null lecture_corrector
|
||||
<dt .deflist__dt> Korrektor
|
||||
<dd .deflist__dd>
|
||||
<ul .list-ul>
|
||||
$forall (E.Value csh, E.Value tid) <- lecture_corrector
|
||||
$forall (E.Value tid, E.Value ssh, E.Value csh) <- lecture_corrector
|
||||
<li .list-ul__item>
|
||||
<a href=@{CourseR tid csh CShowR}>#{display tid} - #{csh}
|
||||
<a href=@{CourseR tid ssh csh CShowR}>#{display tid}-#{display ssh}-#{display csh}
|
||||
$if not $ null studies
|
||||
<dt .deflist__dt> Studiengänge
|
||||
<dd .deflist__dd>
|
||||
@ -59,10 +59,10 @@
|
||||
<dt .deflist__dt> Teilnehmer
|
||||
<dd .deflist__dd>
|
||||
<dl .deflist>
|
||||
$forall (E.Value csh, E.Value tid, regSince) <- participant
|
||||
$forall (E.Value tid, E.Valuse ssh, E.Value csh, regSince) <- participant
|
||||
<dt .deflist__dt>
|
||||
<a href=@{CourseR tid csh CShowR}>#{display tid} - #{csh}
|
||||
<a href=@{CourseR tid ssh csh CShowR}>#{display tid}-#{display ssh}-#{display csh}
|
||||
<dd .deflist__dd>
|
||||
seit #{display regSince}
|
||||
seit #{display regSince}
|
||||
|
||||
^{settingsForm}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user