diff --git a/models/users b/models/users index 7903f5760..2c8506b69 100644 --- a/models/users +++ b/models/users @@ -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 \ No newline at end of file diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 083e5656e..76795c743 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -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} +
+
+ ^{degreeTable} +
+
+ ^{studytermsTable} +
+
+ ^{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{..} \ No newline at end of file diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 0306d097c..417069c88 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -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 ] diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index 05d2463f3..d832b868b 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -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 diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 2b842d487..a7bfbfa9b 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -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)