From a02cf61c82eaa262d56eb090ea543f4e85c7058f Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 13 Mar 2019 13:30:11 +0100 Subject: [PATCH] filter email name ui combined --- models/users | 10 +++++----- src/Database/Esqueleto/Utils.hs | 11 ++++++++++- src/Handler/Course.hs | 29 +++++++++++++++-------------- src/Handler/Utils/Table/Columns.hs | 25 +++++++++++++++---------- 4 files changed, 45 insertions(+), 30 deletions(-) diff --git a/models/users b/models/users index 2c8506b69..60909e42c 100644 --- a/models/users +++ b/models/users @@ -5,16 +5,16 @@ User json lastAuthentication UTCTime Maybe matrikelnummer Text Maybe email (CI Text) - displayName Text - surname Text -- always use: nameWidget displayName surname - maxFavourites Int default=12 + displayName Text -- we always show the LDAP displayName only, but highlight the LDAP surname within (or appended if not contained) + surname Text -- Name displayed through 'nameWidget displayName surname' which highlights surname within displayName + maxFavourites Int default=12 -- Number of last used course names to be remembered for quick links for convenience theme Theme default='Default' dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'" dateFormat DateTimeFormat "default='%d.%m.%Y'" timeFormat DateTimeFormat "default='%R'" - downloadFiles Bool default=false + downloadFiles Bool default=false -- Files should be opened in browser or downloaded mailLanguages MailLanguages default='[]' - notificationSettings NotificationSettings + notificationSettings NotificationSettings -- Bit-array for which events email notification is requested by user UniqueAuthentication ident UniqueEmail email deriving Show Eq Generic diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 4e3e85e22..2dab7cf8d 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -6,6 +6,7 @@ module Database.Esqueleto.Utils , any, all , SqlIn(..) , mkExactFilter, mkContainsFilter + , anyFilter ) where import ClassyPrelude.Yesod hiding (isInfixOf, any, all) @@ -53,6 +54,8 @@ all :: Foldable f => all test = F.foldr (\needle acc -> acc E.&&. test needle) true + +-- Allow usage of Tuples as DbtRowKey, i.e. SqlIn instances for tuples $(sqlInTuples [2..16]) -- | Example for usage of sqlIJproj @@ -74,7 +77,7 @@ mkExactFilter lenslike row criterias -- | generic filter creation for dbTable -- Given a lens-like function, make filter searching for needles in String-like elements --- (Generalizing from Set to Foldable ok here, but gives ambigouus types elsewhere) +-- (Keep Set here to ensure that there are no duplicates) mkContainsFilter :: (E.SqlString a) => (t -> E.SqlExpr (E.Value a)) -- ^ getter from query to searched element -> t -- ^ query row @@ -84,3 +87,9 @@ mkContainsFilter lenslike row criterias | Set.null criterias = true | otherwise = any (hasInfix $ lenslike row) criterias + +anyFilter :: (Foldable f) => f (t -> Set.Set Text-> E.SqlExpr (E.Value Bool)) + -> t -> Set.Set Text-> E.SqlExpr (E.Value Bool) +anyFilter fltrs needle criterias = F.foldr aux false fltrs + where + aux fltr acc = fltr needle criterias E.||. acc \ No newline at end of file diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 417069c88..aa839b697 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -721,7 +721,7 @@ _rowUserSemester = _userTableFeatures . _1 . _Just . _studyFeaturesSemester colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c) colUserComment tid ssh csh = - sortable (Just "course-user-note") (i18nCell MsgCourseUserNote) + sortable (Just "note") (i18nCell MsgCourseUserNote) $ \DBRow{ dbrOutput=(Entity uid _, _, mbNoteKey,_) } -> maybeEmpty mbNoteKey $ const $ anchorCellM (courseLink <$> encrypt uid) (toWidget $ hasComment True) @@ -729,23 +729,23 @@ colUserComment tid ssh csh = courseLink = CourseR tid ssh csh . CUserR colUserSemester :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c) -colUserSemester = sortable (Just "course-user-semesternr") (i18nCell MsgStudyFeatureAge) $ +colUserSemester = sortable (Just "semesternr") (i18nCell MsgStudyFeatureAge) $ foldMap numCell . preview _rowUserSemester colUserField :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c) -colUserField = sortable (Just "course-user-field") (i18nCell MsgCourseStudyFeature) $ +colUserField = sortable (Just "field") (i18nCell MsgCourseStudyFeature) $ foldMap htmlCell . view (_userTableFeatures . _3) colUserFieldShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c) -colUserFieldShort = sortable (Just "course-user-field-short") (i18nCell MsgCourseStudyFeature) $ +colUserFieldShort = sortable (Just "field-short") (i18nCell MsgCourseStudyFeature) $ foldMap (htmlCell . shortStudyTerms) . view (_userTableFeatures . _3) colUserDegree :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c) -colUserDegree = sortable (Just "course-user-degree") (i18nCell MsgStudyFeatureDegree) $ +colUserDegree = sortable (Just "degree") (i18nCell MsgStudyFeatureDegree) $ foldMap htmlCell . preview (_userTableFeatures . _2 . _Just) colUserDegreeShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c) -colUserDegreeShort = sortable (Just "course-user-degree-short") (i18nCell MsgStudyFeatureDegree) $ +colUserDegreeShort = sortable (Just "degree-short") (i18nCell MsgStudyFeatureDegree) $ foldMap (htmlCell . shortStudyDegree) . preview (_userTableFeatures . _2 . _Just) makeCourseUserTable :: CourseId -> _ -> _ -> DB Widget @@ -763,13 +763,13 @@ makeCourseUserTable cid colChoices psValidator = , sortUserDisplayName queryUser -- needed for initial sorting , sortUserEmail queryUser , sortUserMatriclenr queryUser - , ("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 + , ("degree" , SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeName)) + , ("degree-short", SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand)) + , ("field" , SortColumn $ queryFeaturesField >>> (E.?. StudyTermsName)) + , ("field-short" , SortColumn $ queryFeaturesField >>> (E.?. StudyTermsShorthand)) + , ("semesternr" , SortColumn $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester)) + , ("registration", SortColumn $ queryParticipant >>> (E.^. CourseParticipantRegistration)) + , ("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) return . E.max_ $ edit E.^. CourseUserNoteEditTime @@ -779,6 +779,7 @@ makeCourseUserTable cid colChoices psValidator = [ fltrUserNameLink queryUser , fltrUserEmail queryUser , fltrUserMatriclenr queryUser + , fltrUserNameEmail queryUser -- , ("course-user-degree", error "TODO") -- TODO -- , ("course-user-field" , error "TODO") -- TODO , ("course-user-semesternr", FilterColumn $ mkExactFilter $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester)) @@ -786,7 +787,7 @@ makeCourseUserTable cid colChoices psValidator = -- , ("course-user-note", error "TODO") -- TODO ] dbtFilterUI mPrev = mconcat - [ fltrUserNameLinkUI mPrev + [ fltrUserNameEmailUI mPrev , fltrUserMatriclenrUI mPrev ] dbtParams = def diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs index b3791fe47..52e8b5dfe 100644 --- a/src/Handler/Utils/Table/Columns.hs +++ b/src/Handler/Utils/Table/Columns.hs @@ -12,7 +12,7 @@ import Import -- import Text.Blaze (ToMarkup(..)) import qualified Database.Esqueleto as E -import Database.Esqueleto.Utils +import Database.Esqueleto.Utils as E import Utils.Lens import Handler.Utils @@ -97,15 +97,16 @@ fltrUserDisplayName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bo -> (d, FilterColumn t) fltrUserDisplayName queryUser = ( "user-display-name", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserDisplayName)) --- --TODO --- fltrUserAny :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d) --- => (a -> E.SqlExpr (Entity User)) --- -> (d, FilterColumn t) --- fltrUserAny queryUser = ( "user-name-any", FilterColumn $ mkContainsFilter (queryAny . queryName)) --- where --- queryAny user = queryUser >>> (E.^. UserDisplayName) - - +-- | Searche all names, i.e. DisplayName, Surname, EMail +fltrUserNameEmail :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d) + => (a -> E.SqlExpr (Entity User)) + -> (d, FilterColumn t) +fltrUserNameEmail queryUser = ( "user-name-email", FilterColumn $ anyFilter + [ mkContainsFilter $ queryUser >>> (E.^. UserDisplayName) + , mkContainsFilter $ queryUser >>> (E.^. UserSurname) + , mkContainsFilter $ queryUser >>> (E.^. UserEmail) + ] + ) fltrUserNameLinkUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) fltrUserNameLinkUI = fltrUserNameUI @@ -114,6 +115,10 @@ fltrUserNameUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map F fltrUserNameUI mPrev = prismAForm (singletonFilter "user-name") mPrev $ aopt (searchField True) (fslI MsgCourseMembers) +fltrUserNameEmailUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) +fltrUserNameEmailUI mPrev = + prismAForm (singletonFilter "user-name-email") mPrev $ aopt (searchField True) (fslI MsgCourseMembers) + ------------------- -- Matriclenumber colUserMatriclenr :: (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)