new route: getCurrentTerm
This commit is contained in:
parent
a047d81584
commit
5cf1840f09
9
routes
9
routes
@ -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
|
||||||
|
|||||||
@ -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 $ (,)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user