Handle properly cases where there is no test

Handler/Graph.hs

@@ -89,7 +89,9 @@ submissionsToJSON condition challengeName = do
                                                   (\entry -> [entityKey $ tableEntrySubmission entry])
 
 
-  entMainTest <- runDB $ fetchMainTest challengeId
+  mEntMainTest <- runDB $ fetchMainTest challengeId
+  case mEntMainTest of
+    Just entMainTest -> do
       let mainTestRef = getTestReference entMainTest
 
       let naturalRange = getNaturalRange mainTestRef entries
@@ -101,6 +103,8 @@ submissionsToJSON condition challengeName = do
                                     $ map (auxSubmissionToNode mainTestRef naturalRange)
                                     $ entries),
                         "edges" .= map forkToEdge forks ]
+    Nothing -> do
+      return $ object []
 
 getNaturalRange :: TestReference -> [LeaderboardEntry] -> Double
 getNaturalRange testRef entries = 2.0 * (interQuantile

Handler/Shared.hs

@@ -121,7 +121,7 @@ consoleApp jobId = do
     case mchan of
         Nothing -> do
           sendTextData ("CANNOT FIND THE OUTPUT (ALREADY SHOWN??)" :: Text)
-          sendCloseE ("" :: Text)
+          _ <- sendCloseE ("" :: Text)
           return ()
         Just chan -> do
              let loop = do
@@ -131,7 +131,7 @@ consoleApp jobId = do
                          Just text -> do
                              sendTextData text
                              loop
-             loop
+             _ <- loop
              return ()
 
 
@@ -556,7 +556,7 @@ thenCmp :: Ordering -> Ordering -> Ordering
 thenCmp EQ o2 = o2
 thenCmp o1 _  = o1
 
-fetchMainTest :: (MonadIO m, PersistQueryRead backend, BaseBackend backend ~ SqlBackend) => Key Challenge -> ReaderT backend m (Entity Test)
+fetchMainTest :: (MonadIO m, PersistQueryRead backend, BaseBackend backend ~ SqlBackend) => Key Challenge -> ReaderT backend m (Maybe (Entity Test))
 fetchMainTest challengeId = do
   challenge <- get404 challengeId
 
@@ -568,9 +568,7 @@ fetchMainTest challengeId = do
 
 
 fetchTestByName :: (MonadIO m, PersistQueryRead backend, BaseBackend backend ~ SqlBackend) => Maybe Text -> Key Challenge -> ReaderT backend m (Maybe (Entity Test))
-fetchTestByName Nothing challengeId = do
+fetchTestByName Nothing challengeId = fetchMainTest challengeId
-  mainTest <- fetchMainTest challengeId
-  return $ Just mainTest
 fetchTestByName (Just tName) challengeId = do
   challenge <- get404 challengeId
 
@@ -583,8 +581,9 @@ fetchTestByName (Just tName) challengeId = do
 
 
 -- get the test with the highest priority
-getMainTest :: [Entity Test] -> Entity Test
+getMainTest :: [Entity Test] -> Maybe (Entity Test)
-getMainTest tests = DL.maximumBy testComparator tests
+getMainTest [] = Nothing
+getMainTest tests = Just $ DL.maximumBy testComparator tests
 
 -- get all the non-dev tests starting with the one with the highest priorty
 -- (or all the tests if there are no non-dev tests)

Handler/ShowChallenge.hs

@@ -851,11 +851,13 @@ doCreateSubmission' _ userId challengeId challengeSubmissionData chan = do
 
       relevantIndicators <- getOngoingTargets challengeId
 
-      (Entity mainTestId mainTest) <- runDB $ fetchMainTest challengeId
 
       (Entity _ currentVersion) <- runDB $ getBy404 $ UniqueVersionByCommit $ challengeVersion challenge
       let submittedMajorVersion = versionMajor currentVersion
 
+      mMainEnt <- runDB $ fetchMainTest challengeId
+      bestScoreSoFar <- case mMainEnt of
+        Just (Entity _ mainTest) -> do
           let orderDirection = case getMetricOrdering (evaluationSchemeMetric $ testMetric mainTest) of
                 TheHigherTheBetter -> E.desc
                 TheLowerTheBetter -> E.asc
@@ -878,7 +880,9 @@ doCreateSubmission' _ userId challengeId challengeSubmissionData chan = do
               E.orderBy [orderDirection (evaluation ^. EvaluationScore)]
               E.limit 1
               return evaluation
-      let bestScoreSoFar = join (evaluationScore <$> entityVal <$> (listToMaybe bestResultSoFar))
+          let bestScoreSoFar' = join (evaluationScore <$> entityVal <$> (listToMaybe bestResultSoFar))
+          return bestScoreSoFar'
+        Nothing -> return Nothing
 
       case bestScoreSoFar of
         Just s -> msg chan ("best score so far is: " ++ (Data.Text.pack $ show s))
@@ -930,6 +934,10 @@ doCreateSubmission' _ userId challengeId challengeSubmissionData chan = do
 
       app <- getYesod
 
+      let submissionLink = slackLink app "submission" ("q/" ++ (fromSHA1ToText (repoCurrentCommit repo)))
+
+      case mMainEnt of
+        Just (Entity mainTestId mainTest) -> do
           newScores <- mapM (getScoreForOut mainTestId) outs
           let newScores' = catMaybes newScores
           let newScores'' = case getMetricOrdering (evaluationSchemeMetric $ testMetric mainTest) of
@@ -939,8 +947,6 @@ doCreateSubmission' _ userId challengeId challengeSubmissionData chan = do
                 TheLowerTheBetter -> (<)
                 TheHigherTheBetter -> (>)
 
-      let submissionLink = slackLink app "submission" ("q/" ++ (fromSHA1ToText (repoCurrentCommit repo)))
-
           case bestScoreSoFar of
             Just b ->  case newScores'' of
                     (s:_) -> if compOp s b
@@ -973,6 +979,7 @@ doCreateSubmission' _ userId challengeId challengeSubmissionData chan = do
                              else return ()
                     [] -> return ()
             Nothing -> return ()
+        Nothing -> return ()
 
       if appAutoOpening $ appSettings app
         then

Handler/Tables.hs

@@ -276,6 +276,9 @@ theLimitedDiffTextCell h textFun = Table.widget h (
          OneThing u -> limitedWidget textCellSoftLimit textCellHardLimit u
          d@(TwoThings _ _) -> [whamlet|#{d}|])
 
+extractInt :: [PersistValue] -> Int64
+extractInt ((PersistInt64 x):_) = x
+
 statusCellWidget :: Text -> RepoScheme -> Repo -> (SubmissionId, Submission, VariantId, Variant, Maybe UserId) -> WidgetFor App ()
 statusCellWidget challengeName repoScheme challengeRepo (submissionId, submission, variantId, _, mauthId) = do
   isReevaluable <- handlerToWidget $ runDB $ canBeReevaluated submissionId
@@ -351,7 +354,10 @@ getLeaderboardEntriesByCriterion :: (Ord a) => Int
 getLeaderboardEntriesByCriterion maxPriority challengeId condition preselector selector = do
   (evaluationMaps, tests) <- runDB $ getChallengeSubmissionInfos maxPriority condition (const True) preselector challengeId
   let mainTests = getMainTests tests
-  let mainTestEnt = getMainTest tests
+  let mMainTestEnt = getMainTest tests
+  case mMainTestEnt of
+    Nothing -> return ([], ([], []))
+    Just mainTestEnt -> do
       let mainTestRef = getTestReference mainTestEnt
       let (Entity _ mainTest) = mainTestEnt
       let auxItems = concat
@@ -362,7 +368,7 @@ getLeaderboardEntriesByCriterion maxPriority challengeId condition preselector s
       let entryComparator a b =
             (compareMajorVersions (leaderboardVersion a) (leaderboardVersion b))
             <>
-        ((compareResult mainTest) (evaluationScore $ leaderboardEvaluationMap a Map.! mainTestRef)
+            ((compareResult $ Just mainTest) (evaluationScore $ leaderboardEvaluationMap a Map.! mainTestRef)
              (evaluationScore $ leaderboardEvaluationMap b Map.! mainTestRef))
             <>
             (compareVersions (leaderboardVersion a) (leaderboardVersion b))
@@ -423,15 +429,17 @@ toLeaderboardEntry challengeId tests ss = do
               leaderboardIsVisible = isVisible,
               leaderboardTeam = mTeam
               }
-     where mainTestEnt@(Entity _ mainTest) = getMainTest tests
+     where submissionComparator (TableEntry _  _  _ em1 _ _ _ v1 _) (TableEntry _  _ _ em2 _ _ _ v2 _) =
-           mainTestRef = getTestReference mainTestEnt
+             case getMainTest tests of
-           submissionComparator (TableEntry _  _  _ em1 _ _ _ v1 _) (TableEntry _  _ _ em2 _ _ _ v2 _) =
+               Just mainTestEnt@(Entity _ mainTest) ->
-             (compareMajorVersions v1 v2)
+                 let mainTestRef = getTestReference mainTestEnt
+                 in (compareMajorVersions v1 v2)
                     <>
-             (compareResult mainTest) (evaluationScore (em1 Map.! mainTestRef))
+                    (compareResult (Just $ mainTest) (evaluationScore (em1 Map.! mainTestRef))
-                                      (evaluationScore (em2 Map.! mainTestRef))
+                                                     (evaluationScore (em2 Map.! mainTestRef)))
                     <>
                     (compareVersions v1 v2)
+               Nothing -> EQ
 
 getLeaderboardEntries :: Int -> LeaderboardStyle -> Key Challenge -> Handler ([LeaderboardEntry], ([TableEntry], [Entity Test]))
 getLeaderboardEntries maxPriority BySubmitter challengeId =
@@ -449,8 +457,9 @@ getLeaderboardEntries maxPriority ByTag challengeId =
   where noEmptyList [] = [Nothing]
         noEmptyList l = map Just l
 
-compareResult :: Test -> Maybe Double -> Maybe Double -> Ordering
+compareResult :: Maybe Test -> Maybe Double -> Maybe Double -> Ordering
-compareResult test (Just x) (Just y) = (compareFun $ getMetricOrdering $ evaluationSchemeMetric $ testMetric test) x y
+compareResult Nothing _ _ = EQ
+compareResult (Just test) (Just x) (Just y) = (compareFun $ getMetricOrdering $ evaluationSchemeMetric $ testMetric test) x y
 compareResult _ (Just _) Nothing = GT
 compareResult _ Nothing (Just _) = LT
 compareResult _ Nothing Nothing = EQ
@@ -485,7 +494,7 @@ getChallengeSubmissionInfos maxMetricPriority condition variantCondition presele
                E.&&. variant ^. VariantSubmission E.==. submission ^. SubmissionId)
      return (submission, variant)
 
-  scores <- mapM (getScore (entityKey mainTest)) $ map (entityKey . snd) allSubmissionsVariants
+  scores <- mapM (getScore (entityKey <$> mainTest)) $ map (entityKey . snd) allSubmissionsVariants
 
   let allSubmissionsVariantsWithRanks =
         sortBy (\(r1, (s1, _)) (r2, (s2, _)) -> (submissionStamp (entityVal s2) `compare` submissionStamp (entityVal s1))
@@ -495,7 +504,7 @@ getChallengeSubmissionInfos maxMetricPriority condition variantCondition presele
         $ filter (\(_, (s, _)) -> condition s)
         $ map (\(rank, (_, sv)) -> (rank, sv))
         $ zip [1..]
-        $ sortBy (\(s1, _) (s2, _) -> compareResult (entityVal mainTest) s2 s1)
+        $ sortBy (\(s1, _) (s2, _) -> compareResult (entityVal <$> mainTest) s2 s1)
         $ zip scores allSubmissionsVariants
 
   allTests <- selectList [] [Asc TestName]
@@ -512,8 +521,9 @@ getChallengeSubmissionInfos maxMetricPriority condition variantCondition presele
 
 getScore :: (MonadIO m, BackendCompatible SqlBackend backend,
             PersistQueryRead backend, PersistUniqueRead backend, BaseBackend backend ~ SqlBackend)
-           => Key Test -> Key Variant -> ReaderT backend m (Maybe Double)
+           => Maybe (Key Test) -> Key Variant -> ReaderT backend m (Maybe Double)
-getScore testId variantId = do
+getScore Nothing _ = return Nothing
+getScore (Just testId) variantId = do
   evaluations <- E.select $ E.from $ \(out, evaluation, variant, submission) -> do
                   E.where_ (out ^. OutVariant E.==. E.val variantId
                             E.&&. variant ^. VariantId E.==. E.val variantId

messages/en.msg

@@ -105,3 +105,4 @@ YourTeams: your teams
 AsTeam: As team
 InviteToTeam: Invite to team (give the identifier/login of a user)
 Join: Join
+NoTests: SOMETHING IS WRONG WITH THE CHALLENGE, THERE ARE NO TESTS DEFINED. MAYBE TEST DIRECTORY ARE MISSING OR THE CHALLENGE WAS CREATED/UPDATE IN THE INVALID MANNER

templates/show-challenge.hamlet

@@ -25,6 +25,9 @@ $if (checkIfAdmin mUserEnt)
 
 <h2>Leaderboard
 
+$if null tests
+  <p>_{MsgNoTests}
+$else
   ^{Table.buildBootstrap (leaderboardTable mUserId (challengeName challenge) scheme challengeRepo tests) leaderboardWithRanks}
 
   $maybe altLeaderboardWithRanks <- mAltLeaderboardWithRanks