Merge branch 'master' into 'live'

Deploy master

See merge request !40

Dockerfile

@@ -1,6 +0,0 @@
-FROM fpco/stack-build:lts-9.3
-
-ENV DEBIAN_FRONTEND noninteractive
-
-RUN apt-get update
-RUN apt-get install libldap2-dev libsasl2-dev

db.hs

@@ -4,14 +4,49 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE LambdaCase #-}
 
-import "uniworx" Import
+import "uniworx" Import hiding (Option(..))
-import "uniworx" Application (db)
+import "uniworx" Application (db, getAppDevSettings)
+
+import Database.Persist.Postgresql
+import Database.Persist.Sql
+import Control.Monad.Logger
+
+import System.Console.GetOpt
+import System.Exit (exitWith, ExitCode(..))
+import System.IO (hPutStrLn, stderr)
 
 import Data.Time
 
+
+data DBAction = DBClear
+              | DBFill
+
+argsDescr :: [OptDescr DBAction]
+argsDescr =
+  [ Option ['c'] ["clear"] (NoArg DBClear) "Delete everything accessable by the current database user"
+  , Option ['f'] ["fill"]  (NoArg DBFill)  "Fill database with example data"
+  ]
+
+  
 main :: IO ()
-main = db $ do
+main = do
+  args <- map unpack <$> getArgs
+  case getOpt Permute argsDescr args of
+    (acts@(_:_), [], []) -> forM_ acts $ \case
+      DBClear -> runStderrLoggingT $ do -- We don't use `db` here, since we do /not/ want any migrations to run, yet
+        settings <- liftIO getAppDevSettings
+        withPostgresqlConn (pgConnStr $ appDatabaseConf settings) . runSqlConn $ do
+          rawExecute "drop owned by current_user;" []
+      DBFill -> db $ fillDb
+    (_, _, errs) -> do
+      forM_ errs $ hPutStrLn stderr
+      hPutStrLn stderr $ usageInfo "db.hs" argsDescr
+      exitWith $ ExitFailure 2
+
+fillDb :: DB ()
+fillDb = do
   defaultFavourites <- getsYesod $ appDefaultFavourites . appSettings
   now <- liftIO getCurrentTime
   let

messages/de.msg

@@ -10,6 +10,8 @@ DeRegUntil: Abmeldungen bis
 
 SummerTerm year@Integer: Sommersemester #{display year}
 WinterTerm year@Integer: Wintersemester #{display year}/#{display $ succ year}
+SummerTermShort year@Integer: SoSe #{display year}
+WinterTermShort year@Integer: WiSe #{display year}/#{display $ succ year}
 PSLimitNonPositive: “pagesize” muss größer als null sein
 Page n@Int64: #{display n}
 
@@ -99,6 +101,7 @@ UnauthorizedWrite: Sie haben hierfür keine Schreibberechtigung
 EMail: E-Mail
 EMailUnknown email@Text: E-Mail #{email} gehört zu keinem bekannten Benutzer.
 NotAParticipant user@Text tid@TermId csh@Text: #{user} ist nicht im Kurs #{display tid}-#{csh} angemeldet.
+TooManyParticipants: Es wurden zu viele Mitabgebende angegeben
 
 AddCorrector: Zusätzlicher Korrektor
 CorrectorExists user@Text: #{user} ist bereits als Korrektor eingetragen
@@ -178,3 +181,7 @@ FileCorrectedDeleted: Korrigiert (gelöscht)
 RatingUpdated: Korrektur gespeichert
 RatingDeleted: Korrektur zurückgesetzt
 RatingFilesUpdated: Korrigierte Dateien überschrieben
+
+CourseMembers: Teilnehmer
+CourseMembersCount num@Int64: #{display num}
+CourseMembersCountLimited num@Int64 max@Int64: #{display num}/#{display max}

models

@@ -60,7 +60,7 @@ Course
     shorthand        Text
     term             TermId
     school           SchoolId
-    capacity         Int Maybe
+    capacity         Int64 Maybe
     -- canRegisterNow = maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo
     registerFrom     UTCTime Maybe
     registerTo       UTCTime Maybe

src/Application.hs

