From 08c9a534c7794110e6876afeda174af9d9253720 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filip.gralinski@applica.pl>
Date: Fri, 14 Aug 2020 18:33:38 +0200
Subject: [PATCH] Add helper anchors when the output is viewed

---
 Handler/Query.hs             | 8 +++++++-
 templates/view-output.hamlet | 1 +
 2 files changed, 8 insertions(+), 1 deletion(-)

diff --git a/Handler/Query.hs b/Handler/Query.hs
index 37b459b..dd15ecd 100644
--- a/Handler/Query.hs
+++ b/Handler/Query.hs
@@ -238,11 +238,17 @@ getViewVariantR variantId = do
   let (mainTest:_) = sortBy (flip testComparator) tests'
   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 (headerH : headerR) _) = mempty
   ++ 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"
 
 crossTableBody :: TableWithValues (Entity Test, Text) -> [(Text, [(Entity Test, Text)])]
diff --git a/templates/view-output.hamlet b/templates/view-output.hamlet
index b9873da..dc609d6 100644
--- a/templates/view-output.hamlet
+++ b/templates/view-output.hamlet
@@ -8,6 +8,7 @@
      $forall crossTable <- crossTables
        ^{Table.buildBootstrap (crossTableDefinition variantId crossTable) (crossTableBody crossTable)}
      $maybe result <- mResult
+        <a name="worst-items-#{testSet}">
         <h4>worst items
         ^{Table.buildBootstrap (lineByLineTable mainTest theStamp) result}
      $nothing