From 90e4a620f0c1671ff332db1910c176e58ccbac06 Mon Sep 17 00:00:00 2001 From: ros Date: Mon, 31 May 2021 16:23:51 +0200 Subject: [PATCH] feat(course material): first two filters --- .../courses/material/de-de-formal.msg | 2 ++ .../categories/courses/material/en-eu.msg | 2 ++ src/Application.hs | 8 ++++++ src/Handler/Material.hs | 25 +++++++++++++------ test/Database/Fill.hs | 18 +++++++++++++ 5 files changed, 48 insertions(+), 7 deletions(-) diff --git a/messages/uniworx/categories/courses/material/de-de-formal.msg b/messages/uniworx/categories/courses/material/de-de-formal.msg index 63311eb1d..e8fe8430c 100644 --- a/messages/uniworx/categories/courses/material/de-de-formal.msg +++ b/messages/uniworx/categories/courses/material/de-de-formal.msg @@ -30,3 +30,5 @@ MaterialVideoDownload: Herunterladen MaterialFree: Kursmaterialien ohne Anmeldung zugänglich AccessibleSince: Verfügbar seit VisibleFrom: Veröffentlicht +FilterMaterialNameSearch !ident-ok: Name +FilterMaterialTypeAndDescriptionSearch: Art oder Beschreibung \ No newline at end of file diff --git a/messages/uniworx/categories/courses/material/en-eu.msg b/messages/uniworx/categories/courses/material/en-eu.msg index 8c2b0c202..4cc59f300 100644 --- a/messages/uniworx/categories/courses/material/en-eu.msg +++ b/messages/uniworx/categories/courses/material/en-eu.msg @@ -30,3 +30,5 @@ MaterialVideoDownload: Download MaterialFree: Course material is publicly available. AccessibleSince: Accessible since VisibleFrom: Published +FilterMaterialNameSearch !ident-ok: Name +FilterMaterialTypeAndDescriptionSearch: Type or description \ No newline at end of file diff --git a/src/Application.hs b/src/Application.hs index 0c0fcbbd5..9d5e8ebce 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -710,3 +710,11 @@ addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do PWHashConf{..} <- getsYesod $ view _appAuthPWHash (AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength void $ insert User{..} + + + + + + + + diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 2e0e961b5..a09ea741a 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -102,17 +102,17 @@ getMaterialListR tid ssh csh = do & forceFilter "may-access" (Any True) dbTableWidget' psValidator DBTable { dbtIdent = "material-list" :: Text - , dbtStyle = def + , dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } , dbtParams = def - , dbtSQLQuery = \material -> do + , dbtSQLQuery = \material -> do E.where_ $ material E.^. MaterialCourse E.==. E.val cid let filesNum :: E.SqlExpr (E.Value Int64) filesNum = E.subSelectCount . E.from $ \materialFile -> E.where_ $ materialFile E.^. MaterialFileMaterial E.==. material E.^. MaterialId return (material, filesNum) , dbtRowKey = (E.^. MaterialId) - , dbtProj = dbtProjFilteredPostId - , dbtColonnade = widgetColonnade $ mconcat + , dbtProj = dbtProjFilteredPostId + , dbtColonnade = widgetColonnade $ mconcat [ -- dbRow, sortable (Just "type") (i18nCell MsgMaterialType) $ foldMap (textCell . CI.original) . materialType . row2material @@ -138,10 +138,21 @@ getMaterialListR tid ssh csh = do , ( "last-edit" , SortColumn (E.^. MaterialLastEdit) ) ] , dbtFilter = mconcat - [ singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr - -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool + [ (singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr + -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool) + , (singletonMap "searchName". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of + Nothing -> E.val True :: E.SqlExpr (E.Value Bool) + Just needle -> (E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) + , (singletonMap "searchTypeAndDescription". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of + Nothing -> E.val True :: E.SqlExpr (E.Value Bool) + Just needle -> (E.castString (material E.^. MaterialType) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) + --E.||. (E.castString (material E.^. MaterialDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) + ) + ] - , dbtFilterUI = mempty + , dbtFilterUI = \mPrev -> mconcat $ catMaybes + [ Just $ prismAForm (singletonFilter "searchName") mPrev $ aopt textField (fslI MsgFilterMaterialNameSearch) + , Just $ prismAForm (singletonFilter "searchTypeAndDescription") mPrev $ aopt textField (fslI MsgFilterMaterialTypeAndDescriptionSearch) ] , dbtCsvEncode = noCsvEncode , dbtCsvDecode = Nothing , dbtExtraReps = [] diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 5d8755b7b..b97ed31e3 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -730,6 +730,24 @@ fillDb = do } , examStaff = Just "Hofmann" } + _ <- insert' Material + { materialCourse = ffp + , materialName = "Material 1" + , materialType = Just "Typ 1" + , materialDescription = Just $ htmlToStoredMarkup [shamlet|Folien für die Zentralübung|] + , materialVisibleFrom = Just now + , materialLastEdit = now + } + + _ <- insert' Material + { materialCourse = ffp + , materialName = "Material 2" + , materialType = Just "Typ 2" + , materialDescription = Just $ htmlToStoredMarkup [shamlet|Videos für die Vorlesung|] + , materialVisibleFrom = Just now + , materialLastEdit = now + } + void . insertMany $ map (\u -> ExamRegistration examFFP u Nothing now) [ fhamann , maxMuster