fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(course material): auto vorschläge für materialtype

Browse Source
This commit is contained in:
ros 2021-06-21 15:18:45 +02:00 committed by Gregor Kleen
parent 3a9622dfb8
commit decdda359d
2 changed files with 17 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Application.hs
View File

@ -709,4 +709,8 @@ addPWEntry :: User
addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do
PWHashConf{..} <- getsYesod $ view _appAuthPWHash PWHashConf{..} <- getsYesod $ view _appAuthPWHash
(AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength (AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength
void $ insert User{..} void $ insert User{..}

14
src/Handler/Material.hs
View File

@ -81,6 +81,16 @@ fetchMaterial tid ssh csh mnm =
getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getMaterialListR tid ssh csh = do getMaterialListR tid ssh csh = do
cid <- runDB . 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 (\t -> Option t t t) (map CI.original (Set.toAscList (Set.fromList (mapMaybe E.unValue previouslyUsed))))
let matLink :: MaterialName -> Route UniWorX let matLink :: MaterialName -> Route UniWorX
matLink = CourseR tid ssh csh . flip MaterialR MShowR matLink = CourseR tid ssh csh . flip MaterialR MShowR
@ -97,7 +107,7 @@ getMaterialListR tid ssh csh = do
seeAllModificationTimestamps <- hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR -- ordinary users should not see modification dates older than visibility seeAllModificationTimestamps <- hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR -- ordinary users should not see modification dates older than visibility
MsgRenderer mr <- getMsgRenderer MsgRenderer mr <- getMsgRenderer
table <- runDB $ do table <- runDB $ do
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh --cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
let row2material = view $ _dbrOutput . _1 . _entityVal let row2material = view $ _dbrOutput . _1 . _entityVal
psValidator = def & defaultSorting [SortDescBy "last-edit"] psValidator = def & defaultSorting [SortDescBy "last-edit"]
& forceFilter "may-access" (Any True) & forceFilter "may-access" (Any True)
@ -151,7 +161,7 @@ getMaterialListR tid ssh csh = do
] ]
, dbtFilterUI = \mPrev -> mconcat $ catMaybes , dbtFilterUI = \mPrev -> mconcat $ catMaybes
[ Just $ prismAForm (singletonFilter "searchName") mPrev $ aopt textField (fslI MsgFilterMaterialNameSearch) [ Just $ prismAForm (singletonFilter "searchName") mPrev $ aopt textField (fslI MsgFilterMaterialNameSearch)
, Just $ prismAForm (singletonFilter "searchTypeAndDescription") mPrev $ aopt textField (fslI MsgFilterMaterialTypeAndDescriptionSearch) ] , Just $ prismAForm (singletonFilter "searchTypeAndDescription") mPrev $ aopt (textField & addDatalist typeOptions) (fslI MsgFilterMaterialTypeAndDescriptionSearch)]
, dbtCsvEncode = noCsvEncode , dbtCsvEncode = noCsvEncode
, dbtCsvDecode = Nothing , dbtCsvDecode = Nothing
, dbtExtraReps = [] , dbtExtraReps = []