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

Filter-UI course participants improved

Browse Source
This commit is contained in:
Steffen Jost 2019-04-04 18:01:46 +02:00
parent 431affe6ec
commit 6da0850add
2 changed files with 48 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,8 +5,9 @@ module Database.Esqueleto.Utils
, isInfixOf, hasInfix
, any, all
, SqlIn(..)
, mkExactFilter, mkContainsFilter
, anyFilter
, mkExactFilter, mkExactFilterWith
, mkContainsFilter
, anyFilter, allFilter
) where
import ClassyPrelude.Yesod hiding (isInfixOf, any, all)
@ -74,13 +75,22 @@ _queryFeaturesDegree = $(sqlIJproj 3 2)
-- Given a lens-like function, make filter for exact matches in a collection
-- (Generalizing from Set to Foldable ok here, but gives ambigouus types elsewhere)
mkExactFilter :: (PersistField 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
-> Set.Set a -- ^ needle collection
-> E.SqlExpr (E.Value Bool)
mkExactFilter lenslike row criterias
mkExactFilter = mkExactFilterWith id
-- | like @mkExactFiler@ but allows for conversion; convenient in conjunction with @anyFilter@ and @allFilter@
mkExactFilterWith :: (PersistField b)
=> (a -> b) -- ^ type conversion
-> (t -> E.SqlExpr (E.Value b)) -- ^ getter from query to searched element
-> t -- ^ query row
-> Set.Set a -- ^ needle collection
-> E.SqlExpr (E.Value Bool)
mkExactFilterWith cast lenslike row criterias
| Set.null criterias = true
| otherwise = lenslike row `E.in_` E.valList (Set.toList criterias)
| otherwise = lenslike row `E.in_` E.valList (cast <$> Set.toList criterias)
-- | generic filter creation for dbTable
-- Given a lens-like function, make filter searching for needles in String-like elements
@ -94,9 +104,22 @@ 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)
-- | Combine several filters, using logical or
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
aux fltr acc = fltr needle criterias E.||. acc
-- | Combine several filters, using logical and
allFilter :: (Foldable f)
=> f (t -> Set.Set Text-> E.SqlExpr (E.Value Bool))
-> t
-> Set.Set Text
-> E.SqlExpr (E.Value Bool)
allFilter fltrs needle criterias = F.foldr aux true fltrs
where
aux fltr acc = fltr needle criterias E.&&. acc

19
src/Handler/Course.hs
View File

@ -862,15 +862,28 @@ makeCourseUserTable cid colChoices psValidator = do
, fltrUserEmail queryUser
, fltrUserMatriclenr queryUser
, fltrUserNameEmail queryUser
-- , ("course-user-degree", error "TODO") -- TODO
-- , ("field" , FilterColumn $ queryFeaturesField error "TODO") -- TODO
, ("semesternr", FilterColumn $ E.mkExactFilter $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
, ("field-name" , FilterColumn $ E.mkContainsFilter $ queryFeaturesField >>> (E.?. StudyTermsName))
, ("field-short" , FilterColumn $ E.mkContainsFilter $ queryFeaturesField >>> (E.?. StudyTermsShorthand))
, ("field-key" , FilterColumn $ E.mkExactFilter $ queryFeaturesField >>> (E.?. StudyTermsKey))
, ("field" , FilterColumn $ E.anyFilter
[ E.mkContainsFilter $ queryFeaturesField >>> (E.?. StudyTermsName)
, E.mkContainsFilter $ queryFeaturesField >>> (E.?. StudyTermsShorthand)
, E.mkExactFilterWith readMay $ queryFeaturesField >>> (E.?. StudyTermsKey)
] )
, ("degree" , FilterColumn $ E.anyFilter
[ E.mkContainsFilter $ queryFeaturesDegree >>> (E.?. StudyDegreeName)
, E.mkContainsFilter $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand)
, E.mkExactFilterWith readMay $ queryFeaturesDegree >>> (E.?. StudyDegreeKey)
] )
, ("semesternr" , FilterColumn $ E.mkExactFilter $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
-- , ("course-registration", error "TODO") -- TODO
-- , ("course-user-note", error "TODO") -- TODO
]
dbtFilterUI mPrev = mconcat
[ fltrUserNameEmailUI mPrev
, fltrUserMatriclenrUI mPrev
, prismAForm (singletonFilter "degree") mPrev $ aopt (searchField False) (fslI MsgStudyFeatureDegree)
, prismAForm (singletonFilter "field") mPrev $ aopt (searchField False) (fslI MsgCourseStudyFeature)
]
dbtParams = DBParamsForm
{ dbParamsFormMethod = POST