Continue work viewing variants

This commit is contained in:
Filip Gralinski 2019-11-30 08:36:21 +01:00
parent 48119428fe
commit c72cc274d5
6 changed files with 56 additions and 1 deletions

View File

@ -159,6 +159,7 @@ instance Yesod App where
isAuthorized QueryFormR _ = return Authorized isAuthorized QueryFormR _ = return Authorized
isAuthorized (QueryResultsR _) _ = return Authorized isAuthorized (QueryResultsR _) _ = return Authorized
isAuthorized ListChallengesR _ = return Authorized isAuthorized ListChallengesR _ = return Authorized
isAuthorized (ViewVariantR _) _ = return Authorized
isAuthorized TagsR _ = return Authorized isAuthorized TagsR _ = return Authorized
isAuthorized AchievementsR _ = return Authorized isAuthorized AchievementsR _ = return Authorized

View File

@ -92,6 +92,43 @@ processQuery query = do
setTitle "query results" setTitle "query results"
$(widgetFile "query-results") $(widgetFile "query-results")
getViewVariantR :: VariantId -> Handler Html
getViewVariantR variantId = do
mauthId <- maybeAuth
variant <- runDB $ get404 variantId
let theSubmissionId = variantSubmission variant
theSubmission <- runDB $ get404 theSubmissionId
if submissionIsPublic theSubmission || Just (submissionSubmitter theSubmission) == (entityKey <$> mauthId)
then
do
fullSubmissionInfo <- getFullInfo (Entity theSubmissionId theSubmission)
testOutputs <- runDB $ E.select
$ E.from $ \(out, test) -> do
E.where_ (out ^. OutTest E.==. test ^. TestId
E.&&. out ^. OutVariant E.==. E.val variantId)
E.orderBy []
return (out, test)
let outputs =
sortBy (\a b -> ((snd b) `compare` (snd a)))
$ nub
$ map (\(out, test) -> (outChecksum $ entityVal out, testName $ entityVal test)) testOutputs
defaultLayout $ do
setTitle "Variant"
$(widgetFile "view-variant")
else
error "Cannot access this submission variant"
viewOutput :: (SHA1, Text) -> WidgetFor App ()
viewOutput (outputHash, test) = do
let outputSha1AsText = fromSHA1ToText $ outputHash
$(widgetFile "view-output")
resultTable :: Entity Submission -> WidgetFor App () resultTable :: Entity Submission -> WidgetFor App ()
resultTable (Entity submissionId submission) = do resultTable (Entity submissionId submission) = do
(tableEntries, tests) <- handlerToWidget $ runDB $ getChallengeSubmissionInfos (\s -> entityKey s == submissionId) (tableEntries, tests) <- handlerToWidget $ runDB $ getChallengeSubmissionInfos (\s -> entityKey s == submissionId)

View File

@ -32,6 +32,8 @@
/q QueryFormR GET POST /q QueryFormR GET POST
/q/#Text QueryResultsR GET /q/#Text QueryResultsR GET
/view-variant/#VariantId ViewVariantR GET
/api/txt/score/#Text ApiTxtScoreR GET /api/txt/score/#Text ApiTxtScoreR GET
/make-public/#SubmissionId MakePublicR GET /make-public/#SubmissionId MakePublicR GET

View File

@ -9,7 +9,7 @@
<ul> <ul>
$forall (achievement, workingOnId) <- achievements $forall (achievement, workingOnId) <- achievements
<li><a href=@{SubmissionForAchievementR submissionId workingOnId}>send to review for #{achievementName $ entityVal achievement} achievement <li><a href=@{SubmissionForAchievementR submissionId workingOnId}>send to review for #{achievementName $ entityVal achievement} achievement</a>
$maybe variantId <- mVariantId $maybe variantId <- mVariantId
<h4>Variant parameters <h4>Variant parameters

View File

@ -0,0 +1,7 @@
<div class="media">
<div class="media-left">
<p class="media-object">
<span class="glyphicon glyphicon-asterisk" aria-hidden="hidden">
<div class="media-body">
<div class="media-heading">
<div .subm-commit>#{test} / #{outputSha1AsText}

View File

@ -0,0 +1,8 @@
<div class="media">
<div class="media-left">
<p class="media-object">
<span class="glyphicon glyphicon-asterisk" aria-hidden="hidden">
<div class="media-body">
^{submissionHeader fullSubmissionInfo}
$forall output <- outputs
^{viewOutput output}