API for scores handles alternative metrics

This commit is contained in:
Filip Gralinski 2019-11-30 11:56:07 +01:00
parent 1d2c2ca78f
commit 7b4b8b101d
4 changed files with 53 additions and 24 deletions

View File

@ -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

View File

@ -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
mTestEnt <- runDB $ fetchTestByName mMetricName challengeId
case mTestEnt of
Just testEnt -> do
let theTestId = entityKey testEnt
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 ^. 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 mainTest) (Just $ entityVal eval)
[eval] -> return $ formatTruncatedScore (testPrecision $ entityVal testEnt) (Just $ entityVal eval)
_ -> return "NONE"
Nothing -> return "NONE"
getQueryFormR :: Handler Html
getQueryFormR = do

View File

@ -372,6 +372,22 @@ fetchMainTest challengeId = do
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

View File

@ -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