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

Only show material prime action if it makes sense

Browse Source
This commit is contained in:
Steffen Jost 2019-05-04 22:10:08 +02:00
parent 4a65312816
commit 84e73f649a
3 changed files with 33 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/de.msg
View File

@ -303,7 +303,7 @@ CorByProportionOnly proportion@Rational: #{display proportion} Anteile
CorByProportionIncludingTutorial proportion@Rational: #{display proportion} Anteile - Tutorium
CorByProportionExcludingTutorial proportion@Rational: #{display proportion} Anteile + Tutorium
RowCount count@Int64: #{display count} #{pluralDE count "Eintrag" "Einträge"} nach Filter
RowCount count@Int64: #{display count} #{pluralDE count "passender Eintrag" "passende Einträge"} innsgesamt
DeleteRow: Entfernen
ProportionNegative: Anteile dürfen nicht negativ sein
CorrectorUpdated: Korrektor erfolgreich aktualisiert

29
src/Foundation.hs
View File

@ -988,6 +988,22 @@ evalAccess route isWrite = do
evalAccessDB :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> Bool -> ReaderT (YesodPersistBackend UniWorX) m AuthResult
evalAccessDB = evalAccess
-- | Check whether the current user is authorized by `evalAccess` for the given route
-- Convenience function for a commonly used code fragment
hasAccessTo :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> Bool -> m Bool
hasAccessTo route isWrite = (== Authorized) <$> evalAccess route isWrite
-- | Check whether the current user is authorized by `evalAccess` to read from the given route
-- Convenience function for a commonly used code fragment
hasReadAccessTo :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> m Bool
hasReadAccessTo = flip hasAccessTo False
-- | Check whether the current user is authorized by `evalAccess` to rwrite to the given route
-- Convenience function for a commonly used code fragment
hasWriteAccessTo :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> m Bool
hasWriteAccessTo = flip hasAccessTo True
-- | Conditional redirect that hides the URL if the user is not authorized for the route
redirectAccess :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> m a
redirectAccess url = do
-- must hide URL if not authorized
@ -1780,7 +1796,18 @@ pageActions (CourseR tid ssh csh CShowR) =
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute $ CourseR tid ssh csh MaterialListR
, menuItemModal = False
, menuItemAccessCallback' = return True
, menuItemAccessCallback' =
let lecturerAccess = hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR -- Always show for lecturers that can create new material
materialAccess mnm = hasReadAccessTo $ CMaterialR tid ssh csh mnm MShowR -- or show if user can see at least one of the contents
existsVisible = do
matNames <- E.select . E.from $ \(course `E.InnerJoin` material) -> do
E.on $ course E.^. CourseId E.==. material E.^. MaterialCourse
E.where_ $ course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
E.&&. course E.^. CourseShorthand E.==. E.val csh
return $ material E.^. MaterialName
anyM matNames (materialAccess . E.unValue)
in runDB $ lecturerAccess `or2M` existsVisible
}
, MenuItem
{ menuItemType = PageActionPrime

7
src/Utils.hs
View File

@ -588,7 +588,7 @@ ifM c m m' =
ifNotM :: Monad m => m Bool -> m a -> m a -> m a
ifNotM c = flip $ ifM c
-- | Monadic boolean function, copied from Andreas Abel's utility function
-- | Short-circuiting monadic boolean function, copied from Andreas Abel's utility function
and2M, or2M :: Monad m => m Bool -> m Bool -> m Bool
and2M ma mb = ifM ma mb (return False)
or2M ma = ifM ma (return True)
@ -597,6 +597,7 @@ andM, orM :: (Foldable f, Monad m) => f (m Bool) -> m Bool
andM = Fold.foldr and2M (return True)
orM = Fold.foldr or2M (return False)
-- | Short-circuiting monady any
allM, anyM :: (Functor f, Foldable f, Monad m) => f a -> (a -> m Bool) -> m Bool
allM xs f = andM $ fmap f xs
anyM xs f = orM $ fmap f xs
@ -801,10 +802,10 @@ setLastModified lastModified = do
$logDebugS "LastModified" $ tshow (lastModified, ifModifiedSince)
when (maybe False ((lastModified <=) . addUTCTime precision) ifModifiedSince)
notModified
addHeader "Last-Modified" $ formatRFC1123 lastModified
where
precision :: NominalDiffTime
precision = 1
safeMethods = [ methodGet, methodHead, methodOptions ]