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

View File

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