s464900/gonito
1
0
Fork 0
forked from filipg/gonito
Code Issues Pull Requests Projects Releases Wiki Activity

Add helper anchors when the output is viewed

Browse Source
This commit is contained in:
Filip Gralinski 2020-08-14 18:33:38 +02:00
parent b8e7c2172b
commit 08c9a534c7
2 changed files with 8 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Handler/Query.hs
View File

@ -238,11 +238,17 @@ getViewVariantR variantId = do
let (mainTest:_) = sortBy (flip testComparator) tests' let (mainTest:_) = sortBy (flip testComparator) tests'
getViewVariantTestR variantId (entityKey mainTest) getViewVariantTestR variantId (entityKey mainTest)
linkedWithAnchor h propFunc routeFunc anchorFunc =
Table.widget h (
\v -> [whamlet|<a href=@{routeFunc v}\\##{anchorFunc v}>#{propFunc v}|])
crossTableDefinition :: VariantId -> TableWithValues (Entity Test, Text) -> Table.Table App (Text, [(Entity Test, Text)]) crossTableDefinition :: VariantId -> TableWithValues (Entity Test, Text) -> Table.Table App (Text, [(Entity Test, Text)])
crossTableDefinition variantId (TableWithValues (headerH : headerR) _) = mempty crossTableDefinition variantId (TableWithValues (headerH : headerR) _) = mempty
++ Table.text headerH fst ++ Table.text headerH fst
++ mconcat (map (\(ix, h) -> Table.linked h (snd . (!! ix) . snd) ((\(e, _) -> ViewVariantTestR variantId (entityKey e)) . (!! ix) . snd)) $ zip [0..] headerR) ++ mconcat (map (\(ix, h) -> linkedWithAnchor h
(snd . (!! ix) . snd)
((\(e, _) -> ViewVariantTestR variantId (entityKey e)) . (!! ix) . snd)) $ zip [0..] headerR)
fst
crossTableDefinition _ _ = error $ "cross-tab of an unexpected size" crossTableDefinition _ _ = error $ "cross-tab of an unexpected size"
crossTableBody :: TableWithValues (Entity Test, Text) -> [(Text, [(Entity Test, Text)])] crossTableBody :: TableWithValues (Entity Test, Text) -> [(Text, [(Entity Test, Text)])]

1
templates/view-output.hamlet
View File

@ -8,6 +8,7 @@
$forall crossTable <- crossTables $forall crossTable <- crossTables
^{Table.buildBootstrap (crossTableDefinition variantId crossTable) (crossTableBody crossTable)} ^{Table.buildBootstrap (crossTableDefinition variantId crossTable) (crossTableBody crossTable)}
$maybe result <- mResult $maybe result <- mResult
<a name="worst-items-#{testSet}">
<h4>worst items <h4>worst items
^{Table.buildBootstrap (lineByLineTable mainTest theStamp) result} ^{Table.buildBootstrap (lineByLineTable mainTest theStamp) result}
$nothing $nothing