From 35c99f595c984f58d2fb4dc180c48a0eaf7df173 Mon Sep 17 00:00:00 2001
From: Ben Simms <ben@bensimms.moe>
Date: Tue, 3 May 2022 13:19:24 +0100
Subject: Keep track of ordered list indexes and render them (#1407)

* Keep track of ordered list indexes and render them

* Rename some identifiers to clarify
---
 haddock-api/src/Haddock/Interface/Json.hs       | 4 +++-
 haddock-api/src/Haddock/Interface/LexParseRn.hs | 6 +++++-
 2 files changed, 8 insertions(+), 2 deletions(-)

(limited to 'haddock-api/src/Haddock/Interface')

diff --git a/haddock-api/src/Haddock/Interface/Json.hs b/haddock-api/src/Haddock/Interface/Json.hs
index 92fb2e75..8b27a982 100644
--- a/haddock-api/src/Haddock/Interface/Json.hs
+++ b/haddock-api/src/Haddock/Interface/Json.hs
@@ -130,8 +130,10 @@ jsonDoc (DocUnorderedList xs) = jsonObject
 
 jsonDoc (DocOrderedList xs) = jsonObject
     [ ("tag", jsonString "DocOrderedList")
-    , ("documents", jsonArray (fmap jsonDoc xs))
+    , ("items", jsonArray (fmap jsonItem xs))
     ]
+  where
+    jsonItem (index, a) = jsonObject [("document", jsonDoc a), ("seq", jsonInt index)]
 
 jsonDoc (DocDefList xys) = jsonObject
     [ ("tag", jsonString "DocDefList")
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index 14e1d92b..d769f0cc 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -84,6 +84,10 @@ processModuleHeader dflags pkgName gre safety mayStr = do
   where
     failure = (emptyHaddockModInfo, Nothing)
 
+traverseSnd :: (Traversable t, Applicative f) => (a -> f b) -> t (x, a) -> f (t (x, b))
+traverseSnd f = traverse (\(x, a) ->
+                             (\b -> (x, b)) <$> f a)
+
 -- | Takes a 'GlobalRdrEnv' which (hopefully) contains all the
 -- definitions and a parsed comment and we attempt to make sense of
 -- where the identifiers in the comment point to. We're in effect
@@ -146,7 +150,7 @@ rename dflags gre = rn
       DocBold doc -> DocBold <$> rn doc
       DocMonospaced doc -> DocMonospaced <$> rn doc
       DocUnorderedList docs -> DocUnorderedList <$> traverse rn docs
-      DocOrderedList docs -> DocOrderedList <$> traverse rn docs
+      DocOrderedList docs -> DocOrderedList <$> traverseSnd rn docs
       DocDefList list -> DocDefList <$> traverse (\(a, b) -> (,) <$> rn a <*> rn b) list
       DocCodeBlock doc -> DocCodeBlock <$> rn doc
       DocIdentifierUnchecked x -> pure (DocIdentifierUnchecked x)
-- 
cgit v1.2.3