Towards #291

src/Handler/Users.hs

@@ -23,6 +23,9 @@ hijackUserForm cID csrf = do
 
 getUsersR :: Handler Html
 getUsersR = do
+  -- schoolOptions <- runDB $ do
+  --   courses <- selectList [] [Asc CourseSchool] -- >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
+  --   optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
   let
     dbtColonnade = dbColonnade . mconcat $
       [ dbRow
@@ -87,9 +90,40 @@ getUsersR = do
           , SortColumn $ \user -> user E.^. UserMatrikelnummer
           )
         ]
-    , dbtFilter    = mempty
-    , dbtFilterUI  = mempty
-    , dbtStyle     = def
+    , dbtFilter    = Map.fromList -- OverloadedLists does not work with the templates
+        [ ( "user-search", FilterColumn $ \user criterion ->
+              let eFalse :: E.SqlExpr (E.Value Bool)
+                  eFalse = E.val False
+                  searchSql needle = E.castString (user E.^. UserDisplayName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)
+              in  if Set.null criterion then E.val True else -- TODO: why is this condition not needed?
+                  Set.foldr (\needle acc -> acc E.||. searchSql needle) eFalse (criterion :: Set.Set Text)
+          )
+        , ( "matriculation", FilterColumn $ \user criterion -> if
+              | Set.null criterion -> E.val True :: E.SqlExpr (E.Value Bool)
+              | otherwise          -> user E.^. UserMatrikelnummer `E.in_` E.valList (Set.toList criterion)
+          )
+        , ( "school", FilterColumn $ \user criterion -> if
+              | Set.null criterion -> E.val True :: E.SqlExpr (E.Value Bool)
+              | otherwise          -> let schools = E.valList (Set.toList criterion) in
+                  ( E.exists $ E.from $ \ulectr -> do
+                      E.where_ $ ulectr E.^. UserLecturerUser    E.==. user E.^. UserId
+                      E.where_ $ ulectr E.^. UserLecturerSchool `E.in_` schools
+                  ) E.||.
+                  ( E.exists $ E.from $ \uadmin -> do
+                      E.where_ $ uadmin E.^. UserAdminUser       E.==. user E.^. UserId
+                      E.where_ $ uadmin E.^. UserAdminSchool    `E.in_` schools
+                  )
+          )
+        ]
+    , dbtFilterUI  = \mPrev -> mconcat
+        [ prismAForm (singletonFilter "user-search")    mPrev $ aopt (searchField True)  (fslI MsgName)
+        -- , prismAForm (singletonFilter "matriculation" ) mPrev $ aopt (searchField False) (fslI MsgMatrikelNr)
+        , prismAForm (singletonFilter "matriculation" ) mPrev $ aopt matriculationField  (fslI MsgMatrikelNr)
+
+        -- , prismAForm (singletonFilter "school" )        mPrev $ aopt (selectField schoolOptions) (fslI MsgCourseSchool)
+        -- , prismAForm (singletonFilter "school" )        mPrev $ aopt (lift `hoistField` schoolField)         (fslI MsgCourseSchool)
+        ]
+    , dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
     , dbtParams    = def
     , dbtIdent     = "users" :: Text
     }

src/Handler/Utils/Form.hs

@@ -178,6 +178,9 @@ pointsFieldMax :: (Monad m, HandlerSite m ~ UniWorX) => Maybe Points -> Field m
 pointsFieldMax Nothing = pointsField
 pointsFieldMax (Just maxp) = checkBool (<= maxp) (MsgPointsTooHigh maxp) pointsField
 
+matriculationField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text
+matriculationField = textField -- no restrictions, since not everyone has a matriculation and pupils need special tags here
+
 termsActiveField :: Field Handler TermId
 termsActiveField = selectField $ optionsPersistKey [TermActive ==. True] [Desc TermStart] termName