feat(home): show immediate exams on home page

2019-07-03 13:56:19 +02:00 · 2019-07-03 13:56:19 +02:00 · 242cff3060
commit 242cff3060
parent c2975ca06e
11 changed files with 5790 additions and 2479 deletions
--- a/build.sh
+++ b/build.sh
@ -1,4 +1,7 @@
 #!/usr/bin/env bash

-exec -- stack build --fast --flag uniworx:-library-only --flag uniworx:dev $@
-echo Build task completed.
+set -e
+
+echo "Building..."
+stack build --fast --flag uniworx:-library-only --flag uniworx:dev $@
+echo "Done."
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@ -356,6 +356,7 @@ TokensResetSuccess: Authorisierungs-Tokens invalidiert

 HomeOpenCourses: Kurse mit offener Registrierung
 HomeUpcomingSheets: Anstehende Übungsblätter
+HomeUpcomingExams: Bevorstehende Klausuren

 NumCourses num@Int64: #{display num} Kurse
 CloseAlert: Schliessen
@ -489,6 +490,7 @@ MultiSinkException name@Text error@Text: In Abgabe #{name} ist ein Fehler aufget

 NoTableContent: Kein Tabelleninhalt
 NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter
+NoUpcomingExams: In den nächsten 14 Tagen gibt es keine Klausur mit offener Registrierung in Ihren Kursen

 AdminHeading: Administration
 AdminUserHeading: Benutzeradministration
--- a/package-lock.json
+++ b/package-lock.json
--- a/package.json
+++ b/package.json
@ -85,6 +85,7 @@
    "webpack-cli": "^3.3.4"
  },
  "dependencies": {
-    "flatpickr": "^4.5.7"
+    "flatpickr": "^4.5.7",
+    "npm": "^6.9.2"
  }
 }
--- a/package.yaml
+++ b/package.yaml
@ -203,7 +203,7 @@ library:
      then:
        ghc-options:
          - -O0
-          - -ddump-splices
+
        cpp-options: -DDEVELOPMENT
      else:
        ghc-options:
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@ -1085,12 +1085,13 @@ assignHandler tid ssh csh cid assignSids = do
  (btnWdgt, btnResult) <- runButtonForm FIDAssignSubmissions

  -- gather data
-  (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do
+  (orderedSheetNames, assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do
      -- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
      nrParticipants <- count [CourseParticipantCourse ==. cid]

-      sheetList <- selectList [SheetCourse ==. cid] [Asc SheetName]
-      let sheets = entities2map sheetList
+      sheetList <- selectList [SheetCourse ==. cid] [Desc SheetActiveTo, Desc SheetActiveFrom]
+      let orderedSheetNames = fmap (\(Entity _ Sheet{sheetName}) -> sheetName) sheetList
+          sheets = entities2map sheetList
          sheetIds = Map.keys sheets
          groupsPossible :: Bool
          groupsPossible =
@ -1179,15 +1180,12 @@ assignHandler tid ssh csh cid assignSids = do
                            }
              in Map.insertWith (Map.unionWith (<>)) shnm cinf m

-      return (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment)
+      return (orderedSheetNames, assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment)

  let -- infoMap  :: Map SheetName (Map (Maybe UserId) CorrectionInfo) -- repeated here for easier reference
      -- create aggregate maps

-      -- Always iterate over sheetList for consistent sorting!
-      sheetList :: [(SheetName, CorrectionInfo)]
-      sheetList = Map.toDescList sheetMap -- newest Sheet first, except for CorrectionSheetTable
-
+      -- Always iterate over orderedSheetNames for consistent sorting!
      sheetMap :: Map SheetName CorrectionInfo
      sheetMap = Map.map fold infoMap

--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@ -1,17 +1,24 @@
 module Handler.Home where

 import Import
+
+import Utils.Lens
 import Handler.Utils
+import Handler.Utils.Table.Cells
+

 import qualified Data.Map as Map
+import Database.Esqueleto.Utils.TH
 import qualified Database.Esqueleto as E
-
+import qualified Database.Esqueleto.Utils as E

 getHomeR :: Handler Html
 getHomeR = do
  muid <- maybeAuthId
+  upcomingExamsWidget <- for muid $ runDB . homeUpcomingExams
  defaultLayout $ do
    setTitleI MsgHomeHeading
+    fromMaybe mempty upcomingExamsWidget
    maybe mempty homeUpcomingSheets muid
    homeOpenCourses

@ -174,3 +181,115 @@ homeUpcomingSheets uid = do
    , dbtIdent     = "upcoming-sheets" :: Text
    }
  $(widgetFile "home/upcomingSheets")
