Breadcrumbs and Headings fixed

messages/de.msg

@@ -31,6 +31,7 @@ CourseEditHeading: Kurs editieren/anlegen
 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
@@ -65,16 +66,18 @@ 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 tid@TermIdentifier courseShortHand@Text sheetName@Text: #{termToText tid}-#{courseShortHand} #{sheetName}: Abgabe editieren/anlegen
+SubmissionTitle 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
 SubmissionAlreadyExistsFor user@Text: #{user} hat bereits eine Abgabe zu diesem bÜbungsblatt.
 
+
 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 #{termToText tid}-#{csh} angemeldet.
+NotAParticipant user@Text tid@TermIdentifier csh@Text: #{user} ist nicht im Kurs #{display tid}-#{csh} angemeldet.
 
+Users: Benutzer
 HomeHeading: Aktuelle Termine
 ProfileHeading: Benutzerprofil und Einstellungen
 ProfileDataHeading: Gespeicherte Benutzerdaten

src/Foundation.hs

@@ -569,8 +569,9 @@ instance Yesod UniWorX where
 -- Define breadcrumbs.
 instance YesodBreadcrumbs UniWorX where
   breadcrumb TermShowR = return ("Semester", Just HomeR)
-  breadcrumb TermEditR = return ("Neu", Just TermShowR)
+  breadcrumb TermEditR = return ("Neu", Just TermCurrentR)
-  breadcrumb (TermEditExistR _) = return ("Editieren", Just TermShowR)
+  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)
@@ -588,11 +589,14 @@ instance YesodBreadcrumbs UniWorX where
   breadcrumb SubmissionListR = return ("Abgaben", Just HomeR)
 
 
-  breadcrumb HomeR        = return ("UniWorkY", Nothing)
+  breadcrumb HomeR            = return ("UniWorkY", Nothing)
-  breadcrumb (AuthR _)    = return ("Login", Just HomeR)
+  breadcrumb UsersR           = return ("Benutzer", Just HomeR)
-  breadcrumb ProfileR     = return ("Profile", Just HomeR)
+  breadcrumb (AdminUserR _)   = return ("Users"   , Just UsersR)
-  breadcrumb ProfileDataR = return ("Data", Just ProfileR)
+  breadcrumb AdminTestR       = return ("Test"    , Just HomeR)
-  breadcrumb  _ = return ("home", Nothing)
+  breadcrumb (AuthR _)        = return ("Login"   , Just HomeR)
+  breadcrumb ProfileR         = return ("Profile" , Just HomeR)
+  breadcrumb ProfileDataR     = return ("Data"    , Just ProfileR)
+--   breadcrumb  _ = return ("UniWorkY", Nothing) -- Default is no breadcrumb at all
 
 pageActions :: Route UniWorX -> [MenuTypes]
 pageActions (CourseR tid csh CShowR) =
@@ -655,13 +659,19 @@ pageActions TermShowR =
       , menuItemAccessCallback' = return True
       }
   ]
-pageActions (TermCourseListR _) =
+pageActions (TermCourseListR tid) =
   [ PageActionPrime $ MenuItem
       { menuItemLabel = "Neuen Kurs anlegen"
       , menuItemIcon  = Just "book"
       , menuItemRoute = CourseNewR
       , menuItemAccessCallback' = return True
       }
+  , PageActionPrime $ MenuItem
+      { menuItemLabel = "Semster editieren"
+      , menuItemIcon  = Nothing
+      , menuItemRoute = TermEditExistR tid
+      , menuItemAccessCallback' = return True
+      }
   ]
 pageActions (ProfileR) =
   [ PageActionPrime $ MenuItem
@@ -696,6 +706,8 @@ i18nHeading msg = liftWidgetT $ toWidget =<< getMessageRender <*> pure msg
 pageHeading :: Route UniWorX -> Maybe Widget
 pageHeading HomeR
   = Just $ i18nHeading MsgHomeHeading
+pageHeading UsersR
+  = Just $ i18nHeading MsgUsers
 pageHeading (AdminTestR)
   = Just $ [whamlet|Internal Code Demonstration Page|]
 pageHeading ProfileR
@@ -710,10 +722,16 @@ pageHeading (TermCourseListR tid)
   = Just . i18nHeading . MsgTermCourseListHeading $ unTermKey tid
 pageHeading CourseNewR
   = Just $ i18nHeading MsgCourseEditHeading
+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
+pageHeading (CourseR tid csh SheetListR)
+  = Just $ i18nHeading $ MsgSheetList tid csh
+pageHeading (CSheetR tid csh shn SShowR)
+  = Just $ i18nHeading $ MsgSubmissionTitle tid csh shn
 -- TODO: add headings for more single course- and single term-pages
 pageHeading _
   = Nothing

src/Handler/Submission.hs

@@ -231,7 +231,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
 
   mArCid <- fmap ZIPArchiveName <$> traverse encrypt msmid
 
-  let pageTitle = MsgSubmissionTitle (unTermKey tid) csh shn
+  let pageTitle = MsgSubmissionTitle tid csh shn
   let formTitle = pageTitle
   let formText  = Nothing :: Maybe UniWorXMessage
   actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute

src/Handler/Utils/Form.hs

@@ -483,7 +483,8 @@ setNameClass fs gName gClass = fs { fsName= Just gName, fsAttrs=("class",gClass)
 setTooltip :: String -> FieldSettings site -> FieldSettings site
 setTooltip tt fs
   | null tt   = fs { fsTooltip = Nothing }
-  | otherwise = fs { fsTooltip = Just $ fromString tt, fsAttrs=("info",fromString tt):(fsAttrs fs) }
+  | otherwise = fs { fsTooltip = Just $ fromString tt
+                   , fsAttrs=("data-tooltip",fromString tt):(fsAttrs fs) }
 
 optionsPersistCryptoId :: forall site backend a msg.
                           ( YesodPersist site

src/Model/Types.hs

@@ -5,7 +5,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-
+{-- # LANGUAGE ExistentialQuantification #-} -- for DA type
 
 module Model.Types where
 
@@ -92,6 +92,14 @@ instance DisplayAble SheetFileType where -- deprecated, see RenderMessage instan
   display SheetSolution = "Musterlösung"
   display SheetMarking  = "Korrekturhinweise"
 
+{-
+data DA = forall a . (DisplayAble a) => DA a
+
+instance DisplayAble DA where
+  display (DA x) = display x
+-}
+
+
 data ExamStatus = Attended | NoShow | Voided
   deriving (Show, Read, Eq, Ord, Enum, Bounded)
 derivePersistField "ExamStatus"

templates/course.hamlet

@@ -1,4 +1,4 @@
-<div .container>
+0<div .container>
   <div .scrolltable>
     <table .table.table--striped.table--hover.table--vertical>
       $maybe school <- schoolMB