diff --git a/Handler/Query.hs b/Handler/Query.hs index 60f8267..e017686 100644 --- a/Handler/Query.hs +++ b/Handler/Query.hs @@ -18,8 +18,9 @@ import Database.Esqueleto ((^.)) import qualified Data.Text as T -import Data.List (nub) +import Data.List (nub, (!!)) import Data.List.Extra (groupOn) +import qualified Data.Map.Lazy as LM import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3) @@ -29,6 +30,8 @@ import GEval.LineByLine (runLineByLineGeneralized, LineRecord(..)) import qualified Data.Conduit.List as CL import System.FilePath (takeFileName) +import Data.SplitIntoCrossTabs + rawCommitQuery :: (MonadIO m, RawSql a) => Text -> ReaderT SqlBackend m [a] rawCommitQuery sha1Prefix = rawSql "SELECT ?? FROM submission WHERE is_public AND cast(commit as text) like ?" [PersistText $ "\\\\x" ++ sha1Prefix ++ "%"] @@ -216,12 +219,14 @@ getViewVariantR variantId = do error "Cannot access this submission variant" -outputEvaluationsTable :: TableEntry -> Table.Table App (Entity Test) -outputEvaluationsTable tableEntry = mempty - ++ Table.text "Metric" (formatTestEvaluationScheme . entityVal) - ++ Table.text "Score" (\test -> (formatTruncatedScore (testPrecision $ entityVal test) - $ extractScore (getTestReference test) tableEntry)) +crossTableDefinition :: TableWithValues Text -> Table.Table App (Text, [Text]) +crossTableDefinition (TableWithValues (headerH : headerR) _) = mempty + ++ Table.text headerH fst + ++ mconcat (map (\(ix, h) -> Table.text h ((!! ix) . snd)) $ zip [0..] headerR) +crossTableDefinition _ = error $ "cross-tab of an unexpected size" +crossTableBody :: TableWithValues Text -> [(Text, [Text])] +crossTableBody (TableWithValues _ rows) = rows paramsTable :: Table.Table App Parameter paramsTable = mempty @@ -233,7 +238,6 @@ viewOutput entry tests (outputHash, testSet) = do let tests'@(mainTest:_) = filter (\e -> (testName $ entityVal e) == testSet) tests let outputSha1AsText = fromSHA1ToText $ outputHash - mRepoDir <- handlerToWidget $ justGetSubmissionRepoDir (entityKey $ tableEntrySubmission entry) let variant = variantName $ entityVal $ tableEntryVariant entry let theStamp = submissionStamp $ entityVal $ tableEntrySubmission entry @@ -245,9 +249,17 @@ viewOutput entry tests (outputHash, testSet) = do let mainMetric = testMetric $ entityVal mainTest + let testLabels = map (formatTestEvaluationScheme . entityVal) tests' + let mapping = LM.fromList $ map (\test -> (formatTestEvaluationScheme $ entityVal test, + (formatTruncatedScore (testPrecision $ entityVal test) + $ extractScore (getTestReference test) entry))) tests' + let crossTables = splitIntoTablesWithValues "Metric" "Score" mapping testLabels + mResult <- if shouldBeShown then + do + mRepoDir <- handlerToWidget $ justGetSubmissionRepoDir (entityKey $ tableEntrySubmission entry) case mRepoDir of Just repoDir -> do outFile' <- liftIO $ lookForCompressedFiles (repoDir (T.unpack variant) <.> "tsv") diff --git a/gonito.cabal b/gonito.cabal index d17899e..b3b506f 100644 --- a/gonito.cabal +++ b/gonito.cabal @@ -128,7 +128,7 @@ library , filemanip , cryptohash , markdown - , geval >= 1.24 && < 1.27 + , geval >= 1.27 && < 1.28 , filepath , yesod-table , regex-tdfa diff --git a/stack.yaml b/stack.yaml index efd4e46..680e353 100644 --- a/stack.yaml +++ b/stack.yaml @@ -4,5 +4,5 @@ flags: dev: false packages: - '.' -extra-deps: [../geval,wai-handler-fastcgi-3.0.0.2,murmur3-1.0.3,random-strings-0.1.1.0,naturalcomp-0.0.3,Munkres-0.1,Chart-1.9.1,Chart-cairo-1.9.1,multiset-0.3.4.1,pwstore-fast-2.4.4,yesod-table-2.0.3,esqueleto-3.0.0] +extra-deps: [../geval,wai-handler-fastcgi-3.0.0.2,murmur3-1.0.3,random-strings-0.1.1.0,naturalcomp-0.0.3,Munkres-0.1,Chart-1.9.1,Chart-cairo-1.9.1,multiset-0.3.4.1,pwstore-fast-2.4.4,yesod-table-2.0.3,esqueleto-3.0.0,'ordered-containers-0.2.2@sha256:ebf2be3f592d9cf148ea6b8375f8af97148d44f82d8d04476899285e965afdbf,810'] resolver: lts-12.26 diff --git a/templates/view-output.hamlet b/templates/view-output.hamlet index 183789c..4777c71 100644 --- a/templates/view-output.hamlet +++ b/templates/view-output.hamlet @@ -5,7 +5,8 @@
#{testSet} / #{outputSha1AsText} - ^{Table.buildBootstrap (outputEvaluationsTable entry) tests'} + $forall crossTable <- crossTables + ^{Table.buildBootstrap (crossTableDefinition crossTable) (crossTableBody crossTable)} $maybe result <- mResult

worst items ^{Table.buildBootstrap (lineByLineTable mainTest theStamp) result}