Continue work viewing variants

Foundation.hs

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

Handler/Query.hs

@@ -92,6 +92,43 @@ processQuery query = do
     setTitle "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 submissionId submission) = do
   (tableEntries, tests) <- handlerToWidget $ runDB $ getChallengeSubmissionInfos (\s -> entityKey s == submissionId)

config/routes

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

templates/edit-submission.hamlet

@@ -9,7 +9,7 @@
 
 <ul>
  $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
   <h4>Variant parameters

templates/view-output.hamlet

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

templates/view-variant.hamlet

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