Some examples of weird Haddock behavior.

haddock.hs

import Prelude hiding (id, mod, (+))

import qualified Documentation.Haddock.Parser as Haddock
import qualified Documentation.Haddock.Types as Haddock

main :: IO ()
main = runTests

  --
  -- problems
  --

  -- annotations steal syntax from code blocks
  [ "@since 1\n@" ==> p (s "@")
  , "@since a\n@" ==> pre (s "since a\n")

  -- inline math steals syntax from ordered lists
  , "(1)" ==> ol [p empty]
  , "\\(2)" ==> p (s "(2)")
  , "(3\\)" ==> p (s "(3)")
  , "\\(4\\)" ==> p (mathi "4")

  -- display math steals syntax from definition lists
  , "[a]" ==> dl [(s "a", empty)]
  , "\\[b]" ==> p (s "[b]")
  , "[c\\]" ==> dl [(s "c\\", empty)]
  , "\\[d\\]" ==> p (mathd "d")

  -- markdown links and definition lists share syntax
  , "[a] (b)" ==> p (a "b" (Just "a"))
  , "[c] ( d )" ==> dl [(s "c", s "( d )")]

  -- anchors can have spaces but can't be linked to
  , "#a b#" ==> p (anchor "a b")
  , "\"A#b c\"" ==> p (s "\"A#b c\"")
  , "\"A#b\\ c\"" ==> p (s "\"A#b c\"")

  --
  -- syntax
  --

  , "" ==> empty
  , "haddock" ==> p (s "haddock")
  -- paragraphs are separated by two newlines
  , "non\n\nstrict" ==> p (s "non") + p (s "strict")
  -- identifiers are inside single quotes
  , "'id'" ==> p (id quote quote "id")
  , "'+'" ==> p (id quote quote "+")
  -- operator identifiers cannot be in parentheses
  , "'(+)'" ==> p (s "'(+)'")
  , "('+')" ==> p (s "(" + id quote quote "+" + s ")")
  -- identifiers can also use grave accents instead of single quotes
  , "`abs'" ==> p (id grave quote "abs")
  , "'pure`" ==> p (id quote grave "pure")
  , "`curry`" ==> p (id grave grave "curry")
  , "'foldl''" ==> p (id quote quote "foldl'")
  -- modules are inside double quotes
  , "\"Prelude\"" ==> p (mod "Prelude")
  -- modules can include anchors
  , "\"Data.Bool#bool\"" ==> p (mod "Data.Bool#bool")
  -- italics are inside forward slashes
  , "/lazy/" ==> p (i (s "lazy"))
  -- inline code is inside at signs
  -- there must be an adjacent inline element otherwise it's a code block
  , "@ctrl@ after" ==> p (mono (s "ctrl") + s " after")
  , "before @shift@" ==> p (s "before " + mono (s "shift"))
  , "before @alt@ after" ==> p (s "before " + mono (s "alt") + s " after")
  -- bold is inside double underscores
  , "__coffee__" ==> p (b (s "coffee"))
  -- lists use either asterisks or hyphens
  , "* this" ==> ul [p (s "this")]
  , "- that" ==> ul [p (s "that")]
  -- ordered lists can either use periods or parentheses
  , "1. one" ==> ol [p (s "one")]
  , "(1) uno" ==> ol [p (s "uno")]
  -- definition lists use square brackets and optionally colons
  , "[a] first" ==> dl [(s "a", s "first")]
  , "[b]: second" ==> dl [(s "b", s "second")]
  -- code blocks can use bird tracks
  , "> take 1" ==> pre (s "take 1")
  -- or at signs
  , "@drop 1@" ==> pre (s "drop 1")
  -- links are inside angle brackets
  , "<web>" ==> p (a "web" Nothing)
  -- links can have labels
  , "<link here>" ==> p (a "link" (Just "here"))
  -- simple markdown style links work too
  , "[label](url)" ==> p (a "url" (Just "label"))
  -- http, https, and ftp links are automatically detected
  , "http://example" ==> p (a "http://example" Nothing)
  , "https://invalid" ==> p (a "https://invalid" Nothing)
  , "ftp://local" ==> p (a "ftp://local" Nothing)
  -- certain characters are ignored at the end
  , "ftp://comma," ==> p (a "ftp://comma" Nothing + s ",")
  , "ftp://period." ==> p (a "ftp://period" Nothing + s ".")
  , "ftp://exclaim!" ==> p (a "ftp://exclaim" Nothing + s "!")
  , "ftp://question?" ==> p (a "ftp://question" Nothing + s "?")
  -- images are inside double angle brackets
  , "<<cat>>" ==> p (img "cat" Nothing)
  -- images can have titles
  , "<<dog woof>>" ==> p (img "dog" (Just "woof"))
  -- simple markdown style images work too
  , "![chirp](bird)" ==> p (img "bird" (Just "chirp"))
  -- inline math uses "escaped" parentheses
  , "\\(x\\)" ==> p (mathi "x")
  -- block ("display") math uses "escaped" square brackets
  , "\\[y\\]" ==> p (mathd "y")
  -- anchors are inside hash signs
  , "#anchor#" ==> p (anchor "anchor")
  -- properties start with "prop>"
  , "prop> 1 + 1 = 2" ==> prop "1 + 1 = 2"
  -- examples start with ">>>"
  , ">>> 1 + 1" ==> ex [("1 + 1", [])]
  , ">>> 1 + 1\n2" ==> ex [("1 + 1", ["2"])]
  , ">>> 1 + 1\n2\n3" ==> ex [("1 + 1", ["2", "3"])]
  -- blank lines must be given explicitly
  , ">>> 1 + 1\n<BLANKLINE>" ==> ex [("1 + 1", [""])]
  -- there are six levels of headings
  , "= one" ==> h 1 (s "one")
  , "== two" ==> h 2 (s "two")
  , "=== three" ==> h 3 (s "three")
  , "==== four" ==> h 4 (s "four")
  , "===== five" ==> h 5 (s "five")
  , "====== six" ==> h 6 (s "six")
  -- sections and chunks are not handled by this library
  , "* not section" ==> ul [p (s "not section")]
  , "$notChunk" ==> p (s "$notChunk")
  -- annotations are put into the parser state
  -- they don't show up in the output document
  , "@since 1.2.3" ==> empty
  -- annotations with invalid versions end up as strings
  , "@since never" ==> p (s "@since never")

  --
  -- spaces
  --

  , " " ==> empty
  , " a " ==> p (s "a ")
  , " a b " ==> p (s "a b ")
  , " a \n b " ==> p (s "a \n b ")
  , " a \n \n b " ==> p (s "a ") + p (s "b ")
  -- spaces are not allowed inside identifiers
  , " ' a ' " ==> p (s "' a ' ")
  , " 'a' " ==> p (id quote quote "a" + s " ")
  -- spaces are not allowed inside modules
  , " \" A \" " ==> p (s "\" A \" ")
  , " \"A\" " ==> p (mod "A" + s " ")
  , " \"A# b \" " ==> p (s "\"A# b \" ")
  , " / a / " ==> p (i (s " a ") + s " ")
  , " / a b / " ==> p (i (s " a b ") + s " ")
  -- newlines are not allowed inside italics
  , " / a \n b / " ==> p (s "/ a \n b / ")
  , " a @ b @ c " ==> p (s "a " + mono (s " b ") + s " c ")
  , " a @ b c @ d " ==> p (s "a " + mono (s " b c ") + s " d ")
  -- newlines are kept in inline monospaced text
  , " a @ b \n c @ d " ==> p (s "a " + mono (s " b \n c ") + s " d ")
  , " __ a __ " ==> p (b (s " a ") + s " ")
  , " __ a b __ " ==> p (b (s " a b ") + s " ")
  -- newlines are not allowed inside bold text
  , " __ a \n b __ " ==> p (s "__ a \n b __ ")
  , " * a " ==> ul [p (s "a ")]
  , " * a b " ==> ul [p (s "a b ")]
  , " * a \n b " ==> ul [p (s "a \n b ")]
  -- two newlines stop lists
  , " * a \n \n b " ==> ul [p (s "a ")] + p (s "b ")
  , " 1. a " ==> ol [p (s "a ")]
  , " 1. a b " ==> ol [p (s "a b ")]
  , " 1. a \n b " ==> ol [p (s "a \n b ")]
  -- two newlines stop ordered lists
  , " 1. a \n \n b " ==> ol [p (s "a ")] + p (s "b ")
  , " [ k ] v " ==> dl [(s " k ", s "v ")]
  , " [ k ] \n v " ==> dl [(s " k ", s "v ")]
  -- two newlines stop definition lists
  , " [ k ] \n \n v " ==> dl [(s " k ", empty)] + p (s "v ")
  , " [ k ]: v " ==> dl [(s " k ", s "v ")]
  -- newlines are not allowed in definition terms
  , " [ k \n l ] v " ==> p (s "[ k \n l ] v ")
  -- colons in definition lists can't have spaces
  , " [ k ] : v " ==> dl [(s " k ", s ": v ")]
  , " > a " ==> pre (s "a ")
  , " > a b " ==> pre (s "a b ")
  -- a single newline escapes bird tracks
  , " > a \n b " ==> pre (s "a ") + p (s "b ")
  -- minimum leading spaces are removed
  , " > a \n > b " ==> pre (s "a \nb ")
  , " > a \n >  b " ==> pre (s "a \n b ")
  , " >  a \n > b " ==> pre (s " a \nb ")
  , " @ a @ " ==> pre (s " a")
  , " @ a b @ " ==> pre (s " a b")
  -- leading spaces are not removed
  , " @ a \n b @ " ==> pre (s " a \n b")
  , " < a > " ==> p (a "a" Nothing + s " ")
  , " < a b > " ==> p (a "a" (Just "b") + s " ")
  -- newlines are not allowed inside links
  , " < a \n b > " ==> p (s "< a \n b > ")
  , " [ a ] (b) " ==> p (a "b" (Just "a"))
  -- newlines are allowed inside markdown links
  , " [ a ] \n (b) " ==> p (a "b" (Just "a"))
  , " [ a \n b ] (c) " ==> p (a "c" (Just "a \n b"))
  -- spaces are not allowed inside markdown link urls
  -- it turns them into definition lists
  , " [ a ] ( b ) " ==> dl [(s " a ", s "( b ) ")]
  -- image brackets cannot be spaced out
  , " < < a > > " ==> p (a "<" (Just "a") + s " > ")
  , " << a >> " ==> p (img "a" Nothing + s " ")
  , " << a b >> " ==> p (img "a" (Just "b") + s " ")
  -- newlines are not allowed inside images
  , " << a \n b >> " ==> p (s "<< a \n b >> ")
  -- markdown images cannot be spaced out
  , " ! [ a ] (b) " ==> p (s "! " + a "b" (Just "a") + s " ")
  , " ![ a ] (b) " ==> p (img "b" (Just "a") + s " ")
  -- newlines are allowed inside markdown images
  , " ![ a ] \n (b) " ==> p (img "b" (Just "a") + s " ")
  , " ![ a \n b ] \n (c) " ==> p (img "c" (Just "a \n b") + s " ")
  -- spaces are not allowed inside markdown images
  , " ![ a ] ( b ) " ==> p (s "![ a ] ( b ) ")
  -- inline math brackets cannot be spaced out
  , " \\ ( a \\ ) " ==> p (s " ( a  ) ")
  , " \\( a \\) " ==> p (mathi " a " + s " ")
  -- newlines are not allowed inside inline math brackets
  , " \\( a \n b \\) " ==> p (s "( a \n b ) ")
  -- block math brackets cannot be spaced out
  , " \\ [ a \\ ] " ==> p (s " [ a  ] ")
  , " \\[ a \\] " ==> p (mathd " a " + s " ")
  , " \\[ a \n b \\] " ==> p (mathd " a \n b " + s " ")
  -- spaces are allowed within anchors
  , " # a # " ==> p (anchor " a " + s " ")
  -- newlines are not allowed within anchors
  , " # a \n b # " ==> p (s "# a \n b # ")
  , " prop> a " ==> prop "a"
  -- properties cannot be spaced out
  , " prop > a " ==> p (s "prop > a ")
  , " >>> a " ==> ex [("a", [])]
  -- examples cannot be spaced out
  , " > > > a " ==> pre (s "> > a ")
  , " = a " ==> h 1 (s "a ")
  -- headings cannot be spaced out
  , " = = a " ==> h 1 (s "= a ")
  , " @since 1.2.3 " ==> empty
  -- annotations cannot be spaced out
  , " @ since 1.2.3 " ==> p (s "@ since 1.2.3 ")

  --
  -- escape sequences
  --

  -- single quotes cannot be escaped
  , "'a\\''" ==> p (id quote quote "a\\'")
  -- identifiers can have all kinds of symbols
  , "'-_.!#$%&*+/<=>?@\\|~:^'" ==> p (id quote quote "-_.!#$%&*+/<=>?@\\|~:^")
  -- identifiers can be escaped
  , "\\'a'" ==> p (s "'a'")
  -- modules can be escaped
  , "\\\"A\"" ==> p (s "\"A\"")
  -- italics can be escaped
  , "\\/a/" ==> p (s "/a/")
  , "/a\\/" ==> p (s "/a/")
  -- slashes can be escaped in italics
  , "/a\\/b/" ==> p (i (s "a/b"))
  -- at signs can be escaped
  , "inline \\@a@" ==> p (s "inline @a@")
  , "inline @a\\@" ==> p (s "inline @a@")
  -- at signs can be escaped in code
  , "inline @a\\@b@" ==> p (s "inline " + mono (s "a@b"))
  -- underscores can be escaped
  , "\\__a__" ==> p (s "__a__")
  , "_\\_a__" ==> p (s "__a__")
  , "__a_\\_" ==> p (s "__a__")
  -- ... but not at the end
  , "__a\\__" ==> p (b (s "a\\"))
  -- underscores can be escaped in bold text
  , "__a\\__b__" ==> p (b (s "a__b"))
  , "__a_\\_b__" ==> p (b (s "a__b"))
  -- lists can be escaped
  , " \\* a" ==> p (s "* a")
  , " \\- a" ==> p (s "- a")
  -- ordered lists can be escaped
  , "\\1. a" ==> p (s "1. a")
  , "1\\. a" ==> p (s "1. a")
  -- definition lists can be escaped
  , "\\[a] b" ==> p (s "[a] b")
  -- ... but only in one place
  , "[a\\] b" ==> dl [(s "a\\", s "b")]
  , "[a]\\ b" ==> dl [(s "a", s " b")]
  -- colons in definition lists can be escaped
  , "[a]\\: b" ==> dl [(s "a", s ": b")]
  -- bird tracks can be escaped
  , "\\> a" ==> p (s "> a")
  -- code blocks can be escaped
  , "\\@a@" ==> p (s "@a@")
  , "@a\\@" ==> p (s "@a@")
  -- links can be escaped
  , "\\<a>" ==> p (s "<a>")
  -- ... but only at the beginning
  , "<a\\>" ==> p (a "a" Nothing)
  -- links can contain weird characters
  , "<<>" ==> p (a "<" Nothing)
  , "<\\>" ==> p (a "" Nothing)
  , "<\\>>" ==> p (a ">" Nothing)
  -- links can be empty
  , "< >" ==> p (a "" Nothing)
  -- ... but not too empty
  , "<>" ==> p (s "<>")
  -- markdown links can be escaped
  , "\\[a](b)" ==> p (s "[a](b)")
  -- ... but things get weird
  , "[a\\](b)" ==> dl [(s "a\\", s "(b)")]
  , "[a]\\(b)" ==> dl [(s "a", s "(b)")]
  , "[a](b\\)" ==> dl [(s "a", s "(b)")]
  -- markdown links can be empty
  , "[ ](a)" ==> p (a "a" (Just ""))
  -- ... but not too empty
  , "[](a)" ==> p (s "[](a)")
  -- links can be escaped
  , "\\ftp://a" ==> p (s "ftp://a")
  , "f\\tp://a" ==> p (s "ftp://a")
  , "ft\\p://a" ==> p (s "ftp://a")
  , "ftp\\://a" ==> p (s "ftp://a")
  , "ftp:\\//a" ==> p (s "ftp://a")
  , "ftp:/\\/a" ==> p (s "ftp://a")
  -- multiple characters are not removed at the end
  , "ftp://a.." ==> p (a "ftp://a." Nothing + s ".")
  , "ftp://a,," ==> p (a "ftp://a," Nothing + s ",")
  , "ftp://a!!" ==> p (a "ftp://a!" Nothing + s "!")
  , "ftp://a??" ==> p (a "ftp://a?" Nothing + s "?")
  -- ... and they can't be escaped
  , "ftp://a\\.." ==> p (a "ftp://a\\." Nothing + s ".")
  -- images can be escaped
  , "\\<<a>>" ==> p (s "<" + a "a" Nothing + s ">")
  , "<\\<a>>" ==> p (a "<a" Nothing + s ">")
  , "<<a>\\>" ==> p (a "<a" Nothing + s ">")
  -- ... but not at the end
  , "<<a\\>>" ==> p (img "a" Nothing)
  -- markdown images can be escaped
  , "\\![a](b)" ==> p (s "![a](b)")
  , "!\\[a](b)" ==> p (s "![a](b)")
  , "![a\\](b)" ==> p (s "![a](b)")
  , "![a]\\(b)" ==> p (s "![a](b)")
  -- ... but not at the end
  , "![a](b\\)" ==> p (img "b" (Just "a"))
  -- inline math can be escaped
  , "\\\\(a\\)" ==> p (s "\\(a)")
  -- ... but not at the end
  , "\\(a\\\\)" ==> p (mathi "a\\")
  -- block math can be escaped
  , "\\\\[a\\]" ==> p (s "\\[a]")
  -- ... but not at the end
  , "\\[a\\\\]" ==> p (mathd "a\\")
  -- anchors can be escaped
  , "\\#a#" ==> p (s "#a#")
  , "#a\\#" ==> p (s "#a#")
  -- properties can be escaped
  , "\\prop> a" ==> p (s "prop> a")
  , "p\\rop> a" ==> p (s "prop> a")
  , "pr\\op> a" ==> p (s "prop> a")
  , "pro\\p> a" ==> p (s "prop> a")
  , "prop\\> a" ==> p (s "prop> a")
  -- examples can be escaped
  , "\\>>> a" ==> p (s ">>> a")
  -- blank lines cannot be escaped
  , ">>> a\n\\<BLANKLINE>" ==> ex [("a", ["\\<BLANKLINE>"])]
  -- headings can be escaped
  , "\\= a" ==> p (s "= a")
  , "\\== a" ==> p (s "== a")
  , "=\\= a" ==> h 1 (s "= a")
  -- annotations can be escaped
  , "\\@since 1" ==> p (s "@since 1")

  --
  -- back slashes
  --

  , "\\" ==> p (s "\\")
  , "a\\b" ==> p (s "ab")
  , "'\\'" ==> p (id quote quote "\\")
  , "'a\\b'" ==> p (id quote quote "a\\b")
  , "\"\\\"" ==> p (s "\"\"")
  , "\"A\\b\"" ==> p (mod "A\\b")
  , "/\\/" ==> p (s "//")
  , "/a\\b/" ==> p (i (s "ab"))
  , "inline @\\@" ==> p (s "inline @@")
  , "inline @a\\b@" ==> p (s "inline " + mono (s "ab"))
  , "__\\__" ==> p (b (s "\\"))
  , "__a\\b__" ==> p (b (s "ab"))
  , "* \\" ==> ul [p (s "\\")]
  , "* a\\b" ==> ul [p (s "ab")]
  , "1. \\" ==> ol [p (s "\\")]
  , "1. a\\b" ==> ol [p (s "ab")]
  , "[\\] \\" ==> dl [(s "\\", s "\\")]
  , "[a\\b] c\\d" ==> dl [(s "ab", s "cd")]
  , "> \\" ==> pre (s "\\")
  , "> a\\b" ==> pre (s "a\\b")
  , "@\\@" ==> p (s "@@")
  , "@a\\b@" ==> pre (s "ab")
  , "<\\ \\>" ==> p (a "" (Just ""))
  , "<a\\b c\\d>" ==> p (a "ab" (Just "cd"))
  , "[\\](\\)" ==> dl [(s "\\", s "()")]
  , "[a\\b](c\\d)" ==> p (a "cd" (Just "ab"))
  , "ftp://\\" ==> p (a "ftp://\\" Nothing)
  , "ftp://a\\b" ==> p (a "ftp://a\\b" Nothing)
  , "<<\\ \\>>" ==> p (img "" (Just ""))
  , "<<a\\b c\\d>>" ==> p (img "ab" (Just "cd"))
  , "![\\](\\)" ==> p (s "![]()")
  , "![a\\b](c\\d)" ==> p (img "cd" (Just "ab"))
  , "\\(\\\\)" ==> p (mathi "\\")
  , "\\(a\\b\\)" ==> p (mathi "a\\b")
  , "\\[\\\\]" ==> p (mathd "\\")
  , "\\[a\\b\\]" ==> p (mathd "a\\b")
  , "#\\#" ==> p (s "##")
  , "#a\\b#" ==> p (anchor "a\\b")
  , "prop> \\" ==> prop "\\"
  , "prop> a\\b" ==> prop "a\\b"
  , ">>> \\\nc\\d" ==> ex [("\\", ["c\\d"])]
  , ">>> a\\b\nc\\d" ==> ex [("a\\b", ["c\\d"])]
  , "= \\" ==> h 1 (s "\\")
  , "= a\\b" ==> h 1 (s "ab")

  ]

