Fix broken view-variant when headers are set

This commit is contained in:
Filip Gralinski 2020-09-28 21:38:19 +02:00
parent 82486e43f5
commit c15dd30804
2 changed files with 9 additions and 6 deletions

View File

@ -33,9 +33,10 @@ import qualified Data.Map.Lazy as LM
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3)
import Data.Conduit.SmartSource (lookForCompressedFiles)
import GEval.Core (GEvalSpecification(..), ResultOrdering(..))
import GEval.Core (GEvalSpecification(..), GEvalOptions(..), ResultOrdering(..))
import GEval.LineByLine (runLineByLineGeneralized, runDiffGeneralized, LineRecord(..))
import GEval.Common (FormattingOptions(..), MetricValue)
import GEval.OptionsParser (readOptsFromConfigFile)
import qualified Data.Conduit.List as CL
import System.FilePath (takeFileName)
import System.Directory (makeAbsolute)
@ -256,7 +257,7 @@ instance Diffable SHA1 where
postCompareFormR :: VariantId -> TestId -> Handler Html
postCompareFormR variantId testId = do
((result, formWidget), formEnctype) <- runFormPost outQueryForm
((result, _), _) <- runFormPost outQueryForm
case result of
FormSuccess outQuery -> do
(out:_) <- runDB $ rawOutQuery outQuery
@ -370,7 +371,7 @@ data DiffLineRecord = DiffLineRecord Text Text (Diff (Text, MetricValue)) Word32
deriving (Show)
getUniLineRecord :: LineRecord -> DiffLineRecord
getUniLineRecord (LineRecord inp exp out lineNo val) = DiffLineRecord inp exp (OneThing (out, val)) lineNo
getUniLineRecord (LineRecord inp expect out lineNo val) = DiffLineRecord inp expect (OneThing (out, val)) lineNo
getBiLineRecord :: (LineRecord, LineRecord) -> DiffLineRecord
getBiLineRecord ((LineRecord oldInp oldExp oldOut oldLineNo oldVal), (LineRecord newInp newExp newOut newLineNo newVal))
@ -429,6 +430,8 @@ viewOutputWithNonDefaultTestSelected entry tests mainTest (outputHash, testSet)
let testName = T.unpack testSet
Right opts <- liftIO $ readOptsFromConfigFile [] (current repoDir </> "config.txt")
let spec = GEvalSpecification {
gesOutDirectory = current repoDir,
gesExpectedDirectory = Nothing,
@ -448,8 +451,8 @@ viewOutputWithNonDefaultTestSelected entry tests mainTest (outputHash, testSet)
gesGonitoGitAnnexRemote = Nothing,
gesReferences = Nothing,
gesBootstrapResampling = Nothing,
gesInHeader = Nothing,
gesOutHeader = Nothing,
gesInHeader = gesInHeader $ geoSpec opts,
gesOutHeader = gesOutHeader $ geoSpec opts,
gesShowPreprocessed = True }
case outPaths of

View File

@ -130,7 +130,7 @@ library
, filemanip
, cryptohash
, markdown
, geval >= 1.37 && < 1.38
, geval >= 1.37.2 && < 1.38
, filepath
, yesod-table
, regex-tdfa