Add form for entering output hash for diffing

This commit is contained in:
Filip Gralinski 2020-09-28 19:02:14 +02:00
parent b3c259a478
commit 82486e43f5
5 changed files with 30 additions and 2 deletions

View File

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

View File

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

View File

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

View File

@ -92,3 +92,5 @@ AltRepoScheme: alternative git repo scheme (URL without the challenge name point
AltRepoSchemeTooltip: set this if you want to use an alternative git server for all your submissions 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) 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

View File

@ -13,3 +13,11 @@
$forall output <- outputs $forall output <- outputs
^{viewOutputWithNonDefaultTestSelected entry tests testSelectedEnt output} ^{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>