new route: getCurrentTerm

This commit is contained in:
SJost 2018-06-07 11:35:38 +02:00
parent a047d81584
commit 5cf1840f09
2 changed files with 13 additions and 4 deletions

9
routes
View File

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

View File

@ -1,6 +1,7 @@
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
@ -26,6 +27,13 @@ import qualified Data.UUID.Cryptographic as UUID
getCourseListR :: Handler TypedContent getCourseListR :: Handler TypedContent
getCourseListR = redirect TermShowR 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 :: TermId -> Handler Html
getTermCourseListR tidini = do getTermCourseListR tidini = do
(term,courses) <- runDB $ (,) (term,courses) <- runDB $ (,)