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

School Handler Stub; Profile shows own courses with lean dbTable

Browse Source
This commit is contained in:
SJost 2018-09-10 14:38:19 +02:00
parent bf3a12d09d
commit 45563750ac
6 changed files with 181 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
routes
View File

@ -41,13 +41,15 @@
/profile ProfileR GET POST !free !free
/profile/data ProfileDataR GET !free !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
!/terms/#TermId/#SchoolId TermSchoolCourseListR GET !free
/term TermShowR GET !free
/term/current TermCurrentR GET !free
/term/edit TermEditR GET POST
/term/#TermId/edit TermEditExistR GET
!/term/#TermId TermCourseListR GET !free
!/term/#TermId/#SchoolId TermSchoolCourseListR GET !free
/school SchoolListR GET
/school/#SchoolId SchoolShowR GET
-- For Pattern Synonyms see Foundation
/course/ CourseListR GET !free

1
src/Application.hs
View File

@ -52,6 +52,7 @@ import Handler.Profile
import Handler.Users
import Handler.Admin
import Handler.Term
import Handler.School
import Handler.Course
import Handler.Sheet
import Handler.Submission

43
src/Handler/Profile.hs
View File

@ -195,6 +195,38 @@ getProfileDataR = do
-- mr <- getMessageRender
-- Tabelle mit eigenen Kursen
ownCourseTable <- do
let procData :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
procData = id
dbTableWidget' def $ DBTable
{ dbtIdent = "courseOwnership" :: Text
, dbtStyle = def
, dbtSQLQuery = \(course `E.InnerJoin` lecturer) -> do
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
return ( course E.^. CourseTerm
, course E.^. CourseSchool
, course E.^. CourseId
, course E.^. CourseShorthand
)
, dbtColonnade = mconcat
[ colsCourseLink' $ _dbrOutput
-- [ colsCourseLink $ (over each _unValue) . o_dbrOutput
]
, dbtProj = return
, dbtSorting = Map.fromList
[ ( "course", SortColumn $ procData $ \(crse `E.InnerJoin` _) -> crse E.^. CourseShorthand)
, ( "term" , SortColumn $ procData $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm )
, ( "school", SortColumn $ procData $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool )
]
, dbtFilter = Map.fromList
[ ( "course", FilterColumn $ procData $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
, ( "term", FilterColumn $ procData $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
, ( "school", FilterColumn $ procData $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
]
}
-- Tabelle mit allen Teilnehmer: Kurs (link), Datum
courseTable <- do
let
@ -223,19 +255,22 @@ getProfileDataR = do
{ dbtIdent = "courseMembership" :: Text
, dbtSQLQuery = courseData
, dbtColonnade = mconcat
[ colCourseDescrG
[ colsCourseCompleteG
, sortable (Just "time") (i18nCell MsgRegistered) $ do
regTime <- view $ _dbrOutput . _2 . _unValue
return $ timeCell regTime
]
, dbtProj = return
, dbtSorting = Map.fromList
[ ( "course", SortColumn $ procData $ \(crse `E.InnerJoin` _) -> crse E.^. CourseName )
[ ( "course", SortColumn $ procData $ \(crse `E.InnerJoin` _) -> crse E.^. CourseName )
, ( "term" , SortColumn $ procData $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm )
, ( "school", SortColumn $ procData $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool)
, ( "time" , SortColumn $ \(_ `E.InnerJoin` participant) -> participant E.^. CourseParticipantRegistration)
]
, dbtFilter = Map.fromList
[
( "course", FilterColumn $ procData $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand )
[ ( "course", FilterColumn $ procData $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseName )
, ( "term" , FilterColumn $ procData $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
, ( "school", FilterColumn $ procData $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool)
-- , ( "time" , FilterColumn $ \(_ `E.InnerJoin` part :: CourseTableData) -> emptyOrIn $ part E.^. CourseParticipantRegistration )
]
, dbtStyle = def

53
src/Handler/School.hs Normal file
View File

@ -0,0 +1,53 @@
{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
module Handler.School where
import Import
-- import Control.Lens
-- import Utils.Lens
-- import Utils.TH
-- import Handler.Utils
-- import Handler.Utils.Table.Convenience
--
-- -- import Data.Time
-- import qualified Data.Text as T
-- import Data.Function ((&))
-- -- import Yesod.Form.Bootstrap3
--
-- import qualified Data.Set as Set
-- import qualified Data.Map as Map
--
-- import Colonnade hiding (fromMaybe,bool)
--
-- import qualified Database.Esqueleto as E
--
-- import qualified Data.UUID.Cryptographic as UUID
getSchoolListR :: Handler Html
getSchoolListR = do
-- muid <- maybeAuthId
defaultLayout $ do
[whamlet|TODO: Liste aller Institute |] -- TODO
getSchoolShowR :: SchoolId -> Handler Html
getSchoolShowR ssh = do -- TODO
-- muid <- maybeAuthId
defaultLayout $ do
[whamlet|TODO: Informationen zu einem Institut |] -- TODO

76
src/Handler/Utils/Table/Convenience.hs
View File

@ -13,16 +13,51 @@ import Utils.Lens
import Handler.Utils
-- import Handler.Utils.Table.Pagination
import qualified Database.Esqueleto as E (Value(..))
-- newtype CourseLink = CourseLink (TermId, SchoolId, CourseId, CourseShorthand) -- cannot be in Types due to CourseId
type CourseLink = (TermId, SchoolId, CourseId, CourseShorthand) -- cannot be in Types due to CourseId
type CourseLink' = (E.Value TermId, E.Value SchoolId, E.Value CourseId, E.Value CourseShorthand) -- cannot be in Types due to CourseId
-- Special cells
timeCell :: IsDBTable m a => UTCTime -> DBCell m a
timeCell t = cell $ formatTime SelFormatDateTime t >>= toWidget
-- Just for documentation purposes; inline the code instead:
-- Just for documentation purposes; inline this code instead:
maybeTimeCell :: IsDBTable m a => Maybe UTCTime -> DBCell m a
maybeTimeCell = maybe mempty timeCell
termCell :: IsDBTable m a => TermId -> DBCell m a
termCell tid = anchorCell link name
where
link = TermCourseListR tid
name = text2widget $ display tid
schoolCell :: IsDBTable m a => Maybe TermId -> SchoolId -> DBCell m a
schoolCell (Just tid) ssh = anchorCell link name
where
link = TermSchoolCourseListR tid ssh
name = text2widget $ display ssh
schoolCell Nothing ssh = anchorCell link name
where
link = SchoolShowR ssh
name = text2widget $ display ssh
courseLinkCell :: IsDBTable m a => CourseLink -> DBCell m a
courseLinkCell (tid,ssh,_cid,csh) = anchorCell link name
where
link = CourseR tid ssh csh CShowR
name = citext2widget csh
courseLinkCell' :: IsDBTable m a => CourseLink' -> DBCell m a
courseLinkCell' (E.Value tid, E.Value ssh,_cid,E.Value csh) = anchorCell link name
where
link = CourseR tid ssh csh CShowR
name = citext2widget csh
courseCell :: IsDBTable m a => Course -> DBCell m a
courseCell (Course {..}) = anchorCell link name `mappend` desc
where
@ -33,6 +68,7 @@ courseCell (Course {..}) = anchorCell link name `mappend` desc
(Just descr) -> cell [whamlet| <span style="float:right"> ^{modalStatic descr} |]
-- Generic Columns
colCourseDescr :: (HasEntity c Course, HasDBRow s r, IsDBTable m a) =>
@ -53,5 +89,43 @@ colCourseDescrG =
crs <- view course
return $ courseCell crs
colsCourseCompleteG :: (HasCourse s, IsDBTable m a) => Colonnade Sortable s (DBCell m a)
colsCourseCompleteG = mconcat
[ sortable (Just "term") (i18nCell MsgTerm) $ do
crs <- view course
return $ termCell $ courseTerm crs
, sortable (Just "school") (i18nCell MsgCourseSchool) $ do
crs <- view course
return $ schoolCell (Just $ courseTerm crs) (courseSchool crs)
, sortable (Just "course") (i18nCell MsgCourse) $ do
crs <- view course
return $ courseCell crs
]
colsCourseLink :: (IsDBTable m a) => Getting CourseLink s CourseLink -> Colonnade Sortable s (DBCell m a)
colsCourseLink getter = mconcat
[ sortable (Just "term") (i18nCell MsgTerm) $ do
crs <- view getter
return $ termCell $ crs ^. _1
, sortable (Just "school") (i18nCell MsgCourseSchool) $ do
crs <- view getter
return $ schoolCell (Just $ crs ^. _1) (crs ^. _2)
, sortable (Just "course") (i18nCell MsgCourse) $ do
crs <- view getter
return $ courseLinkCell crs
]
colsCourseLink' :: (IsDBTable m a) => Getting CourseLink' s CourseLink' -> Colonnade Sortable s (DBCell m a)
colsCourseLink' getter = mconcat
[ sortable (Just "term") (i18nCell MsgTerm) $ do
crs <- view getter
return $ termCell $ crs ^. _1 . _unValue
, sortable (Just "school") (i18nCell MsgCourseSchool) $ do
crs <- view getter
return $ schoolCell (Just $ crs ^. _1 . _unValue) (crs ^. _2 . _unValue)
, sortable (Just "course") (i18nCell MsgCourse) $ do
crs <- view getter
return $ courseLinkCell' crs
]

5
templates/profileData.hamlet
View File

@ -8,6 +8,11 @@
<em> TODO: Hier alle Daten in Tabellen anzeigen!
<div .container>
<h2> Eigene Kurse
<div .container>
^{ownCourseTable}
<div .container>
<h2> Kursanmeldungen
<div .container>