Format variant results as cross tables

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")

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

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

templates/view-output.hamlet

@@ -5,7 +5,8 @@
   <div class="media-body">
    <div class="media-heading">
      <div .subm-commit>#{testSet} / #{outputSha1AsText}
-     ^{Table.buildBootstrap (outputEvaluationsTable entry) tests'}
+     $forall crossTable <- crossTables
+       ^{Table.buildBootstrap (crossTableDefinition crossTable) (crossTableBody crossTable)}
      $maybe result <- mResult
         <h4>worst items
         ^{Table.buildBootstrap (lineByLineTable mainTest theStamp) result}