From 80fad276925fdecad8b157e896b6ecff305d4a1e Mon Sep 17 00:00:00 2001 From: SJost Date: Fri, 29 Jun 2018 20:24:15 +0200 Subject: [PATCH] Breadcrumbs and Headings all fixed --- messages/de.msg | 40 ++++++++++-------- src/Foundation.hs | 88 ++++++++++++++++++++++++++------------- src/Handler/Course.hs | 7 +++- src/Handler/Sheet.hs | 18 ++++---- src/Handler/Submission.hs | 4 +- 5 files changed, 97 insertions(+), 60 deletions(-) diff --git a/messages/de.msg b/messages/de.msg index 6fa984624..f6baedfea 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -11,12 +11,16 @@ SummerTerm year@Integer: Sommersemester #{tshow year} WinterTerm year@Integer: Wintersemester #{tshow year}/#{tshow $ succ year} PSLimitNonPositive: “pagesize” muss größer als null sein Page n@Int64: #{tshow n} -TermEdited tid@TermIdentifier: Semester #{termToText tid} erfolgreich editiert. -TermNewTitle: Semester editiere/anlegen. + +TermsHeading: Semesterübersicht +TermCurrent: Aktuelles Semester +TermEditHeading: Semester editieren/anlegen +TermEditTid tk@TermId: Semester #{display tk} editieren +TermEdited tid@TermIdentifier: Semester #{display tid} erfolgreich editiert. +TermNewTitle: Semester editieren/anlegen. InvalidInput: Eingaben bitte korrigieren. Term: Semester TermPlaceholder: W/S + vierstellige Jahreszahl -TermEditHeading: Semester editieren/anlegen Course: Kurs CourseSecret: Zugangspasswort @@ -25,21 +29,24 @@ CourseEditOk tid@TermIdentifier courseShortHand@Text: Kurs #{termToText ti CourseNewDupShort tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester. CourseEditDupShort tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester. FFSheetName: Name -TermCourseListHeading tid@TermIdentifier: Kursübersicht #{termToText tid} -TermCourseListTitle tid@TermIdentifier: Kurse #{termToText tid} -CourseEditHeading: Kurs editieren/anlegen +TermCourseListHeading tk@TermId: Kursübersicht #{display tk} +TermCourseListTitle tk@TermId: Kurse #{display tk} +CourseNewHeading: Neuen Kurs anlegen +CourseEditHeading tk@TermId courseShortHand@Text: Kurs #{display tk}-#{courseShortHand} editieren CourseEditTitle: Kurs editieren/anlegen Sheet: Blatt -SheetList tk@TermId courseShortHand@Text : #{display tk}-#{courseShortHand} Übersicht Übungsblätter -SheetNewOk tid@TermIdentifier courseShortHand@Text sheetName@Text: Neues Übungsblatt #{sheetName} wurde im Kurs #{termToText tid}-#{courseShortHand} erfolgreich erstellt. -SheetTitle tid@TermIdentifier courseShortHand@Text sheetName@Text: #{termToText tid}-#{courseShortHand} #{sheetName} -SheetTitleNew tid@TermIdentifier courseShortHand@Text : #{termToText tid}-#{courseShortHand}: Neues Übungsblatt -SheetEditOk tid@TermIdentifier courseShortHand@Text sheetName@Text: Übungsblatt #{sheetName} aus Kurs #{termToText tid}-#{courseShortHand} wurde gespeichert. -SheetNameDup tid@TermIdentifier courseShortHand@Text sheetName@Text: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{termToText tid}-#{courseShortHand}. -SheetDelTitle tid@TermIdentifier courseShortHand@Text sheetName@Text: Übungsblatt #{sheetName} wirklich aus Kurs #{termToText tid}-#{courseShortHand} herauslöschen? +SheetList tk@TermId courseShortHand@Text: #{display tk}-#{courseShortHand} Übersicht Übungsblätter +SheetNewHeading tk@TermId courseShortHand@Text: #{display tk}-#{courseShortHand} Neues Übungsblatt anlegen +SheetNewOk tk@TermId courseShortHand@Text sheetName@Text: Neues Übungsblatt #{sheetName} wurde im Kurs #{display tk}-#{courseShortHand} erfolgreich erstellt. +SheetTitle tk@TermId courseShortHand@Text sheetName@Text: #{display tk}-#{courseShortHand} #{sheetName} +SheetTitleNew tk@TermId courseShortHand@Text : #{display tk}-#{courseShortHand}: Neues Übungsblatt +SheetEditHead tk@TermId courseShortHand@Text sheetName@Text: #{display tk}-#{courseShortHand} #{sheetName} editieren +SheetEditOk tk@TermId courseShortHand@Text sheetName@Text: Übungsblatt #{sheetName} aus Kurs #{display tk}-#{courseShortHand} wurde gespeichert. +SheetNameDup tk@TermId courseShortHand@Text sheetName@Text: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{display tk}-#{courseShortHand}. +SheetDelHead tk@TermId courseShortHand@Text sheetName@Text: Übungsblatt #{sheetName} wirklich aus Kurs #{display tk}-#{courseShortHand} herauslöschen? SheetDelText submissionNo@Int: Dies kann nicht mehr rückgängig gemacht werden! Alle Einreichungen gehen ebenfalls verloren! Es gibt #{show submissionNo} Abgaben. -SheetDelOk tid@TermIdentifier courseShortHand@Text sheetName@Text: #{termToText tid}-#{courseShortHand}: Übungsblatt #{sheetName} gelöscht. +SheetDelOk tk@TermId courseShortHand@Text sheetName@Text: #{display tk}-#{courseShortHand}: Übungsblatt #{sheetName} gelöscht. Deadline: Abgabe Done: Eingereicht @@ -66,7 +73,7 @@ UnauthorizedWrite: Sie haben hierfür keine Schreibberechtigung SubmissionWrongSheet: Abgabenummer gehört nicht zum angegebenen Übungsblatt. SubmissionAlreadyExists: Sie haben bereits eine Abgabe zu diesem Übungsblatt. -SubmissionTitle tk@TermId courseShortHand@Text sheetName@Text: #{display tk}-#{courseShortHand} #{sheetName}: Abgabe editieren/anlegen +SubmissionEditHead tk@TermId courseShortHand@Text sheetName@Text: #{display tk}-#{courseShortHand} #{sheetName}: Abgabe editieren/anlegen SubmissionMember g@Int: Mitabgebende(r) ##{tshow g} SubmissionArchive: Zip-Archiv der Abgabedatei(en) SubmissionFile: Datei zur Abgabe @@ -75,13 +82,12 @@ SubmissionAlreadyExistsFor user@Text: #{user} hat bereits eine Abgabe zu diesem EMail: E-Mail EMailUnknown email@Text: E-Mail #{email} gehört zu keinem bekannten Benutzer. -NotAParticipant user@Text tid@TermIdentifier csh@Text: #{user} ist nicht im Kurs #{display tid}-#{csh} angemeldet. +NotAParticipant user@Text tk@TermId csh@Text: #{user} ist nicht im Kurs #{display tk}-#{csh} angemeldet. Users: Benutzer HomeHeading: Aktuelle Termine ProfileHeading: Benutzerprofil und Einstellungen ProfileDataHeading: Gespeicherte Benutzerdaten -TermsHeading: Semesterübersicht NumCourses n@Int64: #{tshow n} Kurse CloseAlert: Schliessen diff --git a/src/Foundation.hs b/src/Foundation.hs index c04f2c79c..283ae9df5 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -568,35 +568,40 @@ instance Yesod UniWorX where -- Define breadcrumbs. instance YesodBreadcrumbs UniWorX where - breadcrumb TermShowR = return ("Semester", Just HomeR) - breadcrumb TermEditR = return ("Neu", Just TermCurrentR) - breadcrumb TermCurrentR = return ("Aktuell", Just TermShowR) - breadcrumb (TermEditExistR tid) = return ("Editieren", Just $ TermCourseListR tid) - - breadcrumb CourseListR = return ("Kurs", Just HomeR) - breadcrumb (TermCourseListR term) = return (toPathPiece term, Just TermShowR) - breadcrumb (CourseR term course CShowR) = return (course, Just $ TermCourseListR term) - breadcrumb CourseNewR = return ("Neu", Just CourseListR) - breadcrumb (CourseR tid csh CEditR) = return ("Editieren", 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 (CSheetR tid csh shn SShowR) = return (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 (SubmissionR _)) = return ("Abgabe", Just $ CSheetR tid csh shn SShowR) - - breadcrumb SubmissionListR = return ("Abgaben", Just HomeR) - - + breadcrumb (AuthR _) = return ("Login" , Just HomeR) breadcrumb HomeR = return ("UniWorkY", Nothing) breadcrumb UsersR = return ("Benutzer", Just HomeR) - breadcrumb (AdminUserR _) = return ("Users" , Just UsersR) breadcrumb AdminTestR = return ("Test" , Just HomeR) - breadcrumb (AuthR _) = return ("Login" , Just HomeR) + breadcrumb (AdminUserR _) = return ("Users" , Just UsersR) + breadcrumb ProfileR = return ("Profile" , Just HomeR) breadcrumb ProfileDataR = return ("Data" , Just ProfileR) --- breadcrumb _ = return ("UniWorkY", Nothing) -- Default is no breadcrumb at all + + breadcrumb TermShowR = return ("Semester" , Just HomeR) + breadcrumb TermCurrentR = return ("Aktuell" , Just TermShowR) + breadcrumb TermEditR = return ("Neu" , Just TermCurrentR) + breadcrumb (TermEditExistR tid) = return ("Editieren" , Just $ TermCourseListR tid) + breadcrumb (TermCourseListR term) = return (display term, Just TermShowR) + + breadcrumb CourseListR = return ("Kurs" , Just HomeR) + breadcrumb CourseNewR = return ("Neu" , Just CourseListR) + breadcrumb (CourseR tid csh CShowR) = return (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 SheetListR) = return ("Übungen",Just $ CourseR tid csh CShowR) + breadcrumb (CourseR tid csh SheetNewR ) = return ("Neu", Just $ CourseR tid csh SheetListR) + + breadcrumb (CSheetR tid csh shn SShowR) = return (shn, Just $ CourseR tid csh SheetListR) + -- (CSheetR tid csh shn SFileR) -- just for Downloads + 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 SubmissionNewR) = return ("Abgabe", Just $ CSheetR tid csh shn SShowR) + breadcrumb (CSheetR tid csh shn SubmissionOwnR) = return ("Abgabe", Just $ CSheetR tid csh shn SShowR) + breadcrumb (CSheetR tid csh shn (SubmissionR _)) = return ("Abgabe", Just $ CSheetR tid csh shn SShowR) + -- Deprecated below + breadcrumb SubmissionListR = return ("Abgaben", Just HomeR) + -- Others + breadcrumb _ = return ("UniWorkY", Nothing) -- Default is no breadcrumb at all pageActions :: Route UniWorX -> [MenuTypes] pageActions (CourseR tid csh CShowR) = @@ -710,28 +715,53 @@ pageHeading UsersR = Just $ i18nHeading MsgUsers pageHeading (AdminTestR) = Just $ [whamlet|Internal Code Demonstration Page|] +pageHeading (AdminUserR _) + = Just $ [whamlet|User Display for Admin|] + pageHeading ProfileR = Just $ i18nHeading MsgProfileHeading pageHeading ProfileDataR = Just $ i18nHeading MsgProfileDataHeading + pageHeading TermShowR = Just $ i18nHeading MsgTermsHeading +pageHeading TermCurrentR + = Just $ i18nHeading MsgTermCurrent pageHeading TermEditR = Just $ i18nHeading MsgTermEditHeading +pageHeading (TermEditExistR tid) + = Just $ i18nHeading $ MsgTermEditTid tid pageHeading (TermCourseListR tid) - = Just . i18nHeading . MsgTermCourseListHeading $ unTermKey tid + = Just . i18nHeading . MsgTermCourseListHeading $ tid + +-- CourseListR -- just a redirect to TermCurrentR pageHeading CourseNewR - = Just $ i18nHeading MsgCourseEditHeading -pageHeading (CourseR tid csh CEditR) - = Just $ i18nHeading MsgCourseEditHeading + = Just $ i18nHeading MsgCourseNewHeading pageHeading (CourseR tid csh CShowR) = Just $ do Entity _ Course{..} <- handlerToWidget . runDB . getBy404 $ CourseTermShort tid csh toWidget courseName +-- (CourseR tid csh CRegisterR) -- just for POST +pageHeading (CourseR tid csh CEditR) + = Just $ i18nHeading $ MsgCourseEditHeading 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 $ MsgSubmissionTitle tid csh shn + = Just $ i18nHeading $ MsgSheetTitle tid csh shn +-- (CSheetR tid csh shn SFileR) -- just for Downloads +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 SubmissionNewR) + = Just $ i18nHeading $ MsgSubmissionEditHead tid csh shn +pageHeading (CSheetR tid csh shn SubmissionOwnR) + = Just $ i18nHeading $ MsgSubmissionEditHead tid csh shn +pageHeading (CSheetR tid csh shn (SubmissionR _)) -- TODO: Rethink this one! + = Just $ i18nHeading $ MsgSubmissionEditHead tid csh shn + -- TODO: add headings for more single course- and single term-pages pageHeading _ = Nothing diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index a8728f2c9..51b6c8a82 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -25,7 +25,7 @@ import qualified Data.UUID.Cryptographic as UUID getCourseListR :: Handler TypedContent -getCourseListR = redirect TermShowR +getCourseListR = redirect TermCurrentR getTermCurrentR :: Handler Html getTermCurrentR = do @@ -33,6 +33,9 @@ getTermCurrentR = do case fromNullable termIds of Nothing -> notFound (Just (maximum -> tid)) -> getTermCourseListR tid + -- why not "redirect $ TermCourseListR tid" + -- Would save us breadcrumbs, headings, etc.? + getTermCourseListR :: TermId -> Handler Html getTermCourseListR tidini = do @@ -73,7 +76,7 @@ getTermCourseListR tidini = do ] let coursesTable = encodeWidgetTable tableSortable colonnadeTerms courses defaultLayout $ do - setTitleI . MsgTermCourseListTitle $ unTermKey tidini + setTitleI . MsgTermCourseListTitle $ tidini $(widgetFile "courses") getCShowR :: TermId -> Text -> Handler Html diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 085e94af9..9ceb30b25 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -317,7 +317,6 @@ postSEditR = getSEditR handleSheetEdit :: TermId -> Text -> Maybe SheetId -> Maybe SheetForm -> (Sheet -> YesodDB UniWorX (Maybe SheetId)) -> Handler Html handleSheetEdit tid csh msId template dbAction = do - let tident = unTermKey tid let mbshn = sfName <$> template aid <- requireAuthId ((res,formWidget), formEnctype) <- runFormPost $ makeSheetForm msId template @@ -341,20 +340,20 @@ handleSheetEdit tid csh msId template dbAction = do } mbsid <- dbAction newSheet case mbsid of - Nothing -> False <$ addMessageI "danger" (MsgSheetNameDup tident csh sfName) + Nothing -> False <$ addMessageI "danger" (MsgSheetNameDup tid csh sfName) (Just sid) -> do -- save files in DB: whenIsJust sfSheetF $ insertSheetFile' sid SheetExercise whenIsJust sfHintF $ insertSheetFile sid SheetHint whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution insert_ $ SheetEdit aid actTime sid - addMessageI "info" $ MsgSheetEditOk tident csh sfName + addMessageI "info" $ MsgSheetEditOk tid csh sfName return True when saveOkay $ redirect $ CSheetR tid csh sfName SShowR -- redirect must happen outside of runDB (FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml _ -> return () - let pageTitle = maybe (MsgSheetTitleNew tident csh) - (MsgSheetTitle tident csh) mbshn - let formTitle = pageTitle + let pageTitle = maybe (MsgSheetTitleNew tid csh) + (MsgSheetTitle tid csh) mbshn +-- let formTitle = pageTitle -- no longer used in template let formText = Nothing :: Maybe UniWorXMessage actionUrl <- fromMaybe (CourseR tid csh SheetNewR) <$> getCurrentRoute defaultLayout $ do @@ -365,24 +364,23 @@ handleSheetEdit tid csh msId template dbAction = do getSDelR :: TermId -> Text -> Text -> Handler Html getSDelR tid csh shn = do - let tident = unTermKey tid ((result,formWidget), formEnctype) <- runFormPost (buttonForm :: Form BtnDelete) case result of (FormSuccess BtnAbort) -> redirectUltDest $ CSheetR tid csh shn SShowR (FormSuccess BtnDelete) -> do runDB $ fetchSheetId tid csh shn >>= deleteCascade -- TODO: deleteCascade löscht aber nicht die hochgeladenen Dateien!!! - addMessageI "info" $ MsgSheetDelOk tident csh shn + addMessageI "info" $ MsgSheetDelOk tid csh shn redirect $ CourseR tid csh SheetListR _other -> do submissionno <- runDB $ do sid <- fetchSheetId tid csh shn count [SubmissionSheet ==. sid] - let formTitle = MsgSheetDelTitle tident csh shn + let formTitle = MsgSheetDelHead tid csh shn let formText = Just $ MsgSheetDelText submissionno let actionUrl = CSheetR tid csh shn SDelR defaultLayout $ do - setTitleI $ MsgSheetTitle tident csh shn + setTitleI $ MsgSheetTitle tid csh shn $(widgetFile "formPageI18n") postSDelR :: TermId -> Text -> Text -> Handler Html diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index c66c6686a..ae6fb05cd 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -186,7 +186,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do let failmsgs = flip Map.foldMapWithKey participants $ \email -> \case Nothing -> [mr $ MsgEMailUnknown $ CI.original email] - (Just (_,False,_)) -> [mr $ MsgNotAParticipant (CI.original email) (unTermKey tid) csh] + (Just (_,False,_)) -> [mr $ MsgNotAParticipant (CI.original email) tid csh] (Just (_,_, True)) -> [mr $ MsgSubmissionAlreadyExistsFor (CI.original email)] _other -> mempty return $ if null failmsgs @@ -231,7 +231,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do mArCid <- fmap ZIPArchiveName <$> traverse encrypt msmid - let pageTitle = MsgSubmissionTitle tid csh shn + let pageTitle = MsgSubmissionEditHead tid csh shn let formTitle = pageTitle let formText = Nothing :: Maybe UniWorXMessage actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute