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

Fix #270

Browse Source
This commit is contained in:
SJost 2019-01-24 15:12:23 +01:00
parent f5f9dea342
commit 38a35a673a
1 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Handler/Corrections.hs
View File

@ -21,6 +21,7 @@ import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.CaseInsensitive as CI
import Data.CaseInsensitive (CI)
import Data.Semigroup (Sum(..))
import Data.Monoid (All(..))
@ -281,6 +282,11 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
| Set.null shns -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> sheet E.^. SheetName `E.in_` E.valList (Set.toList shns)
)
, ( "sheet-search"
, FilterColumn $ \((_ `E.InnerJoin` sheet `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) shns -> case getLast (shns :: Last (CI Text)) of
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
Just needle -> sheet E.^. SheetName `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)
)
, ( "corrector"
, FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector :: CorrectionTableExpr) emails -> if
| Set.null emails -> E.val True :: E.SqlExpr (E.Value Bool)
@ -495,11 +501,11 @@ postCorrectionsR = do
, colRated
] -- Continue here
filterUI = Just $ \mPrev -> mconcat
[ 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)
, Map.singleton "israted" . fmap toPathPiece . maybeToList <$> aopt boolField (fslI MsgRatingTime) (Just <$> fromPathPiece =<< listToMaybe =<< Map.lookup "israted" =<< 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)
, Map.singleton "sheet-search" . maybeToList <$> aopt (lift `hoistField` searchField False) (fslI MsgSheet) (Just <$> listToMaybe =<< Map.lookup "sheet-search" =<< mPrev)
, Map.singleton "israted" . fmap toPathPiece . maybeToList <$> aopt boolField (fslI MsgRatingTime) (Just <$> fromPathPiece =<< listToMaybe =<< Map.lookup "israted" =<< mPrev)
]
courseOptions = runDB $ do
courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)