fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Warning: some routes renamed; otherwise minor commit.

Browse Source
This commit is contained in:
SJost 2017-10-10 07:42:24 +02:00
parent 77e7e77e74
commit 3fbeed2682
5 changed files with 72 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
routes
View File

@ -12,8 +12,9 @@
/term/edit TermEditR GET POST
/term/#TermIdentifier/edit TermEditExistR GET
/course/ CourseShowR GET
/course/ CourseListR GET
!/course/edit CourseEditR GET POST
!/course/#TermIdentifier CourseShowTermR GET
!/course/#TermIdentifier CourseListTermR GET
/course/#TermIdentifier/#Text/edit CourseEditExistR GET
/course/#TermIdentifier/#Text/show CourseShowR GET

5
src/Foundation.hs
View File

@ -169,8 +169,9 @@ instance Yesod UniWorX where
-- TODO: all?
isAuthorized TermShowR _ = return Authorized
isAuthorized CourseShowR _ = return Authorized
isAuthorized (CourseShowTermR _) _ = return Authorized
isAuthorized CourseListR _ = return Authorized
isAuthorized (CourseShowR _ _) _ = return Authorized
isAuthorized (CourseListTermR _) _ = return Authorized
-- TODO: change to Assistants
isAuthorized TermEditR _ = return Authorized
isAuthorized (TermEditExistR _) _ = return Authorized

40
src/Handler/Course.hs
View File

@ -20,11 +20,11 @@ import Colonnade
import Yesod.Colonnade
getCourseShowR :: Handler TypedContent
getCourseShowR = redirect TermShowR
getCourseListR :: Handler TypedContent
getCourseListR = redirect TermShowR
getCourseShowTermR :: TermIdentifier -> Handler Html
getCourseShowTermR tidini = do
getCourseListTermR :: TermIdentifier -> Handler Html
getCourseListTermR tidini = do
(term,courses) <- runDB $ do
term <- get $ TermKey tidini
courses <- selectList [CourseTermId ==. TermKey tidini] [Asc CourseShorthand]
@ -35,24 +35,34 @@ getCourseShowTermR tidini = do
let colonnadeTerms = mconcat
[ headed "Kürzel" $ (\c ->
let shd = courseShorthand c
(TermKey tid) = courseTermId c
tid = unTermKey $ courseTermId c
in [whamlet| <a href=@{CourseShowR tid shd}>#{shd} |] )
-- , headed "Institut" $ [shamlet| #{course} |]
, headed "Beginn Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterFrom
, headed "Ende Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterTo
, headed " " $ (\c ->
let shd = courseShorthand c
tid = unTermKey $ courseTermId c
in do
adminLink <- handlerToWidget $ isAuthorized (CourseEditExistR tid shd ) False
[whamlet|
$if adminLink == Authorized
<a href=@{CourseEditExistR tid shd}>
#{shd}
$else
#{shd}
|] )
-- , headed "Institut" $ [shamlet| #{course} |]
, headed "Beginn Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterFrom
, headed "Ende Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterTo
editieren
|] )
]
defaultLayout $ do
setTitle "Semesterkurse"
encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal courses)
getCourseShowR :: TermIdentifier -> Text -> Handler Html
getCourseShowR tid csh = do
courseEnt <- runDB $ getBy404 $ CourseTermShort (TermKey tid) csh
let course = entityVal courseEnt
defaultLayout $ do
setTitle $ [shamlet| #{termToText tid} - #{csh}|]
$(widgetFile "course")
getCourseEditR :: Handler Html
getCourseEditR = do
@ -82,7 +92,7 @@ courseEditHandler course = do
runDB $ delete cid -- TODO Sicherheitsabfrage einbauen!
let cti = termToText $ cfTerm res
setMessage $ [shamlet| Kurs #{cti}/#{cfShort res} wurde gelöscht! |]
redirect $ CourseShowTermR $ cfTerm res
redirect $ CourseListTermR $ cfTerm res
| fAct == formActionSave
, Just cid <- cfCourseId res -> do
actTime <- liftIO getCurrentTime
@ -100,7 +110,7 @@ courseEditHandler course = do
]
let cti = termToText $ cfTerm res
setMessage $ [shamlet| Kurs #{cti}/#{cfShort res} wurde geändert. |]
redirect $ CourseShowTermR $ cfTerm res
redirect $ CourseListTermR $ cfTerm res
| fAct == formActionSave
, Nothing <- cfCourseId res -> do
actTime <- liftIO getCurrentTime
@ -124,7 +134,7 @@ courseEditHandler course = do
runDB $ insert_ $ Lecturer aid cid
let cti = termToText $ cfTerm res
setMessage $ [shamlet| Kurs #{cti}/#{cfShort res} wurde angelegt. |]
redirect $ CourseShowTermR $ cfTerm res
redirect $ CourseListTermR $ cfTerm res
Nothing -> do
let cti = termToText $ cfTerm res
setMessage $ [shamlet|

2
src/Handler/Term.hs
View File

@ -41,7 +41,7 @@ getTermShowR = do
, headed "Kursliste" $ (\t -> let tn = termName t in do
numCourses <- handlerToWidget $ runDB $ count [CourseTermId ==. TermKey tn ]
[whamlet|
<a href=@{CourseShowTermR tn}>
<a href=@{CourseListTermR tn}>
#{show numCourses} Kurse
|] )
, headed "Semesteranfang" $ fromString.formatTimeGerWD.termStart

40
templates/course.hamlet Normal file
View File

@ -0,0 +1,40 @@
<div .masthead>
<div .container>
<div .row>
<h1 .header>
#{courseName course}
<div .container>
<div .bs-docs-section>
<div .row>
<div .col-lg-12>
<div .page-header>
<h1 #start>Beschreibung
$maybe descr <- courseDescription course
<p> #{descr}
<p>
You can also use this scaffolded site to explore some concepts, and best practices.
<li .list-group-item>
We can link to other handlers, like the <a href="@{ProfileR}">Profile</a>.
Try it out as an anonymous user and see the access denied.
Then, try to <a href="@{AuthR LoginR}">login</a> with the dummy authentication added
while in development.
<li .list-group-item>
The HTML you are seeing now is actually composed by a number of <em>widgets</em>, #
most of them are brought together by the <tt>defaultLayout</tt> function which #
is defined in the <tt>Foundation.hs</tt> module,
All the files for templates and wigdets are in <tt>templates</tt>.
<li .list-group-item>
A Widget's Html, Css and Javascript are separated in three files with the
<tt>.hamlet</tt>, <tt>.lucius</tt> and <tt>.julius</tt> extensions.
<hr>