+
+
+
+homeUpcomingExams :: UserId -> DB Widget
+homeUpcomingExams uid = do
+  now <- liftIO getCurrentTime
+  let fortnight = addWeeks 2 now
+  let -- code copied and slightly adapted from Handler.Course.getCShowR:
+    examDBTable = DBTable{..}
+      where
+        -- for ease of refactoring:
+        queryCourse = $(sqlIJproj 2 1)
+        queryExam   = $(sqlIJproj 2 2)
+        lensCourse  = _1
+        lensExam    = _2
+
+        dbtSQLQuery (course `E.InnerJoin` exam) = do
+          E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
+          E.where_ $ E.exists $ E.from $ \participant ->
+            E.where_ $ participant E.^. CourseParticipantUser   E.==. E.val uid
+              E.&&.    participant E.^. CourseParticipantCourse E.==. course E.^. CourseId
+          E.where_ $ E.isJust (exam E.^. ExamRegisterFrom)
+                     E.&&.     exam E.^. ExamRegisterFrom  E.<=. E.just (E.val fortnight)
+          E.where_ $ E.isJust (exam E.^. ExamEnd)
+                     E.&&.     exam E.^. ExamEnd           E.>=. E.just (E.val now)
+          return (course, exam)
+        dbtRowKey = queryExam >>> (E.^. ExamId)
+        dbtProj r@DBRow{ dbrOutput } = do
+          let Entity _ Exam{..}   = view lensExam   dbrOutput
+              Entity _ Course{..} = view lensCourse dbrOutput
+          guardM . hasReadAccessTo $ CExamR courseTerm courseSchool courseShorthand examName EShowR -- check access rights
+          return r
+        dbtColonnade = dbColonnade $ mconcat
+          [ sortable (Just "term") (i18nCell MsgTerm)           $ \DBRow{ dbrOutput = view lensCourse -> Entity _ Course{..} } ->
+              textCell $ display courseTerm
+          , sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput = view lensCourse -> Entity _ Course{..} } ->
+              textCell $ display courseSchool
+          , sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput = view lensCourse -> Entity _ Course{..} } ->
+              anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) (toWidget $ display courseShorthand)
+          -- continue here
+          , sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput } -> do
+              let Entity _ Exam{..}   = view lensExam   dbrOutput
+                  Entity _ Course{..} = view lensCourse dbrOutput
+              indicatorCell <> anchorCell (CExamR courseTerm courseSchool courseShorthand examName EShowR) (toWidget examName)
+          , sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = view lensExam -> Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom
+          , sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = view lensExam -> Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo
+          , sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = view lensExam -> Entity _ Exam{..} } -> cell $ do
+              startT <- formatTime SelFormatDateTime examStart
+              endT <- traverse (\examEnd' -> formatTime (bool SelFormatDateTime SelFormatTime $ ((==) `on` utctDay) examStart examEnd') examEnd') examEnd
+              [whamlet|
+                $newline never
+                #{startT}
+                $maybe endT' <- endT
+                  \ – #{endT'}
+              |]
+          {- NOTE: We do not want thoughtless exam registrations, since many people click "register" and don't show up, causing logistic problems.
+             Hence we force them here to click twice. Maybe add a captcha where users have to distinguish pictures showing pink elephants and course lecturers.
+          , sortable Nothing mempty $ \DBRow{ dbrOutput } -> sqlCell $ do
+              let Entity eId Exam{..}   = view lensExam   dbrOutput
+                  Entity _ Course{..} = view lensCourse dbrOutput
+              mayRegister <- (== Authorized) <$> evalAccessDB (CExamR courseTerm courseSchool courseShorthand examName ERegisterR) True
+              isRegistered <- existsBy $ UniqueExamRegistration eId uid
+              if
+                | mayRegister -> do
+                    (examRegisterForm, examRegisterEnctype) <- liftHandlerT . generateFormPost . buttonForm' $ bool [BtnRegister] [BtnDeregister] isRegistered
+                    return $ wrapForm examRegisterForm def
+                      { formAction = Just . SomeRoute $ CExamR courseTerm courseSchool courseShorthand examName ERegisterR
+                      , formEncoding = examRegisterEnctype
+                      , formSubmit = FormNoSubmit
+                      }
+                | isRegistered -> return [whamlet|_{MsgExamRegistered}|]
+                | otherwise -> return mempty
+            -}
+          , sortable (Just "registered") (i18nCell MsgExamRegistration ) $ \DBRow{ dbrOutput } -> sqlCell $ do
+              let Entity eId Exam{..}   = view lensExam   dbrOutput
+                  Entity _ Course{..} = view lensCourse dbrOutput
+              mayRegister <- (== Authorized) <$> evalAccessDB (CExamR courseTerm courseSchool courseShorthand examName ERegisterR) True
+              isRegistered <- existsBy $ UniqueExamRegistration eId uid
+              let label   = bool MsgExamNotRegistered MsgExamRegistered isRegistered
+                  examUrl = CExamR courseTerm courseSchool courseShorthand examName EShowR
+              if | mayRegister -> return $ simpleLinkI (SomeMessage label) examUrl
+                 | otherwise   -> return [whamlet|_{label}|]
+          ]
+        dbtSorting = Map.fromList
+          [ ("demo-both",     SortColumn $ queryCourse &&& queryExam >>> (\(_course,exam)-> exam E.^. ExamName))
+          , ("term",          SortColumn $ queryCourse >>> (E.^. CourseTerm      ))
+          , ("school",        SortColumn $ queryCourse >>> (E.^. CourseSchool    ))
+          , ("course",        SortColumn $ queryCourse >>> (E.^. CourseShorthand ))
+          , ("name",          SortColumn $ queryExam >>> (E.^. ExamName ))
+          , ("time",          SortColumn $ queryExam >>> (E.^. ExamStart ))
+          , ("register-from", SortColumn $ queryExam >>> (E.^. ExamRegisterFrom ))
+          , ("register-to",   SortColumn $ queryExam >>> (E.^. ExamRegisterTo ))
+          , ("visible",       SortColumn $ queryExam >>> (E.^. ExamVisibleFrom ))
+          , ("registered",    SortColumn $ queryExam >>> (\exam ->
+              E.exists $ E.from $ \registration -> do
+                E.where_ $ registration E.^. ExamRegistrationUser E.==. E.val uid
+                E.where_ $ registration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
+            ))
+          ]
+        dbtFilter = Map.empty
+        dbtFilterUI = const mempty
+        dbtStyle = def
+        dbtParams = def
+        dbtIdent :: Text
+        dbtIdent = "exams"
+
+    examDBTableValidator = def
+      & defaultSorting [SortAscBy "time"]
+  (Any hasExams, examTable) <- dbTable examDBTableValidator examDBTable
+  return $(widgetFile "home/upcomingExams")
+
+
--- a/stack.yaml
+++ b/stack.yaml
@ -17,7 +17,7 @@ extra-deps:
    commit: 67bb87ceff53f0178c988dd4e15eeb2daee92b84
  - git: https://github.com/pngwjpgh/memcached-binary.git
    commit: b5461747e7be226d3b67daebc3c9aefe8a4490ad
