Variant information reachable from query results
This commit is contained in:
parent
c0a06ae112
commit
1d2c2ca78f
@ -100,9 +100,10 @@ getViewVariantR variantId = do
|
||||
let theSubmissionId = variantSubmission variant
|
||||
theSubmission <- runDB $ get404 theSubmissionId
|
||||
|
||||
([entry], tests) <- runDB $ getChallengeSubmissionInfos (\e -> entityKey e == theSubmissionId)
|
||||
(\e -> entityKey e == variantId)
|
||||
(submissionChallenge theSubmission)
|
||||
([entry], tests') <- runDB $ getChallengeSubmissionInfos (\e -> entityKey e == theSubmissionId)
|
||||
(\e -> entityKey e == variantId)
|
||||
(submissionChallenge theSubmission)
|
||||
let tests = sortBy (flip testComparator) tests'
|
||||
|
||||
if submissionIsPublic theSubmission || Just (submissionSubmitter theSubmission) == (entityKey <$> mauthId)
|
||||
then
|
||||
|
@ -82,6 +82,11 @@ variantTable paramNames tests = mempty
|
||||
++ Table.int "#" tableEntryRank
|
||||
++ mconcat (map paramExtractor paramNames)
|
||||
++ mconcat (map (\e@(Entity _ t) -> resultCell t (extractScore $ getTestReference e)) tests)
|
||||
++ Table.widget "" variantStatusCellWidget
|
||||
|
||||
variantStatusCellWidget :: TableEntry -> WidgetFor App ()
|
||||
variantStatusCellWidget entry = $(widgetFile "variant-status")
|
||||
where theVariantId = entityKey $ tableEntryVariant entry
|
||||
|
||||
paramExtractor :: Text -> Table App TableEntry
|
||||
paramExtractor paramName = Table.text paramName (\entry ->
|
||||
|
2
templates/variant-status.hamlet
Normal file
2
templates/variant-status.hamlet
Normal file
@ -0,0 +1,2 @@
|
||||
<a href="@{ViewVariantR theVariantId}">
|
||||
<span class="glyphicon glyphicon-info-sign" title="click to see the detailed information" aria-hidden="true">
|
Loading…
Reference in New Issue
Block a user