diff --git a/messages/uniworx/categories/courses/material/de-de-formal.msg b/messages/uniworx/categories/courses/material/de-de-formal.msg index 63311eb1d..6e244f71c 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/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..4fa16fd7e 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/description \ No newline at end of file diff --git a/src/Application.hs b/src/Application.hs index 0c0fcbbd5..001d87096 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -709,4 +709,4 @@ addPWEntry :: User addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do PWHashConf{..} <- getsYesod $ view _appAuthPWHash (AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength - void $ insert User{..} + void $ insert User{..} \ No newline at end of file diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 2e0e961b5..31336fe1c 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -18,6 +18,7 @@ import qualified Data.CaseInsensitive as CI -- import qualified Data.Text.Encoding as Text import qualified Database.Esqueleto.Legacy as E +import qualified Database.Esqueleto.Utils as E import Utils.Form import Handler.Utils @@ -97,22 +98,31 @@ getMaterialListR tid ssh csh = do MsgRenderer mr <- getMsgRenderer table <- runDB $ do cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh + let typeOptions :: HandlerFor UniWorX (OptionList Text) + typeOptions = do + previouslyUsed <- runDB $ + E.select $ E.from $ \material -> + E.distinctOnOrderBy [E.asc $ material E.^. MaterialType] $ do + E.where_ $ material E.^. MaterialCourse E.==. E.val cid + E.&&. E.not_ (E.isNothing $ material E.^. MaterialType) + return $ material E.^. MaterialType + return . mkOptionList . map (\(CI.original -> t) -> Option t t t) . Set.toAscList . Set.fromList $ mapMaybe E.unValue previouslyUsed let row2material = view $ _dbrOutput . _1 . _entityVal psValidator = def & defaultSorting [SortDescBy "last-edit"] & 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 @@ -140,8 +150,17 @@ getMaterialListR tid ssh csh = do , dbtFilter = mconcat [ singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool + , singletonMap "name". 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 "type-and-description". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of + Nothing -> E.val True :: E.SqlExpr (E.Value Bool) + Just needle -> (E.maybe (E.val mempty) E.castString (material E.^. MaterialType) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) + E.||. (E.maybe (E.val mempty) (E.castString.esqueletoMarkupOutput) (material E.^. MaterialDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) ] - , dbtFilterUI = mempty + , dbtFilterUI = \mPrev -> mconcat $ catMaybes + [ Just $ prismAForm (singletonFilter "name") mPrev $ aopt textField (fslI MsgFilterMaterialNameSearch) + , Just $ prismAForm (singletonFilter "type-and-description") mPrev $ aopt (textField & addDatalist typeOptions) (fslI MsgFilterMaterialTypeAndDescriptionSearch)] , dbtCsvEncode = noCsvEncode , dbtCsvDecode = Nothing , dbtExtraReps = [] @@ -389,4 +408,3 @@ getMArchiveR tid ssh csh mnm = do let getMatQuery = materialArchiveSource tid ssh csh mnm serveSomeFiles archiveName getMatQuery - 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