-  
+
  - colonnade-1.2.0
  - yesod-colonnade-1.2.0

@ -50,4 +50,8 @@ extra-deps:

  - haskell-src-exts-util-0.2.1.2

+  - directory-1.3.4.0
+
+  - process-1.6.5.1
+
 resolver: lts-10.5
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@ -0,0 +1,201 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages:
+- completed:
+    cabal-file:
+      size: 1740
+      sha256: 2cab90bba4d15bf6a17e3cb8e50bc8708c1091de503dd4e91d3954240e89f37b
+    name: zip-stream
+    version: 0.1.0.1
+    git: https://github.com/pngwjpgh/zip-stream.git
+    pantry-tree:
+      size: 657
+      sha256: d1626bbc3fb88a48ce9c5c37199f8cbf426be6410740891d76a8343de4f3c109
+    commit: 9272bbed000928d500febad1cdc98d1da29d399e
+  original:
+    git: https://github.com/pngwjpgh/zip-stream.git
+    commit: 9272bbed000928d500febad1cdc98d1da29d399e
+- completed:
+    cabal-file:
+      size: 4141
+      sha256: 88537113b855381b8d70da2442ae644dc979ad6b32aaaec2ebf55306764c8f1a
+    name: encoding
+    version: 0.8.2
+    git: https://github.com/pngwjpgh/encoding.git
+    pantry-tree:
+      size: 5668
+      sha256: 57160d758802aba6a0d2cc88c53f2f0bb60df7d5e6822938351618b7eca0beab
+    commit: 67bb87ceff53f0178c988dd4e15eeb2daee92b84
+  original:
+    git: https://github.com/pngwjpgh/encoding.git
+    commit: 67bb87ceff53f0178c988dd4e15eeb2daee92b84
+- completed:
+    cabal-file:
+      size: 2384
+      sha256: 7b25a0ef819e8a01b485d6d0865baa3445faa826ffb3876c94109dd2469ffbd3
+    name: memcached-binary
+    version: 0.2.0
+    git: https://github.com/pngwjpgh/memcached-binary.git
+    pantry-tree:
+      size: 1170
+      sha256: c466f91129410bae1f53e25aec4026f6984ce2dff0ada4516e2548048aba549a
+    commit: b5461747e7be226d3b67daebc3c9aefe8a4490ad
+  original:
+    git: https://github.com/pngwjpgh/memcached-binary.git
+    commit: b5461747e7be226d3b67daebc3c9aefe8a4490ad
+- completed:
+    hackage: colonnade-1.2.0@sha256:5620e999a68a394abfe157da6302dd6d8ce8a89b527ea9c294519efd7c4edb2c,2092
+    pantry-tree:
+      size: 327
+      sha256: 56ae7b84b5c8001784181e1710a6a1036e5b626e4539a7eee3db0f6ccdf2d861
+  original:
+    hackage: colonnade-1.2.0
+- completed:
+    hackage: yesod-colonnade-1.2.0@sha256:8908b30449ba5ee3de1d1fe38879acd0512094c6d4b0503c1f0011184a0e9310,897
+    pantry-tree:
+      size: 221
+      sha256: e813bb2dba2ce25557e4cf224bc77c505fdc72e3ecee2193a27c4dd64e9f8b2d
+  original:
+    hackage: yesod-colonnade-1.2.0
+- completed:
+    hackage: ldap-client-0.2.0@sha256:a5fce1d809f4a2f7dcbb49e868257895209bb7624d8791cf72765edc90a1f1af,2132
+    pantry-tree:
+      size: 1717
+      sha256: 612ca1bd1a6f1a37a101ea63f22a10d4b58fc71e4a4752ac7c6ddf851f67550d
+  original:
+    hackage: ldap-client-0.2.0
+- completed:
+    hackage: conduit-resumablesink-0.2@sha256:eb7ac70862310a10038fa178594d6e0c0b03cf1a8c3aa6293fc316871c058b24,1375
+    pantry-tree:
+      size: 294
+      sha256: 29e514637bf0c40b8fa72cd091e02da0974d03855eee7ecd24650ef1081c1445
+  original:
+    hackage: conduit-resumablesink-0.2
+- completed:
+    hackage: uuid-crypto-1.4.0.0@sha256:9e2f271e61467d9ea03e78cddad75a97075d8f5108c36a28d59c65abb3efd290,1325
+    pantry-tree:
+      size: 364
+      sha256: 6650b51ea060397c412b07b256c043546913292973284a7149ddd08f489b3e48
+  original:
+    hackage: uuid-crypto-1.4.0.0
+- completed:
+    hackage: filepath-crypto-0.1.0.0@sha256:d5d33a2c9d044d025bbbfd4e5fab61f77228604b3cb7ea46e9164f8c8bcc9fb4,1593
+    pantry-tree:
+      size: 623
+      sha256: 3663e7b1ba2d80c51967a97fb67047bb3d3b5acdaa2b82f4036c4117b3238a49
+  original:
+    hackage: filepath-crypto-0.1.0.0
+- completed:
+    hackage: cryptoids-0.5.1.0@sha256:986f0f0e966a83505013f225a4b7805f03c656822704d2a516bf68caf2a9ee04,1570
+    pantry-tree:
+      size: 513
+      sha256: 4348c28a66cd53602df6c04961f2b980756273f17a1dcefa8c61b6857f7564be
+  original:
+    hackage: cryptoids-0.5.1.0
+- completed:
+    hackage: cryptoids-types-1.0.0@sha256:96a74b33a32ebeebf5bee08e2a205e5c1585b4b46b8bac086ca7fde49aec5f5b,1271
+    pantry-tree:
+      size: 268
+      sha256: 0e9b11f6414a0a179cd11dec55261a1f9995663fcf27bfd4a386c48652655404
+  original:
+    hackage: cryptoids-types-1.0.0
+- completed:
+    hackage: cryptoids-class-0.0.0@sha256:8d22912538faa99849fed7f51eb742fbbf5f9557d04e1d81bcac408d88c16c30,985
+    pantry-tree:
+      size: 359
+      sha256: 6a5af7c785c230501fa6088ecf963c7de7463ab75b3f646510612f17dff69744
+  original:
+    hackage: cryptoids-class-0.0.0
+- completed:
+    hackage: system-locale-0.3.0.0@sha256:13b3982403d8ac8cc6138e68802be8d8e7cf7ebc4cbc7e47e99e3c0dd1be066a,1529
+    pantry-tree:
+      size: 446
+      sha256: 3b22af3e6315835bf614a0d30381ec7e47aca147b59ba601aeaa26f1fdc19373
+  original:
+    hackage: system-locale-0.3.0.0
+- completed:
+    hackage: persistent-2.7.3.1@sha256:ffab77bc3481466265ee32d01941731a34c969806fe5de838b13cba9e0fe6d9e,5237
+    pantry-tree:
+      size: 2164
+      sha256: 0ec69231caf6ed44e709fd5e742861f7eac50eb3de4817f4893295aa747ca824
+  original:
+    hackage: persistent-2.7.3.1
+- completed:
+    hackage: saltine-0.1.0.1@sha256:77071b5746709d35821df74e870ca6bf3a14942bf3ff42d22b8adc413f066d05,3007
+    pantry-tree:
+      size: 1882
+      sha256: e4b0eb2e8b17eec2ea62ea73b29971780cedd3574331f1def521bee58503b80a
+  original:
+    hackage: saltine-0.1.0.1
+- completed:
+    hackage: hlint-test-0.1.0.0@sha256:e427c0593433205fc629fb05b74c6b1deb1de72d1571f26142de008f0d5ee7a9,1814
+    pantry-tree:
+      size: 442
+      sha256: 347eac6c8a3c02fc0101444d6526b57b3c27785809149b12f90d8db57c721fea
+  original:
+    hackage: hlint-test-0.1.0.0
+- completed:
+    hackage: pkcs7-1.0.0.1@sha256:b26e5181868667abbde3ce17f9a61cf705eb695da073cdf82e1f9dfd6cc11176,3594
+    pantry-tree:
+      size: 316
+      sha256: ab3c2d2880179a945ab3122c51d1657ab4a7a628292b646e047cd32b0751a80c
+  original:
+    hackage: pkcs7-1.0.0.1
+- completed:
+    hackage: quickcheck-classes-0.4.14@sha256:fd07ec67aa5f3dc689b58db1212228428589397d75908a1fca4a0f635cd92187,3494
+    pantry-tree:
+      size: 2755
+      sha256: 4e768fdfb52bb1df8649b767dd5b1aba215164e03879752dda8b218928489597
+  original:
+    hackage: quickcheck-classes-0.4.14
+- completed:
+    hackage: semirings-0.2.1.1@sha256:83bdfd8d3abf2e404056dbc70da02d05d68fdc87fdbaa63d06f815155947e7e2,3376
+    pantry-tree:
+      size: 431
+      sha256: ab5ecf0cdd682be98b8362d6793acdf96932bdd50ab528fb85763fa0c76f2711
+  original:
+    hackage: semirings-0.2.1.1
+- completed:
+    hackage: systemd-1.2.0@sha256:94995d4f1268aa0049d1793b21adb1522b6041e270cea4095c43eb589cc7ce53,1389
+    pantry-tree:
+      size: 386
+      sha256: 16d20860c99050194570c4760337a9d9c156580dbe0ae707f4039f6da1474a93
+  original:
+    hackage: systemd-1.2.0
+- completed:
+    hackage: filepath-1.4.2@sha256:397c08e88361563bd29168b8f85d58782d6e0e5eba2374fe246fd0cf5dfde34c,2205
+    pantry-tree:
+      size: 681
+      sha256: 288e706f3d38bea39a5d248c1a5bdbb489a84fea81652966a203b28b58c6a8ca
+  original:
+    hackage: filepath-1.4.2
+- completed:
+    hackage: haskell-src-exts-util-0.2.1.2@sha256:2e14a871cda4416c0f3fb846f208b0d769e658091487db4b22b77930d200a79d,1029
+    pantry-tree:
+      size: 478
+      sha256: 247967e9b2ef347f0cc3494422c9758929a406c29b7bed0f82d3f8ac39cde8e6
+  original:
+    hackage: haskell-src-exts-util-0.2.1.2
+- completed:
+    hackage: directory-1.3.4.0@sha256:500019f04494324d1df16cf83eefeb3f809b2b20b32a32ccd755ee0439c18bfd,2829
+    pantry-tree:
+      size: 3365
+      sha256: 00c09e0c014d29ebfb921b64c1459e61a0ad6f10e70128d795246a47c06394b0
+  original:
+    hackage: directory-1.3.4.0
+- completed:
+    hackage: process-1.6.5.1@sha256:77a9afeb676357f67fe5cf1ad79aca0745fb6f7fb96b786d510af08f622643f6,2468
+    pantry-tree:
+      size: 1211
+      sha256: 19d944da6aa37944332e0726372288319852e5f72aa57dbc3516dc15e760a502
+  original:
+    hackage: process-1.6.5.1
+snapshots:
+- completed:
+    size: 568655
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/10/5.yaml
+    sha256: d5d2a8f55085643b41a30e9191cbbd4f8f707dd63facdddfbce08d811f808444
+  original: lts-10.5
--- a/templates/corrections-overview.hamlet
+++ b/templates/corrections-overview.hamlet
@ -17,30 +17,31 @@
      <th .table__th>_{MsgGenericMin}
      <th .table__th>_{MsgGenericAvg}
      <th .table__th>_{MsgGenericMax}
