From 5cf1840f092b217fe22de15ab8f0ca3a7d4c5bd3 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 7 Jun 2018 11:35:38 +0200
Subject: [PATCH] new route: getCurrentTerm

---
 routes                | 9 +++++----
 src/Handler/Course.hs | 8 ++++++++
 2 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/routes b/routes
index 450bbcd99..2b5511668 100644
--- a/routes
+++ b/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
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 555104172..51fc05fca 100644
--- a/src/Handler/Course.hs
+++ b/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 $ (,)