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

filter email name ui combined

Browse Source
This commit is contained in:
Steffen Jost 2019-03-13 13:30:11 +01:00
parent 579225b4d0
commit a02cf61c82
4 changed files with 45 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
models/users
View File

@ -5,16 +5,16 @@ User json
lastAuthentication UTCTime Maybe lastAuthentication UTCTime Maybe
matrikelnummer Text Maybe matrikelnummer Text Maybe
email (CI Text) email (CI Text)
displayName Text displayName Text -- we always show the LDAP displayName only, but highlight the LDAP surname within (or appended if not contained)
surname Text -- always use: nameWidget displayName surname surname Text -- Name displayed through 'nameWidget displayName surname' which highlights surname within displayName
maxFavourites Int default=12 maxFavourites Int default=12 -- Number of last used course names to be remembered for quick links for convenience
theme Theme default='Default' theme Theme default='Default'
dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'" dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'"
dateFormat DateTimeFormat "default='%d.%m.%Y'" dateFormat DateTimeFormat "default='%d.%m.%Y'"
timeFormat DateTimeFormat "default='%R'" timeFormat DateTimeFormat "default='%R'"
downloadFiles Bool default=false downloadFiles Bool default=false -- Files should be opened in browser or downloaded
mailLanguages MailLanguages default='[]' mailLanguages MailLanguages default='[]'
notificationSettings NotificationSettings notificationSettings NotificationSettings -- Bit-array for which events email notification is requested by user
UniqueAuthentication ident UniqueAuthentication ident
UniqueEmail email UniqueEmail email
deriving Show Eq Generic deriving Show Eq Generic

11
src/Database/Esqueleto/Utils.hs
View File

@ -6,6 +6,7 @@ module Database.Esqueleto.Utils
, any, all , any, all
, SqlIn(..) , SqlIn(..)
, mkExactFilter, mkContainsFilter , mkExactFilter, mkContainsFilter
, anyFilter
) where ) where
import ClassyPrelude.Yesod hiding (isInfixOf, any, all) 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 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]) $(sqlInTuples [2..16])
-- | Example for usage of sqlIJproj -- | Example for usage of sqlIJproj
@ -74,7 +77,7 @@ mkExactFilter lenslike row criterias
-- | generic filter creation for dbTable -- | generic filter creation for dbTable
-- Given a lens-like function, make filter searching for needles in String-like elements -- 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) mkContainsFilter :: (E.SqlString a)
=> (t -> E.SqlExpr (E.Value a)) -- ^ getter from query to searched element => (t -> E.SqlExpr (E.Value a)) -- ^ getter from query to searched element
-> t -- ^ query row -> t -- ^ query row
@ -84,3 +87,9 @@ mkContainsFilter lenslike row criterias
| Set.null criterias = true | Set.null criterias = true
| otherwise = any (hasInfix $ lenslike row) criterias | 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

29
src/Handler/Course.hs
View File