-    $#  Always iterate over sheetList for consistent sorting! Newest first, except in this table
-    $forall (sheetName, CorrectionInfo{ciSubmittors, ciSubmissions, ciAssigned, ciCorrected, ciMin, ciTot, ciMax}) <- reverse sheetList
-      <tr .table__row>
-        <td .table__td>^{simpleLink (toWidget sheetName) (CSheetR tid ssh csh sheetName SSubsR)}
-        $if groupsPossible
-          <td .table__td>#{ciSubmittors}
-        <td .table__td>#{ciSubmissions}
-        $maybe ((splus,sfailed),_,_) <- Map.lookup sheetName assignment
-          $if 0 < Set.size sfailed
-            <td .table__td>#{ciSubmissions - ciAssigned}
-            <td .table__td .alert-danger>(-#{show (Set.size splus)}, failed: #{show (Set.size sfailed)})
-          $elseif 0 < Set.size splus
-            <td .table__td>#{ciSubmissions - ciAssigned}
-            <td .table__td .alert-info>(-#{show (Set.size splus)})
-          $else
+    $#  Always iterate over orderedSheetNames for consistent sorting! Newest first, except in this table
+    $forall sheetName <- reverse orderedSheetNames
+      $maybe CorrectionInfo{ciSubmittors, ciSubmissions, ciAssigned, ciCorrected, ciMin, ciTot, ciMax} <- Map.lookup sheetName sheetMap
+        <tr .table__row>
+          <td .table__td>^{simpleLink (toWidget sheetName) (CSheetR tid ssh csh sheetName SSubsR)}
+          $if groupsPossible
+            <td .table__td>#{ciSubmittors}
+          <td .table__td>#{ciSubmissions}
+          $maybe ((splus,sfailed),_,_) <- Map.lookup sheetName assignment
+            $if 0 < Set.size sfailed
+              <td .table__td>#{ciSubmissions - ciAssigned}
+              <td .table__td .alert-danger>(-#{show (Set.size splus)}, failed: #{show (Set.size sfailed)})
+            $elseif 0 < Set.size splus
+              <td .table__td>#{ciSubmissions - ciAssigned}
+              <td .table__td .alert-info>(-#{show (Set.size splus)})
+            $else
+              <td .table__td>#{ciSubmissions - ciAssigned}
+              <td .table__td>
+          $nothing
            <td .table__td>#{ciSubmissions - ciAssigned}
            <td .table__td>
-        $nothing
-          <td .table__td>#{ciSubmissions - ciAssigned}
-          <td .table__td>
-        <td .table__td>#{ciSubmissions - ciCorrected}
-        <td .table__td>#{showDiffDays ciMin}
-        <td .table__td>#{showAvgsDays ciTot ciCorrected}
-        <td .table__td>#{showDiffDays ciMax}
+          <td .table__td>#{ciSubmissions - ciCorrected}
+          <td .table__td>#{showDiffDays ciMin}
+          <td .table__td>#{showAvgsDays ciTot ciCorrected}
+          <td .table__td>#{showDiffDays ciMax}


 <div>
@ -52,8 +53,9 @@
      <th .table__th colspan=2>_{MsgGenericAll}
      <th .table__th rowspan=2>_{MsgCorDeficitProportion}
      <th .table__th colspan=3>_{MsgCorrectionTime}
-      $#  Always iterate over sheetList for consistent sorting! Newest first, except in this table
-      $forall (shn,_) <- sheetList
+
+      $#  Always iterate over orderedSheetNames for consistent sorting! Newest first, except in this table
+      $forall shn <- orderedSheetNames
        <th .table__th colspan=5>#{shn}
        $# ^{simpleLinkI (SomeMessage MsgMenuCorrectors) (CSheetR tid ssh csh shn SCorrR)}
    <tr .table__row .table__row--head>
@ -62,8 +64,8 @@
      <th .table__th>_{MsgGenericMin}
      <th .table__th>_{MsgGenericAvg}
      <th .table__th>_{MsgGenericMax}
-      $#  Always iterate over sheetList for consistent sorting! Newest first, except in this table
-      $forall _shn <- sheetList
+      $#  Always iterate over orderedSheetNames for consistent sorting! Newest first, except in this table
+      $forall _shn <- orderedSheetNames
        <th .table__th>_{MsgCorProportion}
        <th .table__th>_{MsgNrSubmissionsTotalShort}
        <th .table__th>_{MsgGenericNumChange}
@ -85,32 +87,33 @@
          <td .table__td>#{showDiffDays ciMin}
          <td .table__td>#{showAvgsDays ciTot ciCorrected}
          <td .table__td>#{showDiffDays ciMax}
-          $#  Always iterate over sheetList for consistent sorting! Newest first, except in this table
-          $forall (shn, CorrectionInfo{ciSubmissions=sheetSubmissionsNr}) <- sheetList
-            <td .table__td>
-              $maybe SheetCorrector{sheetCorrectorLoad, sheetCorrectorState} <- Map.lookup shn loadM
-                #{showCompactCorrectorLoad sheetCorrectorLoad sheetCorrectorState}
-                $if sheetCorrectorState == CorrectorNormal
-                  $maybe Load{byProportion=total} <- Map.lookup shn sheetLoad
-                    $if total > 0
-                      \ (#{textPercent' True 0 (byProportion sheetCorrectorLoad) total})
-            $maybe CorrectionInfo{ciSubmissions,ciCorrected,ciTot} <- getCorrSheetStatus ciCorrector shn
-              <td .table__td>#{ciSubmissions}
-                $if sheetSubmissionsNr > 0
-                  \ (#{textPercent' True 0 ciSubmissions sheetSubmissionsNr})
-              $maybe nrNew <- getCorrNewAssignment ciCorrector shn
-                $# <td .table__td>#{ciAssigned} `ciSubmissions` is here always identical to `ciAssigned` and also works for `ciCorrector == Nothing`. ciAssigned only useful in aggregate maps like `sheetMap`
-                <td .table__td .alert-info>(+#{nrNew})
+          $#  Always iterate over orderedSheetNames for consistent sorting! Newest first, except in this table
+          $forall shn <- orderedSheetNames
+            $maybe CorrectionInfo{ciSubmissions=sheetSubmissionsNr} <- Map.lookup shn sheetMap
+              <td .table__td>
+                $maybe SheetCorrector{sheetCorrectorLoad, sheetCorrectorState} <- Map.lookup shn loadM
+                  #{showCompactCorrectorLoad sheetCorrectorLoad sheetCorrectorState}
+                  $if sheetCorrectorState == CorrectorNormal
+                    $maybe Load{byProportion=total} <- Map.lookup shn sheetLoad
+                      $if total > 0
+                        \ (#{textPercent' True 0 (byProportion sheetCorrectorLoad) total})
+              $maybe CorrectionInfo{ciSubmissions,ciCorrected,ciTot} <- getCorrSheetStatus ciCorrector shn
+                <td .table__td>#{ciSubmissions}
+                  $if sheetSubmissionsNr > 0
+                    \ (#{textPercent' True 0 ciSubmissions sheetSubmissionsNr})
+                $maybe nrNew <- getCorrNewAssignment ciCorrector shn
+                  $# <td .table__td>#{ciAssigned} `ciSubmissions` is here always identical to `ciAssigned` and also works for `ciCorrector == Nothing`. ciAssigned only useful in aggregate maps like `sheetMap`
+                  <td .table__td .alert-info>(+#{nrNew})
+                $nothing
+                  <td .table__td>
+                <td .table__td .heated style="--hotness: #{heat ciSubmissions ciCorrected}">#{ciSubmissions - ciCorrected}
+                <td .table__td>#{showAvgsDays ciTot ciCorrected}
              $nothing
                <td .table__td>
-              <td .table__td .heated style="--hotness: #{heat ciSubmissions ciCorrected}">#{ciSubmissions - ciCorrected}
-              <td .table__td>#{showAvgsDays ciTot ciCorrected}
-            $nothing
-              <td .table__td>
-              <td .table__td>
-              <td .table__td>
-              <td .table__td>
-    $if not (null sheetList)
+                <td .table__td>
+                <td .table__td>
+                <td .table__td>
+    $if not (null orderedSheetNames)
      <tr .table__row>
        <td .table__th>Σ
        $with ciSubmissionsNr <- ciSubmissions corrMapSum
@ -121,11 +124,12 @@
        <td .table__th>#{showDiffDays (ciMin corrMapSum)}
        <td .table__th>#{showAvgsDays (ciTot corrMapSum) (ciCorrected corrMapSum)}
        <td .table__th>#{showDiffDays (ciMax corrMapSum)}
-        $#  Always iterate over sheetList for consistent sorting! Newest first, except in this table
-        $forall (shn, CorrectionInfo{ciSubmissions}) <- sheetList
-          <td .table__th>#{getLoadSum shn}
-          <td .table__th>#{ciSubmissions}
-          <td .table__td colspan=3>^{simpleLinkI (SomeMessage MsgMenuCorrectorsChange) (CSheetR tid ssh csh shn SCorrR)}
+        $#  Always iterate over orderedSheetNames for consistent sorting! Newest first, except in this table
+        $forall shn <- orderedSheetNames
+          $maybe CorrectionInfo{ciSubmissions} <- Map.lookup shn sheetMap
+            <td .table__th>#{getLoadSum shn}
+            <td .table__th>#{ciSubmissions}
+            <td .table__td colspan=3>^{simpleLinkI (SomeMessage MsgMenuCorrectorsChange) (CSheetR tid ssh csh shn SCorrR)}
  ^{btnWdgt}
 <div>
  <p>_{MsgAssignSubmissionsRandomWarning}
--- a/templates/home/upcomingExams.hamlet
+++ b/templates/home/upcomingExams.hamlet
@ -0,0 +1,7 @@
+$newline never
+<section>
+  <h2>_{MsgHomeUpcomingExams}
+  $if hasExams
+    ^{examTable}
+  $else
+    _{MsgNoUpcomingExams}