diff --git a/src/Handler/ExamOffice/Exams.hs b/src/Handler/ExamOffice/Exams.hs index cf10c2338..e01555ad1 100644 --- a/src/Handler/ExamOffice/Exams.hs +++ b/src/Handler/ExamOffice/Exams.hs @@ -41,7 +41,7 @@ type ExamsTableExpr = ( E.SqlExpr (Maybe (Entity Exam )) `E.FullOuterJoin` E.SqlExpr (Maybe (Entity ExternalExam)) type ExamsTableData = DBRow ( Either (Entity ExternalExam) (Entity Exam, Entity Course, Entity School) - , Natural, Natural + , Maybe Natural, Maybe Natural ) queryExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity Exam))) @@ -69,7 +69,7 @@ resultSchool = _dbrOutput . _1 . _Right . _3 resultExternalExam :: Traversal' ExamsTableData (Entity ExternalExam) resultExternalExam = _dbrOutput . _1 . _Left -resultSynchronised, resultResults :: Lens' ExamsTableData Natural +resultSynchronised, resultResults :: Lens' ExamsTableData (Maybe Natural) resultSynchronised = _dbrOutput . _2 resultResults = _dbrOutput . _3 @@ -162,24 +162,32 @@ getEOExamsR = do return $ ExternalExam.resultIsSynced (E.val uid) externalExamResult getResults = getExamResults >> getExternalExamResults foldResult (E.Value isSynced) = (Sum 1, guardMonoid isSynced $ Sum 1) - (Sum resultCount, Sum syncedCount) <- lift . lift . runConduit $ getResults .| C.foldMap foldResult - - forMM_ (view $ _dbtProjFilter . _etProjFilterHasResults) $ \b -> - guard $ b == (resultCount > 0) - forMM_ (view $ _dbtProjFilter . _etProjFilterIsSynced) $ \b -> - guard $ b == (syncedCount >= resultCount) + + mCounts <- if getSynced + then do + (Sum resCount, Sum synCount) <- lift . lift . runConduit $ getResults .| C.foldMap foldResult + forMM_ (view $ _dbtProjFilter . _etProjFilterHasResults) $ \b -> + guard $ b == (resCount > 0) + forMM_ (view $ _dbtProjFilter . _etProjFilterIsSynced) $ \b -> + guard $ b == (synCount >= resCount) + return $ Just (resCount, synCount) + else do + forMM_ (view $ _dbtProjFilter . _etProjFilterHasResults) guard + return Nothing case (exam, course, school, externalExam) of (Just exam', Just course', Just school', Nothing) -> return - (Right (exam', course', school'), syncedCount, resultCount) + (Right (exam', course', school'), snd <$> mCounts, fst <$> mCounts) (Nothing, Nothing, Nothing, Just externalExam') -> return - (Left externalExam', syncedCount, resultCount) + (Left externalExam', snd <$> mCounts, fst <$> mCounts) _other -> return $ error "Got exam & externalExam in same result" colSynced = Colonnade.singleton (fromSortable . Sortable (Just "synced") $ i18nCell MsgExamSynchronised) $ \x -> flip runReader x $ do - mExam <- preview resultExam - mSchool <- preview resultSchool + mExam <- preview resultExam + mSchool <- preview resultSchool + mSynced <- view resultSynchronised + mResults <- view resultResults if | Just (Entity _ Exam{examClosed, examFinished}) <- mExam @@ -188,12 +196,10 @@ getEOExamsR = do (NTop examClosed > NTop (Just now)) $ is _ExamCloseSeparate schoolExamCloseMode -> return . cell $ toWidget iconNew - | otherwise + | Just synced <- mSynced + , Just results <- mResults -> do - synced <- view resultSynchronised - results <- view resultResults isSynced <- view resultIsSynced - return $ cell [whamlet| $newline never @@ -205,6 +211,7 @@ getEOExamsR = do & cellAttrs <>~ [ ("class", "heated") , ("style", [st|--hotness: #{tshow (heat results synced)}|]) ] + | otherwise -> return $ cell mempty dbtColonnade :: Colonnade Sortable _ _ @@ -225,7 +232,7 @@ getEOExamsR = do dbtSorting = mconcat $ (bool mempty [ singletonMap "synced" $ - SortProjected . comparing $ ((/) `on` toRational) <$> view resultSynchronised <*> view resultResults + SortProjected . comparing $ ((/) `on` toRational . fromMaybe 0) <$> view resultSynchronised <*> view resultResults , singletonMap "is-synced" $ SortProjected . comparing $ (>=) <$> view resultSynchronised <*> view resultResults ] getSynced) <>