new route: getCurrentTerm

routes

@@ -32,10 +32,11 @@
 /profile ProfileR GET                                         !free
 /users   UsersR   GET                                         -- no tags, i.e. admins only
 
-/term                       TermShowR         GET             !free
-/term/edit                  TermEditR         GET POST
-/term/#TermId/edit          TermEditExistR    GET
-!/term/#TermId              TermCourseListR   GET             !free
+/terms                       TermShowR         GET            !free
+/terms/current               TermCurrentR      GET            !free
+/terms/edit                  TermEditR         GET POST
+/terms/#TermId/edit          TermEditExistR    GET
+!/terms/#TermId              TermCourseListR   GET            !free
 
 -- For Pattern Synonyms see Foundation
 /course/                    CourseListR       GET             !free

src/Handler/Course.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -26,6 +27,13 @@ import qualified Data.UUID.Cryptographic as UUID
 getCourseListR :: Handler TypedContent
 getCourseListR = redirect TermShowR
 
+getTermCurrentR :: Handler Html
+getTermCurrentR = do
+  termIds  <- runDB $ selectKeysList [TermActive ==. True] []
+  case fromNullable termIds of
+    Nothing -> notFound
+    (Just (maximum -> tid)) -> getTermCourseListR tid
+
 getTermCourseListR :: TermId -> Handler Html
 getTermCourseListR tidini = do
   (term,courses) <- runDB $ (,)