@ -721,7 +721,7 @@ _rowUserSemester = _userTableFeatures . _1 . _Just . _studyFeaturesSemester
colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c) colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c)
colUserComment tid ssh csh = colUserComment tid ssh csh =
sortable (Just "course-user-note") (i18nCell MsgCourseUserNote) sortable (Just "note") (i18nCell MsgCourseUserNote)
$ \DBRow{ dbrOutput=(Entity uid _, _, mbNoteKey,_) } -> $ \DBRow{ dbrOutput=(Entity uid _, _, mbNoteKey,_) } ->
maybeEmpty mbNoteKey $ const $ maybeEmpty mbNoteKey $ const $
anchorCellM (courseLink <$> encrypt uid) (toWidget $ hasComment True) anchorCellM (courseLink <$> encrypt uid) (toWidget $ hasComment True)
@ -729,23 +729,23 @@ colUserComment tid ssh csh =
courseLink = CourseR tid ssh csh . CUserR courseLink = CourseR tid ssh csh . CUserR
colUserSemester :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c) 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 foldMap numCell . preview _rowUserSemester
colUserField :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c) 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) foldMap htmlCell . view (_userTableFeatures . _3)
colUserFieldShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c) 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) foldMap (htmlCell . shortStudyTerms) . view (_userTableFeatures . _3)
colUserDegree :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c) 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) foldMap htmlCell . preview (_userTableFeatures . _2 . _Just)
colUserDegreeShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c) 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) foldMap (htmlCell . shortStudyDegree) . preview (_userTableFeatures . _2 . _Just)
makeCourseUserTable :: CourseId -> _ -> _ -> DB Widget makeCourseUserTable :: CourseId -> _ -> _ -> DB Widget
@ -763,13 +763,13 @@ 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 $ queryFeaturesDegree >>> (E.?. StudyDegreeName)) , ("degree" , SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeName))
, ("course-user-degree-short", SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand)) , ("degree-short", SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
, ("course-user-field" , SortColumn $ queryFeaturesField >>> (E.?. StudyTermsName)) , ("field" , SortColumn $ queryFeaturesField >>> (E.?. StudyTermsName))
, ("course-user-field-short" , SortColumn $ queryFeaturesField >>> (E.?. StudyTermsShorthand)) , ("field-short" , SortColumn $ queryFeaturesField >>> (E.?. StudyTermsShorthand))
, ("course-user-semesternr" , SortColumn $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester)) , ("semesternr" , SortColumn $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
, ("course-registration" , SortColumn $ queryParticipant >>> (E.^. CourseParticipantRegistration)) , ("registration", SortColumn $ queryParticipant >>> (E.^. CourseParticipantRegistration))
, ("course-user-note" , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date , ("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)
return . E.max_ $ edit E.^. CourseUserNoteEditTime return . E.max_ $ edit E.^. CourseUserNoteEditTime
@ -779,6 +779,7 @@ makeCourseUserTable cid colChoices psValidator =
[ fltrUserNameLink queryUser [ fltrUserNameLink queryUser
, fltrUserEmail queryUser , fltrUserEmail queryUser
, fltrUserMatriclenr queryUser , fltrUserMatriclenr queryUser
, fltrUserNameEmail 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 $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester)) , ("course-user-semesternr", FilterColumn $ mkExactFilter $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
@ -786,7 +787,7 @@ makeCourseUserTable cid colChoices psValidator =
-- , ("course-user-note", error "TODO") -- TODO -- , ("course-user-note", error "TODO") -- TODO
] ]
dbtFilterUI mPrev = mconcat dbtFilterUI mPrev = mconcat
[ fltrUserNameLinkUI mPrev [ fltrUserNameEmailUI mPrev
, fltrUserMatriclenrUI mPrev , fltrUserMatriclenrUI mPrev
] ]
dbtParams = def dbtParams = def

25
src/Handler/Utils/Table/Columns.hs
View File

@ -12,7 +12,7 @@ import Import
-- import Text.Blaze (ToMarkup(..)) -- import Text.Blaze (ToMarkup(..))
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
import Database.Esqueleto.Utils import Database.Esqueleto.Utils as E
import Utils.Lens import Utils.Lens
import Handler.Utils import Handler.Utils
@ -97,15 +97,16 @@ fltrUserDisplayName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bo
-> (d, FilterColumn t) -> (d, FilterColumn t)
fltrUserDisplayName queryUser = ( "user-display-name", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserDisplayName)) fltrUserDisplayName queryUser = ( "user-display-name", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserDisplayName))
-- --TODO -- | Searche all names, i.e. DisplayName, Surname, EMail
-- fltrUserAny :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d) fltrUserNameEmail :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
-- => (a -> E.SqlExpr (Entity User)) => (a -> E.SqlExpr (Entity User))
-- -> (d, FilterColumn t) -> (d, FilterColumn t)
-- fltrUserAny queryUser = ( "user-name-any", FilterColumn $ mkContainsFilter (queryAny . queryName)) fltrUserNameEmail queryUser = ( "user-name-email", FilterColumn $ anyFilter
-- where [ mkContainsFilter $ queryUser >>> (E.^. UserDisplayName)
-- queryAny user = queryUser >>> (E.^. UserDisplayName) , mkContainsFilter $ queryUser >>> (E.^. UserSurname)
, mkContainsFilter $ queryUser >>> (E.^. UserEmail)
]
)
fltrUserNameLinkUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) fltrUserNameLinkUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
fltrUserNameLinkUI = fltrUserNameUI fltrUserNameLinkUI = fltrUserNameUI
@ -114,6 +115,10 @@ fltrUserNameUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map F
fltrUserNameUI mPrev = fltrUserNameUI mPrev =
prismAForm (singletonFilter "user-name") mPrev $ aopt (searchField True) (fslI MsgCourseMembers) 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 -- Matriclenumber
colUserMatriclenr :: (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c) colUserMatriclenr :: (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)