@@ -7,7 +7,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Application
-    ( getApplicationDev
+    ( getApplicationDev, getAppDevSettings
     , appMain
     , develMain
     , makeFoundation

src/Foundation.hs

@@ -487,6 +487,10 @@ instance Yesod UniWorX where
                             actFav = List.intersect (snd3 <$> favourites) crumbs
                             highRs = if null actFav then crumbs else actFav
                         in \r -> r `elem` highRs
+            favouriteTerms :: [TermIdentifier]
+            favouriteTerms = Set.toDescList $ foldMap (\(Course{..}, _, _) -> Set.singleton $ unTermKey courseTerm) favourites
+            favouriteTerm :: TermIdentifier -> [(Course, Route UniWorX, [MenuTypes])]
+            favouriteTerm tid = filter (\(Course{..}, _, _) -> unTermKey courseTerm == tid) favourites
 
         -- We break up the default layout into two components:
         -- default-layout is the contents of the body tag, and

src/Handler/Course.hs

@@ -18,8 +18,12 @@ import qualified Data.Text as T
 import Data.Function ((&))
 -- import Yesod.Form.Bootstrap3
 
+import qualified Data.Map as Map
+
 import Colonnade hiding (fromMaybe,bool)
-import Yesod.Colonnade
+-- import Yesod.Colonnade
+
+import qualified Database.Esqueleto as E
 
 import qualified Data.UUID.Cryptographic as UUID
 
@@ -37,45 +41,56 @@ getTermCurrentR = do
 
 
 getTermCourseListR :: TermId -> Handler Html
-getTermCourseListR tidini = do
+getTermCourseListR tid = do
-  (term,courses) <- runDB $ (,)
+  void . runDB $ get404 tid -- Just ensure the term exists
-      <$> get tidini
+
-      <*> selectList [CourseTerm ==. tidini] [Asc CourseShorthand]
+  let
-  when (isNothing term) $ do
+    tableData :: E.SqlExpr (Entity Course) -> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (E.Value Int64))
-    addMessage "warning" [shamlet| Semester #{toPathPiece tidini} nicht gefunden. |]
+    tableData course = do
-    redirect TermShowR
+      E.where_ $ course E.^. CourseTerm E.==. E.val tid
-  -- TODO: several runDBs per TableRow are probably too inefficient!
+      let
-  let colonnadeTerms = mconcat
+        participants = E.sub_select . E.from $ \courseParticipant -> do
-        [ headed "Kürzel" $ (\ckv ->
+          E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
-            let c   = entityVal ckv
+          return (E.countRows :: E.SqlExpr (E.Value Int64))
-                shd = courseShorthand c
+      return (course, participants)
-                tid = courseTerm c
+    psValidator = def
-            in [whamlet| <a href=@{CourseR tid shd CShowR}>#{shd} |] )
+      & defaultSorting [("shorthand", SortAsc)]
---         , headed "Institut" $ [shamlet| #{course} |]
+
-        , headed "Beginn Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterFrom.entityVal
+  coursesTable <- dbTable psValidator $ DBTable
-        , headed "Ende Anmeldung"   $ fromString.(maybe "" formatTimeGerWD).courseRegisterTo.entityVal
+    { dbtSQLQuery  = tableData
-        , headed "Teilnehmer" $ (\ckv -> do
+    , dbtColonnade = widgetColonnade $ mconcat
-              let cid = entityKey ckv
+        [ sortable (Just "shorthand") (textCell MsgCourse) $ anchorCell'
-              partiNum <- handlerToWidget $ runDB $ count [CourseParticipantCourse ==. cid]
+            (\(Entity _ Course{..}, _) -> CourseR courseTerm courseShorthand CShowR)
-              [whamlet| #{show partiNum} |]
+            (\(Entity _ Course{..}, _) -> toWidget courseShorthand)
-            )
+        , sortable (Just "register-from") (textCell MsgRegisterFrom) $ \(Entity _ Course{..}, _) -> textCell $ display courseRegisterFrom
-        , headed " " $ (\ckv ->
+        , sortable (Just "register-to") (textCell MsgRegisterTo) $ \(Entity _ Course{..}, _) -> textCell $ display courseRegisterTo
-            let c   = entityVal ckv
+        , sortable (Just "members") (textCell MsgCourseMembers) $ \(Entity _ Course{..}, E.Value num) -> textCell $ case courseCapacity of
-                shd = courseShorthand c
+            Nothing -> MsgCourseMembersCount num
-                tid = courseTerm c
+            Just max -> MsgCourseMembersCountLimited num max
-            in do
+        ]
-              adminLink <- handlerToWidget $ isAuthorized (CourseR tid shd CEditR) False
+    , dbtSorting = Map.fromList
-              -- if (adminLink==Authorized) then linkButton "Ändern" BCWarning (CEditR tid shd) else ""
+        [ ( "shorthand"
-              [whamlet|
+          , SortColumn $ \course -> course E.^. CourseShorthand
-                $if adminLink == Authorized
+          )
-                  <a href=@{CourseR tid shd CEditR}>
+        , ( "register-from"
-                    editieren
+          , SortColumn $ \course -> course E.^. CourseRegisterFrom
-              |]
+          )
+        , ( "register-to"
+          , SortColumn $ \course -> course E.^. CourseRegisterTo
+          )
+        , ( "members"
+          , SortColumn $ \course -> E.sub_select . E.from $ \courseParticipant -> do
+              E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
+              return (E.countRows :: E.SqlExpr (E.Value Int64))
           )
         ]
-  let coursesTable = encodeWidgetTable tableSortable colonnadeTerms courses
+    , dbtFilter = mempty
+    , dbtAttrs = tableDefault
+    , dbtIdent = "courses" :: Text
+    }
+  
   defaultLayout $ do
-    setTitleI . MsgTermCourseListTitle $ tidini
+    setTitleI . MsgTermCourseListTitle $ tid
     $(widgetFile "courses")
 
 getCShowR :: TermId -> Text -> Handler Html
@@ -129,7 +144,7 @@ postCRegisterR tid csh = do
           actTime <- liftIO $ getCurrentTime
           regOk <- runDB $ do
             reg <- count [CourseParticipantCourse ==. cid]
-            if NTop (Just reg) < NTop (courseCapacity course)
+            if NTop (Just $ fromIntegral reg) < NTop (courseCapacity course)
               then -- current capacity has room
                 insertUnique $ CourseParticipant cid aid actTime
               else do -- no space left
@@ -260,7 +275,7 @@ data CourseForm = CourseForm
         , cfShort      :: Text
         , cfTerm       :: TermId
         , cfSchool     :: SchoolId
-        , cfCapacity   :: Maybe Int
+        , cfCapacity   :: Maybe Int64
         , cfSecret     :: Maybe Text
         , cfMatFree    :: Bool
         , cfRegFrom    :: Maybe UTCTime

src/Handler/Submission.hs

@@ -170,11 +170,11 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
       (FormFailure failmsgs)   -> return $ FormFailure failmsgs
       (FormSuccess (mFiles,[])) -> return $ FormSuccess (mFiles,[]) -- Type change
       (FormSuccess (mFiles, (map CI.mk -> gEMails@(_:_)))) -- Validate AdHoc Group Members
-        | (Arbitrary {..}) <- sheetGrouping
+        | (Arbitrary {..}) <- sheetGrouping -> do
-        , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for
+          -- , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for
           let gemails = map CI.foldedCase gEMails
               prep :: [(E.Value Text, (E.Value UserId, E.Value Bool, E.Value Bool))] -> Map (CI Text) (Maybe (UserId, Bool, Bool))
-              prep ps = Map.fromList $ map (, Nothing) gEMails ++ [(CI.mk m, Just (i,p,s))|(E.Value m, (E.Value i, E.Value p, E.Value s)) <- ps]
+              prep ps = Map.filter (maybe True $ \(i,_,_) -> i /= uid) . Map.fromList $ map (, Nothing) gEMails ++ [(CI.mk m, Just (i,p,s))|(E.Value m, (E.Value i, E.Value p, E.Value s)) <- ps]
           participants <- fmap prep . E.select . E.from $ \user -> do
             E.where_ $ (E.lower_ $ user E.^. UserEmail) `E.in_` E.valList gemails
             let
@@ -186,20 +186,29 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
                 E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
                 E.where_ $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
                      E.&&. submission E.^. SubmissionSheet E.==. E.val shid
+                case msmid of -- Multiple `E.where_`-Statements are merged with `&&` in esqueleto 2.5.3
+                  Nothing   -> return ()
+                  Just smid -> E.where_ $ submission E.^. SubmissionId E.!=. E.val smid 
                 return $ E.countRows E.>. E.val (0 :: Int64)
             return (user E.^. UserEmail, (user E.^. UserId, isParticipant, hasSubmitted))
-          $logDebugS "SUBMISSION.AdHocGroupValidation" $ tshow participants
-          mr <- getMessageRender
 
-          let failmsgs = flip Map.foldMapWithKey participants $ \email -> \case
+          $logDebugS "SUBMISSION.AdHocGroupValidation" $ tshow participants
-                  Nothing            -> [mr $ MsgEMailUnknown $ CI.original email]
+
-                  (Just (_,False,_)) -> [mr $ MsgNotAParticipant (CI.original email) tid csh]
+          mr <- getMessageRender
-                  (Just (_,_, True)) -> [mr $ MsgSubmissionAlreadyExistsFor (CI.original email)]
+          let
+            failmsgs = (concat :: [[Text]] -> [Text])
+              [ flip Map.foldMapWithKey participants $ \email -> \case
+                  Nothing            -> pure . mr $ MsgEMailUnknown $ CI.original email
+                  (Just (_,False,_)) -> pure . mr $ MsgNotAParticipant (CI.original email) tid csh
+                  (Just (_,_, True)) -> pure . mr $ MsgSubmissionAlreadyExistsFor (CI.original email)
                   _other             -> mempty
+              , case length participants `compare` maxParticipants of
+                  LT -> mempty
+                  _  -> pure $ mr MsgTooManyParticipants
+              ]
           return $ if null failmsgs
             then FormSuccess (mFiles, foldMap (\(Just (i,_,_)) -> [i]) participants)
             else FormFailure failmsgs
-
         | otherwise -> return $ FormFailure ["Mismatching number of group participants"]
 
 

src/Handler/Utils/Table/Pagination.hs

@@ -22,7 +22,7 @@ module Handler.Utils.Table.Pagination
   , FilterColumn(..), IsFilterColumn
   , DBRow(..), DBOutput
   , DBTable(..), IsDBTable(..)
-  , PaginationSettings(..)
+  , PaginationSettings(..), PaginationInput(..), piIsUnset
   , PSValidator(..)
   , defaultFilter, defaultSorting
   , restrictFilter, restrictSorting
@@ -160,16 +160,41 @@ instance Default PaginationSettings where
     , psShortcircuit = False
     }
 
-newtype PSValidator m x = PSValidator { runPSValidator :: DBTable m x -> Maybe PaginationSettings -> ([SomeMessage UniWorX], PaginationSettings) }
+data PaginationInput = PaginationInput
+  { piSorting      :: Maybe [(CI Text, SortDirection)]
+  , piFilter       :: Maybe (Map (CI Text) [Text])
+  , piLimit        :: Maybe Int64
+  , piPage         :: Maybe Int64
+  , piShortcircuit :: Bool
+  }
+
+piIsUnset :: PaginationInput -> Bool
+piIsUnset PaginationInput{..} = and
+  [ isNothing piSorting
+  , isNothing piFilter
+  , isNothing piLimit
+  , isNothing piPage
+  , not piShortcircuit
+  ]
+
+newtype PSValidator m x = PSValidator { runPSValidator :: DBTable m x -> Maybe PaginationInput -> ([SomeMessage UniWorX], PaginationSettings) }
 
 instance Default (PSValidator m x) where
   def = PSValidator $ \DBTable{..} -> \case
     Nothing -> def
-    Just ps -> swap . (\act -> execRWS act () ps) $ do
+    Just pi -> swap . (\act -> execRWS act pi def) $ do
-      l <- gets psLimit
+      asks piSorting >>= maybe (return ()) (\s -> modify $ \ps -> ps { psSorting = s })
-      when (l <= 0) $ do
+      asks piFilter >>= maybe (return ()) (\f -> modify $ \ps -> ps { psFilter = f })
-        modify $ \ps -> ps { psLimit = psLimit def }
+      
-        tell . pure $ SomeMessage MsgPSLimitNonPositive
+      l <- asks piLimit
+      case l of
+        Just l'
+          | l' >= 0   -> tell . pure $ SomeMessage MsgPSLimitNonPositive
+          | otherwise -> modify $ \ps -> ps { psLimit = l' }
+        Nothing -> return ()
+
+      asks piPage >>= maybe (return ()) (\p -> modify $ \ps -> ps { psPage = p })
+      asks piShortcircuit >>= (\s -> modify $ \ps -> ps { psShortcircuit = s })
 
 defaultFilter :: Map (CI Text) [Text] -> PSValidator m x -> PSValidator m x
 defaultFilter psFilter (runPSValidator -> f) = PSValidator g
@@ -281,24 +306,25 @@ dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent),
       , fieldEnctype = UrlEncoded
       }
     
-  psResult <- runInputGetResult $ PaginationSettings
+  psResult <- runInputGetResult $ PaginationInput
-    <$> (fromMaybe [] <$> iopt (multiSelectField $ return sortingOptions) (wIdent "sorting"))
+    <$> iopt (multiSelectField $ return sortingOptions) (wIdent "sorting")
-    <*> (Map.mapMaybe ((\args -> args <$ guard (not $ null args)) =<<) <$> Map.traverseWithKey (\k _ -> iopt multiTextField . wIdent $ CI.foldedCase k) dbtFilter)
+    <*> ((\m -> m <$ guard (not $ Map.null m)) . Map.mapMaybe ((\args -> args <$ guard (not $ null args)) =<<) <$> Map.traverseWithKey (\k _ -> iopt multiTextField . wIdent $ CI.foldedCase k) dbtFilter)
-    <*> (fromMaybe (psLimit defPS) <$> iopt intField (wIdent "pagesize"))
+    <*> iopt intField (wIdent "pagesize")
-    <*> (fromMaybe (psPage  defPS) <$> iopt intField (wIdent "page"))
+    <*> iopt intField (wIdent "page")
     <*> ireq checkBoxField (wIdent "table-only")
 
-  $(logDebug) . tshow $ (,,,,) <$> (length . psSorting <$> psResult)
+  $(logDebug) . tshow $ (,,,,) <$> (piSorting <$> psResult)
-                               <*> (Map.keys . psFilter <$> psResult)
+                               <*> (piFilter <$> psResult)
-                               <*> (psLimit <$> psResult)
+                               <*> (piLimit <$> psResult)
-                               <*> (psPage <$> psResult)
+                               <*> (piPage <$> psResult)
-                               <*> (psShortcircuit <$> psResult)
+                               <*> (piShortcircuit <$> psResult)
 
   let
     (errs, PaginationSettings{..}) = case psResult of
-      FormSuccess ps   -> runPSValidator dbtable $ Just ps
+      FormSuccess pi
-      FormFailure errs -> first (map SomeMessage errs <>) $ runPSValidator dbtable Nothing
+        | not (piIsUnset pi) -> runPSValidator dbtable $ Just pi
-      FormMissing      -> runPSValidator dbtable Nothing
+      FormFailure errs       -> first (map SomeMessage errs <>) $ runPSValidator dbtable Nothing
+      _                      -> runPSValidator dbtable Nothing
     psSorting' = map (first (dbtSorting !)) psSorting
     sqlQuery' = E.from $ \t -> dbtSQLQuery t
       <* E.orderBy (map (sqlSortDirection t) psSorting')
@@ -308,13 +334,13 @@ dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent),
 
   mapM_ (addMessageI "warning") errs
 
-  rows' <- runDB . E.select $ (,) <$> pure (E.unsafeSqlValue "row_number() OVER ()" :: E.SqlExpr (E.Value Int64), E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64)) <*> sqlQuery'
+  rows' <- runDB . E.select $ (,) <$> pure (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64)) <*> sqlQuery'
 
   let
     rowCount
-      | ((_, E.Value n), _):_ <- rows' = n
+      | (E.Value n, _):_ <- rows' = n
       | otherwise = 0
-    rows = map (\((E.Value dbrIndex, E.Value dbrCount), dbrOutput) -> DBRow{..}) rows'
+    rows = map (\(dbrIndex, (E.Value dbrCount, dbrOutput)) -> DBRow{..}) $ zip [succ (psPage * psLimit)..] rows'
 
     table' :: WriterT x m Widget
     table' = do

stack.yaml

@@ -1,8 +1,5 @@
 flags: {}
 
-docker:
-  enable: false
-  image: uniworx
 nix:
   packages: []
   pure: false

templates/default-layout.lucius

@@ -49,11 +49,11 @@ body {
   --color-lmu-box-border: var(--color-lightwhite);
 
   &.theme--lavender {
-    --color-primary: #4C7A9C;
+    --color-primary: #4c569c;
-    --color-light: #598EB5;
+    --color-light: #5969b5;
-    --color-lighter: #5F98C2;
+    --color-lighter: #5f7dc2;
-    --color-dark: #425d79;
+    --color-dark: #4c4279;
-    --color-darker: #274a65;
+    --color-darker: #273765;
     --color-link: var(--color-dark);
     --color-link-hover: var(--color-darker);
   }
@@ -435,22 +435,26 @@ input[type="button"].btn-info:hover,
 
 .deflist__dt {
   font-weight: 600;
-  font-size: 20px;
-
-  /* bad. avoid this. */
-  > a {
-    font-size: 16px;
-  }
 }
 
 .deflist__dd {
-  margin-bottom: 4px;
+  font-size: 18px;
+  margin-bottom: 10px;
 }
 
 @media (min-width: 768px) {
 
   .deflist {
-    grid-template-columns: max-content auto;
+    grid-template-columns: max-content minmax(auto, max-content);
+
+    .deflist {
+      margin-top: -10px;
+      margin-right: -15px;
+
+      .deflist__dd {
+        padding-right: 15px;
+      }
+    }
   }
 
   .deflist__dt,
@@ -458,6 +462,7 @@ input[type="button"].btn-info:hover,
     border-bottom: 1px solid #d3d3d3;
     padding: 12px 0;
     margin: 0;
+    font-size: 16px;
 
     &:last-of-type {
       border: 0;
@@ -465,7 +470,10 @@ input[type="button"].btn-info:hover,
   }
 
   .deflist__dt {
-    padding-right: 24px;
+    padding-right: 50px;
-    font-size: 16px;
+  }
+
+  .deflist__dd {
+    padding-right: 15px;
   }
 }

templates/table/layout.hamlet

@@ -1,10 +1,7 @@
 $newline never
 <div ##{dbtIdent}-table-wrapper>
   <div .scrolltable>
-    $if null wRows
+    ^{table}
-      Keine anstehenden Übungsblätter.
-    $else
-      ^{table}
   $if pageCount > 1
     <ul ##{dbtIdent}-pagination .pagination>
       $forall p <- pageNumbers

templates/versionHistory.hamlet

@@ -13,7 +13,7 @@
   <p>
     <h2>
       Versionsgeschichte
-    <pre>
+    <pre #changelog>
       #{changeLog}
 
   <p>

templates/versionHistory.lucius

@@ -0,0 +1,4 @@
+#changelog {
+  font-size: 14px;
+  white-space: pre-line;
+}

templates/widgets/asidenav.hamlet

@@ -2,19 +2,23 @@ $newline never
 <aside .main__aside>
   <div .asidenav>
     <div .asidenav__box>
-      <h3 .asidenav__box-title>
+      $forall tid@TermIdentifier{..} <- favouriteTerms
-        $# TODO: this has to come from favourites somehow. Show favourites from older terms?
+        <h3 .asidenav__box-title>
-        WiSe 17/18
+          $case season
-      <ul .asidenav__list>
+            $of Winter
-        $forall (Course{..}, courseRoute, pageActions) <- favourites
+              _{MsgWinterTermShort year}
-          <li .asidenav__list-item :highlight courseRoute:.asidenav__list-item--active>
+            $of Summer
-            <a .asidenav__link-wrapper href=@{courseRoute}>
+              _{MsgSummerTermShort year}
-              <div .asidenav__link-shorthand>#{courseShorthand}
+        <ul .asidenav__list>
-              <div .asidenav__link-label>#{courseName}
+          $forall (Course{..}, courseRoute, pageActions) <- favouriteTerm tid
-            <ul .asidenav__nested-list>
+            <li .asidenav__list-item :highlight courseRoute:.asidenav__list-item--active>
-              $forall action <- pageActions
+              <a .asidenav__link-wrapper href=@{courseRoute}>
-                $case action
+                <div .asidenav__link-shorthand>#{courseShorthand}
-                  $of PageActionPrime (MenuItem{..})
+                <div .asidenav__link-label>#{courseName}
-                    <li .asidenav__nested-list-item>
+              <ul .asidenav__nested-list>
-                      <a .asidenav__link-wrapper href=@{menuItemRoute}>#{menuItemLabel}
+                $forall action <- pageActions
-                  $of _
+                  $case action
+                    $of PageActionPrime (MenuItem{..})
+                      <li .asidenav__nested-list-item>
+                        <a .asidenav__link-wrapper href=@{menuItemRoute}>#{menuItemLabel}
+                    $of _