From d8bedeb98a84db0d51c49d41c632d9d4846d1bbe Mon Sep 17 00:00:00 2001
From: Alec Theriault <alec.theriault@gmail.com>
Date: Sat, 28 Mar 2020 13:17:35 -0400
Subject: `haddock-library` document header level

Document the fact the header level is going to always be between 1 and 6
inclusive. Along the way, I also optimized the parsing code a bit.
---
 haddock-library/src/Documentation/Haddock/Parser.hs | 8 ++++----
 haddock-library/src/Documentation/Haddock/Types.hs  | 2 +-
 2 files changed, 5 insertions(+), 5 deletions(-)

(limited to 'haddock-library')

diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index 17240792..149ff93d 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -512,11 +512,11 @@ since = ("@since " *> version <* skipHorizontalSpace <* endOfLine) >>= setSince
 header :: Parser (DocH mod Identifier)
 header = do
   let psers = map (string . flip T.replicate "=") [6, 5 .. 1]
-      pser = choice' psers
-  delim <- T.unpack <$> pser
-  line <- skipHorizontalSpace *> nonEmptyLine >>= return . parseText
+      pser = Parsec.choice psers
+  depth <- T.length <$> pser
+  line <- parseText <$> (skipHorizontalSpace *> nonEmptyLine)
   rest <- try paragraph <|> return DocEmpty
-  return $ DocHeader (Header (length delim) line) `docAppend` rest
+  return $ DocHeader (Header depth line) `docAppend` rest
 
 textParagraph :: Parser (DocH mod Identifier)
 textParagraph = parseText . T.intercalate "\n" <$> some nonEmptyLine
diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs
index 4cf61fee..d8c7a9fa 100644
--- a/haddock-library/src/Documentation/Haddock/Types.hs
+++ b/haddock-library/src/Documentation/Haddock/Types.hs
@@ -79,7 +79,7 @@ data Picture = Picture
   } deriving (Eq, Show)
 
 data Header id = Header
-  { headerLevel :: Int
+  { headerLevel :: Int  -- ^ between 1 and 6 inclusive
   , headerTitle :: id
   } deriving (Eq, Show, Functor, Foldable, Traversable)
 
-- 
cgit v1.2.3