Breadcrumbs and Headings all fixed

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}
+TermCourseListHeading tk@TermId: Kursübersicht #{display tk}
-TermCourseListTitle tid@TermIdentifier: Kurse #{termToText tid}
+TermCourseListTitle   tk@TermId: Kurse #{display tk}
-CourseEditHeading: Kurs editieren/anlegen
+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
+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.
+SheetNewHeading    tk@TermId courseShortHand@Text: #{display tk}-#{courseShortHand} Neues Übungsblatt anlegen
-SheetTitle         tid@TermIdentifier courseShortHand@Text sheetName@Text: #{termToText tid}-#{courseShortHand} #{sheetName}
+SheetNewOk         tk@TermId courseShortHand@Text sheetName@Text: Neues Übungsblatt #{sheetName} wurde im Kurs #{display tk}-#{courseShortHand} erfolgreich erstellt.
-SheetTitleNew      tid@TermIdentifier courseShortHand@Text               : #{termToText tid}-#{courseShortHand}: Neues Übungsblatt
+SheetTitle         tk@TermId courseShortHand@Text sheetName@Text: #{display tk}-#{courseShortHand} #{sheetName}
-SheetEditOk        tid@TermIdentifier courseShortHand@Text sheetName@Text: Übungsblatt #{sheetName} aus Kurs #{termToText tid}-#{courseShortHand} wurde gespeichert.
+SheetTitleNew      tk@TermId courseShortHand@Text               : #{display tk}-#{courseShortHand}: Neues Übungsblatt
-SheetNameDup       tid@TermIdentifier courseShortHand@Text sheetName@Text: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{termToText tid}-#{courseShortHand}.
+SheetEditHead      tk@TermId courseShortHand@Text sheetName@Text: #{display tk}-#{courseShortHand} #{sheetName} editieren
-SheetDelTitle      tid@TermIdentifier courseShortHand@Text sheetName@Text: Übungsblatt #{sheetName} wirklich aus Kurs #{termToText tid}-#{courseShortHand} herauslöschen?
+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

src/Foundation.hs

@@ -568,35 +568,40 @@ instance Yesod UniWorX where
 
 -- Define breadcrumbs.
 instance YesodBreadcrumbs UniWorX where
-  breadcrumb TermShowR = return ("Semester", Just HomeR)
+  breadcrumb (AuthR _)        = return ("Login"   , 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 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
+  = Just $ i18nHeading MsgCourseNewHeading
-pageHeading (CourseR tid csh CEditR)
-  = Just $ i18nHeading MsgCourseEditHeading
 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

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

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)
+  let pageTitle = maybe (MsgSheetTitleNew tid csh)
-                        (MsgSheetTitle    tident csh) mbshn
+                        (MsgSheetTitle    tid csh) mbshn
-  let formTitle = pageTitle
+--   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

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