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