Handle version while sorting

Handler/ShowChallenge.hs

@@ -20,6 +20,8 @@ import Handler.MakePublic
 import Handler.Dashboard
 import Handler.Common
 
+import Text.Blaze
+
 import Gonito.ExtractMetadata (ExtractionOptions(..),
                                extractMetadataFromRepoDir,
                                GonitoMetadata(..),
@@ -88,8 +90,8 @@ challengeReadme name = do
   let repoId = challengePublicRepo challenge
   repoDir <- getRepoDir repoId
   let readmeFilePath = repoDir </> readmeFile
-  contents <- liftIO $ System.IO.readFile readmeFilePath
+  theContents <- liftIO $ System.IO.readFile readmeFilePath
-  return $ markdown def $ TL.pack contents
+  return $ markdown def $ TL.pack theContents
 
 showChallengeWidget :: Maybe (Entity User)
                       -> Entity Challenge
@@ -178,6 +180,7 @@ defaultBranch :: IsString a => RepoScheme -> Maybe a
 defaultBranch SelfHosted = Just "master"
 defaultBranch Branches = Nothing
 
+challengeHowTo :: (Text.Blaze.ToMarkup a1, Text.Blaze.ToMarkup a2) => Challenge -> AppSettings -> Repo -> a1 -> Bool -> Bool -> Maybe a2 -> WidgetFor App ()
 challengeHowTo challenge settings repo shownId isIDSet isSSHUploaded mToken = $(widgetFile "challenge-how-to")
   where myBranch = case appRepoScheme settings of
           SelfHosted -> "master" :: Text
@@ -431,6 +434,7 @@ checkTarget theNow user submissionLink entries indicator target chan = do
        return ()
   where indicatorText = prettyIndicatorEntry indicator
 
+getScoreForOut :: (PersistQueryRead (YesodPersistBackend site), YesodPersist site, BaseBackend (YesodPersistBackend site) ~ SqlBackend) => Key Test -> Out -> HandlerFor site (Maybe Double)
 getScoreForOut mainTestId out = do
   mEvaluation <- runDB $ selectFirst [EvaluationChecksum ==. (outChecksum out),
                                      EvaluationTest ==. mainTestId]
@@ -466,7 +470,9 @@ getOuts chan submissionId generalParams = do
   submission <- runDB $ get404 submissionId
   let challengeId = submissionChallenge submission
   repoDir <- getRepoDir $ submissionRepo submission
-  activeTests <- runDB $ selectList [TestChallenge ==. challengeId, TestActive ==. True] []
+  activeTests <- runDB $ selectList [TestChallenge ==. challengeId,
+                                    TestActive ==. True,
+                                    TestCommit ==. submissionVersion submission] []
 
   outs' <- mapM (outsForTest repoDir submissionId generalParams) activeTests
   let outs = concat outs'
@@ -606,6 +612,7 @@ checkRepoAvailibility challengeId repoId chan = do
           return False
         Nothing -> return True
 
+challengeSubmissionWidget :: (ToMarkup a1, ToWidget App a2) => a2 -> a1 -> Challenge -> WidgetFor App ()
 challengeSubmissionWidget formWidget formEnctype challenge = $(widgetFile "challenge-submission")
 
 submissionForm :: Maybe Text -> Maybe Text -> Maybe Text -> Form (Maybe Text, Maybe Text, Text, Text, Maybe Text)

Handler/Tables.hs

@@ -42,7 +42,8 @@ data LeaderboardEntry = LeaderboardEntry {
   leaderboardEvaluationMap :: Map TestReference Evaluation,
   leaderboardNumberOfSubmissions :: Int,
   leaderboardTags :: [(Entity Tag, Entity SubmissionTag)],
-  leaderboardParams :: [Parameter]
+  leaderboardParams :: [Parameter],
+  leaderboardVersion :: (Int, Int, Int)
 }
 
 data TableEntry = TableEntry {
@@ -117,6 +118,7 @@ leaderboardTable mauthId challengeName repoScheme challengeRepo tests = mempty
   ++ Table.int "#" fst
   ++ Table.text "submitter" (formatSubmitter . leaderboardUser . snd)
   ++ timestampCell "when" (submissionStamp . leaderboardBestSubmission . snd)
+  ++ Table.text "ver." (formatVersion . leaderboardVersion . snd)
   ++ leaderboardDescriptionCell mauthId
   ++ mconcat (map (\e@(Entity _ t) -> resultCell t (extractScoreFromLeaderboardEntry (getTestReference e) . snd)) tests)
   ++ Table.int "×" (leaderboardNumberOfSubmissions . snd)
@@ -188,6 +190,14 @@ getAuxSubmissionEnts testId evaluationMaps = map processEvaluationMap evaluation
                                                                                      Nothing -> []))
 
 
+compareMajorVersions ::  (Int, Int, Int) -> (Int, Int, Int) -> Ordering
+compareMajorVersions (aM, _, _) (bM, _, _) = aM `compare` bM
+
+compareVersions :: (Int, Int, Int) -> (Int, Int, Int) -> Ordering
+compareVersions (aM, aN, aP) (bM, bN, bP) = (aM `compare` bM)
+                                            <> (aN `compare` bN)
+                                            <> (aP `compare` bP)
+
 getLeaderboardEntriesByCriterion :: (Ord a) => Key Challenge
                                              -> ((Entity Submission) -> Bool)
                                              -> (TableEntry -> [a])
@@ -203,8 +213,13 @@ getLeaderboardEntriesByCriterion challengeId condition selector = do
                  $ filter (\entry -> member mainTestRef $ tableEntryMapping entry)
                  $ evaluationMaps
   let auxItemsMap = Map.fromListWith (++) auxItems