type Test = (String, Doc)

type Doc = Haddock.DocH () Haddock.Identifier

runTests :: [Test] -> IO ()
runTests tests = do
  let count = length (tests)
  putStrLn ("Running " ++ show count ++ " test(s)...")
  results <- mapM runTest tests
  let failedCount = length (filter not results)
  if failedCount > 0
    then do
      putStrLn
        ( show failedCount
        ++ " test(s) out of "
        ++ show count
        ++ " failed."
        )
      fail ""
    else putStrLn ("All " ++ show count ++ " test(s) passed.")

runTest :: Test -> IO Bool
runTest (input, expected) = do
  let actual = parse input
  let passed = actual == expected
  if passed
    then putStrLn ("PASS: " ++ show input)
    else putStr (unlines
      [ "FAIL: " ++ show input
      , "  expected: " ++ show expected
      , "    actual: " ++ show actual
      ])
  pure passed

(==>) :: String -> Doc -> Test
(==>) = (,)
infix 0 ==>

parse :: String -> Doc
parse = Haddock._doc . Haddock.parseParas

empty :: Doc
empty = Haddock.DocEmpty

(+) :: Doc -> Doc -> Doc
(+) = Haddock.DocAppend
infixr 1 +

s :: String -> Doc
s = Haddock.DocString

