From 82486e43f5d9d3bb458cbb6719f49e342cb677b1 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Mon, 28 Sep 2020 19:02:14 +0200
Subject: [PATCH] Add form for entering output hash for diffing

---
 Foundation.hs                 |  2 ++
 Handler/Query.hs              | 16 +++++++++++++++-
 config/routes                 |  2 ++
 messages/en.msg               |  4 +++-
 templates/view-variant.hamlet |  8 ++++++++
 5 files changed, 30 insertions(+), 2 deletions(-)

diff --git a/Foundation.hs b/Foundation.hs
index cbf9136..b1ba47a 100644
--- a/Foundation.hs
+++ b/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
 
diff --git a/Handler/Query.hs b/Handler/Query.hs
index bb55073..da4754e 100644
--- a/Handler/Query.hs
+++ b/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
diff --git a/config/routes b/config/routes
index c6901df..2d2bffb 100644
--- a/config/routes
+++ b/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
diff --git a/messages/en.msg b/messages/en.msg
index 40321cf..1e0d53c 100644
--- a/messages/en.msg
+++ b/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
\ No newline at end of file
+ShowAnnotations: show annotations
+Compare: Compare
+OutSha1: Output Sha1 hash
diff --git a/templates/view-variant.hamlet b/templates/view-variant.hamlet
index 900ba2b..f137f99 100644
--- a/templates/view-variant.hamlet
+++ b/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>