API for scores handles alternative metrics

Foundation.hs

@@ -201,7 +201,8 @@ instance Yesod App where
 
     isAuthorized (ChallengeImageR _) _ = return Authorized
 
-    isAuthorized (ApiTxtScoreR _) _ = return Authorized
+    isAuthorized (ApiTxtScoreMainMetricR _) _ = return Authorized
+    isAuthorized (ApiTxtScoreWithMetricR _ _) _ = return Authorized
 
     isAuthorized (ChallengeParamGraphDataR _ _ _) _ = return Authorized
     isAuthorized (IndicatorGraphDataR _) _ = return Authorized

Handler/Query.hs

@@ -34,34 +34,45 @@ findSubmissions sha1Prefix = do
     Nothing -> rawCommitQuery sha1Prefix
   mapM getFullInfo submissions
 
-getApiTxtScoreR :: Text -> Handler Text
-getApiTxtScoreR sha1Prefix = do
+getApiTxtScoreMainMetricR :: Text -> Handler Text
+getApiTxtScoreMainMetricR sha1Prefix = getApiTxtScore Nothing sha1Prefix
+
+getApiTxtScoreWithMetricR :: Text -> Text -> Handler Text
+getApiTxtScoreWithMetricR sha1Prefix metricName = getApiTxtScore (Just metricName) sha1Prefix
+
+getApiTxtScore :: Maybe Text -> Text -> Handler Text
+getApiTxtScore mMetricName sha1Prefix = do
   submissions <- runDB $ rawCommitQuery sha1Prefix
   case submissions of
-    [submission] -> doGetScore submission
+    [submission] -> doGetScore mMetricName submission
     [] -> return "NONE"
     _ -> return "AMBIGUOUS ARGUMENT"
 
-doGetScore :: (BaseBackend (YesodPersistBackend site) ~ SqlBackend, PersistUniqueRead (YesodPersistBackend site), BackendCompatible SqlBackend (YesodPersistBackend site), YesodPersist site, PersistQueryRead (YesodPersistBackend site)) => Entity Submission -> HandlerFor site Text
-doGetScore submission = do
+doGetScore :: (BaseBackend (YesodPersistBackend site) ~ SqlBackend, PersistUniqueRead (YesodPersistBackend site), BackendCompatible SqlBackend (YesodPersistBackend site), YesodPersist site, PersistQueryRead (YesodPersistBackend site)) => Maybe Text -> Entity Submission -> HandlerFor site Text
+doGetScore mMetricName submission = do
   let challengeId = submissionChallenge $ entityVal submission
-  mainTest <- runDB $ fetchMainTest challengeId
-  let mainTestId = entityKey mainTest
-  let submissionId = entityKey submission
 
-  evals <- runDB $ E.select
-                   $ E.from $ \(out, evaluation, variant) -> do
-                     E.where_ (variant ^. VariantSubmission E.==. E.val submissionId
-                               E.&&. out ^. OutVariant E.==. variant ^. VariantId
-                               E.&&. out ^. OutTest E.==. E.val mainTestId
-                               E.&&. evaluation ^. EvaluationTest E.==. E.val mainTestId
-                               E.&&. out ^. OutChecksum E.==. evaluation ^. EvaluationChecksum)
-                     E.orderBy []
-                     return (evaluation)
+  mTestEnt <- runDB $ fetchTestByName mMetricName challengeId
+  case mTestEnt of
+    Just testEnt -> do
+      let theTestId = entityKey testEnt
 
-  case evals of
-    [eval] -> return $ formatTruncatedScore (testPrecision $ entityVal mainTest) (Just $ entityVal eval)
-    _ -> return "NONE"
+      let submissionId = entityKey submission
+
+      evals <- runDB $ E.select
+                    $ E.from $ \(out, evaluation, variant) -> do
+                      E.where_ (variant ^. VariantSubmission E.==. E.val submissionId
+                                E.&&. out ^. OutVariant E.==. variant ^. VariantId
+                                E.&&. out ^. OutTest E.==. E.val theTestId
+                                E.&&. evaluation ^. EvaluationTest E.==. E.val theTestId
+                                E.&&. out ^. OutChecksum E.==. evaluation ^. EvaluationChecksum)
+                      E.orderBy []
+                      return (evaluation)
+
+      case evals of
+        [eval] -> return $ formatTruncatedScore (testPrecision $ entityVal testEnt) (Just $ entityVal eval)
+        _ -> return "NONE"
+    Nothing -> return "NONE"
 
 getQueryFormR :: Handler Html
 getQueryFormR = do

Handler/Shared.hs

@@ -367,11 +367,27 @@ fetchMainTest challengeId = do
   challenge <- get404 challengeId
 
   activeTests <- selectList [TestChallenge ==. challengeId,
-                                    TestActive ==. True,
-                                    TestCommit ==. challengeVersion challenge] []
+                            TestActive ==. True,
+                            TestCommit ==. challengeVersion challenge] []
 
   return $ getMainTest activeTests
 
+
+fetchTestByName :: (MonadIO m, PersistQueryRead backend, BaseBackend backend ~ SqlBackend) => Maybe Text -> Key Challenge -> ReaderT backend m (Maybe (Entity Test))
+fetchTestByName Nothing challengeId = do
+  mainTest <- fetchMainTest challengeId
+  return $ Just mainTest
+fetchTestByName (Just tName) challengeId = do
+  challenge <- get404 challengeId
+
+  tests' <- selectList [TestChallenge ==. challengeId,
+                       TestCommit ==. challengeVersion challenge] []
+
+  let tests = sortBy (flip testComparator) tests'
+
+  return $ find (\t -> formatTestEvaluationScheme (entityVal t) == tName) tests
+
+
 -- get the test with the highest priority
 getMainTest :: [Entity Test] -> Entity Test
 getMainTest tests = DL.maximumBy testComparator tests

config/routes

@@ -34,7 +34,8 @@
 
 /view-variant/#VariantId ViewVariantR GET
 
-/api/txt/score/#Text ApiTxtScoreR GET
+/api/txt/score/#Text ApiTxtScoreMainMetricR GET
+/api/txt/score/#Text/#Text ApiTxtScoreWithMetricR GET
 
 /make-public/#SubmissionId MakePublicR GET
 /hide-submission/#SubmissionId HideSubmissionR GET