p :: Doc -> Doc
p = Haddock.DocParagraph

id :: Char -> Char -> String -> Doc
id l r x = Haddock.DocIdentifier (l, x, r)

quote :: Char
quote = '\''

grave :: Char
grave = '`'

mod :: String -> Doc
mod = Haddock.DocModule

i :: Doc -> Doc
i = Haddock.DocEmphasis

mono :: Doc -> Doc
mono = Haddock.DocMonospaced

b :: Doc -> Doc
b = Haddock.DocBold

ul :: [Doc] -> Doc
ul = Haddock.DocUnorderedList

ol :: [Doc] -> Doc
ol = Haddock.DocOrderedList

dl :: [(Doc, Doc)] -> Doc
dl = Haddock.DocDefList

pre :: Doc -> Doc
pre = Haddock.DocCodeBlock

a :: String -> Maybe String -> Doc
a x = Haddock.DocHyperlink . Haddock.Hyperlink x

img :: String -> Maybe String -> Doc
img x = Haddock.DocPic . Haddock.Picture x

mathi :: String -> Doc
mathi = Haddock.DocMathInline

mathd :: String -> Doc
mathd = Haddock.DocMathDisplay

anchor :: String -> Doc
anchor = Haddock.DocAName

prop :: String -> Doc
prop = Haddock.DocProperty

ex :: [(String, [String])] -> Doc
ex = Haddock.DocExamples . map ex_

ex_ :: (String, [String]) -> Haddock.Example
ex_ = uncurry Haddock.Example

h_ :: Int -> Doc -> Haddock.Header Doc
h_ = Haddock.Header

h :: Int -> Doc -> Doc
h x = Haddock.DocHeader . h_ x