[commit: haddock] T6018-injective-type-families, adamse-D1033, ghc-head, master, metainfo, wip/10268, wip/10313, wip/D538, wip/D538-1, wip/D538-2, wip/D538-3, wip/D538-4, wip/D538-5, wip/D538-6, wip/D548-master, wip/D548-master-2, wip/T10483, wip/T9840, wip/api-annot-tweaks-7.10, wip/api-annots-ghc-7.10-3, wip/orf-reboot: Minor refactoring (ae2900c)

git at git.haskell.org git at git.haskell.org
Wed Jul 8 08:32:21 UTC 2015


Repository : ssh://git@git.haskell.org/haddock

On branches: T6018-injective-type-families,adamse-D1033,ghc-head,master,metainfo,wip/10268,wip/10313,wip/D538,wip/D538-1,wip/D538-2,wip/D538-3,wip/D538-4,wip/D538-5,wip/D538-6,wip/D548-master,wip/D548-master-2,wip/T10483,wip/T9840,wip/api-annot-tweaks-7.10,wip/api-annots-ghc-7.10-3,wip/orf-reboot
Link       : http://git.haskell.org/haddock.git/commitdiff/ae2900cf4f75096ed269523f8835a1cc6caa0053

>---------------------------------------------------------------

commit ae2900cf4f75096ed269523f8835a1cc6caa0053
Author: Simon Hengel <sol at typeful.net>
Date:   Sun Nov 2 07:32:54 2014 +0800

    Minor refactoring


>---------------------------------------------------------------

ae2900cf4f75096ed269523f8835a1cc6caa0053
 .../src/Documentation/Haddock/Parser.hs            | 50 ++++++++++++----------
 1 file changed, 28 insertions(+), 22 deletions(-)

diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index 110a0de..94750ad 100644
--- a/haddock-library/src/Documentation/Haddock/Parser.hs
+++ b/haddock-library/src/Documentation/Haddock/Parser.hs
@@ -210,9 +210,16 @@ picture = DocPic . makeLabeled Picture . decodeUtf8
 
 -- | Paragraph parser, called by 'parseParas'.
 paragraph :: Parser (DocH mod Identifier)
-paragraph = examples <|> skipSpace *> (list <|> birdtracks <|> codeblock
-                                       <|> property <|> header
-                                       <|> textParagraph)
+paragraph = examples <|> skipSpace *> (
+      unorderedList
+  <|> orderedList
+  <|> definitionList
+  <|> birdtracks
+  <|> codeblock
+  <|> property
+  <|> header
+  <|> textParagraph
+  )
 
 -- | Headers inside the comment denoted with @=@ signs, up to 6 levels
 -- deep.
@@ -233,20 +240,17 @@ header = do
 textParagraph :: Parser (DocH mod Identifier)
 textParagraph = docParagraph . parseString . intercalate "\n" <$> many1 nonEmptyLine
 
--- | List parser, called by 'paragraph'.
-list :: Parser (DocH mod Identifier)
-list = DocUnorderedList <$> unorderedList
-       <|> DocOrderedList <$> orderedList
-       <|> DocDefList <$> definitionList
-
 -- | Parses unordered (bullet) lists.
-unorderedList :: Parser [DocH mod Identifier]
-unorderedList = ("*" <|> "-") *> innerList unorderedList
+unorderedList :: Parser (DocH mod Identifier)
+unorderedList = DocUnorderedList <$> p
+  where
+    p = ("*" <|> "-") *> innerList p
 
 -- | Parses ordered lists (numbered or dashed).
-orderedList :: Parser [DocH mod Identifier]
-orderedList = (paren <|> dot) *> innerList orderedList
+orderedList :: Parser (DocH mod Identifier)
+orderedList = DocOrderedList <$> p
   where
+    p = (paren <|> dot) *> innerList p
     dot = (decimal :: Parser Int) <* "."
     paren = "(" *> decimal <* ")"
 
@@ -265,15 +269,17 @@ innerList item = do
     Right i -> contents : i
 
 -- | Parses definition lists.
-definitionList :: Parser [(DocH mod Identifier, DocH mod Identifier)]
-definitionList = do
-  label <- "[" *> (parseStringBS <$> takeWhile1 (`notElem` "]\n")) <* "]"
-  c <- takeLine
-  (cs, items) <- more definitionList
-  let contents = parseString . dropNLs . unlines $ c : cs
-  return $ case items of
-    Left p -> [(label, contents `docAppend` p)]
-    Right i -> (label, contents) : i
+definitionList :: Parser (DocH mod Identifier)
+definitionList = DocDefList <$> p
+  where
+    p = do
+      label <- "[" *> (parseStringBS <$> takeWhile1 (`notElem` "]\n")) <* "]"
+      c <- takeLine
+      (cs, items) <- more p
+      let contents = parseString . dropNLs . unlines $ c : cs
+      return $ case items of
+        Left x -> [(label, contents `docAppend` x)]
+        Right i -> (label, contents) : i
 
 -- | Drops all trailing newlines.
 dropNLs :: String -> String



More information about the ghc-commits mailing list