From 421eef1c28bf8da8def2b1e870938df15da686f3 Mon Sep 17 00:00:00 2001
From: Janus Troelsen <ysangkok@gmail.com>
Date: Sat, 9 Apr 2022 00:25:37 -0500
Subject: [PATCH] Default to HTML handler, not the first

---
 src/Distribution/Server/Framework/Resource.hs | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/src/Distribution/Server/Framework/Resource.hs b/src/Distribution/Server/Framework/Resource.hs
index 3067d8ac4..3ccddfbe2 100644
--- a/src/Distribution/Server/Framework/Resource.hs
+++ b/src/Distribution/Server/Framework/Resource.hs
@@ -464,8 +464,14 @@ serveResource errRes (Resource _ rget rput rpost rdelete rformat rend _) = \dpat
                 Just answer -> handleErrors (Just format) $ answer dpath
                 Nothing -> mzero -- return 404 if the specific format is not found
                   -- return default response when format is empty or non-existent
-            _ -> do (format,answer) <- negotiateContent (head res) res
-                    handleErrors (Just format) $ answer dpath
+            _ -> do
+              let
+                contentResponsePair =
+                  case find ((== "html") . fst) res of
+                    Just x -> x
+                    Nothing -> head res
+              (format,answer) <- negotiateContent contentResponsePair res
+              handleErrors (Just format) $ answer dpath
 
     handleErrors format =
       handleErrorResponse (serveErrorResponse errRes format)