Default to HTML handler, not the first (#1053)

haskell · Apr 11, 2022 · e88e25a · e88e25a
1 parent 73d008d
commit e88e25a
Showing 1 changed file with 8 additions and 2 deletions.
diff --git 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)