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

Towards #270

Browse Source
This commit is contained in:
SJost 2019-01-16 16:17:38 +01:00
parent b6b6cf75bb
commit ffda17ada0
1 changed files with 14 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Handler/Corrections.hs
View File

@ -268,6 +268,11 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
| Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool) | Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids) | otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
) )
, ( "school"
, FilterColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) sids -> if
| Set.null sids -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> course E.^. CourseSchool `E.in_` E.valList (Set.toList sids)
)
, ( "course" , ( "course"
, FilterColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) cshs -> if , FilterColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) cshs -> if
| Set.null cshs -> E.val True :: E.SqlExpr (E.Value Bool) | Set.null cshs -> E.val True :: E.SqlExpr (E.Value Bool)
@ -486,12 +491,19 @@ postCorrectionsR = do
, colRated , colRated
] -- Continue here ] -- Continue here
filterUI = Just $ \mPrev -> mconcat filterUI = Just $ \mPrev -> mconcat
[ Map.singleton "course" . maybeToList <$> aopt (lift `hoistField` selectField courseOptions) (fslI MsgCourse) (Just <$> listToMaybe =<< Map.lookup "course" =<< mPrev) [ Map.singleton "course" . maybeToList <$> aopt (lift `hoistField` selectField courseOptions) (fslI MsgCourse) (Just <$> listToMaybe =<< Map.lookup "course" =<< mPrev)
, Map.singleton "term" . maybeToList <$> aopt (lift `hoistField` selectField termOptions) (fslI MsgTerm) (Just <$> listToMaybe =<< Map.lookup "term" =<< mPrev)
, Map.singleton "school" . maybeToList <$> aopt (lift `hoistField` selectField schoolOptions) (fslI MsgCourseSchool) (Just <$> listToMaybe =<< Map.lookup "school" =<< mPrev)
] ]
courseOptions = runDB $ do courseOptions = runDB $ do
courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessDB (CourseR courseTerm courseSchool courseShorthand CNotesR) False) courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessDB (CourseR courseTerm courseSchool courseShorthand CNotesR) False)
optionsPairs $ map (id &&& id) $ nub $ map (CI.original . courseShorthand . entityVal) courses optionsPairs $ map (id &&& id) $ nub $ map (CI.original . courseShorthand . entityVal) courses
termOptions = runDB $ do
courses <- selectList [] [Asc CourseTerm] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessDB (CourseR courseTerm courseSchool courseShorthand CNotesR) False)
optionsPairs $ map (id &&& id) $ nub $ map (termToText . unTermKey . courseTerm . entityVal) courses
schoolOptions = runDB $ do
courses <- selectList [] [Asc CourseSchool] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessDB (CourseR courseTerm courseSchool courseShorthand CNotesR) False)
optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
psValidator = def psValidator = def
& restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information & restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information