table for candidates added to admin-features
This commit is contained in:
Steffen Jost
parent
a76090a31f
commit
579225b4d0
@ -47,7 +47,7 @@ StudyTerms -- Studiengang
|
||||
name Text Maybe
|
||||
Primary key
|
||||
StudyTermCandidate
|
||||
incidence UUID
|
||||
incidence UUID --random id per login to associate matching pairs
|
||||
key Int
|
||||
name Text
|
||||
deriving Show Eq Ord
|
||||
@ -165,14 +165,23 @@ postAdminErrMsgR = do
|
||||
|
||||
getAdminFeaturesR :: Handler Html
|
||||
getAdminFeaturesR = do
|
||||
degreeTable <- runDB mkDegreeTable
|
||||
studytermsTable <- runDB mkStudytermsTable
|
||||
(degreeTable,studytermsTable,candidateTable) <- runDB $ (,,)
|
||||
<$> mkDegreeTable
|
||||
<*> mkStudytermsTable
|
||||
<*> mkCandidateTable
|
||||
|
||||
siteLayoutMsg MsgAdminFeaturesHeading $ do
|
||||
setTitleI MsgAdminFeaturesHeading
|
||||
[whamlet|
|
||||
^{degreeTable}
|
||||
^{studytermsTable}
|
||||
<div .container>
|
||||
<section>
|
||||
^{degreeTable}
|
||||
<div .container>
|
||||
<section>
|
||||
^{studytermsTable}
|
||||
<div .container>
|
||||
<section>
|
||||
^{candidateTable}
|
||||
|]
|
||||
where
|
||||
mkDegreeTable =
|
||||
@ -219,4 +228,27 @@ getAdminFeaturesR = do
|
||||
dbtFilterUI = mempty
|
||||
dbtParams = def
|
||||
psValidator = def & defaultSorting [SortAscBy "studyterms-name", SortAscBy "studyterms-short", SortAscBy "studyterms-key"]
|
||||
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{..}
|
||||
@ -660,8 +660,8 @@ type UserTableExpr = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity
|
||||
`E.LeftOuterJoin`
|
||||
(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 = id
|
||||
-- forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a)
|
||||
-- forceUserTableType = id
|
||||
|
||||
-- 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
|
||||
@ -674,17 +674,14 @@ queryParticipant = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
|
||||
queryUserNote :: UserTableExpr -> E.SqlExpr (Maybe (Entity CourseUserNote))
|
||||
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)))
|
||||
queryUserFeatures = $(sqlLOJproj 3 3)
|
||||
queryFeaturesStudy :: UserTableExpr -> E.SqlExpr (Maybe (Entity StudyFeatures))
|
||||
queryFeaturesStudy = $(sqlIJproj 3 1) . $(sqlLOJproj 3 3)
|
||||
|
||||
queryFeaturesStudy :: (a `E.InnerJoin` b `E.InnerJoin` c) -> a
|
||||
queryFeaturesStudy = $(sqlIJproj 3 1)
|
||||
queryFeaturesDegree :: UserTableExpr -> E.SqlExpr (Maybe (Entity StudyDegree))
|
||||
queryFeaturesDegree = $(sqlIJproj 3 2) . $(sqlLOJproj 3 3)
|
||||
|
||||
queryFeaturesDegree :: (a `E.InnerJoin` b `E.InnerJoin` c) -> b
|
||||
queryFeaturesDegree = $(sqlIJproj 3 2)
|
||||
|
||||
queryFeaturesField :: (a `E.InnerJoin` b `E.InnerJoin` c) -> c
|
||||
queryFeaturesField = $(sqlIJproj 3 3)
|
||||
queryFeaturesField :: UserTableExpr -> E.SqlExpr (Maybe (Entity StudyTerms))
|
||||
queryFeaturesField = $(sqlIJproj 3 3) . $(sqlLOJproj 3 3)
|
||||
|
||||
|
||||
userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery ( E.SqlExpr (Entity User)
|
||||
@ -766,12 +763,12 @@ makeCourseUserTable cid colChoices psValidator =
|
||||
, sortUserDisplayName queryUser -- needed for initial sorting
|
||||
, sortUserEmail queryUser
|
||||
, sortUserMatriclenr queryUser
|
||||
, ("course-user-degree" , SortColumn $ queryUserFeatures >>> queryFeaturesDegree >>> (E.?. StudyDegreeName))
|
||||
, ("course-user-degree-short", SortColumn $ queryUserFeatures >>> queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
|
||||
, ("course-user-field" , SortColumn $ queryUserFeatures >>> queryFeaturesField >>> (E.?. StudyTermsName))
|
||||
, ("course-user-field-short" , SortColumn $ queryUserFeatures >>> queryFeaturesField >>> (E.?. StudyTermsShorthand))
|
||||
, ("course-user-semesternr" , SortColumn $ queryUserFeatures >>> queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
|
||||
, ("course-registration" , SortColumn $ queryParticipant >>> (E.^. CourseParticipantRegistration))
|
||||
, ("course-user-degree" , SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeName))
|
||||
, ("course-user-degree-short", SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
|
||||
, ("course-user-field" , SortColumn $ queryFeaturesField >>> (E.?. StudyTermsName))
|
||||
, ("course-user-field-short" , SortColumn $ queryFeaturesField >>> (E.?. StudyTermsShorthand))
|
||||
, ("course-user-semesternr" , SortColumn $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
|
||||
, ("course-registration" , SortColumn $ queryParticipant >>> (E.^. CourseParticipantRegistration))
|
||||
, ("course-user-note" , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
|
||||
E.sub_select . E.from $ \edit -> do
|
||||
E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote)
|
||||
@ -784,7 +781,7 @@ makeCourseUserTable cid colChoices psValidator =
|
||||
, fltrUserMatriclenr queryUser
|
||||
-- , ("course-user-degree", 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-user-note", error "TODO") -- TODO
|
||||
]
|
||||
|
||||
@ -42,6 +42,9 @@ maybeCell = flip foldMap
|
||||
htmlCell :: (IsDBTable m a, ToMarkup c) => c -> DBCell m a
|
||||
htmlCell = cell . toWidget . toMarkup
|
||||
|
||||
pathPieceCell :: (IsDBTable m a, PathPiece p) => p -> DBCell m a
|
||||
pathPieceCell = cell . toWidget . toPathPiece
|
||||
|
||||
---------------------
|
||||
-- Icon cells
|
||||
|
||||
|
||||
@ -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
|
||||
) => DBTable
|
||||
{ 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'
|
||||
, dbtColonnade :: Colonnade h r' (DBCell m x)
|
||||
, dbtSorting :: Map SortingKey (SortColumn t)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user