-  let entryComparator a b = (compareResult mainTest) (evaluationScore $ leaderboardEvaluationMap a Map.! mainTestRef)
+  let entryComparator a b =
-                                                     (evaluationScore $ leaderboardEvaluationMap b Map.! mainTestRef)
+        (compareMajorVersions (leaderboardVersion a) (leaderboardVersion b))
+        <>
+        ((compareResult mainTest) (evaluationScore $ leaderboardEvaluationMap a Map.! mainTestRef)
+         (evaluationScore $ leaderboardEvaluationMap b Map.! mainTestRef))
+        <>
+        (compareVersions (leaderboardVersion a) (leaderboardVersion b))
   entries' <- mapM (toLeaderboardEntry challengeId mainTests)
              $ filter (\ll -> not (null ll))
              $ map snd
@@ -213,7 +228,8 @@ getLeaderboardEntriesByCriterion challengeId condition selector = do
                 $ sortBy (flip entryComparator) entries'
   return (entries, (evaluationMaps, mainTests))
 
-toLeaderboardEntry :: (BaseBackend (YesodPersistBackend site) ~ SqlBackend, PersistQueryRead (YesodPersistBackend site), YesodPersist site, Foldable t) => Key Challenge -> [Entity Test] -> t TableEntry -> HandlerFor site LeaderboardEntry
+
+toLeaderboardEntry :: (Foldable t, YesodPersist site, PersistQueryRead (YesodPersistBackend site), PersistUniqueRead (YesodPersistBackend site), BaseBackend (YesodPersistBackend site) ~ SqlBackend) => Key Challenge -> [Entity Test] -> t TableEntry -> HandlerFor site LeaderboardEntry
 toLeaderboardEntry challengeId tests ss = do
   let bestOne = DL.maximumBy submissionComparator ss
   let (TableEntry bestSubmission bestVariant user evals _ _ _ _) = bestOne
@@ -222,6 +238,13 @@ toLeaderboardEntry challengeId tests ss = do
 
   parameters <- runDB $ selectList [ParameterVariant ==. (entityKey bestVariant)] [Asc ParameterName]
 
+  submission <- runDB $ get404 submissionId
+  (Just (Entity _ version)) <- runDB $ getBy $ UniqueVersionByCommit $ submissionVersion submission
+
+  let theVersion = (versionMajor version,
+                    versionMinor version,
+                    versionPatch version)
+
   -- get all user submissions, including hidden ones
   allUserSubmissions <- runDB $ selectList [SubmissionChallenge ==. challengeId,
                                            SubmissionSubmitter ==. entityKey user]
@@ -236,13 +259,18 @@ toLeaderboardEntry challengeId tests ss = do
               leaderboardEvaluationMap = evals,
               leaderboardNumberOfSubmissions = length allUserSubmissions,
               leaderboardTags = tagEnts,
-              leaderboardParams = map entityVal parameters
+              leaderboardParams = map entityVal parameters,
+              leaderboardVersion = theVersion
               }
      where mainTestEnt@(Entity _ mainTest) = getMainTest tests
            mainTestRef = getTestReference mainTestEnt
-           submissionComparator (TableEntry _  _  _ em1 _ _ _ _) (TableEntry _  _ _ em2 _ _ _ _) =
+           submissionComparator (TableEntry _  _  _ em1 _ _ _ v1) (TableEntry _  _ _ em2 _ _ _ v2) =
+             (compareMajorVersions v1 v2)
+             <>
              (compareResult mainTest) (evaluationScore (em1 Map.! mainTestRef))
                                       (evaluationScore (em2 Map.! mainTestRef))
+             <>
+             (compareVersions v1 v2)
 
 getLeaderboardEntries :: LeaderboardStyle -> Key Challenge -> Handler ([LeaderboardEntry], ([TableEntry], [Entity Test]))
 getLeaderboardEntries BySubmitter challengeId =
@@ -262,6 +290,7 @@ compareResult _ (Just _) Nothing = GT
 compareResult _ Nothing (Just _) = LT
 compareResult _ Nothing Nothing = EQ
 
+getChallengeSubmissionInfos :: (MonadIO m, PersistQueryRead backend, BackendCompatible SqlBackend backend, PersistUniqueRead backend, BaseBackend backend ~ SqlBackend) => (Entity Submission -> Bool) -> Key Challenge -> ReaderT backend m ([TableEntry], [Entity Test])
 getChallengeSubmissionInfos condition challengeId = do
 
   challenge <- get404 challengeId
@@ -291,6 +320,7 @@ getChallengeSubmissionInfos condition challengeId = do
   evaluationMaps <- mapM getEvaluationMap allSubmissionsVariantsWithRanks
   return (evaluationMaps, tests)
 
+getScore :: (MonadIO m, BackendCompatible SqlBackend backend, PersistQueryRead backend, PersistUniqueRead backend) => Key Test -> Key Variant -> ReaderT backend m (Maybe Double)
 getScore testId variantId = do
   evaluations <- E.select $ E.from $ \(out, evaluation) -> do
                   E.where_ (out ^. OutVariant E.==. E.val variantId
@@ -303,6 +333,7 @@ getScore testId variantId = do
              [] -> Nothing
 
 
+getEvaluationMap :: (MonadIO m, PersistQueryRead backend, PersistUniqueRead backend, BaseBackend backend ~ SqlBackend) => (Int, (Entity Submission, Entity Variant)) -> ReaderT backend m TableEntry
 getEvaluationMap (rank, (s@(Entity submissionId submission), v@(Entity variantId _))) = do
   outs <- selectList [OutVariant ==. variantId] []
   user <- get404 $ submissionSubmitter submission