Add form for entering output hash for diffing

Foundation.hs

@@ -208,6 +208,8 @@ instance Yesod App where
     isAuthorized (ChallengeParamGraphDataR _ _ _) _ = regularAuthorization
     isAuthorized (IndicatorGraphDataR _) _ = regularAuthorization
 
+    isAuthorized (CompareFormR _ _) _ = regularAuthorization
+
     -- Default to Authorized for now.
     isAuthorized _ _ = isTrustedAuthorized
 

Handler/Query.hs

@@ -37,7 +37,7 @@ import GEval.Core (GEvalSpecification(..), ResultOrdering(..))
 import GEval.LineByLine (runLineByLineGeneralized, runDiffGeneralized, LineRecord(..))
 import GEval.Common (FormattingOptions(..), MetricValue)
 import qualified Data.Conduit.List as CL
-import System.FilePath (takeFileName, makeRelative)
+import System.FilePath (takeFileName)
 import System.Directory (makeAbsolute)
 
 import Data.SplitIntoCrossTabs
@@ -254,6 +254,15 @@ instance Diffable SHA1 where
     | old == new = OneThing new
     | otherwise = TwoThings old new
 
+postCompareFormR :: VariantId -> TestId -> Handler Html
+postCompareFormR variantId testId = do
+    ((result, formWidget), formEnctype) <- runFormPost outQueryForm
+    case result of
+      FormSuccess outQuery -> do
+        (out:_) <- runDB $ rawOutQuery outQuery
+        let otherVariantId = outVariant $ entityVal out
+        doViewVariantTestR (TwoThings otherVariantId variantId) testId
+
 nullSHA1 :: SHA1
 nullSHA1 = fromTextToSHA1 "da39a3ee5e6b4b0d3255bfef95601890afd80709"
 
@@ -276,6 +285,8 @@ doViewVariantTestR variantId testId = do
         sortBy (\a b -> ((snd b) `compare` (snd a)))
         $ map swap $ LM.toList $ runDiff (nullSHA1, ()) $ fmap (LM.fromList . map swap) outputs'
 
+  (formWidget, formEnctype) <- generateFormPost outQueryForm
+
   defaultLayout $ do
     setTitle "Variant"
     $(widgetFile "view-variant")
@@ -560,3 +571,6 @@ queryResult submission = do
 
 queryForm :: Form Text
 queryForm = renderBootstrap3 BootstrapBasicForm $ areq textField (fieldSettingsLabel MsgGitCommitSha1) Nothing
+
+outQueryForm :: Form Text
+outQueryForm = renderBootstrap3 BootstrapBasicForm $ areq textField (fieldSettingsLabel MsgOutSha1) Nothing

config/routes

@@ -40,6 +40,8 @@
 /q QueryFormR GET POST
 /q/#Text QueryResultsR  GET
 
+/compare/#VariantId/#TestId CompareFormR POST
+
 /view-variant/#VariantId ViewVariantR GET
 /view-variant-test/#VariantId/#TestId ViewVariantTestR GET
 /view-variant-diff/#VariantId/#VariantId/#TestId ViewVariantDiffR GET

messages/en.msg

@@ -91,4 +91,6 @@ UserIdentifier: user login/identifier
 AltRepoScheme: alternative git repo scheme (URL without the challenge name pointing to some external server)
 AltRepoSchemeTooltip: set this if you want to use an alternative git server for all your submissions
 ShouldChallengeBeValidated: validate challenge (do not switch off unless you have a good reason)
-ShowAnnotations: show annotations
+ShowAnnotations: show annotations
+Compare: Compare
+OutSha1: Output Sha1 hash

templates/view-variant.hamlet

@@ -13,3 +13,11 @@
 
   $forall output <- outputs
     ^{viewOutputWithNonDefaultTestSelected entry tests testSelectedEnt output}
+
+ <h3>Compare with other submission
+
+ <p>
+  <form method=post action=@{CompareFormR (current variantId) testId}#form enctype=#{formEnctype}>
+    ^{formWidget}
+    <button .btn .btn-primary type="submit">
+       _{MsgCompare} <span class="glyphicon glyphicon-upload"></span>