fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Hierarchical Routes

Browse Source
This commit is contained in:
SJost 2018-03-22 16:04:38 +01:00
parent 217ae28d9e
commit 5f6640148c
8 changed files with 60 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
routes
View File

@ -15,26 +15,17 @@
/course/ CourseListR GET /course/ CourseListR GET
!/course/new CourseNewR GET POST !/course/new CourseNewR GET POST
!/course/#TermId CourseListTermR GET !/course/#TermId CourseListTermR GET
/course/#TermId/#Text CourseR:
/show CourseShowR GET POST
/edit CourseEditR GET POST
-- /course/#TermId/#Text CourseR !tag: /ex SheetR !registered:
-- /edit CourseEditR GET POST / SheetListR GET
-- /show CourseShowR GET POST -- CourseR tid csh CourseShowR /new SheetNewR GET POST !lecturer
-- /ex/#Text SheetR: !registered /#Text/show SheetShowR GET
-- /show /#Text/#SheetFileType/#FilePath SheetFileR GET
-- /edit -- CourseR tid csg (SheetR csh SheetEditR) /#Text/edit SheetEditR GET POST !lecturer
-- /delete /#Text/delete SheetDelR GET POST !lecturer
/course/#TermId/#Text/edit CourseEditR GET
/course/#TermId/#Text/show CourseShowR GET POST
/course/#TermId/#Text/ex/ SheetListR GET
/course/#TermId/#Text/ex/#Text/show SheetShowR GET
/course/#TermId/#Text/ex/#Text/#SheetFileType/#FilePath SheetFileR GET
/course/#TermId/#Text/ex/new SheetNewR GET POST
/course/#TermId/#Text/ex/#Text/edit SheetEditR GET POST
/course/#TermId/#Text/ex/#Text/delete SheetDelR GET POST
/submission SubmissionListR GET POST /submission SubmissionListR GET POST
/submission/#CryptoUUIDSubmission SubmissionR GET POST /submission/#CryptoUUIDSubmission SubmissionR GET POST

43
src/Foundation.hs
View File

