feat(course material): first two filters

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

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

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{..}
+
+
+
+
+
+
+
+

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 = []

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|<i>Folien</i> 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|<i>Videos</i> für die Vorlesung|]
+    , materialVisibleFrom = Just now
+    , materialLastEdit = now 
+    }
+
   void . insertMany $ map (\u -> ExamRegistration examFFP u Nothing now)
     [ fhamann
     , maxMuster