haddock-library 1.7.0 → 1.11.0
raw patch · 49 files changed
Files
- CHANGES.md +20/−0
- LICENSE +21/−18
- fixtures/Fixtures.hs +6/−4
- fixtures/examples/definitionList.input +1/−0
- fixtures/examples/definitionList.parsed +1/−0
- fixtures/examples/identifier.input +1/−0
- fixtures/examples/identifier.parsed +1/−0
- fixtures/examples/identifierBackticks.input +1/−0
- fixtures/examples/identifierBackticks.parsed +1/−0
- fixtures/examples/link.input +1/−0
- fixtures/examples/link.parsed +5/−0
- fixtures/examples/linkInline.input +1/−0
- fixtures/examples/linkInline.parsed +7/−0
- fixtures/examples/linkInlineMarkup.input +1/−0
- fixtures/examples/linkInlineMarkup.parsed +8/−0
- fixtures/examples/list-blocks1.input +15/−0
- fixtures/examples/list-blocks1.parsed +12/−0
- fixtures/examples/list-blocks2.input +10/−0
- fixtures/examples/list-blocks2.parsed +10/−0
- fixtures/examples/table-cell-strip-whitespaces.input +5/−0
- fixtures/examples/table-cell-strip-whitespaces.parsed +29/−0
- fixtures/examples/table-simple.input +7/−0
- fixtures/examples/table-simple.parsed +42/−0
- fixtures/examples/table1.input +12/−0
- fixtures/examples/table1.parsed +68/−0
- fixtures/examples/table2.input +7/−0
- fixtures/examples/table2.parsed +46/−0
- fixtures/examples/table3.input +7/−0
- fixtures/examples/table3.parsed +50/−0
- fixtures/examples/table4.input +17/−0
- fixtures/examples/table4.parsed +26/−0
- fixtures/examples/table5.input +8/−0
- fixtures/examples/table5.parsed +46/−0
- fixtures/examples/url.input +1/−0
- fixtures/examples/url.parsed +4/−0
- fixtures/examples/urlLabel.input +1/−0
- fixtures/examples/urlLabel.parsed +5/−0
- haddock-library.cabal +75/−60
- src/CompatPrelude.hs +53/−0
- src/Documentation/Haddock/Markup.hs +58/−24
- src/Documentation/Haddock/Parser.hs +114/−111
- src/Documentation/Haddock/Parser/Identifier.hs +159/−0
- src/Documentation/Haddock/Parser/Monad.hs +78/−21
- src/Documentation/Haddock/Parser/Util.hs +7/−7
- src/Documentation/Haddock/Types.hs +42/−19
- src/Documentation/Haddock/Utf8.hs +0/−74
- test/Documentation/Haddock/Parser/UtilSpec.hs +4/−1
- test/Documentation/Haddock/ParserSpec.hs +159/−49
- test/Documentation/Haddock/Utf8Spec.hs +0/−14
CHANGES.md view
@@ -1,3 +1,23 @@+## Changes in version 1.11.0++ * Add support for linking identifiers with a quote between backticks (#1408)++## Changes in version 1.10.0++ * Add support for labeled module references (#1360)+## Changes in version 1.9.0++ * Fix build-time regression for `base < 4.7` (#1119)++ * Update parsing to strip whitespace from table cells (#1074)++## Changes in version 1.8.0++ * Support inline markup in markdown-style links (#875)++ * Remove now unused `Documentation.Haddock.Utf8` module.+ This module was anyways copied from the `utf8-string` package.+ ## Changes in version 1.7.0 * Make `Documentation.Haddock.Parser.Monad` an internal module
LICENSE view
@@ -1,23 +1,26 @@-Copyright 2002-2010, Simon Marlow. All rights reserved.+Copyright (c) 2002-2010, Simon Marlow+All rights reserved. Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:+modification, are permitted provided that the following conditions are+met: -- Redistributions of source code must retain the above copyright notice,-this list of conditions and the following disclaimer.+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer. -- Redistributions in binary form must reproduce the above copyright notice,-this list of conditions and the following disclaimer in the documentation-and/or other materials provided with the distribution.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the+ distribution. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY-EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR-PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE-LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR-CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF-SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR-BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,-WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE-OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN-IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
fixtures/Fixtures.hs view
@@ -9,8 +9,7 @@ import Data.List (foldl') import Data.Traversable (for) import GHC.Generics (Generic)-import Prelude ()-import Prelude.Compat+import Prelude import System.Directory (getDirectoryContents) import System.Exit (exitFailure) import System.FilePath@@ -146,8 +145,11 @@ deriving instance Generic (Header id) instance ToExpr id => ToExpr (Header id) -deriving instance Generic Hyperlink-instance ToExpr Hyperlink+deriving instance Generic (Hyperlink id)+instance ToExpr id => ToExpr (Hyperlink id)++deriving instance Generic (ModLink id)+instance ToExpr id => ToExpr (ModLink id) deriving instance Generic Picture instance ToExpr Picture
+ fixtures/examples/definitionList.input view
@@ -0,0 +1,1 @@+[foo]: bar
+ fixtures/examples/definitionList.parsed view
@@ -0,0 +1,1 @@+DocDefList [_×_ (DocString "foo") (DocString "bar")]
+ fixtures/examples/identifier.input view
@@ -0,0 +1,1 @@+'foo'
+ fixtures/examples/identifier.parsed view
@@ -0,0 +1,1 @@+DocParagraph (DocIdentifier "foo")
+ fixtures/examples/identifierBackticks.input view
@@ -0,0 +1,1 @@+`foo`
+ fixtures/examples/identifierBackticks.parsed view
@@ -0,0 +1,1 @@+DocParagraph (DocIdentifier "foo")
+ fixtures/examples/link.input view
@@ -0,0 +1,1 @@+[link](http://example.com)
+ fixtures/examples/link.parsed view
@@ -0,0 +1,5 @@+DocParagraph+ (DocHyperlink+ Hyperlink+ {hyperlinkLabel = Just (DocString "link"),+ hyperlinkUrl = "http://example.com"})
+ fixtures/examples/linkInline.input view
@@ -0,0 +1,1 @@+Bla [link](http://example.com)
+ fixtures/examples/linkInline.parsed view
@@ -0,0 +1,7 @@+DocParagraph+ (DocAppend+ (DocString "Bla ")+ (DocHyperlink+ Hyperlink+ {hyperlinkLabel = Just (DocString "link"),+ hyperlinkUrl = "http://example.com"}))
+ fixtures/examples/linkInlineMarkup.input view
@@ -0,0 +1,1 @@+Bla [link /emphasized/](http://example.com)
+ fixtures/examples/linkInlineMarkup.parsed view
@@ -0,0 +1,8 @@+DocParagraph+ (DocAppend+ (DocString "Bla ")+ (DocHyperlink+ Hyperlink+ {hyperlinkLabel = Just (DocAppend (DocString "link ")+ (DocEmphasis (DocString "emphasized"))),+ hyperlinkUrl = "http://example.com"}))
+ fixtures/examples/list-blocks1.input view
@@ -0,0 +1,15 @@+* Something about foo++ @+ foo :: a -> b -> c+ foo a b = bar c b+ @++* Something about bar++ @+ bar :: a -> b -> c+ bar a b = foo b a+ @++* And then we continue
+ fixtures/examples/list-blocks1.parsed view
@@ -0,0 +1,12 @@+DocUnorderedList+ [DocAppend+ (DocParagraph (DocString "Something about foo"))+ (DocCodeBlock+ (DocString+ (concat ["foo :: a -> b -> c\n", "foo a b = bar c b\n"]))),+ DocAppend+ (DocParagraph (DocString "Something about bar"))+ (DocCodeBlock+ (DocString+ (concat ["bar :: a -> b -> c\n", "bar a b = foo b a\n"]))),+ DocParagraph (DocString "And then we continue")]
+ fixtures/examples/list-blocks2.input view
@@ -0,0 +1,10 @@+=== Title++* List directly+* after the title++ @+ with some inline things+ @++* is parsed weirdly
+ fixtures/examples/list-blocks2.parsed view
@@ -0,0 +1,10 @@+DocAppend+ (DocAppend+ (DocHeader+ Header {headerLevel = 3, headerTitle = DocString "Title"})+ (DocUnorderedList+ [DocParagraph (DocString "List directly"),+ DocAppend+ (DocParagraph (DocString "after the title"))+ (DocCodeBlock (DocString "with some inline things\n"))]))+ (DocUnorderedList [DocParagraph (DocString "is parsed weirdly")])
+ fixtures/examples/table-cell-strip-whitespaces.input view
@@ -0,0 +1,5 @@++------+--------------+-------------------------------------------------++| C1 | C2 | C3 |++======+==============+=================================================++| row | 'test' | 'test table cell with .. whitepspace ' |++------+--------------+-------------------------------------------------+
+ fixtures/examples/table-cell-strip-whitespaces.parsed view
@@ -0,0 +1,29 @@+DocTable+ Table+ {tableBodyRows = [TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "row",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocIdentifier "test",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString+ "'test table cell with .. whitepspace '",+ tableCellRowspan = 1}]],+ tableHeaderRows = [TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "C1",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "C2",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "C3",+ tableCellRowspan = 1}]]}
+ fixtures/examples/table-simple.input view
@@ -0,0 +1,7 @@++------+--------------+------------------------------------------++| code | message | description |++======+==============+==========================================++| 200 | @OK@ | operation successful |++------+--------------+------------------------------------------++| 204 | @No Content@ | operation successful, no body returned |++------+--------------+------------------------------------------+
+ fixtures/examples/table-simple.parsed view
@@ -0,0 +1,42 @@+DocTable+ Table+ {tableBodyRows = [TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "200",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocMonospaced (DocString "OK"),+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "operation successful",+ tableCellRowspan = 1}],+ TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "204",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocMonospaced (DocString "No Content"),+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString+ "operation successful, no body returned",+ tableCellRowspan = 1}]],+ tableHeaderRows = [TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "code",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "message",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "description",+ tableCellRowspan = 1}]]}
+ fixtures/examples/table1.input view
@@ -0,0 +1,12 @@++------------------------+------------+----------+----------++| Header row, column 1 | Header 2 | Header 3 | Header 4 |+| (header rows optional) | | | |++========================+============+==========+==========++| body row 1, column 1 | column 2 | column 3 | column 4 |++------------------------+------------+----------+----------++| body row 2 | Cells may span columns. |++------------------------+------------+---------------------++| body row 3 | Cells may | \[ |++------------------------+ span rows. | f(n) = \sum_{i=1} |+| body row 4 | | \] |++------------------------+------------+---------------------+
+ fixtures/examples/table1.parsed view
@@ -0,0 +1,68 @@+DocTable+ Table+ {tableBodyRows = [TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "body row 1, column 1",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "column 2",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "column 3",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "column 4",+ tableCellRowspan = 1}],+ TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "body row 2",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 3,+ tableCellContents = DocString "Cells may span columns.",+ tableCellRowspan = 1}],+ TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "body row 3",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString+ (concat ["Cells may\n", "span rows.\n"]),+ tableCellRowspan = 2},+ TableCell+ {tableCellColspan = 2,+ tableCellContents = DocMathDisplay+ (concat ["\n", "f(n) = \\sum_{i=1}\n"]),+ tableCellRowspan = 2}],+ TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "body row 4",+ tableCellRowspan = 1}]],+ tableHeaderRows = [TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString+ (concat+ ["Header row, column 1\n",+ "(header rows optional)"]),+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "Header 2\n",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "Header 3\n",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "Header 4\n",+ tableCellRowspan = 1}]]}
+ fixtures/examples/table2.input view
@@ -0,0 +1,7 @@++--------------+----------+-----------+-----------++| row 1, col 1 | column 2 | column 3 | column 4 |++--------------+----------+-----------+-----------++| row 2 | |++--------------+----------+-----------+-----------++| row 3 | | | |++--------------+----------+-----------+-----------+
+ fixtures/examples/table2.parsed view
@@ -0,0 +1,46 @@+DocTable+ Table+ {tableBodyRows = [TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "row 1, col 1",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "column 2",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "column 3",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "column 4",+ tableCellRowspan = 1}],+ TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "row 2",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 3,+ tableCellContents = DocEmpty,+ tableCellRowspan = 1}],+ TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "row 3",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocEmpty,+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocEmpty,+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocEmpty,+ tableCellRowspan = 1}]],+ tableHeaderRows = []}
+ fixtures/examples/table3.input view
@@ -0,0 +1,7 @@++--------------+----------+-----------+-----------++| row 1, col 1 | column 2 | column 3 | column 4 |++--------------+----------+-----------+-----------++| row 2 | Use the command ``ls | more``. |++--------------+----------+-----------+-----------++| row 3 | | | |++--------------+----------+-----------+-----------+
+ fixtures/examples/table3.parsed view
@@ -0,0 +1,50 @@+DocTable+ Table+ {tableBodyRows = [TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "row 1, col 1",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "column 2",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "column 3",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "column 4",+ tableCellRowspan = 1}],+ TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "row 2",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 2,+ tableCellContents = DocString "Use the command ``ls",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "more``.",+ tableCellRowspan = 1}],+ TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "row 3",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocEmpty,+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocEmpty,+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocEmpty,+ tableCellRowspan = 1}]],+ tableHeaderRows = []}
+ fixtures/examples/table4.input view
@@ -0,0 +1,17 @@+Single outer cell:+++-------------++| outer |+| |++-------+ |+| inner | |++-------+-----+++Broken (only inner cell is rendered):+++-------+-----++| inner | |++-------+ |+| |+| outer |++-------------+
+ fixtures/examples/table4.parsed view
@@ -0,0 +1,26 @@+DocAppend+ (DocParagraph (DocString "Single outer cell:"))+ (DocAppend+ (DocTable+ Table+ {tableBodyRows = [TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString+ (concat+ ["outer\n",+ "\n",+ "-------+\n",+ "inner |"]),+ tableCellRowspan = 1}]],+ tableHeaderRows = []})+ (DocAppend+ (DocParagraph (DocString "Broken (only inner cell is rendered):"))+ (DocTable+ Table+ {tableBodyRows = [TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "inner",+ tableCellRowspan = 1}]],+ tableHeaderRows = []})))
+ fixtures/examples/table5.input view
@@ -0,0 +1,8 @@++--------------+----------+-----------+-----------++| row 1, col 1 | column 2 | column 3 | column 4 |++==============+==========+===========+===========++| row 2 | Use the command @ls | more@. |+| | |+| +----------+-----------+-----------++| row 3 | | | |++--------------+----------+-----------+-----------+
+ fixtures/examples/table5.parsed view
@@ -0,0 +1,46 @@+DocTable+ Table+ {tableBodyRows = [TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString+ (concat ["row 2\n", "\n", "\n", "row 3"]),+ tableCellRowspan = 2},+ TableCell+ {tableCellColspan = 3,+ tableCellContents = DocAppend+ (DocString "Use the command ")+ (DocAppend+ (DocMonospaced (DocString "ls | more"))+ (DocString ".\n")),+ tableCellRowspan = 1}],+ TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocEmpty,+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocEmpty,+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocEmpty,+ tableCellRowspan = 1}]],+ tableHeaderRows = [TableRow+ [TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "row 1, col 1",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "column 2",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "column 3",+ tableCellRowspan = 1},+ TableCell+ {tableCellColspan = 1,+ tableCellContents = DocString "column 4",+ tableCellRowspan = 1}]]}
+ fixtures/examples/url.input view
@@ -0,0 +1,1 @@+<http://example.com/>
+ fixtures/examples/url.parsed view
@@ -0,0 +1,4 @@+DocParagraph+ (DocHyperlink+ Hyperlink+ {hyperlinkLabel = Nothing, hyperlinkUrl = "http://example.com/"})
+ fixtures/examples/urlLabel.input view
@@ -0,0 +1,1 @@+<http://example.com/ some link>
+ fixtures/examples/urlLabel.parsed view
@@ -0,0 +1,5 @@+DocParagraph+ (DocHyperlink+ Hyperlink+ {hyperlinkLabel = Just (DocString "some link"),+ hyperlinkUrl = "http://example.com/"})
haddock-library.cabal view
@@ -1,34 +1,56 @@-cabal-version: 2.0+cabal-version: 3.0 name: haddock-library-version: 1.7.0+version: 1.11.0 synopsis: Library exposing some functionality of Haddock.+ description: Haddock is a documentation-generation tool for Haskell- libraries. These modules expose some functionality of it- without pulling in the GHC dependency. Please note that the- API is likely to change so specify upper bounds in your- project. For interacting with Haddock+ libraries. These modules expose some+ functionality of it without pulling in the GHC+ dependency. Please note that the API is likely+ to change so be sure to specify upper bounds in+ your projects. For interacting with Haddock itself, see the [haddock package](https://hackage.haskell.org/package/haddock).-license: BSD3-license-files: LICENSE++license: BSD-2-Clause+license-file: LICENSE maintainer: Alec Theriault <alec.theriault@gmail.com>, Alex Biehl <alexbiehl@gmail.com>, Simon Hengel <sol@typeful.net>, Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> homepage: http://www.haskell.org/haddock/ bug-reports: https://github.com/haskell/haddock/issues category: Documentation-build-type: Simple+tested-with: GHC == 7.4.2+ , GHC == 7.6.3+ , GHC == 7.8.4+ , GHC == 7.10.3+ , GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.3+ , GHC == 8.10.1+ , GHC == 9.0.1+ , GHC == 9.2.0+ extra-source-files: CHANGES.md+ fixtures/examples/*.input+ fixtures/examples/*.parsed -library- default-language: Haskell2010+common lib-defaults+ default-language: Haskell2010 build-depends:- base >= 4.5 && < 4.13- , bytestring >= 0.9.2.1 && < 0.11- , containers >= 0.4.2.1 && < 0.7- , transformers >= 0.3.0 && < 0.6- , text >= 1.2.3.0 && < 1.3- , parsec >= 3.1.13.0 && < 3.2+ , base >= 4.5 && < 4.17+ , containers ^>= 0.4.2.1 || ^>= 0.5.0.0 || ^>= 0.6.0.1+ , text ^>= 1.2.3.0 || ^>= 2.0+ , parsec ^>= 3.1.13.0 + ghc-options: -funbox-strict-fields -Wall+ if impl(ghc >= 8.0)+ ghc-options: -Wcompat -Wnoncanonical-monad-instances++library+ import: lib-defaults+ hs-source-dirs: src exposed-modules:@@ -36,73 +58,66 @@ Documentation.Haddock.Markup Documentation.Haddock.Parser Documentation.Haddock.Types- Documentation.Haddock.Utf8 other-modules:+ CompatPrelude Documentation.Haddock.Parser.Util Documentation.Haddock.Parser.Monad-- ghc-options: -funbox-strict-fields -Wall -fwarn-tabs- if impl(ghc >= 8.0)- ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances-+ Documentation.Haddock.Parser.Identifier test-suite spec+ import: lib-defaults type: exitcode-stdio-1.0- default-language: Haskell2010 main-is: Spec.hs hs-source-dirs:- test- , src- ghc-options: -Wall-- cpp-options:- -DTEST+ test+ src other-modules:- Documentation.Haddock.Doc- Documentation.Haddock.Parser- Documentation.Haddock.Parser.Monad- Documentation.Haddock.Parser.Util- Documentation.Haddock.Parser.UtilSpec- Documentation.Haddock.ParserSpec- Documentation.Haddock.Types- Documentation.Haddock.Utf8- Documentation.Haddock.Utf8Spec+ CompatPrelude+ Documentation.Haddock.Doc+ Documentation.Haddock.Markup+ Documentation.Haddock.Parser+ Documentation.Haddock.Parser.Monad+ Documentation.Haddock.Parser.Util+ Documentation.Haddock.Parser.UtilSpec+ Documentation.Haddock.ParserSpec+ Documentation.Haddock.Types+ Documentation.Haddock.Parser.Identifier build-depends:- base >= 4.5 && < 4.13- , base-compat >= 0.9.3 && < 0.11- , bytestring >= 0.9.2.1 && < 0.11- , containers >= 0.4.2.1 && < 0.7- , transformers >= 0.3.0 && < 0.6- , hspec >= 2.4.4 && < 2.6- , QuickCheck ^>= 2.11- , text >= 1.2.3.0 && < 1.3- , parsec >= 3.1.13.0 && < 3.2- , deepseq >= 1.3 && < 1.5+ , base-compat ^>= 0.12.0+ , QuickCheck ^>= 2.11 || ^>= 2.13.2 || ^>= 2.14 + , deepseq ^>= 1.3.0.0 || ^>= 1.4.0.0 + -- NB: build-depends & build-tool-depends have independent+ -- install-plans, so it's best to limit to a single major+ -- version of `hspec` & `hspec-discover` to ensure+ -- intercompatibility+ build-depends:+ , hspec >= 2.4.4 && < 2.10+ build-tool-depends:- hspec-discover:hspec-discover >= 2.4.4 && < 2.6+ , hspec-discover:hspec-discover >= 2.4.4 && < 2.10 test-suite fixtures type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: Fixtures.hs- ghc-options: -Wall -O0+ ghc-options: -Wall hs-source-dirs: fixtures- buildable: False build-depends:- base >= 4.5 && < 4.13- , base-compat >= 0.9.3 && < 0.11+ -- intra-package dependency+ , haddock-library+ -- constraints inherited via lib:haddock-library component+ , base++ -- extra dependencies+ , base-compat ^>= 0.12.0 , directory ^>= 1.3.0.2 , filepath ^>= 1.4.1.2- , optparse-applicative ^>= 0.14.0.0- , tree-diff ^>= 0.0.0.1-- -- Depend on the library.- build-depends:- haddock-library+ , optparse-applicative ^>= 0.15+ , tree-diff ^>= 0.2 source-repository head type: git
+ src/CompatPrelude.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE CPP #-}++#ifdef __HLINT__+#elif !MIN_VERSION_base(4,5,0)+# error This module doesn't provide compat-shims for versions prior to base-4.5+#endif++-- | Bridge impedance mismatch of different @base@ versions back till @base-4.5@ (GHC 7.4.2)+module CompatPrelude+ ( ($>)+ , isSymbolChar+ ) where++#if MIN_VERSION_base(4,7,0)+import Data.Functor ( ($>) )+#else+import Data.Functor ( (<$) )+#endif++#if MIN_VERSION_base(4,9,0)+import Text.Read.Lex (isSymbolChar)+#else+import Data.Char (GeneralCategory(..), generalCategory)+#endif+++#if !MIN_VERSION_base(4,7,0)+infixl 4 $>++-- | Flipped version of '<$'.+--+-- @since 4.7.0.0+($>) :: Functor f => f a -> b -> f b+($>) = flip (<$)+#endif++#if !MIN_VERSION_base(4,9,0)+-- inlined from base-4.10.0.0+isSymbolChar :: Char -> Bool+isSymbolChar c = not (isPuncChar c) && case generalCategory c of+ MathSymbol -> True+ CurrencySymbol -> True+ ModifierSymbol -> True+ OtherSymbol -> True+ DashPunctuation -> True+ OtherPunctuation -> c `notElem` "'\""+ ConnectorPunctuation -> c /= '_'+ _ -> False+ where+ -- | The @special@ character class as defined in the Haskell Report.+ isPuncChar :: Char -> Bool+ isPuncChar = (`elem` (",;()[]{}`" :: String))+#endif
src/Documentation/Haddock/Markup.hs view
@@ -2,35 +2,38 @@ module Documentation.Haddock.Markup ( markup , idMarkup+ , plainMarkup ) where import Documentation.Haddock.Types +import Data.Maybe ( fromMaybe )+ markup :: DocMarkupH mod id a -> DocH mod id -> a-markup m DocEmpty = markupEmpty m-markup m (DocAppend d1 d2) = markupAppend m (markup m d1) (markup m d2)-markup m (DocString s) = markupString m s-markup m (DocParagraph d) = markupParagraph m (markup m d)-markup m (DocIdentifier x) = markupIdentifier m x-markup m (DocIdentifierUnchecked x) = markupIdentifierUnchecked m x-markup m (DocModule mod0) = markupModule m mod0-markup m (DocWarning d) = markupWarning m (markup m d)-markup m (DocEmphasis d) = markupEmphasis m (markup m d)-markup m (DocBold d) = markupBold m (markup m d)-markup m (DocMonospaced d) = markupMonospaced m (markup m d)-markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds)-markup m (DocOrderedList ds) = markupOrderedList m (map (markup m) ds)-markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds)-markup m (DocCodeBlock d) = markupCodeBlock m (markup m d)-markup m (DocHyperlink l) = markupHyperlink m l-markup m (DocAName ref) = markupAName m ref-markup m (DocPic img) = markupPic m img-markup m (DocMathInline mathjax) = markupMathInline m mathjax-markup m (DocMathDisplay mathjax) = markupMathDisplay m mathjax-markup m (DocProperty p) = markupProperty m p-markup m (DocExamples e) = markupExample m e-markup m (DocHeader (Header l t)) = markupHeader m (Header l (markup m t))-markup m (DocTable (Table h b)) = markupTable m (Table (map (fmap (markup m)) h) (map (fmap (markup m)) b))+markup m DocEmpty = markupEmpty m+markup m (DocAppend d1 d2) = markupAppend m (markup m d1) (markup m d2)+markup m (DocString s) = markupString m s+markup m (DocParagraph d) = markupParagraph m (markup m d)+markup m (DocIdentifier x) = markupIdentifier m x+markup m (DocIdentifierUnchecked x) = markupIdentifierUnchecked m x+markup m (DocModule (ModLink mo l)) = markupModule m (ModLink mo (fmap (markup m) l))+markup m (DocWarning d) = markupWarning m (markup m d)+markup m (DocEmphasis d) = markupEmphasis m (markup m d)+markup m (DocBold d) = markupBold m (markup m d)+markup m (DocMonospaced d) = markupMonospaced m (markup m d)+markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds)+markup m (DocOrderedList ds) = markupOrderedList m (map (\(index, a) -> (index, markup m a)) ds)+markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds)+markup m (DocCodeBlock d) = markupCodeBlock m (markup m d)+markup m (DocHyperlink (Hyperlink u l)) = markupHyperlink m (Hyperlink u (fmap (markup m) l))+markup m (DocAName ref) = markupAName m ref+markup m (DocPic img) = markupPic m img+markup m (DocMathInline mathjax) = markupMathInline m mathjax+markup m (DocMathDisplay mathjax) = markupMathDisplay m mathjax+markup m (DocProperty p) = markupProperty m p+markup m (DocExamples e) = markupExample m e+markup m (DocHeader (Header l t)) = markupHeader m (Header l (markup m t))+markup m (DocTable (Table h b)) = markupTable m (Table (map (fmap (markup m)) h) (map (fmap (markup m)) b)) markupPair :: DocMarkupH mod id a -> (DocH mod id, DocH mod id) -> (a, a) markupPair m (a,b) = (markup m a, markup m b)@@ -62,4 +65,35 @@ markupExample = DocExamples, markupHeader = DocHeader, markupTable = DocTable+ }++-- | Map a 'DocH' into a best estimate of an alternate string. The idea is to+-- strip away any formatting while preserving as much of the actual text as+-- possible.+plainMarkup :: (mod -> String) -> (id -> String) -> DocMarkupH mod id String+plainMarkup plainMod plainIdent = Markup {+ markupEmpty = "",+ markupString = id,+ markupParagraph = id,+ markupAppend = (++),+ markupIdentifier = plainIdent,+ markupIdentifierUnchecked = plainMod,+ markupModule = \(ModLink m lbl) -> fromMaybe m lbl,+ markupWarning = id,+ markupEmphasis = id,+ markupBold = id,+ markupMonospaced = id,+ markupUnorderedList = const "",+ markupOrderedList = const "",+ markupDefList = const "",+ markupCodeBlock = id,+ markupHyperlink = \(Hyperlink url lbl) -> fromMaybe url lbl,+ markupAName = id,+ markupPic = \(Picture uri title) -> fromMaybe uri title,+ markupMathInline = id,+ markupMathDisplay = id,+ markupProperty = id,+ markupExample = const "",+ markupHeader = \(Header _ title) -> title,+ markupTable = const "" }
src/Documentation/Haddock/Parser.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} -- |@@ -27,14 +26,16 @@ import Control.Applicative import Control.Arrow (first) import Control.Monad-import Data.Char (chr, isUpper, isAlpha, isAlphaNum, isSpace)-import Data.List (intercalate, unfoldr, elemIndex, notElem)+import Data.Char (chr, isUpper, isAlpha, isSpace)+import Data.List (intercalate, unfoldr, elemIndex) import Data.Maybe (fromMaybe, mapMaybe) import Data.Monoid import qualified Data.Set as Set import Documentation.Haddock.Doc+import Documentation.Haddock.Markup ( markup, plainMarkup ) import Documentation.Haddock.Parser.Monad import Documentation.Haddock.Parser.Util+import Documentation.Haddock.Parser.Identifier import Documentation.Haddock.Types import Prelude hiding (takeWhile) import qualified Prelude as P@@ -45,69 +46,42 @@ import qualified Data.Text as T import Data.Text (Text) -#if MIN_VERSION_base(4,9,0)-import Text.Read.Lex (isSymbolChar)-#else-import Data.Char (GeneralCategory (..),- generalCategory)-#endif -- $setup -- >>> :set -XOverloadedStrings -#if !MIN_VERSION_base(4,9,0)--- inlined from base-4.10.0.0-isSymbolChar :: Char -> Bool-isSymbolChar c = not (isPuncChar c) && case generalCategory c of- MathSymbol -> True- CurrencySymbol -> True- ModifierSymbol -> True- OtherSymbol -> True- DashPunctuation -> True- OtherPunctuation -> c `notElem` ("'\"" :: String)- ConnectorPunctuation -> c /= '_'- _ -> False- where- -- | The @special@ character class as defined in the Haskell Report.- isPuncChar :: Char -> Bool- isPuncChar = (`elem` (",;()[]{}`" :: String))-#endif---- | Identifier string surrounded with opening and closing quotes/backticks.-type Identifier = (Char, String, Char)- -- | Drops the quotes/backticks around all identifiers, as if they -- were valid but still 'String's. toRegular :: DocH mod Identifier -> DocH mod String-toRegular = fmap (\(_, x, _) -> x)+toRegular = fmap (\(Identifier _ _ x _) -> x) -- | Maps over 'DocIdentifier's over 'String' with potentially failing -- conversion using user-supplied function. If the conversion fails, -- the identifier is deemed to not be valid and is treated as a -- regular string.-overIdentifier :: (String -> Maybe a)+overIdentifier :: (Namespace -> String -> Maybe a) -> DocH mod Identifier -> DocH mod a overIdentifier f d = g d where- g (DocIdentifier (o, x, e)) = case f x of- Nothing -> DocString $ o : x ++ [e]+ g (DocIdentifier (Identifier ns o x e)) = case f ns x of+ Nothing -> DocString $ renderNs ns ++ [o] ++ x ++ [e] Just x' -> DocIdentifier x' g DocEmpty = DocEmpty g (DocAppend x x') = DocAppend (g x) (g x') g (DocString x) = DocString x g (DocParagraph x) = DocParagraph $ g x g (DocIdentifierUnchecked x) = DocIdentifierUnchecked x- g (DocModule x) = DocModule x+ g (DocModule (ModLink m x)) = DocModule (ModLink m (fmap g x)) g (DocWarning x) = DocWarning $ g x g (DocEmphasis x) = DocEmphasis $ g x g (DocMonospaced x) = DocMonospaced $ g x g (DocBold x) = DocBold $ g x g (DocUnorderedList x) = DocUnorderedList $ fmap g x- g (DocOrderedList x) = DocOrderedList $ fmap g x+ g (DocOrderedList x) = DocOrderedList $ fmap (\(index, a) -> (index, g a)) x g (DocDefList x) = DocDefList $ fmap (\(y, z) -> (g y, g z)) x g (DocCodeBlock x) = DocCodeBlock $ g x- g (DocHyperlink x) = DocHyperlink x+ g (DocHyperlink (Hyperlink u x)) = DocHyperlink (Hyperlink u (fmap g x)) g (DocPic x) = DocPic x g (DocMathInline x) = DocMathInline x g (DocMathDisplay x) = DocMathDisplay x@@ -174,6 +148,7 @@ , mathDisplay , mathInline , markdownImage+ , markdownLink , hyperlink , bold , emphasis@@ -198,11 +173,11 @@ -- Once we have checked for any of these and tried to parse the -- relevant markup, we can assume they are used as regular text. specialChar :: [Char]-specialChar = "_/<@\"&'`# "+specialChar = "_/<@\"&'`#[ " -- | Plain, regular parser for text. Called as one of the last parsers -- to ensure that we have already given a chance to more meaningful parsers--- before capturing their characers.+-- before capturing their characters. string' :: Parser (DocH mod a) string' = DocString . unescape . T.unpack <$> takeWhile1_ (`notElem` specialChar) where@@ -253,7 +228,7 @@ -- DocAName "Hello world" anchor :: Parser (DocH mod a) anchor = DocAName . T.unpack <$>- disallowNewline ("#" *> takeWhile1_ (/= '#') <* "#")+ ("#" *> takeWhile1_ (\x -> x /= '#' && not (isSpace x)) <* "#") -- | Monospaced strings. --@@ -268,15 +243,43 @@ -- Note that we allow '#' and '\' to support anchors (old style anchors are of -- the form "SomeModule\#anchor"). moduleName :: Parser (DocH mod a)-moduleName = DocModule <$> ("\"" *> modid <* "\"")+moduleName = DocModule . flip ModLink Nothing <$> ("\"" *> moduleNameString <* "\"")++-- | A module name, optionally with an anchor+--+moduleNameString :: Parser String+moduleNameString = modid `maybeFollowedBy` anchor_ where modid = intercalate "." <$> conid `Parsec.sepBy1` "."+ anchor_ = (++)+ <$> (Parsec.string "#" <|> Parsec.string "\\#")+ <*> many (Parsec.satisfy (\c -> c /= '"' && not (isSpace c)))++ maybeFollowedBy pre suf = (\x -> maybe x (x ++)) <$> pre <*> optional suf+ conid :: Parser String conid = (:) <$> Parsec.satisfy (\c -> isAlpha c && isUpper c)- <*> many (conChar <|> Parsec.oneOf "\\#")+ <*> many conChar conChar = Parsec.alphaNum <|> Parsec.char '_' +-- | A labeled link to an indentifier, module or url using markdown+-- syntax.+markdownLink :: Parser (DocH mod Identifier)+markdownLink = do+ lbl <- markdownLinkText+ choice' [ markdownModuleName lbl, markdownURL lbl ]+ where+ markdownModuleName lbl = do+ mn <- "(" *> skipHorizontalSpace *>+ "\"" *> moduleNameString <* "\""+ <* skipHorizontalSpace <* ")"+ pure $ DocModule (ModLink mn (Just lbl))++ markdownURL lbl = do+ target <- markdownLinkTarget+ pure $ DocHyperlink $ Hyperlink target (Just lbl)+ -- | Picture parser, surrounded by \<\< and \>\>. It's possible to specify -- a title for the picture. --@@ -293,7 +296,7 @@ -- >>> parseString "\\(\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\)" -- DocMathInline "\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}" mathInline :: Parser (DocH mod a)-mathInline = DocMathInline . T.unpack +mathInline = DocMathInline . T.unpack <$> disallowNewline ("\\(" *> takeUntil "\\)") -- | Display math parser, surrounded by \\[ and \\].@@ -301,13 +304,22 @@ -- >>> parseString "\\[\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\]" -- DocMathDisplay "\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}" mathDisplay :: Parser (DocH mod a)-mathDisplay = DocMathDisplay . T.unpack +mathDisplay = DocMathDisplay . T.unpack <$> ("\\[" *> takeUntil "\\]") -markdownImage :: Parser (DocH mod a)-markdownImage = fromHyperlink <$> ("!" *> linkParser)+-- | Markdown image parser. As per the commonmark reference recommendation, the+-- description text for an image converted to its a plain string representation.+--+-- >>> parseString ""+-- DocPic (Picture "www.site.com" (Just "some emphasis in a description"))+markdownImage :: Parser (DocH mod Identifier)+markdownImage = do+ text <- markup stringMarkup <$> ("!" *> markdownLinkText)+ url <- markdownLinkTarget+ pure $ DocPic (Picture url (Just text)) where- fromHyperlink (Hyperlink url label) = DocPic (Picture url label)+ stringMarkup = plainMarkup (const "") renderIdent+ renderIdent (Identifier ns l c r) = renderNs ns <> [l] <> c <> [r] -- | Paragraph parser, called by 'parseParas'. paragraph :: Parser (DocH mod Identifier)@@ -349,7 +361,7 @@ firstRow <- parseFirstRow let len = T.length firstRow - -- then we parse all consequtive rows starting and ending with + or |,+ -- then we parse all consecutive rows starting and ending with + or |, -- of the width `len`. restRows <- many (try (parseRestRows len)) @@ -360,32 +372,34 @@ parseFirstRow :: Parser Text parseFirstRow = do skipHorizontalSpace- -- upper-left corner is +- c <- Parsec.char '+'- cs <- some (Parsec.char '-' <|> Parsec.char '+')+ cs <- takeWhile (\c -> c == '-' || c == '+') - -- upper right corner is + too- guard (last cs == '+')+ -- upper-left and upper-right corners are `+`+ guard (T.length cs >= 2 &&+ T.head cs == '+' &&+ T.last cs == '+') -- trailing space skipHorizontalSpace _ <- Parsec.newline - return (T.cons c $ T.pack cs)+ return cs parseRestRows :: Int -> Parser Text parseRestRows l = do skipHorizontalSpace+ bs <- scan predicate l - c <- Parsec.char '|' <|> Parsec.char '+'- bs <- scan predicate (l - 2)- c2 <- Parsec.char '|' <|> Parsec.char '+'+ -- Left and right edges are `|` or `+`+ guard (T.length bs >= 2 &&+ (T.head bs == '|' || T.head bs == '+') &&+ (T.last bs == '|' || T.last bs == '+')) -- trailing space skipHorizontalSpace _ <- Parsec.newline - return (T.cons c (T.snoc bs c2))+ return bs where predicate n c | n <= 0 = Nothing@@ -509,7 +523,7 @@ -- extract cell contents given boundaries extract :: Int -> Int -> Int -> Int -> Text extract x y x2 y2 = T.intercalate "\n"- [ T.take (x2 - x + 1) $ T.drop x $ rs !! y'+ [ T.stripEnd $ T.stripStart $ T.take (x2 - x + 1) $ T.drop x $ rs !! y' | y' <- [y .. y2] ] @@ -529,11 +543,11 @@ 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@@ -563,10 +577,24 @@ orderedList :: Text -> Parser (DocH mod Identifier) orderedList indent = DocOrderedList <$> p where- p = (paren <|> dot) *> innerList indent p+ p = do+ index <- paren <|> dot+ innerList' indent p index dot = (decimal :: Parser Int) <* "." paren = "(" *> decimal <* ")" +-- | Like 'innerList' but takes the parsed index of the list item+innerList' :: Text -> Parser [(Int, DocH mod Identifier)]+ -> Int+ -> Parser [(Int, DocH mod Identifier)]+innerList' indent item index = do+ c <- takeLine+ (cs, items) <- more indent item+ let contents = docParagraph . parseText . dropNLs . T.unlines $ c : cs+ return $ case items of+ Left p -> [(index, contents `docAppend` p)]+ Right i -> (index, contents) : i+ -- | Generic function collecting any further lines belonging to the -- list entry and recursively collecting any further lists in the -- same paragraph. Usually used as@@ -596,7 +624,7 @@ Right i -> (label, contents) : i -- | Drops all trailing newlines.-dropNLs :: Text -> Text +dropNLs :: Text -> Text dropNLs = T.dropWhileEnd (== '\n') -- | Main worker for 'innerList' and 'definitionList'.@@ -662,7 +690,7 @@ -- Doesn't discard the trailing newline. takeNonEmptyLine :: Parser Text takeNonEmptyLine = do- l <- takeWhile1 (Parsec.noneOf "\n") >>= nonSpace+ l <- takeWhile1 (/= '\n') >>= nonSpace _ <- "\n" pure (l <> "\n") @@ -670,7 +698,7 @@ -- -- More precisely: skips all whitespace-only lines and returns indentation -- (horizontal space, might be empty) of that non-empty line.-takeIndent :: Parser Text +takeIndent :: Parser Text takeIndent = do indent <- takeHorizontalSpace choice' [ "\n" *> takeIndent@@ -696,7 +724,7 @@ Just (' ',t') -> Just t' _ -> Nothing --- | Parses examples. Examples are a paragraph level entitity (separated by an empty line).+-- | Parses examples. Examples are a paragraph level entity (separated by an empty line). -- Consecutive examples are accepted. examples :: Parser (DocH mod a) examples = DocExamples <$> (many (try (skipHorizontalSpace *> "\n")) *> go)@@ -728,21 +756,21 @@ substituteBlankLine "<BLANKLINE>" = "" substituteBlankLine xs = xs -nonEmptyLine :: Parser Text +nonEmptyLine :: Parser Text nonEmptyLine = try (mfilter (T.any (not . isSpace)) takeLine) takeLine :: Parser Text-takeLine = try (takeWhile (Parsec.noneOf "\n") <* endOfLine)+takeLine = try (takeWhile (/= '\n') <* endOfLine) endOfLine :: Parser ()-endOfLine = void "\n" <|> Parsec.eof +endOfLine = void "\n" <|> Parsec.eof -- | Property parser. -- -- >>> snd <$> parseOnly property "prop> hello world" -- Right (DocProperty "hello world") property :: Parser (DocH mod a)-property = DocProperty . T.unpack . T.strip <$> ("prop>" *> takeWhile1 (Parsec.noneOf "\n"))+property = DocProperty . T.unpack . T.strip <$> ("prop>" *> takeWhile1 (/= '\n')) -- | -- Paragraph level codeblock. Anything between the two delimiting \@ is parsed@@ -782,23 +810,22 @@ | isNewline && isSpace c = Just isNewline | otherwise = Just $ c == '\n' -hyperlink :: Parser (DocH mod a)-hyperlink = choice' [ angleBracketLink, markdownLink, autoUrl ]+hyperlink :: Parser (DocH mod Identifier)+hyperlink = choice' [ angleBracketLink, autoUrl ] angleBracketLink :: Parser (DocH mod a) angleBracketLink =- DocHyperlink . makeLabeled Hyperlink + DocHyperlink . makeLabeled (\s -> Hyperlink s . fmap DocString) <$> disallowNewline ("<" *> takeUntil ">") -markdownLink :: Parser (DocH mod a)-markdownLink = DocHyperlink <$> linkParser+-- | The text for a markdown link, enclosed in square brackets.+markdownLinkText :: Parser (DocH mod Identifier)+markdownLinkText = parseParagraph . T.strip <$> ("[" *> takeUntil "]") -linkParser :: Parser Hyperlink-linkParser = flip Hyperlink <$> label <*> (whitespace *> url)+-- | The target for a markdown link, enclosed in parenthesis.+markdownLinkTarget :: Parser String+markdownLinkTarget = whitespace *> url where- label :: Parser (Maybe String)- label = Just . decode . T.strip <$> ("[" *> takeUntil "]")- whitespace :: Parser () whitespace = skipHorizontalSpace <* optional ("\n" *> skipHorizontalSpace) @@ -816,41 +843,17 @@ autoUrl :: Parser (DocH mod a) autoUrl = mkLink <$> url where- url = mappend <$> choice' [ "http://", "https://", "ftp://"] <*> takeWhile1 (Parsec.satisfy (not . isSpace))- + url = mappend <$> choice' [ "http://", "https://", "ftp://"] <*> takeWhile1 (not . isSpace)+ mkLink :: Text -> DocH mod a mkLink s = case T.unsnoc s of Just (xs,x) | x `elem` (",.!?" :: String) -> DocHyperlink (mkHyperlink xs) `docAppend` DocString [x] _ -> DocHyperlink (mkHyperlink s) - mkHyperlink :: Text -> Hyperlink+ mkHyperlink :: Text -> Hyperlink (DocH mod a) mkHyperlink lnk = Hyperlink (T.unpack lnk) Nothing ---- | Parses strings between identifier delimiters. Consumes all input that it--- deems to be valid in an identifier. Note that it simply blindly consumes--- characters and does no actual validation itself.-parseValid :: Parser String-parseValid = p some- where- idChar = Parsec.satisfy (\c -> isAlphaNum c || isSymbolChar c || c == '_')-- p p' = do- vs <- p' idChar- c <- peekChar'- case c of- '`' -> return vs- '\'' -> choice' [ (\x -> vs ++ "'" ++ x) <$> ("'" *> p many), return vs ]- _ -> fail "outofvalid"---- | Parses identifiers with help of 'parseValid'. Asks GHC for--- 'String' from the string it deems valid.+-- | Parses identifiers with help of 'parseValid'. identifier :: Parser (DocH mod Identifier)-identifier = do- o <- idDelim- vid <- parseValid- e <- idDelim- return $ DocIdentifier (o, vid, e)- where- idDelim = Parsec.satisfy (\c -> c == '\'' || c == '`')+identifier = DocIdentifier <$> parseValid
+ src/Documentation/Haddock/Parser/Identifier.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE BangPatterns #-}+-- |+-- Module : Documentation.Haddock.Parser.Identifier+-- Copyright : (c) Alec Theriault 2019,+-- License : BSD-like+--+-- Maintainer : haddock@projects.haskell.org+-- Stability : experimental+-- Portability : portable+--+-- Functionality for parsing identifiers and operators++module Documentation.Haddock.Parser.Identifier (+ Identifier(..),+ parseValid,+) where++import Documentation.Haddock.Types ( Namespace(..) )+import Documentation.Haddock.Parser.Monad+import qualified Text.Parsec as Parsec+import Text.Parsec.Pos ( updatePosChar )+import Text.Parsec ( State(..)+ , getParserState, setParserState )++import Data.Text (Text)+import qualified Data.Text as T++import Data.Char (isAlpha, isAlphaNum)+import Control.Monad (guard)+import Data.Maybe+import CompatPrelude++-- | Identifier string surrounded with namespace, opening, and closing quotes/backticks.+data Identifier = Identifier !Namespace !Char String !Char+ deriving (Show, Eq)++parseValid :: Parser Identifier+parseValid = do+ s@State{ stateInput = inp, statePos = pos } <- getParserState++ case takeIdentifier inp of+ Nothing -> Parsec.parserFail "parseValid: Failed to match a valid identifier"+ Just (ns, op, ident, cl, inp') ->+ let posOp = updatePosChar pos op+ posIdent = T.foldl updatePosChar posOp ident+ posCl = updatePosChar posIdent cl+ s' = s{ stateInput = inp', statePos = posCl }+ in setParserState s' $> Identifier ns op (T.unpack ident) cl+++-- | Try to parse a delimited identifier off the front of the given input.+--+-- This tries to match as many valid Haskell identifiers/operators as possible,+-- to the point of sometimes accepting invalid things (ex: keywords). Some+-- considerations:+--+-- - operators and identifiers can have module qualifications+-- - operators can be wrapped in parens (for prefix)+-- - identifiers can be wrapped in backticks (for infix)+-- - delimiters are backticks or regular ticks+-- - since regular ticks are also valid in identifiers, we opt for the+-- longest successful parse+--+-- This function should make /O(1)/ allocations+takeIdentifier :: Text -> Maybe (Namespace, Char, Text, Char, Text)+takeIdentifier input = listToMaybe $ do++ -- Optional namespace+ let (ns, input') = case T.uncons input of+ Just ('v', i) -> (Value, i)+ Just ('t', i) -> (Type, i)+ _ -> (None, input)++ -- Opening tick+ (op, input'') <- maybeToList (T.uncons input')+ guard (op == '\'' || op == '`')++ -- Identifier/operator+ (ident, input''') <- wrapped input''++ -- Closing tick+ (cl, input'''') <- maybeToList (T.uncons input''')+ guard (cl == '\'' || cl == '`')++ return (ns, op, ident, cl, input'''')++ where++ -- | Parse out a wrapped, possibly qualified, operator or identifier+ wrapped t = do+ (c, t' ) <- maybeToList (T.uncons t)+ -- Tuples+ case c of+ '(' | Just (c', _) <- T.uncons t'+ , c' == ',' || c' == ')'+ -> do let (commas, t'') = T.span (== ',') t'+ (')', t''') <- maybeToList (T.uncons t'')+ return (T.take (T.length commas + 2) t, t''')++ -- Parenthesized+ '(' -> do (n, t'' ) <- general False 0 [] t'+ (')', t''') <- maybeToList (T.uncons t'')+ return (T.take (n + 2) t, t''')++ -- Backticked+ '`' -> do (n, t'' ) <- general False 0 [] t'+ ('`', t''') <- maybeToList (T.uncons t'')+ return (T.take (n + 2) t, t''')++ -- Unadorned+ _ -> do (n, t'' ) <- general False 0 [] t+ return (T.take n t, t'')++ -- | Parse out a possibly qualified operator or identifier+ general :: Bool -- ^ refuse inputs starting with operators+ -> Int -- ^ total characters \"consumed\" so far+ -> [(Int, Text)] -- ^ accumulated results+ -> Text -- ^ current input+ -> [(Int, Text)] -- ^ total characters parsed & what remains+ general !identOnly !i acc t+ -- Starts with an identifier (either just an identifier, or a module qual)+ | Just (n, rest) <- identLike t+ = if T.null rest+ then acc+ else case T.head rest of+ '`' -> (n + i, rest) : acc+ ')' -> (n + i, rest) : acc+ '.' -> general False (n + i + 1) acc (T.tail rest)+ '\'' -> let (m, rest') = quotes rest+ in general True (n + m + 1 + i) ((n + m + i, rest') : acc) (T.tail rest')+ _ -> acc++ -- An operator+ | Just (n, rest) <- optr t+ , not identOnly+ = (n + i, rest) : acc++ -- Anything else+ | otherwise+ = acc++ -- | Parse an identifier off the front of the input+ identLike t+ | T.null t = Nothing+ | isAlpha (T.head t) || '_' == T.head t+ = let !(idt, rest) = T.span (\c -> isAlphaNum c || c == '_') t+ !(octos, rest') = T.span (== '#') rest+ in Just (T.length idt + T.length octos, rest')+ | otherwise = Nothing++ -- | Parse all but the last quote off the front of the input+ -- PRECONDITION: T.head t `elem` ['\'', '`']+ quotes :: Text -> (Int, Text)+ quotes t = let !n = T.length (T.takeWhile (`elem` ['\'', '`']) t) - 1+ in (n, T.drop n t)++ -- | Parse an operator off the front of the input+ optr t = let !(op, rest) = T.span isSymbolChar t+ in if T.null op then Nothing else Just (T.length op, rest)
src/Documentation/Haddock/Parser/Monad.hs view
@@ -1,18 +1,33 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE TypeSynonymInstances #-}+-- |+-- Module : Documentation.Haddock.Parser.Monad+-- Copyright : (c) Alec Theriault 2018-2019,+-- License : BSD-like+--+-- Maintainer : haddock@projects.haskell.org+-- Stability : experimental+-- Portability : portable+--+-- Defines the Parsec monad over which all parsing is done and also provides+-- more efficient versions of the usual parsec combinator functions (but+-- specialized to 'Text'). module Documentation.Haddock.Parser.Monad where import qualified Text.Parsec.Char as Parsec import qualified Text.Parsec as Parsec+import Text.Parsec.Pos ( updatePosChar )+import Text.Parsec ( State(..)+ , getParserState, setParserState ) import qualified Data.Text as T import Data.Text ( Text ) +import Control.Monad ( mfilter ) import Data.String ( IsString(..) ) import Data.Bits ( Bits(..) ) import Data.Char ( ord )@@ -21,6 +36,12 @@ import Documentation.Haddock.Types ( Version ) +import Prelude hiding (takeWhile)+import CompatPrelude++-- | The only bit of information we really care about trudging along with us+-- through parsing is the version attached to a @\@since@ annotation - if+-- the doc even contained one. newtype ParserState = ParserState { parserStateSince :: Maybe Version } deriving (Eq, Show)@@ -29,7 +50,7 @@ initialParserState = ParserState Nothing setSince :: Version -> Parser ()-setSince since = Parsec.modifyState (\st -> st {parserStateSince = Just since})+setSince since = Parsec.modifyState (\st -> st{ parserStateSince = Just since }) type Parser = Parsec.Parsec Text ParserState @@ -44,38 +65,74 @@ -- | Always succeeds, but returns 'Nothing' if at the end of input. Does not -- consume input.+--+-- Equivalent to @Parsec.optionMaybe . Parsec.lookAhead $ Parsec.anyChar@, but+-- more efficient. peekChar :: Parser (Maybe Char)-peekChar = Parsec.optionMaybe . Parsec.try . Parsec.lookAhead $ Parsec.anyChar+peekChar = headOpt . stateInput <$> getParserState+ where headOpt t | T.null t = Nothing+ | otherwise = Just (T.head t)+{-# INLINE peekChar #-} -- | Fails if at the end of input. Does not consume input.+--+-- Equivalent to @Parsec.lookAhead Parsec.anyChar@, but more efficient. peekChar' :: Parser Char-peekChar' = Parsec.lookAhead Parsec.anyChar +peekChar' = headFail . stateInput =<< getParserState+ where headFail t | T.null t = Parsec.parserFail "peekChar': reached EOF"+ | otherwise = App.pure (T.head t)+{-# INLINE peekChar' #-} -- | Parses the given string. Returns the parsed string.+--+-- Equivalent to @Parsec.string (T.unpack t) $> t@, but more efficient. string :: Text -> Parser Text-string t = Parsec.string (T.unpack t) *> App.pure t+string t = do+ s@State{ stateInput = inp, statePos = pos } <- getParserState+ case T.stripPrefix t inp of+ Nothing -> Parsec.parserFail "string: Failed to match the input string"+ Just inp' ->+ let pos' = T.foldl updatePosChar pos t+ s' = s{ stateInput = inp', statePos = pos' }+ in setParserState s' $> t +-- | Keep matching characters as long as the predicate function holds (and+-- return them).+--+-- Equivalent to @fmap T.pack . Parsec.many@, but more efficient.+takeWhile :: (Char -> Bool) -> Parser Text+takeWhile f = do+ s@State{ stateInput = inp, statePos = pos } <- getParserState+ let (t, inp') = T.span f inp+ pos' = T.foldl updatePosChar pos t+ s' = s{ stateInput = inp', statePos = pos' }+ setParserState s' $> t++-- | Like 'takeWhile', but fails if no characters matched.+--+-- Equivalent to @fmap T.pack . Parsec.many1@, but more efficient.+takeWhile1 :: (Char -> Bool) -> Parser Text+takeWhile1 = mfilter (not . T.null) . takeWhile+ -- | Scan the input text, accumulating characters as long as the scanning -- function returns true. scan :: (s -> Char -> Maybe s) -- ^ scan function -> s -- ^ initial state -> Parser Text -scan f = fmap T.pack . go- where go s1 = do { cOpt <- peekChar- ; case cOpt >>= f s1 of- Nothing -> pure ""- Just s2 -> (:) <$> Parsec.anyChar <*> go s2- }---- | Apply a parser for a character zero or more times and collect the result in--- a string.-takeWhile :: Parser Char -> Parser Text-takeWhile = fmap T.pack . Parsec.many+scan f st = do+ s@State{ stateInput = inp, statePos = pos } <- getParserState+ go inp st pos 0 $ \inp' pos' n ->+ let s' = s{ Parsec.stateInput = inp', Parsec.statePos = pos' }+ in setParserState s' $> T.take n inp+ where+ go inp s !pos !n cont+ = case T.uncons inp of+ Nothing -> cont inp pos n -- ran out of input+ Just (c, inp') ->+ case f s c of+ Nothing -> cont inp pos n -- scan function failed+ Just s' -> go inp' s' (updatePosChar pos c) (n+1) cont --- | Apply a parser for a character one or more times and collect the result in--- a string.-takeWhile1 :: Parser Char -> Parser Text-takeWhile1 = fmap T.pack . Parsec.many1 -- | Parse a decimal number. decimal :: Integral a => Parser a
src/Documentation/Haddock/Parser/Util.hs view
@@ -31,16 +31,16 @@ import Data.Char (isSpace) -- | Characters that count as horizontal space-horizontalSpace :: [Char]-horizontalSpace = " \t\f\v\r"+horizontalSpace :: Char -> Bool+horizontalSpace c = isSpace c && c /= '\n' -- | Skip and ignore leading horizontal space skipHorizontalSpace :: Parser ()-skipHorizontalSpace = Parsec.skipMany (Parsec.oneOf horizontalSpace)+skipHorizontalSpace = Parsec.skipMany (Parsec.satisfy horizontalSpace) -- | Take leading horizontal space-takeHorizontalSpace :: Parser Text -takeHorizontalSpace = takeWhile (Parsec.oneOf horizontalSpace)+takeHorizontalSpace :: Parser Text+takeHorizontalSpace = takeWhile horizontalSpace makeLabeled :: (String -> Maybe String -> a) -> Text -> a makeLabeled f input = case T.break isSpace $ removeEscapes $ T.strip input of@@ -60,10 +60,10 @@ -- | Consume characters from the input up to and including the given pattern. -- Return everything consumed except for the end pattern itself.-takeUntil :: Text -> Parser Text +takeUntil :: Text -> Parser Text takeUntil end_ = T.dropEnd (T.length end_) <$> requireEnd (scan p (False, end)) >>= gotSome where- end = T.unpack end_ + end = T.unpack end_ p :: (Bool, String) -> Char -> Maybe (Bool, String) p acc c = case acc of
src/Documentation/Haddock/Types.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}+{-# LANGUAGE CPP, DeriveTraversable #-} -- | -- Module : Documentation.Haddock.Types@@ -44,14 +44,17 @@ } deriving (Eq, Show, Functor, Foldable, Traversable) #if MIN_VERSION_base(4,8,0)+-- | __NOTE__: Only defined for @base >= 4.8.0@ instance Bifunctor MetaDoc where bimap f g (MetaDoc m d) = MetaDoc m (bimap f g d) #endif #if MIN_VERSION_base(4,10,0)+-- | __NOTE__: Only defined for @base >= 4.10.0@ instance Bifoldable MetaDoc where bifoldr f g z d = bifoldr f g z (_doc d) +-- | __NOTE__: Only defined for @base >= 4.10.0@ instance Bitraversable MetaDoc where bitraverse f g (MetaDoc m d) = MetaDoc m <$> bitraverse f g d #endif@@ -65,18 +68,23 @@ type Version = [Int] type Package = String -data Hyperlink = Hyperlink+data Hyperlink id = Hyperlink { hyperlinkUrl :: String- , hyperlinkLabel :: Maybe String- } deriving (Eq, Show)+ , hyperlinkLabel :: Maybe id+ } deriving (Eq, Show, Functor, Foldable, Traversable) +data ModLink id = ModLink+ { modLinkName :: String+ , modLinkLabel :: Maybe id+ } deriving (Eq, Show, Functor, Foldable, Traversable)+ data Picture = Picture { pictureUri :: String , pictureTitle :: Maybe String } deriving (Eq, Show) data Header id = Header- { headerLevel :: Int+ { headerLevel :: Int -- ^ between 1 and 6 inclusive , headerTitle :: id } deriving (Eq, Show, Functor, Foldable, Traversable) @@ -108,22 +116,23 @@ | DocIdentifier id | DocIdentifierUnchecked mod -- ^ A qualified identifier that couldn't be resolved.- | DocModule String+ | DocModule (ModLink (DocH mod id))+ -- ^ A link to a module, with an optional label. | DocWarning (DocH mod id) -- ^ This constructor has no counterpart in Haddock markup. | DocEmphasis (DocH mod id) | DocMonospaced (DocH mod id) | DocBold (DocH mod id) | DocUnorderedList [DocH mod id]- | DocOrderedList [DocH mod id]+ | DocOrderedList [(Int, DocH mod id)] | DocDefList [(DocH mod id, DocH mod id)] | DocCodeBlock (DocH mod id)- | DocHyperlink Hyperlink+ | DocHyperlink (Hyperlink (DocH mod id)) | DocPic Picture | DocMathInline String | DocMathDisplay String | DocAName String- -- ^ A (HTML) anchor.+ -- ^ A (HTML) anchor. It must not contain any spaces. | DocProperty String | DocExamples [Example] | DocHeader (Header (DocH mod id))@@ -131,6 +140,7 @@ deriving (Eq, Show, Functor, Foldable, Traversable) #if MIN_VERSION_base(4,8,0)+-- | __NOTE__: Only defined for @base >= 4.8.0@ instance Bifunctor DocH where bimap _ _ DocEmpty = DocEmpty bimap f g (DocAppend docA docB) = DocAppend (bimap f g docA) (bimap f g docB)@@ -138,16 +148,16 @@ bimap f g (DocParagraph doc) = DocParagraph (bimap f g doc) bimap _ g (DocIdentifier i) = DocIdentifier (g i) bimap f _ (DocIdentifierUnchecked m) = DocIdentifierUnchecked (f m)- bimap _ _ (DocModule s) = DocModule s+ bimap f g (DocModule (ModLink m lbl)) = DocModule (ModLink m (fmap (bimap f g) lbl)) bimap f g (DocWarning doc) = DocWarning (bimap f g doc) bimap f g (DocEmphasis doc) = DocEmphasis (bimap f g doc) bimap f g (DocMonospaced doc) = DocMonospaced (bimap f g doc) bimap f g (DocBold doc) = DocBold (bimap f g doc) bimap f g (DocUnorderedList docs) = DocUnorderedList (map (bimap f g) docs)- bimap f g (DocOrderedList docs) = DocOrderedList (map (bimap f g) docs)+ bimap f g (DocOrderedList docs) = DocOrderedList (map (\(index, a) -> (index, bimap f g a)) docs) bimap f g (DocDefList docs) = DocDefList (map (bimap f g *** bimap f g) docs) bimap f g (DocCodeBlock doc) = DocCodeBlock (bimap f g doc)- bimap _ _ (DocHyperlink hyperlink) = DocHyperlink hyperlink+ bimap f g (DocHyperlink (Hyperlink url lbl)) = DocHyperlink (Hyperlink url (fmap (bimap f g) lbl)) bimap _ _ (DocPic picture) = DocPic picture bimap _ _ (DocMathInline s) = DocMathInline s bimap _ _ (DocMathDisplay s) = DocMathDisplay s@@ -159,6 +169,7 @@ #endif #if MIN_VERSION_base(4,10,0)+-- | __NOTE__: Only defined for @base >= 4.10.0@ instance Bifoldable DocH where bifoldr f g z (DocAppend docA docB) = bifoldr f g (bifoldr f g z docA) docB bifoldr f g z (DocParagraph doc) = bifoldr f g z doc@@ -169,13 +180,14 @@ bifoldr f g z (DocMonospaced doc) = bifoldr f g z doc bifoldr f g z (DocBold doc) = bifoldr f g z doc bifoldr f g z (DocUnorderedList docs) = foldr (flip (bifoldr f g)) z docs- bifoldr f g z (DocOrderedList docs) = foldr (flip (bifoldr f g)) z docs+ bifoldr f g z (DocOrderedList docs) = foldr (flip (bifoldr f g)) z (map snd docs) bifoldr f g z (DocDefList docs) = foldr (\(l, r) acc -> bifoldr f g (bifoldr f g acc l) r) z docs bifoldr f g z (DocCodeBlock doc) = bifoldr f g z doc bifoldr f g z (DocHeader (Header _ title)) = bifoldr f g z title bifoldr f g z (DocTable (Table header body)) = foldr (\r acc -> foldr (flip (bifoldr f g)) acc r) (foldr (\r acc -> foldr (flip (bifoldr f g)) acc r) z body) header bifoldr _ _ z _ = z +-- | __NOTE__: Only defined for @base >= 4.10.0@ instance Bitraversable DocH where bitraverse _ _ DocEmpty = pure DocEmpty bitraverse f g (DocAppend docA docB) = DocAppend <$> bitraverse f g docA <*> bitraverse f g docB@@ -183,16 +195,17 @@ bitraverse f g (DocParagraph doc) = DocParagraph <$> bitraverse f g doc bitraverse _ g (DocIdentifier i) = DocIdentifier <$> g i bitraverse f _ (DocIdentifierUnchecked m) = DocIdentifierUnchecked <$> f m- bitraverse _ _ (DocModule s) = pure (DocModule s)+ bitraverse f g (DocModule (ModLink m lbl)) = DocModule <$> (ModLink m <$> traverse (bitraverse f g) lbl) bitraverse f g (DocWarning doc) = DocWarning <$> bitraverse f g doc bitraverse f g (DocEmphasis doc) = DocEmphasis <$> bitraverse f g doc bitraverse f g (DocMonospaced doc) = DocMonospaced <$> bitraverse f g doc bitraverse f g (DocBold doc) = DocBold <$> bitraverse f g doc bitraverse f g (DocUnorderedList docs) = DocUnorderedList <$> traverse (bitraverse f g) docs- bitraverse f g (DocOrderedList docs) = DocOrderedList <$> traverse (bitraverse f g) docs+ bitraverse f g (DocOrderedList docs) = DocOrderedList <$> traverseSnd (bitraverse f g) docs+ where traverseSnd f' = traverse (\(x, a) -> (\b -> (x, b)) <$> f' a) bitraverse f g (DocDefList docs) = DocDefList <$> traverse (bitraverse (bitraverse f g) (bitraverse f g)) docs bitraverse f g (DocCodeBlock doc) = DocCodeBlock <$> bitraverse f g doc- bitraverse _ _ (DocHyperlink hyperlink) = pure (DocHyperlink hyperlink)+ bitraverse f g (DocHyperlink (Hyperlink url lbl)) = DocHyperlink <$> (Hyperlink url <$> traverse (bitraverse f g) lbl) bitraverse _ _ (DocPic picture) = pure (DocPic picture) bitraverse _ _ (DocMathInline s) = pure (DocMathInline s) bitraverse _ _ (DocMathDisplay s) = pure (DocMathDisplay s)@@ -203,6 +216,16 @@ bitraverse f g (DocTable (Table header body)) = (\h b -> DocTable (Table h b)) <$> traverse (traverse (bitraverse f g)) header <*> traverse (traverse (bitraverse f g)) body #endif +-- | The namespace qualification for an identifier.+data Namespace = Value | Type | None deriving (Eq, Ord, Enum, Show)++-- | Render the a namespace into the same format it was initially parsed.+renderNs :: Namespace -> String+renderNs Value = "v"+renderNs Type = "t"+renderNs None = ""++ -- | 'DocMarkupH' is a set of instructions for marking up documentation. -- In fact, it's really just a mapping from 'Doc' to some other -- type [a], where [a] is usually the type of the output (HTML, say).@@ -218,16 +241,16 @@ , markupAppend :: a -> a -> a , markupIdentifier :: id -> a , markupIdentifierUnchecked :: mod -> a- , markupModule :: String -> a+ , markupModule :: ModLink a -> a , markupWarning :: a -> a , markupEmphasis :: a -> a , markupBold :: a -> a , markupMonospaced :: a -> a , markupUnorderedList :: [a] -> a- , markupOrderedList :: [a] -> a+ , markupOrderedList :: [(Int,a)] -> a , markupDefList :: [(a,a)] -> a , markupCodeBlock :: a -> a- , markupHyperlink :: Hyperlink -> a+ , markupHyperlink :: Hyperlink a -> a , markupAName :: String -> a , markupPic :: Picture -> a , markupMathInline :: String -> a
− src/Documentation/Haddock/Utf8.hs
@@ -1,74 +0,0 @@-module Documentation.Haddock.Utf8 (encodeUtf8, decodeUtf8) where-import Data.Bits ((.|.), (.&.), shiftL, shiftR)-import qualified Data.ByteString as BS-import Data.Char (chr, ord)-import Data.Word (Word8)---- | Helper that encodes and packs a 'String' into a 'BS.ByteString'-encodeUtf8 :: String -> BS.ByteString-encodeUtf8 = BS.pack . encode---- | Helper that unpacks and decodes a 'BS.ByteString' into a 'String'-decodeUtf8 :: BS.ByteString -> String-decodeUtf8 = decode . BS.unpack---- Copy/pasted functions from Codec.Binary.UTF8.String for encoding/decoding--- | Character to use when 'encode' or 'decode' fail for a byte.-replacementCharacter :: Char-replacementCharacter = '\xfffd'---- | Encode a Haskell String to a list of Word8 values, in UTF8 format.-encode :: String -> [Word8]-encode = concatMap (map fromIntegral . go . ord)- where- go oc- | oc <= 0x7f = [oc]-- | oc <= 0x7ff = [ 0xc0 + (oc `shiftR` 6)- , 0x80 + oc .&. 0x3f- ]-- | oc <= 0xffff = [ 0xe0 + (oc `shiftR` 12)- , 0x80 + ((oc `shiftR` 6) .&. 0x3f)- , 0x80 + oc .&. 0x3f- ]- | otherwise = [ 0xf0 + (oc `shiftR` 18)- , 0x80 + ((oc `shiftR` 12) .&. 0x3f)- , 0x80 + ((oc `shiftR` 6) .&. 0x3f)- , 0x80 + oc .&. 0x3f- ]---- | Decode a UTF8 string packed into a list of Word8 values, directly to String-decode :: [Word8] -> String-decode [ ] = ""-decode (c:cs)- | c < 0x80 = chr (fromEnum c) : decode cs- | c < 0xc0 = replacementCharacter : decode cs- | c < 0xe0 = multi1- | c < 0xf0 = multi_byte 2 0xf 0x800- | c < 0xf8 = multi_byte 3 0x7 0x10000- | c < 0xfc = multi_byte 4 0x3 0x200000- | c < 0xfe = multi_byte 5 0x1 0x4000000- | otherwise = replacementCharacter : decode cs- where- multi1 = case cs of- c1 : ds | c1 .&. 0xc0 == 0x80 ->- let d = ((fromEnum c .&. 0x1f) `shiftL` 6) .|. fromEnum (c1 .&. 0x3f)- in if d >= 0x000080 then toEnum d : decode ds- else replacementCharacter : decode ds- _ -> replacementCharacter : decode cs-- multi_byte :: Int -> Word8 -> Int -> String- multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask))- where- aux 0 rs acc- | overlong <= acc && acc <= 0x10ffff &&- (acc < 0xd800 || 0xdfff < acc) &&- (acc < 0xfffe || 0xffff < acc) = chr acc : decode rs- | otherwise = replacementCharacter : decode rs-- aux n (r:rs) acc- | r .&. 0xc0 == 0x80 = aux (n-1) rs- $ shiftL acc 6 .|. fromEnum (r .&. 0x3f)-- aux _ rs _ = replacementCharacter : decode rs
test/Documentation/Haddock/Parser/UtilSpec.hs view
@@ -1,11 +1,14 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Documentation.Haddock.Parser.UtilSpec (main, spec) where import Documentation.Haddock.Parser.Monad import Documentation.Haddock.Parser.Util-import Data.Either.Compat (isLeft)+import Data.Either (isLeft) import Test.Hspec+#if !(MIN_VERSION_base(4,8,0)) import Control.Applicative+#endif main :: IO () main = hspec spec
test/Documentation/Haddock/ParserSpec.hs view
@@ -3,6 +3,7 @@ module Documentation.Haddock.ParserSpec (main, spec) where +import Data.Char (isSpace) import Data.String import qualified Documentation.Haddock.Parser as Parse import Documentation.Haddock.Types@@ -37,7 +38,7 @@ parseString :: String -> Doc String parseString = Parse.toRegular . Parse.parseString -hyperlink :: String -> Maybe String -> Doc String+hyperlink :: String -> Maybe (Doc String) -> Doc String hyperlink url = DocHyperlink . Hyperlink url main :: IO ()@@ -112,7 +113,7 @@ "``" `shouldParseTo` "``" it "can parse an identifier in infix notation enclosed within backticks" $ do- "``infix``" `shouldParseTo` "`" <> DocIdentifier "infix" <> "`"+ "``infix``" `shouldParseTo` DocIdentifier "`infix`" it "can parse identifiers containing a single quote" $ do "'don't'" `shouldParseTo` DocIdentifier "don't"@@ -120,6 +121,9 @@ it "can parse identifiers ending with a single quote" $ do "'foo''" `shouldParseTo` DocIdentifier "foo'" + it "can parse identifiers in backticks ending with a single quote" $ do+ "`foo'`" `shouldParseTo` DocIdentifier "foo'"+ it "can parse an identifier containing a digit" $ do "'f0'" `shouldParseTo` DocIdentifier "f0" @@ -132,6 +136,19 @@ it "can parse an identifier that starts with an underscore" $ do "'_x'" `shouldParseTo` DocIdentifier "_x" + it "can parse value-namespaced identifiers" $ do+ "v'foo'" `shouldParseTo` DocIdentifier "foo"++ it "can parse type-namespaced identifiers" $ do+ "t'foo'" `shouldParseTo` DocIdentifier "foo"++ it "can parse parenthesized operators and backticked identifiers" $ do+ "'(<|>)'" `shouldParseTo` DocIdentifier "(<|>)"+ "'`elem`'" `shouldParseTo` DocIdentifier "`elem`"++ it "can properly figure out the end of identifiers" $ do+ "'DbModule'/'DbUnitId'" `shouldParseTo` DocIdentifier "DbModule" <> "/" <> DocIdentifier "DbUnitId"+ context "when parsing operators" $ do it "can parse an operator enclosed within single quotes" $ do "'.='" `shouldParseTo` DocIdentifier ".="@@ -202,6 +219,10 @@ "[some label]( url)" `shouldParseTo` "[some label]( url)" + it "allows inline markup in the label" $ do+ "[something /emphasized/](url)" `shouldParseTo`+ hyperlink "url" (Just ("something " <> DocEmphasis "emphasized"))+ context "when URL is on a separate line" $ do it "allows URL to be on a separate line" $ do "[some label]\n(url)" `shouldParseTo`@@ -271,8 +292,10 @@ it "parses a single word anchor" $ do "#foo#" `shouldParseTo` DocAName "foo" - it "parses a multi word anchor" $ do- "#foo bar#" `shouldParseTo` DocAName "foo bar"+ -- Spaces are not allowed:+ -- https://www.w3.org/TR/html51/dom.html#the-id-attribute+ it "doesn't parse a multi word anchor" $ do+ "#foo bar#" `shouldParseTo` "#foo bar#" it "parses a unicode anchor" $ do "#灼眼のシャナ#" `shouldParseTo` DocAName "灼眼のシャナ"@@ -287,6 +310,9 @@ it "does not accept empty anchors" $ do "##" `shouldParseTo` "##" + it "does not accept anchors containing spaces" $ do+ "{-# LANGUAGE GADTs #-}" `shouldParseTo` "{-# LANGUAGE GADTs #-}"+ context "when parsing emphasised text" $ do it "emphasises a word on its own" $ do "/foo/" `shouldParseTo` DocEmphasis "foo"@@ -380,20 +406,20 @@ context "when parsing module strings" $ do it "should parse a module on its own" $ do "\"Module\"" `shouldParseTo`- DocModule "Module"+ DocModule (ModLink "Module" Nothing) it "should parse a module inline" $ do "This is a \"Module\"." `shouldParseTo`- "This is a " <> DocModule "Module" <> "."+ "This is a " <> DocModule (ModLink "Module" Nothing) <> "." it "can accept a simple module name" $ do- "\"Hello\"" `shouldParseTo` DocModule "Hello"+ "\"Hello\"" `shouldParseTo` DocModule (ModLink "Hello" Nothing) it "can accept a module name with dots" $ do- "\"Hello.World\"" `shouldParseTo` DocModule "Hello.World"+ "\"Hello.World\"" `shouldParseTo` DocModule (ModLink "Hello.World" Nothing) it "can accept a module name with unicode" $ do- "\"Hello.Worldλ\"" `shouldParseTo` DocModule "Hello.Worldλ"+ "\"Hello.Worldλ\"" `shouldParseTo` DocModule (ModLink "Hello.Worldλ" Nothing) it "parses a module name with a trailing dot as regular quoted string" $ do "\"Hello.\"" `shouldParseTo` "\"Hello.\""@@ -405,17 +431,86 @@ "\"Hello&[{}(=*)+]!\"" `shouldParseTo` "\"Hello&[{}(=*)+]!\"" it "accepts a module name with unicode" $ do- "\"Foo.Barλ\"" `shouldParseTo` DocModule "Foo.Barλ"+ "\"Foo.Barλ\"" `shouldParseTo` DocModule (ModLink "Foo.Barλ" Nothing) it "treats empty module name as regular double quotes" $ do "\"\"" `shouldParseTo` "\"\"" it "accepts anchor reference syntax as DocModule" $ do- "\"Foo#bar\"" `shouldParseTo` DocModule "Foo#bar"+ "\"Foo#bar\"" `shouldParseTo` DocModule (ModLink "Foo#bar" Nothing) + it "accepts anchor with hyphen as DocModule" $ do+ "\"Foo#bar-baz\"" `shouldParseTo` DocModule (ModLink "Foo#bar-baz" Nothing)+ it "accepts old anchor reference syntax as DocModule" $ do- "\"Foo\\#bar\"" `shouldParseTo` DocModule "Foo\\#bar"+ "\"Foo\\#bar\"" `shouldParseTo` DocModule (ModLink "Foo\\#bar" Nothing) + context "when parsing labeled module links" $ do+ it "parses a simple labeled module link" $ do+ "[some label](\"Some.Module\")" `shouldParseTo`+ DocModule (ModLink "Some.Module" (Just "some label"))++ it "allows escaping in label" $ do+ "[some\\] label](\"Some.Module\")" `shouldParseTo`+ DocModule (ModLink "Some.Module" (Just "some] label"))++ it "strips leading and trailing whitespace from label" $ do+ "[ some label ](\"Some.Module\")" `shouldParseTo`+ DocModule (ModLink "Some.Module" (Just "some label"))++ it "allows whitespace in module name link" $ do+ "[some label]( \"Some.Module\"\t )" `shouldParseTo`+ DocModule (ModLink "Some.Module" (Just "some label"))++ it "allows inline markup in the label" $ do+ "[something /emphasized/](\"Some.Module\")" `shouldParseTo`+ DocModule (ModLink "Some.Module" (Just ("something " <> DocEmphasis "emphasized")))++ it "should parse a labeled module on its own" $ do+ "[label](\"Module\")" `shouldParseTo`+ DocModule (ModLink "Module" (Just "label"))++ it "should parse a labeled module inline" $ do+ "This is a [label](\"Module\")." `shouldParseTo`+ "This is a " <> DocModule (ModLink "Module" (Just "label")) <> "."++ it "can accept a labeled module name with dots" $ do+ "[label](\"Hello.World\")" `shouldParseTo` DocModule (ModLink "Hello.World" (Just "label"))++ it "can accept a labeled module name with unicode" $ do+ "[label](\"Hello.Worldλ\")" `shouldParseTo` DocModule (ModLink "Hello.Worldλ" (Just "label"))++ it "parses a labeled module name with a trailing dot as a hyperlink" $ do+ "[label](\"Hello.\")" `shouldParseTo`+ hyperlink "\"Hello.\"" (Just "label")++ it "parses a labeled module name with a space as a regular string" $ do+ "[label](\"Hello World\")" `shouldParseTo` "[label](\"Hello World\")"++ it "parses a module name with invalid characters as a hyperlink" $ do+ "[label](\"Hello&[{}(=*+]!\")" `shouldParseTo`+ hyperlink "\"Hello&[{}(=*+]!\"" (Just "label")++ it "accepts a labeled module name with unicode" $ do+ "[label](\"Foo.Barλ\")" `shouldParseTo`+ DocModule (ModLink "Foo.Barλ" (Just "label"))++ it "treats empty labeled module name as empty hyperlink" $ do+ "[label](\"\")" `shouldParseTo`+ hyperlink "\"\"" (Just "label")++ it "accepts anchor reference syntax for labeled module name" $ do+ "[label](\"Foo#bar\")" `shouldParseTo`+ DocModule (ModLink "Foo#bar" (Just "label"))++ it "accepts old anchor reference syntax for labeled module name" $ do+ "[label](\"Foo\\#bar\")" `shouldParseTo`+ DocModule (ModLink "Foo\\#bar" (Just "label"))++ it "interprets empty label as a unlabeled module name" $ do+ "[](\"Module.Name\")" `shouldParseTo`+ "[](" <> DocModule (ModLink "Module.Name" Nothing) <> ")"+ describe "parseParas" $ do let infix 1 `shouldParseTo` shouldParseTo :: String -> Doc String -> Expectation@@ -425,6 +520,10 @@ property $ \xs -> (length . show . parseParas) xs `shouldSatisfy` (> 0) + -- See <https://github.com/haskell/haddock/issues/1142>+ it "doesn't crash on unicode whitespace" $ do+ "\8197" `shouldParseTo` DocEmpty+ context "when parsing @since" $ do it "adds specified version to the result" $ do parseParas "@since 0.5.0" `shouldBe`@@ -453,7 +552,8 @@ context "when parsing text paragraphs" $ do- let filterSpecial = filter (`notElem` (".(=#-[*`\v\f\n\t\r\\\"'_/@<> " :: String))+ let isSpecial c = isSpace c || c `elem` (".(=#-[*`\\\"'_/@<>" :: String)+ filterSpecial = filter (not . isSpecial) it "parses an empty paragraph" $ do "" `shouldParseTo` DocEmpty@@ -479,28 +579,38 @@ it "turns it into a code block" $ do "@foo@" `shouldParseTo` DocCodeBlock "foo" - context "when a paragraph starts with a markdown link" $ do- it "correctly parses it as a text paragraph (not a definition list)" $ do- "[label](url)" `shouldParseTo`- DocParagraph (hyperlink "url" "label")+ context "when a paragraph contains a markdown link" $ do+ it "correctly parses the link" $ do+ "Blah [label](url)" `shouldParseTo`+ DocParagraph ("Blah " <> hyperlink "url" "label") - it "can be followed by an other paragraph" $ do- "[label](url)\n\nfoobar" `shouldParseTo`- DocParagraph (hyperlink "url" "label") <> DocParagraph "foobar"+ context "when the paragraph starts with the markdown link" $ do+ it "correctly parses it as a text paragraph (not a definition list)" $ do+ "[label](url)" `shouldParseTo`+ DocParagraph (hyperlink "url" "label") - context "when paragraph contains additional text" $ do- it "accepts more text after the link" $ do- "[label](url) foo bar baz" `shouldParseTo`- DocParagraph (hyperlink "url" "label" <> " foo bar baz")+ it "can be followed by an other paragraph" $ do+ "[label](url)\n\nfoobar" `shouldParseTo`+ DocParagraph (hyperlink "url" "label") <> DocParagraph "foobar" - it "accepts a newline right after the markdown link" $ do- "[label](url)\nfoo bar baz" `shouldParseTo`- DocParagraph (hyperlink "url" "label" <> " foo bar baz")+ context "when paragraph contains additional text" $ do+ it "accepts more text after the link" $ do+ "[label](url) foo bar baz" `shouldParseTo`+ DocParagraph (hyperlink "url" "label" <> " foo bar baz") - it "can be followed by an other paragraph" $ do- "[label](url)foo\n\nbar" `shouldParseTo`- DocParagraph (hyperlink "url" "label" <> "foo") <> DocParagraph "bar"+ it "accepts a newline right after the markdown link" $ do+ "[label](url)\nfoo bar baz" `shouldParseTo`+ DocParagraph (hyperlink "url" "label" <> " foo bar baz") + it "can be followed by an other paragraph" $ do+ "[label](url)foo\n\nbar" `shouldParseTo`+ DocParagraph (hyperlink "url" "label" <> "foo") <> DocParagraph "bar"++ context "when the link starts on a new line not at the beginning of the paragraph" $ do+ it "correctly parses the link" $ do+ "Bla\n[label](url)" `shouldParseTo`+ DocParagraph ("Bla\n" <> hyperlink "url" "label")+ context "when parsing birdtracks" $ do it "parses them as a code block" $ do unlines [@@ -713,7 +823,7 @@ it "can nest another type of list inside" $ do "* foo\n\n 1. bar" `shouldParseTo` DocUnorderedList [ DocParagraph "foo"- <> DocOrderedList [DocParagraph "bar"]]+ <> DocOrderedList [(1, DocParagraph "bar")]] it "can nest a code block inside" $ do "* foo\n\n @foo bar baz@" `shouldParseTo`@@ -752,7 +862,7 @@ DocUnorderedList [ DocParagraph "foo" <> DocUnorderedList [ DocParagraph "bar" ] ]- <> DocOrderedList [ DocParagraph "baz" ]+ <> DocOrderedList [ (1, DocParagraph "baz") ] it "allows arbitrary initial indent of a list" $ do unlines@@ -776,20 +886,20 @@ DocDefList [ ("foo", "foov" <> DocDefList [ ("bar", "barv") ]) ]- <> DocOrderedList [ DocParagraph "baz" ]+ <> DocOrderedList [ (1, DocParagraph "baz") ] it "list order is preserved in presence of nesting + extra text" $ do "1. Foo\n\n > Some code\n\n2. Bar\n\nSome text" `shouldParseTo`- DocOrderedList [ DocParagraph "Foo" <> DocCodeBlock "Some code"- , DocParagraph "Bar"+ DocOrderedList [ (1, DocParagraph "Foo" <> DocCodeBlock "Some code")+ , (2, DocParagraph "Bar") ] <> DocParagraph (DocString "Some text") "1. Foo\n\n2. Bar\n\nSome text" `shouldParseTo`- DocOrderedList [ DocParagraph "Foo"- , DocParagraph "Bar"+ DocOrderedList [ (1, DocParagraph "Foo")+ , (2, DocParagraph "Bar") ] <> DocParagraph (DocString "Some text") @@ -873,9 +983,9 @@ , " 3. three" ] `shouldParseTo` DocOrderedList [- DocParagraph "one"- , DocParagraph "two"- , DocParagraph "three"+ (1, DocParagraph "one")+ , (1, DocParagraph "two")+ , (3, DocParagraph "three") ] it "ignores empty lines between list items" $ do@@ -885,12 +995,12 @@ , "2. two" ] `shouldParseTo` DocOrderedList [- DocParagraph "one"- , DocParagraph "two"+ (1, DocParagraph "one")+ , (2, DocParagraph "two") ] it "accepts an empty list item" $ do- "1." `shouldParseTo` DocOrderedList [DocParagraph DocEmpty]+ "1." `shouldParseTo` DocOrderedList [(1, DocParagraph DocEmpty)] it "accepts multi-line list items" $ do unlines [@@ -900,12 +1010,12 @@ , "more two" ] `shouldParseTo` DocOrderedList [- DocParagraph "point one\n more one"- , DocParagraph "point two\nmore two"+ (1, DocParagraph "point one\n more one")+ , (1, DocParagraph "point two\nmore two") ] it "accepts markup in list items" $ do- "1. /foo/" `shouldParseTo` DocOrderedList [DocParagraph (DocEmphasis "foo")]+ "1. /foo/" `shouldParseTo` DocOrderedList [(1, DocParagraph (DocEmphasis "foo"))] it "requires empty lines between list and other paragraphs" $ do unlines [@@ -915,7 +1025,7 @@ , "" , "baz" ]- `shouldParseTo` DocParagraph "foo" <> DocOrderedList [DocParagraph "bar"] <> DocParagraph "baz"+ `shouldParseTo` DocParagraph "foo" <> DocOrderedList [(1, DocParagraph "bar")] <> DocParagraph "baz" context "when parsing definition lists" $ do it "parses a simple list" $ do@@ -1002,8 +1112,8 @@ ] `shouldParseTo` DocUnorderedList [ DocParagraph "bullet" , DocParagraph "different bullet"]- <> DocOrderedList [ DocParagraph "ordered"- , DocParagraph "different bullet"+ <> DocOrderedList [ (1, DocParagraph "ordered")+ , (2, DocParagraph "different bullet") ] <> DocDefList [ ("cat", "kitten") , ("pineapple", "fruit")
− test/Documentation/Haddock/Utf8Spec.hs
@@ -1,14 +0,0 @@-module Documentation.Haddock.Utf8Spec (main, spec) where--import Test.Hspec-import Test.QuickCheck-import Documentation.Haddock.Utf8--main :: IO ()-main = hspec spec--spec :: Spec-spec = do- describe "decodeUtf8" $ do- it "is inverse to encodeUtf8" $ do- property $ \xs -> (decodeUtf8 . encodeUtf8) xs `shouldBe` xs