@ -4,6 +4,7 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
@ -53,6 +54,9 @@ import System.FilePath
import Handler.Utils.Templates import Handler.Utils.Templates
-- infixl 9 :$:
-- pattern a :$: b = a b
-- | The foundation datatype for your application. This can be a good place to -- | The foundation datatype for your application. This can be a good place to
-- keep settings and values requiring initialization before your application -- keep settings and values requiring initialization before your application
-- starts running, such as database connections. Every handler will have -- starts running, such as database connections. Every handler will have
@ -80,7 +84,9 @@ data UniWorX = UniWorX
-- type Widget = WidgetT UniWorX IO () -- type Widget = WidgetT UniWorX IO ()
mkYesodData "UniWorX" $(parseRoutesFile "routes") mkYesodData "UniWorX" $(parseRoutesFile "routes")
type DB a = YesodDB UniWorX a -- Pattern Synonyms for convenience
pattern CSheetR tid csh ptn = CourseR tid csh (SheetR ptn)
data MenuItem = MenuItem data MenuItem = MenuItem
{ menuItemLabel :: Text { menuItemLabel :: Text
@ -95,7 +101,8 @@ data MenuTypes
| NavbarExtra { menuItem :: MenuItem } | NavbarExtra { menuItem :: MenuItem }
| NavbarSecondary { menuItem :: MenuItem } | NavbarSecondary { menuItem :: MenuItem }
-- | A convenient synonym for creating forms. -- | Convenient Type Synonyms:
type DB a = YesodDB UniWorX a
type Form x = Html -> MForm (HandlerT UniWorX IO) (FormResult x, Widget) type Form x = Html -> MForm (HandlerT UniWorX IO) (FormResult x, Widget)
mkMessage "UniWorX" "messages" "de" mkMessage "UniWorX" "messages" "de"
@ -151,7 +158,7 @@ instance Yesod UniWorX where
isAuthorized TermShowR _ = return Authorized isAuthorized TermShowR _ = return Authorized
isAuthorized CourseListR _ = return Authorized isAuthorized CourseListR _ = return Authorized
isAuthorized (CourseListTermR _) _ = return Authorized isAuthorized (CourseListTermR _) _ = return Authorized
isAuthorized (CourseShowR _ _) _ = return Authorized isAuthorized (CourseR _ _ CourseShowR) _ = return Authorized
isAuthorized (CryptoUUIDDispatchR _) _ = return Authorized isAuthorized (CryptoUUIDDispatchR _) _ = return Authorized
isAuthorized SubmissionListR _ = isAuthenticated isAuthorized SubmissionListR _ = isAuthenticated
isAuthorized SubmissionDownloadMultiArchiveR _ = isAuthenticated isAuthorized SubmissionDownloadMultiArchiveR _ = isAuthenticated
@ -205,14 +212,14 @@ isAuthorizedDB (SubmissionDownloadArchiveR (splitExtension -> (baseName, _))) _
isAuthorizedDB TermEditR _ = adminAccess Nothing isAuthorizedDB TermEditR _ = adminAccess Nothing
isAuthorizedDB (TermEditExistR _) _ = adminAccess Nothing isAuthorizedDB (TermEditExistR _) _ = adminAccess Nothing
isAuthorizedDB CourseNewR _ = lecturerAccess Nothing isAuthorizedDB CourseNewR _ = lecturerAccess Nothing
isAuthorizedDB (CourseEditR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) isAuthorizedDB (CourseR t c CourseEditR) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c)
isAuthorizedDB (SheetListR t c) False = return Authorized -- isAuthorizedDB (CourseR t c (SheetR SheetListR)) False = return Authorized --
isAuthorizedDB (SheetShowR t c s) _ = return Authorized -- TODO: nur für angemeldete Kursteilnehmer falls sichtbar, sonst nur Lectrurer oder Korrektor isAuthorizedDB (CourseR t c (SheetR SheetListR)) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c)
isAuthorizedDB (SheetFileR t c s _ _) _ = return Authorized -- TODO: nur für angemeldete Kursteilnehmer falls sichtbar, sonst nur Lectrurer oder Korrektor isAuthorizedDB (CourseR t c (SheetR (SheetShowR s))) _ = return Authorized -- TODO: nur für angemeldete Kursteilnehmer falls sichtbar, sonst nur Lectrurer oder Korrektor
isAuthorizedDB (SheetListR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) isAuthorizedDB (CourseR t c (SheetR (SheetFileR s _ _))) _ = return Authorized -- TODO: nur für angemeldete Kursteilnehmer falls sichtbar, sonst nur Lectrurer oder Korrektor
isAuthorizedDB (SheetNewR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) isAuthorizedDB (CourseR t c (SheetR SheetNewR)) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c)
isAuthorizedDB (SheetEditR t c s) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) isAuthorizedDB (CourseR t c (SheetR (SheetEditR s))) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c)
isAuthorizedDB (SheetDelR t c s) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) isAuthorizedDB (CourseR t c (SheetR (SheetDelR s))) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c)
isAuthorizedDB (CourseEditIDR cID) _ = do isAuthorizedDB (CourseEditIDR cID) _ = do
courseId <- decrypt cID courseId <- decrypt cID
courseLecturerAccess courseId courseLecturerAccess courseId
@ -285,15 +292,15 @@ instance YesodBreadcrumbs UniWorX where
breadcrumb CourseListR = return ("Kurs", Just HomeR) breadcrumb CourseListR = return ("Kurs", Just HomeR)
breadcrumb (CourseListTermR term) = return (toPathPiece term, Just TermShowR) breadcrumb (CourseListTermR term) = return (toPathPiece term, Just TermShowR)
breadcrumb (CourseShowR term course) = return (course, Just $ CourseListTermR term) breadcrumb (CourseR term course CourseShowR) = return (course, Just $ CourseListTermR term)
breadcrumb CourseNewR = return ("Neu", Just CourseListR) breadcrumb CourseNewR = return ("Neu", Just CourseListR)
breadcrumb (CourseEditR _ _) = return ("Editieren", Just CourseListR) breadcrumb (CourseR _ _ CourseEditR) = return ("Editieren", Just CourseListR)
breadcrumb (SheetListR tid csh) = return ("Übungen",Just $ CourseShowR tid csh) breadcrumb (CourseR tid csh (SheetR SheetListR)) = return ("Übungen",Just $ CourseR tid csh CourseShowR)
breadcrumb (SheetNewR tid csh) = return ("Neu", Just $ SheetListR tid csh) breadcrumb (CourseR tid csh (SheetR SheetNewR )) = return ("Neu", Just $ CourseR tid csh $ SheetR SheetListR)
breadcrumb (SheetShowR tid csh shn) = return (shn, Just $ SheetListR tid csh) breadcrumb (CourseR tid csh (SheetR (SheetShowR shn))) = return (shn, Just $ CourseR tid csh $ SheetR SheetListR)
breadcrumb (SheetEditR tid csh shn) = return ("Edit", Just $ SheetShowR tid csh shn) breadcrumb (CourseR tid csh (SheetR (SheetEditR shn))) = return ("Edit", Just $ CourseR tid csh $ SheetR $ SheetShowR shn)
breadcrumb (SheetDelR tid csh shn) = return ("DELETE", Just $ SheetShowR tid csh shn) breadcrumb (CourseR tid csh (SheetR (SheetDelR shn))) = return ("DELETE", Just $ CourseR tid csh $ SheetR $ SheetShowR shn)
breadcrumb SubmissionListR = return ("Abgaben", Just HomeR) breadcrumb SubmissionListR = return ("Abgaben", Just HomeR)
breadcrumb (SubmissionR _) = return ("Abgabe", Just SubmissionListR) breadcrumb (SubmissionR _) = return ("Abgabe", Just SubmissionListR)

