Merge branch 'master' of gitlab2.rz.ifi.lmu.de:uni2work/uni2work

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

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

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

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
+      , dbtProj      = dbtProjFilteredPostId 
-      , dbtColonnade = widgetColonnade $ mconcat
+      , 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
-

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