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

table for candidates added to admin-features

Browse Source
This commit is contained in:
Steffen Jost 2019-03-13 11:20:08 +01:00
parent a76090a31f
commit 579225b4d0
5 changed files with 56 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
models/users
View File

@ -47,7 +47,7 @@ StudyTerms -- Studiengang
name Text Maybe name Text Maybe
Primary key Primary key
StudyTermCandidate StudyTermCandidate
incidence UUID incidence UUID --random id per login to associate matching pairs
key Int key Int
name Text name Text
deriving Show Eq Ord deriving Show Eq Ord

40
src/Handler/Admin.hs
View File

@ -165,14 +165,23 @@ postAdminErrMsgR = do
getAdminFeaturesR :: Handler Html getAdminFeaturesR :: Handler Html
getAdminFeaturesR = do getAdminFeaturesR = do
degreeTable <- runDB mkDegreeTable (degreeTable,studytermsTable,candidateTable) <- runDB $ (,,)
studytermsTable <- runDB mkStudytermsTable <$> mkDegreeTable
<*> mkStudytermsTable
<*> mkCandidateTable
siteLayoutMsg MsgAdminFeaturesHeading $ do siteLayoutMsg MsgAdminFeaturesHeading $ do
setTitleI MsgAdminFeaturesHeading setTitleI MsgAdminFeaturesHeading
[whamlet| [whamlet|
^{degreeTable} <div .container>
^{studytermsTable} <section>
^{degreeTable}
<div .container>
<section>
^{studytermsTable}
<div .container>
<section>
^{candidateTable}
|] |]
where where
mkDegreeTable = mkDegreeTable =
@ -220,3 +229,26 @@ getAdminFeaturesR = do
dbtParams = def dbtParams = def
psValidator = def & defaultSorting [SortAscBy "studyterms-name", SortAscBy "studyterms-short", SortAscBy "studyterms-key"] psValidator = def & defaultSorting [SortAscBy "studyterms-name", SortAscBy "studyterms-short", SortAscBy "studyterms-key"]
in dbTableWidget' psValidator DBTable{..} in dbTableWidget' psValidator DBTable{..}
mkCandidateTable =
let dbtIdent = "admin-termcandidate" :: Text
dbtStyle = def
dbtSQLQuery :: (E.SqlExpr (Entity StudyTermCandidate)) -> E.SqlQuery ( E.SqlExpr (Entity StudyTermCandidate))
dbtSQLQuery = return
dbtRowKey = (E.^. StudyTermCandidateId)
dbtProj = return
dbtColonnade = mconcat
[ sortable (Just "termcandidate-key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _entityVal . _studyTermCandidateKey))
, sortable (Just "termcandidate-name") (i18nCell MsgStudyTermsName) (textCell . view (_dbrOutput . _entityVal . _studyTermCandidateName))
, sortable (Just "termcandidate-incidence") (i18nCell MsgStudyTermsShort) (pathPieceCell . view (_dbrOutput . _entityVal . _studyTermCandidateIncidence))
]
dbtSorting = Map.fromList
[ ("termcandidate-key" , SortColumn (E.^. StudyTermCandidateKey))
, ("termcandidate-name" , SortColumn (E.^. StudyTermCandidateName))
, ("termcandidate-incidence", SortColumn (E.^. StudyTermCandidateIncidence))
]
dbtFilter = mempty
dbtFilterUI = mempty
dbtParams = def
psValidator = def & defaultSorting [SortAscBy "termcandidate-name", SortAscBy "termcandidate-key"]
in dbTableWidget' psValidator DBTable{..}

33
src/Handler/Course.hs
View File

@ -660,8 +660,8 @@ type UserTableExpr = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity
`E.LeftOuterJoin` `E.LeftOuterJoin`
(E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin`E.SqlExpr (Maybe (Entity StudyTerms))) (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin`E.SqlExpr (Maybe (Entity StudyTerms)))
forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a) -- forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a)
forceUserTableType = id -- forceUserTableType = id
-- Sql-Getters for this query, used for sorting and filtering (cannot be lenses due to being Esqueleto expressions) -- Sql-Getters for this query, used for sorting and filtering (cannot be lenses due to being Esqueleto expressions)
-- This ought to ease refactoring the query -- This ought to ease refactoring the query
@ -674,17 +674,14 @@ queryParticipant = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
queryUserNote :: UserTableExpr -> E.SqlExpr (Maybe (Entity CourseUserNote)) queryUserNote :: UserTableExpr -> E.SqlExpr (Maybe (Entity CourseUserNote))
queryUserNote = $(sqlLOJproj 3 2) queryUserNote = $(sqlLOJproj 3 2)
queryUserFeatures :: UserTableExpr -> (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin`E.SqlExpr (Maybe (Entity StudyTerms))) queryFeaturesStudy :: UserTableExpr -> E.SqlExpr (Maybe (Entity StudyFeatures))
queryUserFeatures = $(sqlLOJproj 3 3) queryFeaturesStudy = $(sqlIJproj 3 1) . $(sqlLOJproj 3 3)
queryFeaturesStudy :: (a `E.InnerJoin` b `E.InnerJoin` c) -> a queryFeaturesDegree :: UserTableExpr -> E.SqlExpr (Maybe (Entity StudyDegree))
queryFeaturesStudy = $(sqlIJproj 3 1) queryFeaturesDegree = $(sqlIJproj 3 2) . $(sqlLOJproj 3 3)
queryFeaturesDegree :: (a `E.InnerJoin` b `E.InnerJoin` c) -> b queryFeaturesField :: UserTableExpr -> E.SqlExpr (Maybe (Entity StudyTerms))
queryFeaturesDegree = $(sqlIJproj 3 2) queryFeaturesField = $(sqlIJproj 3 3) . $(sqlLOJproj 3 3)
queryFeaturesField :: (a `E.InnerJoin` b `E.InnerJoin` c) -> c
queryFeaturesField = $(sqlIJproj 3 3)
userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery ( E.SqlExpr (Entity User) userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery ( E.SqlExpr (Entity User)
@ -766,12 +763,12 @@ makeCourseUserTable cid colChoices psValidator =
, sortUserDisplayName queryUser -- needed for initial sorting , sortUserDisplayName queryUser -- needed for initial sorting
, sortUserEmail queryUser , sortUserEmail queryUser
, sortUserMatriclenr queryUser , sortUserMatriclenr queryUser
, ("course-user-degree" , SortColumn $ queryUserFeatures >>> queryFeaturesDegree >>> (E.?. StudyDegreeName)) , ("course-user-degree" , SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeName))
, ("course-user-degree-short", SortColumn $ queryUserFeatures >>> queryFeaturesDegree >>> (E.?. StudyDegreeShorthand)) , ("course-user-degree-short", SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
, ("course-user-field" , SortColumn $ queryUserFeatures >>> queryFeaturesField >>> (E.?. StudyTermsName)) , ("course-user-field" , SortColumn $ queryFeaturesField >>> (E.?. StudyTermsName))
, ("course-user-field-short" , SortColumn $ queryUserFeatures >>> queryFeaturesField >>> (E.?. StudyTermsShorthand)) , ("course-user-field-short" , SortColumn $ queryFeaturesField >>> (E.?. StudyTermsShorthand))
, ("course-user-semesternr" , SortColumn $ queryUserFeatures >>> queryFeaturesStudy >>> (E.?. StudyFeaturesSemester)) , ("course-user-semesternr" , SortColumn $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
, ("course-registration" , SortColumn $ queryParticipant >>> (E.^. CourseParticipantRegistration)) , ("course-registration" , SortColumn $ queryParticipant >>> (E.^. CourseParticipantRegistration))
, ("course-user-note" , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date , ("course-user-note" , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
E.sub_select . E.from $ \edit -> do E.sub_select . E.from $ \edit -> do
E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote) E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote)
@ -784,7 +781,7 @@ makeCourseUserTable cid colChoices psValidator =
, fltrUserMatriclenr queryUser , fltrUserMatriclenr queryUser
-- , ("course-user-degree", error "TODO") -- TODO -- , ("course-user-degree", error "TODO") -- TODO
-- , ("course-user-field" , error "TODO") -- TODO -- , ("course-user-field" , error "TODO") -- TODO
, ("course-user-semesternr", FilterColumn $ mkExactFilter $ queryUserFeatures >>> queryFeaturesStudy >>> (E.?. StudyFeaturesSemester)) , ("course-user-semesternr", FilterColumn $ mkExactFilter $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
-- , ("course-registration", error "TODO") -- TODO -- , ("course-registration", error "TODO") -- TODO
-- , ("course-user-note", error "TODO") -- TODO -- , ("course-user-note", error "TODO") -- TODO
] ]

3
src/Handler/Utils/Table/Cells.hs
View File

@ -42,6 +42,9 @@ maybeCell = flip foldMap
htmlCell :: (IsDBTable m a, ToMarkup c) => c -> DBCell m a htmlCell :: (IsDBTable m a, ToMarkup c) => c -> DBCell m a
htmlCell = cell . toWidget . toMarkup htmlCell = cell . toWidget . toMarkup
pathPieceCell :: (IsDBTable m a, PathPiece p) => p -> DBCell m a
pathPieceCell = cell . toWidget . toPathPiece
--------------------- ---------------------
-- Icon cells -- Icon cells

2
src/Handler/Utils/Table/Pagination.hs
View File

@ -373,7 +373,7 @@ data DBTable m x = forall a r r' h i t k k'.
, E.From E.SqlQuery E.SqlExpr E.SqlBackend t , E.From E.SqlQuery E.SqlExpr E.SqlBackend t
) => DBTable ) => DBTable
{ dbtSQLQuery :: t -> E.SqlQuery a { dbtSQLQuery :: t -> E.SqlQuery a
, dbtRowKey :: t -> k , dbtRowKey :: t -> k -- ^ required for table forms; always same key for repeated requests. For joins: return unique tuples.
, dbtProj :: DBRow r -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) r' , dbtProj :: DBRow r -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) r'
, dbtColonnade :: Colonnade h r' (DBCell m x) , dbtColonnade :: Colonnade h r' (DBCell m x)
, dbtSorting :: Map SortingKey (SortColumn t) , dbtSorting :: Map SortingKey (SortColumn t)