15
src/Handler/Course.hs
View File

@ -40,7 +40,7 @@ getCourseListTermR tidini = do
let c = entityVal ckv let c = entityVal ckv
shd = courseShorthand c shd = courseShorthand c
tid = courseTermId c tid = courseTermId c
in [whamlet| <a href=@{CourseShowR tid shd}>#{shd} |] ) in [whamlet| <a href=@{CourseR tid shd CourseShowR}>#{shd} |] )
-- , headed "Institut" $ [shamlet| #{course} |] -- , headed "Institut" $ [shamlet| #{course} |]
, headed "Beginn Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterFrom.entityVal , headed "Beginn Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterFrom.entityVal
, headed "Ende Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterTo.entityVal , headed "Ende Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterTo.entityVal
@ -54,11 +54,11 @@ getCourseListTermR tidini = do
shd = courseShorthand c shd = courseShorthand c
tid = courseTermId c tid = courseTermId c
in do in do
adminLink <- handlerToWidget $ isAuthorized (CourseEditR tid shd ) False adminLink <- handlerToWidget $ isAuthorized (CourseR tid shd CourseEditR) False
-- if (adminLink==Authorized) then linkButton "Ändern" BCWarning (CourseEditR tid shd) else "" -- if (adminLink==Authorized) then linkButton "Ändern" BCWarning (CourseEditR tid shd) else ""
[whamlet| [whamlet|
$if adminLink == Authorized $if adminLink == Authorized
<a href=@{CourseEditR tid shd}> <a href=@{CourseR tid shd CourseEditR}>
editieren editieren
|] |]
) )
@ -96,8 +96,8 @@ getCourseShowR tid csh = do
[ NavbarAside $ MenuItem [ NavbarAside $ MenuItem
{ menuItemLabel = "Übungsblätter" { menuItemLabel = "Übungsblätter"
, menuItemIcon = Nothing , menuItemIcon = Nothing
, menuItemRoute = SheetListR tid csh , menuItemRoute = CSheetR tid csh SheetListR
, menuItemAccessCallback = (== Authorized) <$> isAuthorized (SheetListR tid csh) False , menuItemAccessCallback = (== Authorized) <$> isAuthorized (CSheetR tid csh SheetListR) False
} }
] ]
defaultLinkLayout pageActions $ do defaultLinkLayout pageActions $ do
@ -145,6 +145,9 @@ getCourseEditR tid csh = do
course <- runDB $ getBy $ CourseTermShort tid csh course <- runDB $ getBy $ CourseTermShort tid csh
courseEditHandler course courseEditHandler course
postCourseEditR :: TermId -> Text -> Handler Html
postCourseEditR = getCourseEditR
getCourseEditIDR :: CryptoUUIDCourse -> Handler Html getCourseEditIDR :: CryptoUUIDCourse -> Handler Html
getCourseEditIDR cID = do getCourseEditIDR cID = do
cIDKey <- getsYesod appCryptoIDKey cIDKey <- getsYesod appCryptoIDKey
@ -256,7 +259,7 @@ courseEditHandler course = do
(FormFailure _) -> addMessageI "warning" MsgInvalidInput (FormFailure _) -> addMessageI "warning" MsgInvalidInput
other -> addMessage "error" $ [shamlet| Error: #{show other}|] other -> addMessage "error" $ [shamlet| Error: #{show other}|]
let formTitle = "Kurs editieren/anlegen" :: Text let formTitle = "Kurs editieren/anlegen" :: Text
let actionUrl = CourseNewR -- CourseEditR -- TODO actionUrl <- fromMaybe CourseNewR <$> getCurrentRoute
defaultLayout $ do defaultLayout $ do
setTitle [shamlet| #{formTitle} |] setTitle [shamlet| #{formTitle} |]
$(widgetFile "formPage") $(widgetFile "formPage")

24
src/Handler/Sheet.hs
View File

@ -74,7 +74,7 @@ makeSheetForm template = identForm FIDsheet $ \html -> do
<*> areq utcTimeField (fsb "Abgabe ab") (sfActiveFrom <$> template) <*> areq utcTimeField (fsb "Abgabe ab") (sfActiveFrom <$> template)
<*> areq utcTimeField (fsb "Abgabefrist") (sfActiveTo <$> template) <*> areq utcTimeField (fsb "Abgabefrist") (sfActiveTo <$> template)
<*> fileAFormOpt (fsb "Aufgabenstellung") <*> fileAFormOpt (fsb "Aufgabenstellung")
<*> aopt utcTimeField (fsb "Hinweis ab") (sfHintFrom <$> template) <*> aopt utcTimeField (fsb "Hinweise ab") (sfHintFrom <$> template)
<*> fileAFormOpt (fsb "Hinweis") <*> fileAFormOpt (fsb "Hinweis")
<*> aopt utcTimeField (fsb "Lösung ab") (sfSolutionFrom <$> template) <*> aopt utcTimeField (fsb "Lösung ab") (sfSolutionFrom <$> template)
<*> fileAFormOpt (fsb "Lösung") <*> fileAFormOpt (fsb "Lösung")
@ -162,7 +162,7 @@ getSheetList courseEnt = do
rated <- count $ (SubmissionRatingTime !=. Nothing):sheetsub rated <- count $ (SubmissionRatingTime !=. Nothing):sheetsub
return (sid, sheet, (submissions, rated)) return (sid, sheet, (submissions, rated))
let colBase = mconcat let colBase = mconcat
[ headed "Blatt" $ \(sid,sheet,_) -> linkButton (toWgt $ sheetName sheet) BCLink $ SheetShowR tid csh (sheetName sheet) [ headed "Blatt" $ \(sid,sheet,_) -> linkButton (toWgt $ sheetName sheet) BCLink $ CourseR tid csh $ SheetR $ SheetShowR $ sheetName sheet
, headed "Abgabe ab" $ toWgt . formatTimeGerWD . sheetActiveFrom . snd3 , headed "Abgabe ab" $ toWgt . formatTimeGerWD . sheetActiveFrom . snd3
, headed "Abgabe bis" $ toWgt . formatTimeGerWD . sheetActiveTo . snd3 , headed "Abgabe bis" $ toWgt . formatTimeGerWD . sheetActiveTo . snd3
, headed "Bewertung" $ toWgt . show . sheetType . snd3 , headed "Bewertung" $ toWgt . show . sheetType . snd3
@ -170,13 +170,13 @@ getSheetList courseEnt = do
, headed "Eingereicht" $ toWgt . fst . trd3 , headed "Eingereicht" $ toWgt . fst . trd3
] ]
let colAdmin = mconcat -- only show edit button for allowed course assistants let colAdmin = mconcat -- only show edit button for allowed course assistants
[ headed "" $ \s -> linkButton "Edit" BCLink $ SheetEditR tid csh $ sheetName $ snd3 s [ headed "" $ \s -> linkButton "Edit" BCLink $ CourseR tid csh $ SheetR $ SheetEditR $ sheetName $ snd3 s
, headed "" $ \s -> linkButton "Delete" BCLink $ SheetDelR tid csh $ sheetName $ snd3 s , headed "" $ \s -> linkButton "Delete" BCLink $ CourseR tid csh $ SheetR $ SheetDelR $ sheetName $ snd3 s
] ]
showAdmin <- case sheets of showAdmin <- case sheets of
((_,firstSheet,_):_) -> do ((_,firstSheet,_):_) -> do
setUltDestCurrent setUltDestCurrent
(Authorized ==) <$> isAuthorized (SheetEditR tid csh $ sheetName firstSheet) False (Authorized ==) <$> isAuthorized (CourseR tid csh $ SheetR $ SheetEditR $ sheetName firstSheet) False
_otherwise -> return False _otherwise -> return False
let colSheets = if showAdmin let colSheets = if showAdmin
then colBase `mappend` colAdmin then colBase `mappend` colAdmin
@ -185,7 +185,7 @@ getSheetList courseEnt = do
[ NavbarAside $ MenuItem [ NavbarAside $ MenuItem
{ menuItemLabel = "Neues Übungsblatt" { menuItemLabel = "Neues Übungsblatt"
, menuItemIcon = Nothing , menuItemIcon = Nothing
, menuItemRoute = SheetNewR tid csh , menuItemRoute = CSheetR tid csh SheetNewR
, menuItemAccessCallback = (== Authorized) <$> isAuthorized CourseNewR False , menuItemAccessCallback = (== Authorized) <$> isAuthorized CourseNewR False
} }
] ]
@ -211,7 +211,7 @@ getSheetShowR tid csh shn = do
E.where_ (sheet E.^. SheetId E.==. E.val sid ) E.where_ (sheet E.^. SheetId E.==. E.val sid )
-- return desired columns -- return desired columns
return $ (file E.^. FileTitle, sheetFile E.^. SheetFileType) return $ (file E.^. FileTitle, sheetFile E.^. SheetFileType)
let fileLinks = map (\(E.Value fName, E.Value fType) -> SheetFileR tid csh shn fType fName) fileNameTypes let fileLinks = map (\(E.Value fName, E.Value fType) -> CSheetR tid csh (SheetFileR shn fType fName)) fileNameTypes
defaultLayout $ do defaultLayout $ do
setTitle $ toHtml $ T.append "Übung " $ sheetName sheet setTitle $ toHtml $ T.append "Übung " $ sheetName sheet
@ -325,14 +325,14 @@ handleSheetEdit tid csh template dbAction = do
whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution
addMessageI "info" $ MsgSheetEditOk tident csh sfName addMessageI "info" $ MsgSheetEditOk tident csh sfName
return True return True
when saveOkay $ redirect $ SheetShowR tid csh sfName -- redirect must happen outside of runDB when saveOkay $ redirect $ CSheetR tid csh $ SheetShowR sfName -- redirect must happen outside of runDB
(FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml (FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml
_ -> return () _ -> return ()
let pageTitle = maybe (MsgSheetTitleNew tident csh) let pageTitle = maybe (MsgSheetTitleNew tident csh)
(MsgSheetTitle tident csh) mbshn (MsgSheetTitle tident csh) mbshn
let formTitle = pageTitle let formTitle = pageTitle
let formText = Nothing :: Maybe UniWorXMessage let formText = Nothing :: Maybe UniWorXMessage
actionUrl <- fromMaybe (SheetNewR tid csh) <$> getCurrentRoute actionUrl <- fromMaybe (CSheetR tid csh SheetNewR) <$> getCurrentRoute
defaultLayout $ do defaultLayout $ do
setTitleI pageTitle setTitleI pageTitle
$(widgetFile "formPageI18n") $(widgetFile "formPageI18n")
@ -344,19 +344,19 @@ getSheetDelR tid csh shn = do
let tident = unTermKey tid let tident = unTermKey tid
((result,formWidget), formEnctype) <- runFormPost (buttonForm :: Form BtnDelete) ((result,formWidget), formEnctype) <- runFormPost (buttonForm :: Form BtnDelete)
case result of case result of
(FormSuccess BtnAbort) -> redirectUltDest $ SheetShowR tid csh shn (FormSuccess BtnAbort) -> redirectUltDest $ CSheetR tid csh $ SheetShowR shn
(FormSuccess BtnDelete) -> do (FormSuccess BtnDelete) -> do
runDB $ fetchSheetId tid csh shn >>= deleteCascade runDB $ fetchSheetId tid csh shn >>= deleteCascade
-- TODO: deleteCascade löscht aber nicht die hochgeladenen Dateien!!! -- TODO: deleteCascade löscht aber nicht die hochgeladenen Dateien!!!
setMessageI $ MsgSheetDelOk tident csh shn setMessageI $ MsgSheetDelOk tident csh shn
redirect $ SheetListR tid csh redirect $ CSheetR tid csh SheetListR
_other -> do _other -> do
submissionno <- runDB $ do submissionno <- runDB $ do
sid <- fetchSheetId tid csh shn sid <- fetchSheetId tid csh shn
count [SubmissionSheetId ==. sid] count [SubmissionSheetId ==. sid]
let formTitle = MsgSheetDelTitle tident csh shn let formTitle = MsgSheetDelTitle tident csh shn
let formText = Just $ MsgSheetDelText submissionno let formText = Just $ MsgSheetDelText submissionno
let actionUrl = SheetDelR tid csh shn let actionUrl = CSheetR tid csh $ SheetDelR shn
defaultLayout $ do defaultLayout $ do
setTitleI $ MsgSheetTitle tident csh shn setTitleI $ MsgSheetTitle tident csh shn
$(widgetFile "formPageI18n") $(widgetFile "formPageI18n")

2
src/Handler/Submission.hs
View File

@ -53,7 +53,7 @@ submissionTable = do
(,,) <$> encrypt submissionId <*> encrypt submissionId <*> pure s (,,) <$> encrypt submissionId <*> encrypt submissionId <*> pure s
let let
anchorCourse (_, _, (_, _, Entity _ Course{..})) = CourseShowR courseTermId courseShorthand anchorCourse (_, _, (_, _, Entity _ Course{..})) = CourseR courseTermId courseShorthand CourseShowR
courseText (_, _, (_, _, Entity _ Course{..})) = toWidget courseName courseText (_, _, (_, _, Entity _ Course{..})) = toWidget courseName
anchorSubmission (_, cUUID, _) = SubmissionR cUUID anchorSubmission (_, cUUID, _) = SubmissionR cUUID
submissionText (cID, _, _) = toWidget . toPathPiece . CI.foldedCase $ ciphertext cID submissionText (cID, _, _) = toWidget . toPathPiece . CI.foldedCase $ ciphertext cID

2
src/Model/Types.hs
View File

@ -55,7 +55,7 @@ deriveJSON defaultOptions ''SheetType
derivePersistFieldJSON "SheetType" derivePersistFieldJSON "SheetType"
data SheetGroup data SheetGroup
= Arbitrary { maxParticipants :: Int } = Arbitrary { maxParticipants :: Int } -- Distinguish Limited/Arbitrary
| RegisteredGroups | RegisteredGroups
| NoGroups | NoGroups
deriving (Show, Read, Eq) deriving (Show, Read, Eq)

2
templates/course.hamlet
View File

@ -16,7 +16,7 @@
\ bis #{formatTimeGerWD regTo} \ bis #{formatTimeGerWD regTo}
<div> <div>
<form method=post action=@{CourseShowR tid csh} enctype=#{regEnctype}> <form method=post action=@{CourseR tid csh CourseShowR} enctype=#{regEnctype}>
^{regWidget} ^{regWidget}
<div .course-header__title> <div .course-header__title>

2
templates/sheetShow.hamlet
View File

@ -29,7 +29,7 @@
$forall fileLink <- fileLinks $forall fileLink <- fileLinks
<li> <li>
$case fileLink $case fileLink
$of SheetFileR _ _ _ typ name $of CourseR _ _ (SheetR (SheetFileR _ typ name))
#{toPathPiece typ} #{toPathPiece typ}
<a href=@{fileLink}>#{name} <a href=@{fileLink}>#{name}
$of other $of other