From e0ada1743cb722d2f82498a95b201f3ffb303137 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 11 Apr 2017 20:35:08 +0200 Subject: Read files for hyperlinker eagerly This also exposes Documentation.Haddock.Utf8 --- haddock-library/haddock-library.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'haddock-library') diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index cabfbc67..4e355dd1 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -34,6 +34,7 @@ library Documentation.Haddock.Parser.Monad Documentation.Haddock.Types Documentation.Haddock.Doc + Documentation.Haddock.Utf8 other-modules: Data.Attoparsec @@ -48,7 +49,6 @@ library Data.Attoparsec.Internal.Types Data.Attoparsec.Number Documentation.Haddock.Parser.Util - Documentation.Haddock.Utf8 test-suite spec type: exitcode-stdio-1.0 -- cgit v1.2.3 From 3b64e93ec1811bb5741550a4956ea5f28be24443 Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Wed, 12 Apr 2017 16:32:04 +0200 Subject: Add @alexbiehl as maintaner --- haddock-api/haddock-api.cabal | 2 +- haddock-library/haddock-library.cabal | 2 +- haddock.cabal | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) (limited to 'haddock-library') diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 922aa07c..f98a8202 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -6,7 +6,7 @@ description: Haddock is a documentation-generation tool for Haskell license: BSD3 license-file: LICENSE author: Simon Marlow, David Waern -maintainer: Simon Hengel , Mateusz Kowalczyk +maintainer: Alex Biehl , Simon Hengel , Mateusz Kowalczyk homepage: http://www.haskell.org/haddock/ bug-reports: https://github.com/haskell/haddock/issues copyright: (c) Simon Marlow, David Waern diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 4e355dd1..463569a3 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -9,7 +9,7 @@ description: Haddock is a documentation-generation tool for Haskell itself, see the ‘haddock’ package. license: BSD3 license-file: LICENSE -maintainer: Simon Hengel , Mateusz Kowalczyk +maintainer: Alex Biehl , Simon Hengel , Mateusz Kowalczyk homepage: http://www.haskell.org/haddock/ bug-reports: https://github.com/haskell/haddock/issues category: Documentation diff --git a/haddock.cabal b/haddock.cabal index 6ebdad76..a79f8c78 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -6,7 +6,7 @@ description: Haddock is a documentation-generation tool for Haskell license: BSD3 license-file: LICENSE author: Simon Marlow, David Waern -maintainer: Simon Hengel , Mateusz Kowalczyk +maintainer: Alex Biehl , Simon Hengel , Mateusz Kowalczyk homepage: http://www.haskell.org/haddock/ bug-reports: https://github.com/haskell/haddock/issues copyright: (c) Simon Marlow, David Waern -- cgit v1.2.3 From 70885ce16e1b0b9bf19fe0efb85a48daa0e5c281 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 18 Apr 2017 16:45:32 +0200 Subject: Travis: Use ghc-8.2.1 on master --- .travis.yml | 84 +++++++++++++++++++++++++++------ haddock-api/haddock-api.cabal | 5 +- haddock-api/src/Haddock.hs | 25 ++++++---- haddock-library/haddock-library.cabal | 5 +- haddock-test/src/Test/Haddock/Config.hs | 17 +++++-- haddock.cabal | 53 ++++++++++++--------- 6 files changed, 136 insertions(+), 53 deletions(-) (limited to 'haddock-library') diff --git a/.travis.yml b/.travis.yml index 405f8753..c1f8f504 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,26 +1,80 @@ +# This Travis job script has been generated by a script via +# +# make_travis_yml_2.hs 'haddock.cabal' +# +# For more information, see https://github.com/hvr/multi-ghc-travis +# +language: c sudo: false +git: + submodules: false # whether to recursively clone submodules + +cache: + directories: + - $HOME/.cabal/packages + - $HOME/.cabal/store + +before_cache: + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log + # remove files that are regenerated by 'cabal update' + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx + matrix: include: - - env: CABALVER=head GHCVER=head - addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} + - compiler: "ghc-8.2.1" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}} + - compiler: "ghc-head" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-head], sources: [hvr-ghc]}} allow_failures: - - env: CABALVER=head GHCVER=head + - compiler: "ghc-head" before_install: - - export PATH=$HOME/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH + - HC=${CC} + - unset CC + - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH + - PKGNAME='haddock' + +install: - cabal --version - - cabal update - - cd haddock-library - - cabal install --only-dependencies --enable-tests -# - cabal install doctest - # --ghc-options=-Werror - - cabal configure --enable-tests && cabal build && cabal test -# - doctest -isrc -i$(echo vendor/attoparsec-*) -optP-include -optPdist/build/autogen/cabal_macros.h src/Documentation/Haddock/Parser.hs - - cabal install - - cd .. - - (cd haddock-api/ && cabal install --only-dependencies --enable-tests && cabal configure --enable-tests && cabal build && cabal test && cabal install) + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" + - BENCH=${BENCH---enable-benchmarks} + - TEST=${TEST---enable-tests} + - travis_retry cabal update -v + - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config + - rm -fv cabal.project.local + - rm -f cabal.project.freeze + - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all +# Here starts the actual work to be performed for the package under test; +# any command which exits with a non-zero exit code causes the build to fail. script: - - cabal configure --enable-tests && cabal build && cabal test + - if [ -f configure.ac ]; then autoreconf -i; fi + - rm -rf dist/ + - cabal sdist # test that a source-distribution can be generated + - cd dist/ + - SRCTAR=(${PKGNAME}-*.tar.gz) + - SRC_BASENAME="${SRCTAR/%.tar.gz}" + - tar -xvf "./$SRC_BASENAME.tar.gz" + - cd "$SRC_BASENAME/" +## from here on, CWD is inside the extracted source-tarball + - rm -fv cabal.project.local + # this builds all libraries and executables (without tests/benchmarks) + - rm -f cabal.project.freeze + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all + # this builds all libraries and executables (including tests/benchmarks) + # - rm -rf ./dist-newstyle + + # build & run tests + - cabal new-build -w ${HC} ${TEST} ${BENCH} all + - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi + +# EOF diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index f98a8202..921e16eb 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -12,7 +12,7 @@ bug-reports: https://github.com/haskell/haddock/issues copyright: (c) Simon Marlow, David Waern category: Documentation build-type: Simple -cabal-version: >= 1.10 +cabal-version: >= 2.0 stability: experimental data-dir: @@ -120,6 +120,9 @@ test-suite spec , hspec , QuickCheck == 2.* + build-tool-depends: + hspec-discover:hspec-discover + source-repository head type: git location: https://github.com/haskell/haddock.git diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 6af0874a..dec85b79 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -426,15 +426,22 @@ getHaddockLibDir flags = #ifdef IN_GHC_TREE getInTreeDir #else - d <- getDataDir -- provided by Cabal - doesDirectoryExist d >>= \exists -> case exists of - True -> return d - False -> do - -- If directory does not exist then we are probably invoking from - -- ./dist/build/haddock/haddock so we use ./resources as a fallback. - doesDirectoryExist "resources" >>= \exists_ -> case exists_ of - True -> return "resources" - False -> die ("Haddock's resource directory (" ++ d ++ ") does not exist!\n") + -- if data directory does not exist we are probably + -- invoking from either ./haddock-api or ./ + let res_dirs = [ getDataDir -- provided by Cabal + , pure "resources" + , pure "haddock-api/resources" + ] + + check get_path = do + p <- get_path + exists <- doesDirectoryExist p + pure $ if exists then Just p else Nothing + + dirs <- mapM check res_dirs + case [p | Just p <- dirs] of + (p : _) -> return p + _ -> die "Haddock's resource directory does not exist!\n" #endif fs -> return (last fs) diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 463569a3..b7a20758 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -14,7 +14,7 @@ homepage: http://www.haskell.org/haddock/ bug-reports: https://github.com/haskell/haddock/issues category: Documentation build-type: Simple -cabal-version: >= 1.10 +cabal-version: >= 2.0 stability: experimental library @@ -78,6 +78,9 @@ test-suite spec , hspec , QuickCheck == 2.* + build-tool-depends: + hspec-discover:hspec-discover + source-repository head type: git subdir: haddock-library diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs index e1e920f2..50616c7f 100644 --- a/haddock-test/src/Test/Haddock/Config.hs +++ b/haddock-test/src/Test/Haddock/Config.hs @@ -165,11 +165,18 @@ loadConfig ccfg dcfg flags files = do cfgEnv <- (:) ("haddock_datadir", dcfgResDir dcfg) <$> getEnvironment systemHaddockPath <- List.lookup "HADDOCK_PATH" <$> getEnvironment - cfgHaddockPath <- case flagsHaddockPath flags <|> systemHaddockPath of + haddockOnPath <- findExecutable "haddock" + + let haddock_path = msum [ flagsHaddockPath flags + , systemHaddockPath + , haddockOnPath + ] + + cfgHaddockPath <- case haddock_path of Just path -> pure path - Nothing -> do - hPutStrLn stderr $ "Haddock executable not specified" - exitFailure + Nothing -> do + hPutStrLn stderr "Haddock executable not found" + exitFailure ghcPath <- init <$> rawSystemStdout normal cfgHaddockPath ["--print-ghc-path"] @@ -195,7 +202,7 @@ loadConfig ccfg dcfg flags files = do let cfgAccept = FlagAccept `elem` flags let cfgCheckConfig = ccfg - let cfgDirConfig = dcfg + let cfgDirConfig = dcfg return $ Config { .. } diff --git a/haddock.cabal b/haddock.cabal index a79f8c78..fa8a3531 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -12,9 +12,10 @@ bug-reports: https://github.com/haskell/haddock/issues copyright: (c) Simon Marlow, David Waern category: Documentation build-type: Simple -cabal-version: >= 1.10 +cabal-version: >= 2.0 stability: experimental - +tested-with: GHC==8.2.*, GHC==8.3 + extra-source-files: CHANGES README.md @@ -130,32 +131,40 @@ test-suite driver-test test-suite html-test type: exitcode-stdio-1.0 - default-language: Haskell2010 - main-is: Main.hs - hs-source-dirs: html-test - build-depends: base, filepath, haddock-test == 0.0.1 + -- This tells cabal that this test depends on the executable + -- component 'haddock' from this very same package, as well + -- as adding the build-folder where the `haddock` + -- executable can be found in front of $PATH + build-tool-depends: haddock:haddock + default-language: Haskell2010 + main-is: Main.hs + hs-source-dirs: html-test + build-depends: base, filepath, haddock-test == 0.0.1 test-suite hypsrc-test - type: exitcode-stdio-1.0 - default-language: Haskell2010 - main-is: Main.hs - hs-source-dirs: hypsrc-test - build-depends: base, filepath, haddock-test == 0.0.1 - ghc-options: -Wall -fwarn-tabs + type: exitcode-stdio-1.0 + build-tool-depends: haddock:haddock + default-language: Haskell2010 + main-is: Main.hs + hs-source-dirs: hypsrc-test + build-depends: base, filepath, haddock-test == 0.0.1 + ghc-options: -Wall -fwarn-tabs test-suite latex-test - type: exitcode-stdio-1.0 - default-language: Haskell2010 - main-is: Main.hs - hs-source-dirs: latex-test - build-depends: base, filepath, haddock-test == 0.0.1 + type: exitcode-stdio-1.0 + build-tool-depends: haddock:haddock + default-language: Haskell2010 + main-is: Main.hs + hs-source-dirs: latex-test + build-depends: base, filepath, haddock-test == 0.0.1 test-suite hoogle-test - type: exitcode-stdio-1.0 - default-language: Haskell2010 - main-is: Main.hs - hs-source-dirs: hoogle-test - build-depends: base, filepath, haddock-test == 0.0.1 + type: exitcode-stdio-1.0 + build-tool-depends: haddock:haddock + default-language: Haskell2010 + main-is: Main.hs + hs-source-dirs: hoogle-test + build-depends: base, filepath, haddock-test == 0.0.1 source-repository head type: git -- cgit v1.2.3 From 67d6345e7b941008080ea79ea462229f0f377d50 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Wed, 26 Apr 2017 07:49:10 +0200 Subject: Cherry-picked remaining commits from haddock-2.17.4-release (#603) * Release haddock/haddock-api 2.17.4 and haddock-library 1.4.3 * Set version bounds for haddock-library NB: This allows GHC 8.2.1's base * Set version bounds for haddock & haddock-api The version bounds support GHC 8.2 * Merge (temporary) v2.17.3 branch into v2.17 This allows us to delete the v2.17.3 branch * Fixup changelog * Pin down haddock-api to a single version as otherwise `haddock`'s package version has no proper meaning * fix source-repo spec for haddock-api --- CHANGES | 14 ++++++++++++ haddock-api/haddock-api.cabal | 42 ++++++++++++++++++----------------- haddock-api/src/Haddock/Types.hs | 4 ++-- haddock-library/haddock-library.cabal | 10 ++++----- haddock.cabal | 7 ++++-- 5 files changed, 48 insertions(+), 29 deletions(-) (limited to 'haddock-library') diff --git a/CHANGES b/CHANGES index 4389c58a..7e3d052a 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,17 @@ +Changes in version 2.17.4 + + * Fix 'internal error: links: UnhelpfulSpan' (#554, #565) + + * Hyperlink backend knows about `DataKinds` (#510) + + * Fix rendering of class methods for `Eq` and `Ord` (#549) + + * Export `MDoc` and `toInstalledIface` from `Haddock.Types` + +Changes in version 2.17.3.1 + + * Disable `NFData` instances for GHC types when GHC >= 8.0.2 (#537) + Changes in version 2.17.3 * Remove framed view of the HTML documentation diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 921e16eb..20b656b9 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -1,5 +1,5 @@ name: haddock-api -version: 2.17.3 +version: 2.17.4 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries @@ -33,28 +33,29 @@ data-files: latex/haddock.sty library - default-language: - Haskell2010 + default-language: Haskell2010 - build-depends: - base >= 4.3 && < 4.11 - , bytestring - , filepath - , directory - , containers - , transformers - , deepseq - , array - , xhtml >= 3000.2 && < 3000.3 - , Cabal >= 1.10 - , ghc-boot - , ghc == 8.2.* + -- this package typically supports only single major versions + build-depends: base == 4.10.* + , Cabal == 2.0.* + , ghc == 8.2.* + , ghc-paths == 0.1.* + , haddock-library >= 1.4.2 && < 1.5 + , xhtml == 3000.2.* - , ghc-paths - , haddock-library == 1.4.* + -- Versions for the dependencies below are transitively pinned by + -- the non-reinstallable `ghc` package and hence need no version + -- bounds + build-depends: array + , bytestring + , containers + , deepseq + , directory + , filepath + , ghc-boot + , transformers - hs-source-dirs: - src + hs-source-dirs: src ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 @@ -125,4 +126,5 @@ test-suite spec source-repository head type: git + subdir: haddock-api location: https://github.com/haskell/haddock.git diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index a6dd6354..803995cc 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -460,8 +460,8 @@ instance (NFData a, NFData mod) DocExamples a -> a `deepseq` () DocHeader a -> a `deepseq` () -#if __GLASGOW_HASKELL__ < 801 --- These were added to GHC itself in 8.2.1 +#if !MIN_VERSION_ghc(8,0,2) +-- These were added to GHC itself in 8.0.2 instance NFData Name where rnf x = seq x () instance NFData OccName where rnf x = seq x () instance NFData ModuleName where rnf x = seq x () diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index b7a20758..be433e6a 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -1,5 +1,5 @@ name: haddock-library -version: 1.4.2 +version: 1.4.3 synopsis: Library exposing some functionality of Haddock. description: Haddock is a documentation-generation tool for Haskell libraries. These modules expose some functionality of it @@ -21,10 +21,10 @@ library default-language: Haskell2010 build-depends: - base >= 4.5 && < 4.11 - , bytestring - , transformers - , deepseq + base >= 4.5 && < 4.11 + , bytestring >= 0.9.2.1 && < 0.11 + , transformers >= 0.3.0 && < 0.6 + , deepseq >= 1.3 && < 1.5 hs-source-dirs: src, vendor/attoparsec-0.12.1.1 ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 diff --git a/haddock.cabal b/haddock.cabal index fa8a3531..598f2b9a 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -1,5 +1,5 @@ name: haddock -version: 2.17.3 +version: 2.17.4 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries @@ -43,6 +43,7 @@ executable haddock hs-source-dirs: driver ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 -threaded + -- haddock typically only supports a single GHC major version build-depends: base >= 4.3 && < 4.11 if flag(in-ghc-tree) @@ -120,7 +121,9 @@ executable haddock Haddock.Syb Haddock.Convert else - build-depends: haddock-api == 2.17.* + -- in order for haddock's advertised version number to have proper meaning, + -- we pin down to a single haddock-api version. + build-depends: haddock-api == 2.17.4 test-suite driver-test type: exitcode-stdio-1.0 -- cgit v1.2.3 From 799a41fffde7ec6e1c2097b895925a4adac5419f Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Fri, 28 Apr 2017 11:28:08 +0200 Subject: Update attoparsec-0.12.1.1 to attoparsec-0.13.1.0 --- haddock-library/haddock-library.cabal | 4 +- .../vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs | 23 - .../Data/Attoparsec/ByteString.hs | 223 --------- .../Data/Attoparsec/ByteString/Buffer.hs | 151 ------ .../Data/Attoparsec/ByteString/Char8.hs | 469 ------------------ .../Data/Attoparsec/ByteString/FastSet.hs | 115 ----- .../Data/Attoparsec/ByteString/Internal.hs | 485 ------------------- .../Data/Attoparsec/Combinator.hs | 220 --------- .../Data/Attoparsec/Internal.hs | 142 ------ .../Data/Attoparsec/Internal/Fhthagn.hs | 18 - .../Data/Attoparsec/Internal/Types.hs | 230 --------- .../attoparsec-0.12.1.1/Data/Attoparsec/Number.hs | 137 ------ haddock-library/vendor/attoparsec-0.12.1.1/LICENSE | 30 -- .../vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs | 23 + .../Data/Attoparsec/ByteString.hs | 230 +++++++++ .../Data/Attoparsec/ByteString/Buffer.hs | 156 ++++++ .../Data/Attoparsec/ByteString/Char8.hs | 464 ++++++++++++++++++ .../Data/Attoparsec/ByteString/FastSet.hs | 115 +++++ .../Data/Attoparsec/ByteString/Internal.hs | 536 +++++++++++++++++++++ .../Data/Attoparsec/Combinator.hs | 233 +++++++++ .../Data/Attoparsec/Internal.hs | 157 ++++++ .../Data/Attoparsec/Internal/Fhthagn.hs | 18 + .../Data/Attoparsec/Internal/Types.hs | 243 ++++++++++ .../attoparsec-0.13.1.0/Data/Attoparsec/Number.hs | 137 ++++++ haddock-library/vendor/attoparsec-0.13.1.0/LICENSE | 30 ++ haddock.cabal | 2 +- 26 files changed, 2345 insertions(+), 2246 deletions(-) delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/LICENSE create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/LICENSE (limited to 'haddock-library') diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index be433e6a..a293039a 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -26,7 +26,7 @@ library , transformers >= 0.3.0 && < 0.6 , deepseq >= 1.3 && < 1.5 - hs-source-dirs: src, vendor/attoparsec-0.12.1.1 + hs-source-dirs: src, vendor/attoparsec-0.13.1.0 ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 exposed-modules: @@ -57,7 +57,7 @@ test-suite spec hs-source-dirs: test , src - , vendor/attoparsec-0.12.1.1 + , vendor/attoparsec-0.13.1.0 ghc-options: -Wall cpp-options: diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs deleted file mode 100644 index 53d91190..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs +++ /dev/null @@ -1,23 +0,0 @@ --- | --- Module : Data.Attoparsec --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient combinator parsing for --- 'Data.ByteString.ByteString' strings, loosely based on the Parsec --- library. --- --- This module is deprecated. Use "Data.Attoparsec.ByteString" --- instead. - -module Data.Attoparsec - {-# DEPRECATED "This module will be removed in the next major release." #-} - ( - module Data.Attoparsec.ByteString - ) where - -import Data.Attoparsec.ByteString diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs deleted file mode 100644 index da28b723..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs +++ /dev/null @@ -1,223 +0,0 @@ --- | --- Module : Data.Attoparsec.ByteString --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient combinator parsing for 'B.ByteString' strings, --- loosely based on the Parsec library. - -module Data.Attoparsec.ByteString - ( - -- * Differences from Parsec - -- $parsec - - -- * Incremental input - -- $incremental - - -- * Performance considerations - -- $performance - - -- * Parser types - I.Parser - , Result - , T.IResult(..) - , I.compareResults - - -- * Running parsers - , parse - , feed - , I.parseOnly - , parseWith - , parseTest - - -- ** Result conversion - , maybeResult - , eitherResult - - -- * Parsing individual bytes - , I.word8 - , I.anyWord8 - , I.notWord8 - , I.satisfy - , I.satisfyWith - , I.skip - - -- ** Lookahead - , I.peekWord8 - , I.peekWord8' - - -- ** Byte classes - , I.inClass - , I.notInClass - - -- * Efficient string handling - , I.string - , I.skipWhile - , I.take - , I.scan - , I.takeWhile - , I.takeWhile1 - , I.takeTill - - -- ** Consume all remaining input - , I.takeByteString - , I.takeLazyByteString - - -- * Combinators - , try - , () - , choice - , count - , option - , many' - , many1 - , many1' - , manyTill - , manyTill' - , sepBy - , sepBy' - , sepBy1 - , sepBy1' - , skipMany - , skipMany1 - , eitherP - , I.match - -- * State observation and manipulation functions - , I.endOfInput - , I.atEnd - ) where - -import Data.Attoparsec.Combinator -import qualified Data.Attoparsec.ByteString.Internal as I -import qualified Data.Attoparsec.Internal as I -import qualified Data.ByteString as B -import Data.Attoparsec.ByteString.Internal (Result, parse) -import qualified Data.Attoparsec.Internal.Types as T - --- $parsec --- --- Compared to Parsec 3, attoparsec makes several tradeoffs. It is --- not intended for, or ideal for, all possible uses. --- --- * While attoparsec can consume input incrementally, Parsec cannot. --- Incremental input is a huge deal for efficient and secure network --- and system programming, since it gives much more control to users --- of the library over matters such as resource usage and the I/O --- model to use. --- --- * Much of the performance advantage of attoparsec is gained via --- high-performance parsers such as 'I.takeWhile' and 'I.string'. --- If you use complicated combinators that return lists of bytes or --- characters, there is less performance difference between the two --- libraries. --- --- * Unlike Parsec 3, attoparsec does not support being used as a --- monad transformer. --- --- * attoparsec is specialised to deal only with strict 'B.ByteString' --- input. Efficiency concerns rule out both lists and lazy --- bytestrings. The usual use for lazy bytestrings would be to --- allow consumption of very large input without a large footprint. --- For this need, attoparsec's incremental input provides an --- excellent substitute, with much more control over when input --- takes place. If you must use lazy bytestrings, see the --- "Data.Attoparsec.ByteString.Lazy" module, which feeds lazy chunks --- to a regular parser. --- --- * Parsec parsers can produce more helpful error messages than --- attoparsec parsers. This is a matter of focus: attoparsec avoids --- the extra book-keeping in favour of higher performance. - --- $incremental --- --- attoparsec supports incremental input, meaning that you can feed it --- a bytestring that represents only part of the expected total amount --- of data to parse. If your parser reaches the end of a fragment of --- input and could consume more input, it will suspend parsing and --- return a 'T.Partial' continuation. --- --- Supplying the 'T.Partial' continuation with a bytestring will --- resume parsing at the point where it was suspended, with the --- bytestring you supplied used as new input at the end of the --- existing input. You must be prepared for the result of the resumed --- parse to be another 'T.Partial' continuation. --- --- To indicate that you have no more input, supply the 'T.Partial' --- continuation with an empty bytestring. --- --- Remember that some parsing combinators will not return a result --- until they reach the end of input. They may thus cause 'T.Partial' --- results to be returned. --- --- If you do not need support for incremental input, consider using --- the 'I.parseOnly' function to run your parser. It will never --- prompt for more input. --- --- /Note/: incremental input does /not/ imply that attoparsec will --- release portions of its internal state for garbage collection as it --- proceeds. Its internal representation is equivalent to a single --- 'ByteString': if you feed incremental input to a parser, it will --- require memory proportional to the amount of input you supply. --- (This is necessary to support arbitrary backtracking.) - --- $performance --- --- If you write an attoparsec-based parser carefully, it can be --- realistic to expect it to perform similarly to a hand-rolled C --- parser (measuring megabytes parsed per second). --- --- To actually achieve high performance, there are a few guidelines --- that it is useful to follow. --- --- Use the 'B.ByteString'-oriented parsers whenever possible, --- e.g. 'I.takeWhile1' instead of 'many1' 'I.anyWord8'. There is --- about a factor of 100 difference in performance between the two --- kinds of parser. --- --- For very simple byte-testing predicates, write them by hand instead --- of using 'I.inClass' or 'I.notInClass'. For instance, both of --- these predicates test for an end-of-line byte, but the first is --- much faster than the second: --- --- >endOfLine_fast w = w == 13 || w == 10 --- >endOfLine_slow = inClass "\r\n" --- --- Make active use of benchmarking and profiling tools to measure, --- find the problems with, and improve the performance of your parser. - --- | Run a parser and print its result to standard output. -parseTest :: (Show a) => I.Parser a -> B.ByteString -> IO () -parseTest p s = print (parse p s) - --- | Run a parser with an initial input string, and a monadic action --- that can supply more input if needed. -parseWith :: Monad m => - (m B.ByteString) - -- ^ An action that will be executed to provide the parser - -- with more input, if necessary. The action must return an - -- 'B.empty' string when there is no more input available. - -> I.Parser a - -> B.ByteString - -- ^ Initial input for the parser. - -> m (Result a) -parseWith refill p s = step $ parse p s - where step (T.Partial k) = (step . k) =<< refill - step r = return r -{-# INLINE parseWith #-} - --- | Convert a 'Result' value to a 'Maybe' value. A 'T.Partial' result --- is treated as failure. -maybeResult :: Result r -> Maybe r -maybeResult (T.Done _ r) = Just r -maybeResult _ = Nothing - --- | Convert a 'Result' value to an 'Either' value. A 'T.Partial' --- result is treated as failure. -eitherResult :: Result r -> Either String r -eitherResult (T.Done _ r) = Right r -eitherResult (T.Fail _ _ msg) = Left msg -eitherResult _ = Left "Result: incomplete input" diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs deleted file mode 100644 index 5e32d022..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs +++ /dev/null @@ -1,151 +0,0 @@ -{-# LANGUAGE BangPatterns #-} --- | --- Module : Data.Attoparsec.ByteString.Buffer --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : GHC --- --- An "immutable" buffer that supports cheap appends. --- --- A Buffer is divided into an immutable read-only zone, followed by a --- mutable area that we've preallocated, but not yet written to. --- --- We overallocate at the end of a Buffer so that we can cheaply --- append. Since a user of an existing Buffer cannot see past the end --- of its immutable zone into the data that will change during an --- append, this is safe. --- --- Once we run out of space at the end of a Buffer, we do the usual --- doubling of the buffer size. --- --- The fact of having a mutable buffer really helps with performance, --- but it does have a consequence: if someone misuses the Partial API --- that attoparsec uses by calling the same continuation repeatedly --- (which never makes sense in practice), they could overwrite data. --- --- Since the API *looks* pure, it should *act* pure, too, so we use --- two generation counters (one mutable, one immutable) to track the --- number of appends to a mutable buffer. If the counters ever get out --- of sync, someone is appending twice to a mutable buffer, so we --- duplicate the entire buffer in order to preserve the immutability --- of its older self. --- --- While we could go a step further and gain protection against API --- abuse on a multicore system, by use of an atomic increment --- instruction to bump the mutable generation counter, that would be --- very expensive, and feels like it would also be in the realm of the --- ridiculous. Clients should never call a continuation more than --- once; we lack a linear type system that could enforce this; and --- there's only so far we should go to accommodate broken uses. - -module Data.Attoparsec.ByteString.Buffer - ( - Buffer - , buffer - , unbuffer - , pappend - , length - , unsafeIndex - , substring - , unsafeDrop - ) where - -import Control.Exception (assert) -import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr) -import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO) -import Data.List (foldl1') -import Data.Monoid (Monoid(..)) -import Data.Word (Word8) -import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) -import Foreign.Ptr (castPtr, plusPtr) -import Foreign.Storable (peek, peekByteOff, poke, sizeOf) -import GHC.ForeignPtr (mallocPlainForeignPtrBytes) -import Prelude hiding (length) - -data Buffer = Buf { - _fp :: {-# UNPACK #-} !(ForeignPtr Word8) - , _off :: {-# UNPACK #-} !Int - , _len :: {-# UNPACK #-} !Int - , _cap :: {-# UNPACK #-} !Int - , _gen :: {-# UNPACK #-} !Int - } - -instance Show Buffer where - showsPrec p = showsPrec p . unbuffer - --- | The initial 'Buffer' has no mutable zone, so we can avoid all --- copies in the (hopefully) common case of no further input being fed --- to us. -buffer :: ByteString -> Buffer -buffer (PS fp off len) = Buf fp off len len 0 - -unbuffer :: Buffer -> ByteString -unbuffer (Buf fp off len _ _) = PS fp off len - -instance Monoid Buffer where - mempty = Buf nullForeignPtr 0 0 0 0 - - mappend (Buf _ _ _ 0 _) b = b - mappend a (Buf _ _ _ 0 _) = a - mappend buf (Buf fp off len _ _) = append buf fp off len - - mconcat [] = mempty - mconcat xs = foldl1' mappend xs - -pappend :: Buffer -> ByteString -> Buffer -pappend (Buf _ _ _ 0 _) (PS fp off len) = Buf fp off len 0 0 -pappend buf (PS fp off len) = append buf fp off len - -append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer -append (Buf fp0 off0 len0 cap0 gen0) !fp1 !off1 !len1 = - inlinePerformIO . withForeignPtr fp0 $ \ptr0 -> - withForeignPtr fp1 $ \ptr1 -> do - let genSize = sizeOf (0::Int) - newlen = len0 + len1 - gen <- if gen0 == 0 - then return 0 - else peek (castPtr ptr0) - if gen == gen0 && newlen <= cap0 - then do - let newgen = gen + 1 - poke (castPtr ptr0) newgen - memcpy (ptr0 `plusPtr` (off0+len0)) - (ptr1 `plusPtr` off1) - (fromIntegral len1) - return (Buf fp0 off0 newlen cap0 newgen) - else do - let newcap = newlen * 2 - fp <- mallocPlainForeignPtrBytes (newcap + genSize) - withForeignPtr fp $ \ptr_ -> do - let ptr = ptr_ `plusPtr` genSize - newgen = 1 - poke (castPtr ptr_) newgen - memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0) - memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1) - (fromIntegral len1) - return (Buf fp genSize newlen newcap newgen) - -length :: Buffer -> Int -length (Buf _ _ len _ _) = len -{-# INLINE length #-} - -unsafeIndex :: Buffer -> Int -> Word8 -unsafeIndex (Buf fp off len _ _) i = assert (i >= 0 && i < len) . - inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i) -{-# INLINE unsafeIndex #-} - -substring :: Int -> Int -> Buffer -> ByteString -substring s l (Buf fp off len _ _) = - assert (s >= 0 && s <= len) . - assert (l >= 0 && l <= len-s) $ - PS fp (off+s) l -{-# INLINE substring #-} - -unsafeDrop :: Int -> Buffer -> ByteString -unsafeDrop s (Buf fp off len _ _) = - assert (s >= 0 && s <= len) $ - PS fp (off+s) (len-s) -{-# INLINE unsafeDrop #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs deleted file mode 100644 index 576dded9..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs +++ /dev/null @@ -1,469 +0,0 @@ -{-# LANGUAGE BangPatterns, FlexibleInstances, TypeFamilies, - TypeSynonymInstances, GADTs #-} -{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} - --- | --- Module : Data.Attoparsec.ByteString.Char8 --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient, character-oriented combinator parsing for --- 'B.ByteString' strings, loosely based on the Parsec library. - -module Data.Attoparsec.ByteString.Char8 - ( - -- * Character encodings - -- $encodings - - -- * Parser types - Parser - , A.Result - , A.IResult(..) - , I.compareResults - - -- * Running parsers - , A.parse - , A.feed - , A.parseOnly - , A.parseWith - , A.parseTest - - -- ** Result conversion - , A.maybeResult - , A.eitherResult - - -- * Parsing individual characters - , char - , char8 - , anyChar - , notChar - , satisfy - - -- ** Lookahead - , peekChar - , peekChar' - - -- ** Special character parsers - , digit - , letter_iso8859_15 - , letter_ascii - , space - - -- ** Fast predicates - , isDigit - , isDigit_w8 - , isAlpha_iso8859_15 - , isAlpha_ascii - , isSpace - , isSpace_w8 - - -- *** Character classes - , inClass - , notInClass - - -- * Efficient string handling - , I.string - , stringCI - , skipSpace - , skipWhile - , I.take - , scan - , takeWhile - , takeWhile1 - , takeTill - - -- ** String combinators - -- $specalt - , (.*>) - , (<*.) - - -- ** Consume all remaining input - , I.takeByteString - , I.takeLazyByteString - - -- * Text parsing - , I.endOfLine - , isEndOfLine - , isHorizontalSpace - - -- * Numeric parsers - , decimal - , hexadecimal - , signed - , Number(..) - - -- * Combinators - , try - , () - , choice - , count - , option - , many' - , many1 - , many1' - , manyTill - , manyTill' - , sepBy - , sepBy' - , sepBy1 - , sepBy1' - , skipMany - , skipMany1 - , eitherP - , I.match - -- * State observation and manipulation functions - , I.endOfInput - , I.atEnd - ) where - -import Control.Applicative ((*>), (<*), (<$>), (<|>)) -import Data.Attoparsec.ByteString.FastSet (charClass, memberChar) -import Data.Attoparsec.ByteString.Internal (Parser) -import Data.Attoparsec.Combinator -import Data.Attoparsec.Number (Number(..)) -import Data.Bits (Bits, (.|.), shiftL) -import Data.ByteString.Internal (c2w, w2c) -import Data.Int (Int8, Int16, Int32, Int64) -import Data.String (IsString(..)) -import Data.Word -import Prelude hiding (takeWhile) -import qualified Data.Attoparsec.ByteString as A -import qualified Data.Attoparsec.ByteString.Internal as I -import qualified Data.Attoparsec.Internal as I -import qualified Data.ByteString as B8 -import qualified Data.ByteString.Char8 as B - -instance (a ~ B.ByteString) => IsString (Parser a) where - fromString = I.string . B.pack - --- $encodings --- --- This module is intended for parsing text that is --- represented using an 8-bit character set, e.g. ASCII or --- ISO-8859-15. It /does not/ make any attempt to deal with character --- encodings, multibyte characters, or wide characters. In --- particular, all attempts to use characters above code point U+00FF --- will give wrong answers. --- --- Code points below U+0100 are simply translated to and from their --- numeric values, so e.g. the code point U+00A4 becomes the byte --- @0xA4@ (which is the Euro symbol in ISO-8859-15, but the generic --- currency sign in ISO-8859-1). Haskell 'Char' values above U+00FF --- are truncated, so e.g. U+1D6B7 is truncated to the byte @0xB7@. - --- ASCII-specific but fast, oh yes. -toLower :: Word8 -> Word8 -toLower w | w >= 65 && w <= 90 = w + 32 - | otherwise = w - --- | Satisfy a literal string, ignoring case. -stringCI :: B.ByteString -> Parser B.ByteString -stringCI = I.stringTransform (B8.map toLower) -{-# INLINE stringCI #-} - --- | Consume input as long as the predicate returns 'True', and return --- the consumed input. --- --- This parser requires the predicate to succeed on at least one byte --- of input: it will fail if the predicate never returns 'True' or if --- there is no input left. -takeWhile1 :: (Char -> Bool) -> Parser B.ByteString -takeWhile1 p = I.takeWhile1 (p . w2c) -{-# INLINE takeWhile1 #-} - --- | The parser @satisfy p@ succeeds for any byte for which the --- predicate @p@ returns 'True'. Returns the byte that is actually --- parsed. --- --- >digit = satisfy isDigit --- > where isDigit c = c >= '0' && c <= '9' -satisfy :: (Char -> Bool) -> Parser Char -satisfy = I.satisfyWith w2c -{-# INLINE satisfy #-} - --- | Match a letter, in the ISO-8859-15 encoding. -letter_iso8859_15 :: Parser Char -letter_iso8859_15 = satisfy isAlpha_iso8859_15 "letter_iso8859_15" -{-# INLINE letter_iso8859_15 #-} - --- | Match a letter, in the ASCII encoding. -letter_ascii :: Parser Char -letter_ascii = satisfy isAlpha_ascii "letter_ascii" -{-# INLINE letter_ascii #-} - --- | A fast alphabetic predicate for the ISO-8859-15 encoding --- --- /Note/: For all character encodings other than ISO-8859-15, and --- almost all Unicode code points above U+00A3, this predicate gives --- /wrong answers/. -isAlpha_iso8859_15 :: Char -> Bool -isAlpha_iso8859_15 c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || - (c >= '\166' && moby c) - where moby = notInClass "\167\169\171-\179\182\183\185\187\191\215\247" - {-# NOINLINE moby #-} -{-# INLINE isAlpha_iso8859_15 #-} - --- | A fast alphabetic predicate for the ASCII encoding --- --- /Note/: For all character encodings other than ASCII, and --- almost all Unicode code points above U+007F, this predicate gives --- /wrong answers/. -isAlpha_ascii :: Char -> Bool -isAlpha_ascii c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') -{-# INLINE isAlpha_ascii #-} - --- | Parse a single digit. -digit :: Parser Char -digit = satisfy isDigit "digit" -{-# INLINE digit #-} - --- | A fast digit predicate. -isDigit :: Char -> Bool -isDigit c = c >= '0' && c <= '9' -{-# INLINE isDigit #-} - --- | A fast digit predicate. -isDigit_w8 :: Word8 -> Bool -isDigit_w8 w = w >= 48 && w <= 57 -{-# INLINE isDigit_w8 #-} - --- | Match any character. -anyChar :: Parser Char -anyChar = satisfy $ const True -{-# INLINE anyChar #-} - --- | Match any character, to perform lookahead. Returns 'Nothing' if --- end of input has been reached. Does not consume any input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'many', because such parsers loop until a --- failure occurs. Careless use will thus result in an infinite loop. -peekChar :: Parser (Maybe Char) -peekChar = (fmap w2c) `fmap` I.peekWord8 -{-# INLINE peekChar #-} - --- | Match any character, to perform lookahead. Does not consume any --- input, but will fail if end of input has been reached. -peekChar' :: Parser Char -peekChar' = w2c `fmap` I.peekWord8' -{-# INLINE peekChar' #-} - --- | Fast predicate for matching ASCII space characters. --- --- /Note/: This predicate only gives correct answers for the ASCII --- encoding. For instance, it does not recognise U+00A0 (non-breaking --- space) as a space character, even though it is a valid ISO-8859-15 --- byte. For a Unicode-aware and only slightly slower predicate, --- use 'Data.Char.isSpace' -isSpace :: Char -> Bool -isSpace c = (c == ' ') || ('\t' <= c && c <= '\r') -{-# INLINE isSpace #-} - --- | Fast 'Word8' predicate for matching ASCII space characters. -isSpace_w8 :: Word8 -> Bool -isSpace_w8 w = (w == 32) || (9 <= w && w <= 13) -{-# INLINE isSpace_w8 #-} - - --- | Parse a space character. --- --- /Note/: This parser only gives correct answers for the ASCII --- encoding. For instance, it does not recognise U+00A0 (non-breaking --- space) as a space character, even though it is a valid ISO-8859-15 --- byte. -space :: Parser Char -space = satisfy isSpace "space" -{-# INLINE space #-} - --- | Match a specific character. -char :: Char -> Parser Char -char c = satisfy (== c) [c] -{-# INLINE char #-} - --- | Match a specific character, but return its 'Word8' value. -char8 :: Char -> Parser Word8 -char8 c = I.satisfy (== c2w c) [c] -{-# INLINE char8 #-} - --- | Match any character except the given one. -notChar :: Char -> Parser Char -notChar c = satisfy (/= c) "not " ++ [c] -{-# INLINE notChar #-} - --- | Match any character in a set. --- --- >vowel = inClass "aeiou" --- --- Range notation is supported. --- --- >halfAlphabet = inClass "a-nA-N" --- --- To add a literal \'-\' to a set, place it at the beginning or end --- of the string. -inClass :: String -> Char -> Bool -inClass s = (`memberChar` mySet) - where mySet = charClass s -{-# INLINE inClass #-} - --- | Match any character not in a set. -notInClass :: String -> Char -> Bool -notInClass s = not . inClass s -{-# INLINE notInClass #-} - --- | Consume input as long as the predicate returns 'True', and return --- the consumed input. --- --- This parser does not fail. It will return an empty string if the --- predicate returns 'False' on the first byte of input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'many', because such parsers loop until a --- failure occurs. Careless use will thus result in an infinite loop. -takeWhile :: (Char -> Bool) -> Parser B.ByteString -takeWhile p = I.takeWhile (p . w2c) -{-# INLINE takeWhile #-} - --- | A stateful scanner. The predicate consumes and transforms a --- state argument, and each transformed state is passed to successive --- invocations of the predicate on each byte of the input until one --- returns 'Nothing' or the input ends. --- --- This parser does not fail. It will return an empty string if the --- predicate returns 'Nothing' on the first byte of input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'many', because such parsers loop until a --- failure occurs. Careless use will thus result in an infinite loop. -scan :: s -> (s -> Char -> Maybe s) -> Parser B.ByteString -scan s0 p = I.scan s0 (\s -> p s . w2c) -{-# INLINE scan #-} - --- | Consume input as long as the predicate returns 'False' --- (i.e. until it returns 'True'), and return the consumed input. --- --- This parser does not fail. It will return an empty string if the --- predicate returns 'True' on the first byte of input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'many', because such parsers loop until a --- failure occurs. Careless use will thus result in an infinite loop. -takeTill :: (Char -> Bool) -> Parser B.ByteString -takeTill p = I.takeTill (p . w2c) -{-# INLINE takeTill #-} - --- | Skip past input for as long as the predicate returns 'True'. -skipWhile :: (Char -> Bool) -> Parser () -skipWhile p = I.skipWhile (p . w2c) -{-# INLINE skipWhile #-} - --- | Skip over white space. -skipSpace :: Parser () -skipSpace = I.skipWhile isSpace_w8 -{-# INLINE skipSpace #-} - --- $specalt --- --- If you enable the @OverloadedStrings@ language extension, you can --- use the '*>' and '<*' combinators to simplify the common task of --- matching a statically known string, then immediately parsing --- something else. --- --- Instead of writing something like this: --- --- @ ---'I.string' \"foo\" '*>' wibble --- @ --- --- Using @OverloadedStrings@, you can omit the explicit use of --- 'I.string', and write a more compact version: --- --- @ --- \"foo\" '*>' wibble --- @ --- --- (Note: the '.*>' and '<*.' combinators that were originally --- provided for this purpose are obsolete and unnecessary, and will be --- removed in the next major version.) - --- | /Obsolete/. A type-specialized version of '*>' for --- 'B.ByteString'. Use '*>' instead. -(.*>) :: B.ByteString -> Parser a -> Parser a -s .*> f = I.string s *> f -{-# DEPRECATED (.*>) "This is no longer necessary, and will be removed. Use '*>' instead." #-} - --- | /Obsolete/. A type-specialized version of '<*' for --- 'B.ByteString'. Use '<*' instead. -(<*.) :: Parser a -> B.ByteString -> Parser a -f <*. s = f <* I.string s -{-# DEPRECATED (<*.) "This is no longer necessary, and will be removed. Use '<*' instead." #-} - --- | A predicate that matches either a carriage return @\'\\r\'@ or --- newline @\'\\n\'@ character. -isEndOfLine :: Word8 -> Bool -isEndOfLine w = w == 13 || w == 10 -{-# INLINE isEndOfLine #-} - --- | A predicate that matches either a space @\' \'@ or horizontal tab --- @\'\\t\'@ character. -isHorizontalSpace :: Word8 -> Bool -isHorizontalSpace w = w == 32 || w == 9 -{-# INLINE isHorizontalSpace #-} - --- | Parse and decode an unsigned hexadecimal number. The hex digits --- @\'a\'@ through @\'f\'@ may be upper or lower case. --- --- This parser does not accept a leading @\"0x\"@ string. -hexadecimal :: (Integral a, Bits a) => Parser a -hexadecimal = B8.foldl' step 0 `fmap` I.takeWhile1 isHexDigit - where - isHexDigit w = (w >= 48 && w <= 57) || - (w >= 97 && w <= 102) || - (w >= 65 && w <= 70) - step a w | w >= 48 && w <= 57 = (a `shiftL` 4) .|. fromIntegral (w - 48) - | w >= 97 = (a `shiftL` 4) .|. fromIntegral (w - 87) - | otherwise = (a `shiftL` 4) .|. fromIntegral (w - 55) -{-# SPECIALISE hexadecimal :: Parser Int #-} -{-# SPECIALISE hexadecimal :: Parser Int8 #-} -{-# SPECIALISE hexadecimal :: Parser Int16 #-} -{-# SPECIALISE hexadecimal :: Parser Int32 #-} -{-# SPECIALISE hexadecimal :: Parser Int64 #-} -{-# SPECIALISE hexadecimal :: Parser Integer #-} -{-# SPECIALISE hexadecimal :: Parser Word #-} -{-# SPECIALISE hexadecimal :: Parser Word8 #-} -{-# SPECIALISE hexadecimal :: Parser Word16 #-} -{-# SPECIALISE hexadecimal :: Parser Word32 #-} -{-# SPECIALISE hexadecimal :: Parser Word64 #-} - --- | Parse and decode an unsigned decimal number. -decimal :: Integral a => Parser a -decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDig - where isDig w = w >= 48 && w <= 57 - step a w = a * 10 + fromIntegral (w - 48) -{-# SPECIALISE decimal :: Parser Int #-} -{-# SPECIALISE decimal :: Parser Int8 #-} -{-# SPECIALISE decimal :: Parser Int16 #-} -{-# SPECIALISE decimal :: Parser Int32 #-} -{-# SPECIALISE decimal :: Parser Int64 #-} -{-# SPECIALISE decimal :: Parser Integer #-} -{-# SPECIALISE decimal :: Parser Word #-} -{-# SPECIALISE decimal :: Parser Word8 #-} -{-# SPECIALISE decimal :: Parser Word16 #-} -{-# SPECIALISE decimal :: Parser Word32 #-} -{-# SPECIALISE decimal :: Parser Word64 #-} - --- | Parse a number with an optional leading @\'+\'@ or @\'-\'@ sign --- character. -signed :: Num a => Parser a -> Parser a -{-# SPECIALISE signed :: Parser Int -> Parser Int #-} -{-# SPECIALISE signed :: Parser Int8 -> Parser Int8 #-} -{-# SPECIALISE signed :: Parser Int16 -> Parser Int16 #-} -{-# SPECIALISE signed :: Parser Int32 -> Parser Int32 #-} -{-# SPECIALISE signed :: Parser Int64 -> Parser Int64 #-} -{-# SPECIALISE signed :: Parser Integer -> Parser Integer #-} -signed p = (negate <$> (char8 '-' *> p)) - <|> (char8 '+' *> p) - <|> p diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs deleted file mode 100644 index cb615167..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs +++ /dev/null @@ -1,115 +0,0 @@ -{-# LANGUAGE BangPatterns, MagicHash #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Attoparsec.ByteString.FastSet --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Fast set membership tests for 'Word8' and 8-bit 'Char' values. The --- set representation is unboxed for efficiency. For small sets, we --- test for membership using a binary search. For larger sets, we use --- a lookup table. --- ------------------------------------------------------------------------------ -module Data.Attoparsec.ByteString.FastSet - ( - -- * Data type - FastSet - -- * Construction - , fromList - , set - -- * Lookup - , memberChar - , memberWord8 - -- * Debugging - , fromSet - -- * Handy interface - , charClass - ) where - -import Data.Bits ((.&.), (.|.)) -import Foreign.Storable (peekByteOff, pokeByteOff) -import GHC.Base (Int(I#), iShiftRA#, narrow8Word#, shiftL#) -import GHC.Word (Word8(W8#)) -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import qualified Data.ByteString.Internal as I -import qualified Data.ByteString.Unsafe as U - -data FastSet = Sorted { fromSet :: !B.ByteString } - | Table { fromSet :: !B.ByteString } - deriving (Eq, Ord) - -instance Show FastSet where - show (Sorted s) = "FastSet Sorted " ++ show (B8.unpack s) - show (Table _) = "FastSet Table" - --- | The lower bound on the size of a lookup table. We choose this to --- balance table density against performance. -tableCutoff :: Int -tableCutoff = 8 - --- | Create a set. -set :: B.ByteString -> FastSet -set s | B.length s < tableCutoff = Sorted . B.sort $ s - | otherwise = Table . mkTable $ s - -fromList :: [Word8] -> FastSet -fromList = set . B.pack - -data I = I {-# UNPACK #-} !Int {-# UNPACK #-} !Word8 - -shiftR :: Int -> Int -> Int -shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#) - -shiftL :: Word8 -> Int -> Word8 -shiftL (W8# x#) (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#)) - -index :: Int -> I -index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7)) -{-# INLINE index #-} - --- | Check the set for membership. -memberWord8 :: Word8 -> FastSet -> Bool -memberWord8 w (Table t) = - let I byte bit = index (fromIntegral w) - in U.unsafeIndex t byte .&. bit /= 0 -memberWord8 w (Sorted s) = search 0 (B.length s - 1) - where search lo hi - | hi < lo = False - | otherwise = - let mid = (lo + hi) `quot` 2 - in case compare w (U.unsafeIndex s mid) of - GT -> search (mid + 1) hi - LT -> search lo (mid - 1) - _ -> True - --- | Check the set for membership. Only works with 8-bit characters: --- characters above code point 255 will give wrong answers. -memberChar :: Char -> FastSet -> Bool -memberChar c = memberWord8 (I.c2w c) -{-# INLINE memberChar #-} - -mkTable :: B.ByteString -> B.ByteString -mkTable s = I.unsafeCreate 32 $ \t -> do - _ <- I.memset t 0 32 - U.unsafeUseAsCStringLen s $ \(p, l) -> - let loop n | n == l = return () - | otherwise = do - c <- peekByteOff p n :: IO Word8 - let I byte bit = index (fromIntegral c) - prev <- peekByteOff t byte :: IO Word8 - pokeByteOff t byte (prev .|. bit) - loop (n + 1) - in loop 0 - -charClass :: String -> FastSet -charClass = set . B8.pack . go - where go (a:'-':b:xs) = [a..b] ++ go xs - go (x:xs) = x : go xs - go _ = "" diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs deleted file mode 100644 index f6ec3b32..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs +++ /dev/null @@ -1,485 +0,0 @@ -{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings, RecordWildCards #-} --- | --- Module : Data.Attoparsec.ByteString.Internal --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient parser combinators for 'ByteString' strings, --- loosely based on the Parsec library. - -module Data.Attoparsec.ByteString.Internal - ( - -- * Parser types - Parser - , Result - - -- * Running parsers - , parse - , parseOnly - - -- * Combinators - , module Data.Attoparsec.Combinator - - -- * Parsing individual bytes - , satisfy - , satisfyWith - , anyWord8 - , skip - , word8 - , notWord8 - - -- ** Lookahead - , peekWord8 - , peekWord8' - - -- ** Byte classes - , inClass - , notInClass - - -- * Parsing more complicated structures - , storable - - -- * Efficient string handling - , skipWhile - , string - , stringTransform - , take - , scan - , runScanner - , takeWhile - , takeWhile1 - , takeTill - - -- ** Consume all remaining input - , takeByteString - , takeLazyByteString - - -- * Utilities - , endOfLine - , endOfInput - , match - , atEnd - ) where - -import Control.Applicative ((<|>), (<$>)) -import Control.Monad (when) -import Data.Attoparsec.ByteString.Buffer (Buffer, buffer) -import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8) -import Data.Attoparsec.Combinator (()) -import Data.Attoparsec.Internal -import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO) -import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success) -import Data.ByteString (ByteString) -import Data.Word (Word8) -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Ptr (castPtr, minusPtr, plusPtr) -import Foreign.Storable (Storable(peek, sizeOf)) -import Prelude hiding (getChar, succ, take, takeWhile) -import qualified Data.Attoparsec.ByteString.Buffer as Buf -import qualified Data.Attoparsec.Internal.Types as T -import qualified Data.ByteString as B8 -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Internal as B -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Unsafe as B - -type Parser = T.Parser ByteString -type Result = IResult ByteString -type Failure r = T.Failure ByteString Buffer r -type Success a r = T.Success ByteString Buffer a r - --- | The parser @satisfy p@ succeeds for any byte for which the --- predicate @p@ returns 'True'. Returns the byte that is actually --- parsed. --- --- >digit = satisfy isDigit --- > where isDigit w = w >= 48 && w <= 57 -satisfy :: (Word8 -> Bool) -> Parser Word8 -satisfy p = do - h <- peekWord8' - if p h - then advance 1 >> return h - else fail "satisfy" -{-# INLINE satisfy #-} - --- | The parser @skip p@ succeeds for any byte for which the predicate --- @p@ returns 'True'. --- --- >skipDigit = skip isDigit --- > where isDigit w = w >= 48 && w <= 57 -skip :: (Word8 -> Bool) -> Parser () -skip p = do - h <- peekWord8' - if p h - then advance 1 - else fail "skip" - --- | The parser @satisfyWith f p@ transforms a byte, and succeeds if --- the predicate @p@ returns 'True' on the transformed value. The --- parser returns the transformed byte that was parsed. -satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a -satisfyWith f p = do - h <- peekWord8' - let c = f h - if p c - then advance 1 >> return c - else fail "satisfyWith" -{-# INLINE satisfyWith #-} - -storable :: Storable a => Parser a -storable = hack undefined - where - hack :: Storable b => b -> Parser b - hack dummy = do - (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy) - return . B.inlinePerformIO . withForeignPtr fp $ \p -> - peek (castPtr $ p `plusPtr` o) - --- | Consume @n@ bytes of input, but succeed only if the predicate --- returns 'True'. -takeWith :: Int -> (ByteString -> Bool) -> Parser ByteString -takeWith n0 p = do - let n = max n0 0 - s <- ensure n - if p s - then advance n >> return s - else fail "takeWith" - --- | Consume exactly @n@ bytes of input. -take :: Int -> Parser ByteString -take n = takeWith n (const True) -{-# INLINE take #-} - --- | @string s@ parses a sequence of bytes that identically match --- @s@. Returns the parsed string (i.e. @s@). This parser consumes no --- input if it fails (even if a partial match). --- --- /Note/: The behaviour of this parser is different to that of the --- similarly-named parser in Parsec, as this one is all-or-nothing. --- To illustrate the difference, the following parser will fail under --- Parsec given an input of @\"for\"@: --- --- >string "foo" <|> string "for" --- --- The reason for its failure is that the first branch is a --- partial match, and will consume the letters @\'f\'@ and @\'o\'@ --- before failing. In attoparsec, the above parser will /succeed/ on --- that input, because the failed first branch will consume nothing. -string :: ByteString -> Parser ByteString -string s = takeWith (B.length s) (==s) -{-# INLINE string #-} - -stringTransform :: (ByteString -> ByteString) -> ByteString - -> Parser ByteString -stringTransform f s = takeWith (B.length s) ((==f s) . f) -{-# INLINE stringTransform #-} - --- | Skip past input for as long as the predicate returns 'True'. -skipWhile :: (Word8 -> Bool) -> Parser () -skipWhile p = go - where - go = do - t <- B8.takeWhile p <$> get - continue <- inputSpansChunks (B.length t) - when continue go -{-# INLINE skipWhile #-} - --- | Consume input as long as the predicate returns 'False' --- (i.e. until it returns 'True'), and return the consumed input. --- --- This parser does not fail. It will return an empty string if the --- predicate returns 'True' on the first byte of input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'Control.Applicative.many', because such --- parsers loop until a failure occurs. Careless use will thus result --- in an infinite loop. -takeTill :: (Word8 -> Bool) -> Parser ByteString -takeTill p = takeWhile (not . p) -{-# INLINE takeTill #-} - --- | Consume input as long as the predicate returns 'True', and return --- the consumed input. --- --- This parser does not fail. It will return an empty string if the --- predicate returns 'False' on the first byte of input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'Control.Applicative.many', because such --- parsers loop until a failure occurs. Careless use will thus result --- in an infinite loop. -takeWhile :: (Word8 -> Bool) -> Parser ByteString -takeWhile p = (B.concat . reverse) `fmap` go [] - where - go acc = do - s <- B8.takeWhile p <$> get - continue <- inputSpansChunks (B.length s) - if continue - then go (s:acc) - else return (s:acc) -{-# INLINE takeWhile #-} - -takeRest :: Parser [ByteString] -takeRest = go [] - where - go acc = do - input <- wantInput - if input - then do - s <- get - advance (B.length s) - go (s:acc) - else return (reverse acc) - --- | Consume all remaining input and return it as a single string. -takeByteString :: Parser ByteString -takeByteString = B.concat `fmap` takeRest - --- | Consume all remaining input and return it as a single string. -takeLazyByteString :: Parser L.ByteString -takeLazyByteString = L.fromChunks `fmap` takeRest - -data T s = T {-# UNPACK #-} !Int s - -scan_ :: (s -> [ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s) - -> Parser r -scan_ f s0 p = go [] s0 - where - go acc s1 = do - let scanner (B.PS fp off len) = - withForeignPtr fp $ \ptr0 -> do - let start = ptr0 `plusPtr` off - end = start `plusPtr` len - inner ptr !s - | ptr < end = do - w <- peek ptr - case p s w of - Just s' -> inner (ptr `plusPtr` 1) s' - _ -> done (ptr `minusPtr` start) s - | otherwise = done (ptr `minusPtr` start) s - done !i !s = return (T i s) - inner start s1 - bs <- get - let T i s' = inlinePerformIO $ scanner bs - !h = B.unsafeTake i bs - continue <- inputSpansChunks i - if continue - then go (h:acc) s' - else f s' (h:acc) -{-# INLINE scan_ #-} - --- | A stateful scanner. The predicate consumes and transforms a --- state argument, and each transformed state is passed to successive --- invocations of the predicate on each byte of the input until one --- returns 'Nothing' or the input ends. --- --- This parser does not fail. It will return an empty string if the --- predicate returns 'Nothing' on the first byte of input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'Control.Applicative.many', because such --- parsers loop until a failure occurs. Careless use will thus result --- in an infinite loop. -scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString -scan = scan_ $ \_ chunks -> - case chunks of - [x] -> return x - xs -> return $! B.concat $ reverse xs -{-# INLINE scan #-} - --- | Like 'scan', but generalized to return the final state of the --- scanner. -runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s) -runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s) -{-# INLINE runScanner #-} - --- | Consume input as long as the predicate returns 'True', and return --- the consumed input. --- --- This parser requires the predicate to succeed on at least one byte --- of input: it will fail if the predicate never returns 'True' or if --- there is no input left. -takeWhile1 :: (Word8 -> Bool) -> Parser ByteString -takeWhile1 p = do - (`when` demandInput) =<< endOfChunk - s <- B8.takeWhile p <$> get - let len = B.length s - if len == 0 - then fail "takeWhile1" - else do - advance len - eoc <- endOfChunk - if eoc - then (s<>) `fmap` takeWhile p - else return s - --- | Match any byte in a set. --- --- >vowel = inClass "aeiou" --- --- Range notation is supported. --- --- >halfAlphabet = inClass "a-nA-N" --- --- To add a literal @\'-\'@ to a set, place it at the beginning or end --- of the string. -inClass :: String -> Word8 -> Bool -inClass s = (`memberWord8` mySet) - where mySet = charClass s - {-# NOINLINE mySet #-} -{-# INLINE inClass #-} - --- | Match any byte not in a set. -notInClass :: String -> Word8 -> Bool -notInClass s = not . inClass s -{-# INLINE notInClass #-} - --- | Match any byte. -anyWord8 :: Parser Word8 -anyWord8 = satisfy $ const True -{-# INLINE anyWord8 #-} - --- | Match a specific byte. -word8 :: Word8 -> Parser Word8 -word8 c = satisfy (== c) show c -{-# INLINE word8 #-} - --- | Match any byte except the given one. -notWord8 :: Word8 -> Parser Word8 -notWord8 c = satisfy (/= c) "not " ++ show c -{-# INLINE notWord8 #-} - --- | Match any byte, to perform lookahead. Returns 'Nothing' if end of --- input has been reached. Does not consume any input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'Control.Applicative.many', because such --- parsers loop until a failure occurs. Careless use will thus result --- in an infinite loop. -peekWord8 :: Parser (Maybe Word8) -peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ -> - case () of - _| pos_ < Buf.length t -> - let !w = Buf.unsafeIndex t pos_ - in succ t pos more (Just w) - | more == Complete -> - succ t pos more Nothing - | otherwise -> - let succ' t' pos' more' = let !w = Buf.unsafeIndex t' pos_ - in succ t' pos' more' (Just w) - lose' t' pos' more' = succ t' pos' more' Nothing - in prompt t pos more lose' succ' -{-# INLINE peekWord8 #-} - --- | Match any byte, to perform lookahead. Does not consume any --- input, but will fail if end of input has been reached. -peekWord8' :: Parser Word8 -peekWord8' = T.Parser $ \t pos more lose succ -> - if lengthAtLeast pos 1 t - then succ t pos more (Buf.unsafeIndex t (fromPos pos)) - else let succ' t' pos' more' bs' = succ t' pos' more' $! B.unsafeHead bs' - in ensureSuspended 1 t pos more lose succ' -{-# INLINE peekWord8' #-} - --- | Match either a single newline character @\'\\n\'@, or a carriage --- return followed by a newline character @\"\\r\\n\"@. -endOfLine :: Parser () -endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ()) - --- | Terminal failure continuation. -failK :: Failure a -failK t (Pos pos) _more stack msg = Fail (Buf.unsafeDrop pos t) stack msg -{-# INLINE failK #-} - --- | Terminal success continuation. -successK :: Success a a -successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a -{-# INLINE successK #-} - --- | Run a parser. -parse :: Parser a -> ByteString -> Result a -parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK -{-# INLINE parse #-} - --- | Run a parser that cannot be resupplied via a 'Partial' result. --- --- This function does not force a parser to consume all of its input. --- Instead, any residual input will be discarded. To force a parser --- to consume all of its input, use something like this: --- --- @ ---'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput') --- @ -parseOnly :: Parser a -> ByteString -> Either String a -parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of - Fail _ _ err -> Left err - Done _ a -> Right a - _ -> error "parseOnly: impossible error!" -{-# INLINE parseOnly #-} - -get :: Parser ByteString -get = T.Parser $ \t pos more _lose succ -> - succ t pos more (Buf.unsafeDrop (fromPos pos) t) -{-# INLINE get #-} - -endOfChunk :: Parser Bool -endOfChunk = T.Parser $ \t pos more _lose succ -> - succ t pos more (fromPos pos == Buf.length t) -{-# INLINE endOfChunk #-} - -inputSpansChunks :: Int -> Parser Bool -inputSpansChunks i = T.Parser $ \t pos_ more _lose succ -> - let pos = pos_ + Pos i - in if fromPos pos < Buf.length t || more == Complete - then succ t pos more False - else let lose' t' pos' more' = succ t' pos' more' False - succ' t' pos' more' = succ t' pos' more' True - in prompt t pos more lose' succ' -{-# INLINE inputSpansChunks #-} - -advance :: Int -> Parser () -advance n = T.Parser $ \t pos more _lose succ -> - succ t (pos + Pos n) more () -{-# INLINE advance #-} - -ensureSuspended :: Int -> Buffer -> Pos -> More - -> Failure r - -> Success ByteString r - -> Result r -ensureSuspended n t pos more lose succ = - runParser (demandInput >> go) t pos more lose succ - where go = T.Parser $ \t' pos' more' lose' succ' -> - if lengthAtLeast pos' n t' - then succ' t' pos' more' (substring pos (Pos n) t') - else runParser (demandInput >> go) t' pos' more' lose' succ' - --- | If at least @n@ elements of input are available, return the --- current input, otherwise fail. -ensure :: Int -> Parser ByteString -ensure n = T.Parser $ \t pos more lose succ -> - if lengthAtLeast pos n t - then succ t pos more (substring pos (Pos n) t) - -- The uncommon case is kept out-of-line to reduce code size: - else ensureSuspended n t pos more lose succ --- Non-recursive so the bounds check can be inlined: -{-# INLINE ensure #-} - --- | Return both the result of a parse and the portion of the input --- that was consumed while it was being parsed. -match :: Parser a -> Parser (ByteString, a) -match p = T.Parser $ \t pos more lose succ -> - let succ' t' pos' more' a = - succ t' pos' more' (substring pos (pos'-pos) t', a) - in runParser p t pos more lose succ' - -lengthAtLeast :: Pos -> Int -> Buffer -> Bool -lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n -{-# INLINE lengthAtLeast #-} - -substring :: Pos -> Pos -> Buffer -> ByteString -substring (Pos pos) (Pos n) = Buf.substring pos n -{-# INLINE substring #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs deleted file mode 100644 index 65788ce9..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs +++ /dev/null @@ -1,220 +0,0 @@ -{-# LANGUAGE BangPatterns #-} --- | --- Module : Data.Attoparsec.Combinator --- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : portable --- --- Useful parser combinators, similar to those provided by Parsec. -module Data.Attoparsec.Combinator - ( - -- * Combinators - try - , () - , choice - , count - , option - , many' - , many1 - , many1' - , manyTill - , manyTill' - , sepBy - , sepBy' - , sepBy1 - , sepBy1' - , skipMany - , skipMany1 - , eitherP - , feed - , satisfyElem - , endOfInput - , atEnd - ) where - -import Control.Applicative (Alternative(..), Applicative(..), empty, liftA2, - many, (<|>), (*>), (<$>)) -import Control.Monad (MonadPlus(..)) -import Data.Attoparsec.Internal.Types (Parser(..), IResult(..)) -import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem) -import Data.ByteString (ByteString) -import Data.Monoid (Monoid(mappend)) -import Prelude hiding (succ) - --- | Attempt a parse, and if it fails, rewind the input so that no --- input appears to have been consumed. --- --- This combinator is provided for compatibility with Parsec. --- attoparsec parsers always backtrack on failure. -try :: Parser i a -> Parser i a -try p = p -{-# INLINE try #-} - --- | Name the parser, in case failure occurs. -() :: Parser i a - -> String -- ^ the name to use if parsing fails - -> Parser i a -p msg0 = Parser $ \t pos more lose succ -> - let lose' t' pos' more' strs msg = lose t' pos' more' (msg0:strs) msg - in runParser p t pos more lose' succ -{-# INLINE () #-} -infix 0 - --- | @choice ps@ tries to apply the actions in the list @ps@ in order, --- until one of them succeeds. Returns the value of the succeeding --- action. -choice :: Alternative f => [f a] -> f a -choice = foldr (<|>) empty -{-# SPECIALIZE choice :: [Parser ByteString a] - -> Parser ByteString a #-} - --- | @option x p@ tries to apply action @p@. If @p@ fails without --- consuming input, it returns the value @x@, otherwise the value --- returned by @p@. --- --- > priority = option 0 (digitToInt <$> digit) -option :: Alternative f => a -> f a -> f a -option x p = p <|> pure x -{-# SPECIALIZE option :: a -> Parser ByteString a -> Parser ByteString a #-} - --- | A version of 'liftM2' that is strict in the result of its first --- action. -liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c -liftM2' f a b = do - !x <- a - y <- b - return (f x y) -{-# INLINE liftM2' #-} - --- | @many' p@ applies the action @p@ /zero/ or more times. Returns a --- list of the returned values of @p@. The value returned by @p@ is --- forced to WHNF. --- --- > word = many' letter -many' :: (MonadPlus m) => m a -> m [a] -many' p = many_p - where many_p = some_p `mplus` return [] - some_p = liftM2' (:) p many_p -{-# INLINE many' #-} - --- | @many1 p@ applies the action @p@ /one/ or more times. Returns a --- list of the returned values of @p@. --- --- > word = many1 letter -many1 :: Alternative f => f a -> f [a] -many1 p = liftA2 (:) p (many p) -{-# INLINE many1 #-} - --- | @many1' p@ applies the action @p@ /one/ or more times. Returns a --- list of the returned values of @p@. The value returned by @p@ is --- forced to WHNF. --- --- > word = many1' letter -many1' :: (MonadPlus m) => m a -> m [a] -many1' p = liftM2' (:) p (many' p) -{-# INLINE many1' #-} - --- | @sepBy p sep@ applies /zero/ or more occurrences of @p@, separated --- by @sep@. Returns a list of the values returned by @p@. --- --- > commaSep p = p `sepBy` (symbol ",") -sepBy :: Alternative f => f a -> f s -> f [a] -sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure [] -{-# SPECIALIZE sepBy :: Parser ByteString a -> Parser ByteString s - -> Parser ByteString [a] #-} - --- | @sepBy' p sep@ applies /zero/ or more occurrences of @p@, separated --- by @sep@. Returns a list of the values returned by @p@. The value --- returned by @p@ is forced to WHNF. --- --- > commaSep p = p `sepBy'` (symbol ",") -sepBy' :: (MonadPlus m) => m a -> m s -> m [a] -sepBy' p s = scan `mplus` return [] - where scan = liftM2' (:) p ((s >> sepBy1' p s) `mplus` return []) -{-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s - -> Parser ByteString [a] #-} - --- | @sepBy1 p sep@ applies /one/ or more occurrences of @p@, separated --- by @sep@. Returns a list of the values returned by @p@. --- --- > commaSep p = p `sepBy1` (symbol ",") -sepBy1 :: Alternative f => f a -> f s -> f [a] -sepBy1 p s = scan - where scan = liftA2 (:) p ((s *> scan) <|> pure []) -{-# SPECIALIZE sepBy1 :: Parser ByteString a -> Parser ByteString s - -> Parser ByteString [a] #-} - --- | @sepBy1' p sep@ applies /one/ or more occurrences of @p@, separated --- by @sep@. Returns a list of the values returned by @p@. The value --- returned by @p@ is forced to WHNF. --- --- > commaSep p = p `sepBy1'` (symbol ",") -sepBy1' :: (MonadPlus m) => m a -> m s -> m [a] -sepBy1' p s = scan - where scan = liftM2' (:) p ((s >> scan) `mplus` return []) -{-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s - -> Parser ByteString [a] #-} - --- | @manyTill p end@ applies action @p@ /zero/ or more times until --- action @end@ succeeds, and returns the list of values returned by --- @p@. This can be used to scan comments: --- --- > simpleComment = string "") --- --- (Note the overlapping parsers @anyChar@ and @string \"-->\"@. --- While this will work, it is not very efficient, as it will cause a --- lot of backtracking.) -manyTill :: Alternative f => f a -> f b -> f [a] -manyTill p end = scan - where scan = (end *> pure []) <|> liftA2 (:) p scan -{-# SPECIALIZE manyTill :: Parser ByteString a -> Parser ByteString b - -> Parser ByteString [a] #-} - --- | @manyTill' p end@ applies action @p@ /zero/ or more times until --- action @end@ succeeds, and returns the list of values returned by --- @p@. This can be used to scan comments: --- --- > simpleComment = string "") --- --- (Note the overlapping parsers @anyChar@ and @string \"-->\"@. --- While this will work, it is not very efficient, as it will cause a --- lot of backtracking.) --- --- The value returned by @p@ is forced to WHNF. -manyTill' :: (MonadPlus m) => m a -> m b -> m [a] -manyTill' p end = scan - where scan = (end >> return []) `mplus` liftM2' (:) p scan -{-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b - -> Parser ByteString [a] #-} - --- | Skip zero or more instances of an action. -skipMany :: Alternative f => f a -> f () -skipMany p = scan - where scan = (p *> scan) <|> pure () -{-# SPECIALIZE skipMany :: Parser ByteString a -> Parser ByteString () #-} - --- | Skip one or more instances of an action. -skipMany1 :: Alternative f => f a -> f () -skipMany1 p = p *> skipMany p -{-# SPECIALIZE skipMany1 :: Parser ByteString a -> Parser ByteString () #-} - --- | Apply the given action repeatedly, returning every result. -count :: Monad m => Int -> m a -> m [a] -count n p = sequence (replicate n p) -{-# INLINE count #-} - --- | Combine two alternatives. -eitherP :: (Alternative f) => f a -> f b -> f (Either a b) -eitherP a b = (Left <$> a) <|> (Right <$> b) -{-# INLINE eitherP #-} - --- | If a parser has returned a 'T.Partial' result, supply it with more --- input. -feed :: Monoid i => IResult i r -> i -> IResult i r -feed f@(Fail _ _ _) _ = f -feed (Partial k) d = k d -feed (Done t r) d = Done (mappend t d) r -{-# INLINE feed #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs deleted file mode 100644 index 371770a9..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs +++ /dev/null @@ -1,142 +0,0 @@ -{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-} --- | --- Module : Data.Attoparsec.Internal --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient parser combinators, loosely based on the Parsec --- library. - -module Data.Attoparsec.Internal - ( compareResults - , prompt - , demandInput - , wantInput - , endOfInput - , atEnd - , satisfyElem - ) where - -import Control.Applicative ((<$>)) -#if __GLASGOW_HASKELL__ >= 700 -import Data.ByteString (ByteString) -#endif -import Data.Attoparsec.Internal.Types -import Prelude hiding (succ) - --- | Compare two 'IResult' values for equality. --- --- If both 'IResult's are 'Partial', the result will be 'Nothing', as --- they are incomplete and hence their equality cannot be known. --- (This is why there is no 'Eq' instance for 'IResult'.) -compareResults :: (Eq i, Eq r) => IResult i r -> IResult i r -> Maybe Bool -compareResults (Fail t0 ctxs0 msg0) (Fail t1 ctxs1 msg1) = - Just (t0 == t1 && ctxs0 == ctxs1 && msg0 == msg1) -compareResults (Done t0 r0) (Done t1 r1) = - Just (t0 == t1 && r0 == r1) -compareResults (Partial _) (Partial _) = Nothing -compareResults _ _ = Just False - --- | Ask for input. If we receive any, pass it to a success --- continuation, otherwise to a failure continuation. -prompt :: Chunk t - => State t -> Pos -> More - -> (State t -> Pos -> More -> IResult t r) - -> (State t -> Pos -> More -> IResult t r) - -> IResult t r -prompt t pos _more lose succ = Partial $ \s -> - if nullChunk s - then lose t pos Complete - else succ (pappendChunk t s) pos Incomplete -#if __GLASGOW_HASKELL__ >= 700 -{-# SPECIALIZE prompt :: State ByteString -> Pos -> More - -> (State ByteString -> Pos -> More - -> IResult ByteString r) - -> (State ByteString -> Pos -> More - -> IResult ByteString r) - -> IResult ByteString r #-} -#endif - --- | Immediately demand more input via a 'Partial' continuation --- result. -demandInput :: Chunk t => Parser t () -demandInput = Parser $ \t pos more lose succ -> - case more of - Complete -> lose t pos more [] "not enough input" - _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input" - succ' t' pos' more' = succ t' pos' more' () - in prompt t pos more lose' succ' -#if __GLASGOW_HASKELL__ >= 700 -{-# SPECIALIZE demandInput :: Parser ByteString () #-} -#endif - --- | This parser always succeeds. It returns 'True' if any input is --- available either immediately or on demand, and 'False' if the end --- of all input has been reached. -wantInput :: forall t . Chunk t => Parser t Bool -wantInput = Parser $ \t pos more _lose succ -> - case () of - _ | pos < atBufferEnd (undefined :: t) t -> succ t pos more True - | more == Complete -> succ t pos more False - | otherwise -> let lose' t' pos' more' = succ t' pos' more' False - succ' t' pos' more' = succ t' pos' more' True - in prompt t pos more lose' succ' -{-# INLINE wantInput #-} - --- | Match only if all input has been consumed. -endOfInput :: forall t . Chunk t => Parser t () -endOfInput = Parser $ \t pos more lose succ -> - case () of - _| pos < atBufferEnd (undefined :: t) t -> lose t pos more [] "endOfInput" - | more == Complete -> succ t pos more () - | otherwise -> - let lose' t' pos' more' _ctx _msg = succ t' pos' more' () - succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput" - in runParser demandInput t pos more lose' succ' -#if __GLASGOW_HASKELL__ >= 700 -{-# SPECIALIZE endOfInput :: Parser ByteString () #-} -#endif - --- | Return an indication of whether the end of input has been --- reached. -atEnd :: Chunk t => Parser t Bool -atEnd = not <$> wantInput -{-# INLINE atEnd #-} - -satisfySuspended :: forall t r . Chunk t - => (ChunkElem t -> Bool) - -> State t -> Pos -> More - -> Failure t (State t) r - -> Success t (State t) (ChunkElem t) r - -> IResult t r -satisfySuspended p t pos more lose succ = - runParser (demandInput >> go) t pos more lose succ - where go = Parser $ \t' pos' more' lose' succ' -> - case bufferElemAt (undefined :: t) pos' t' of - Just (e, l) | p e -> succ' t' (pos' + Pos l) more' e - | otherwise -> lose' t' pos' more' [] "satisfyElem" - Nothing -> runParser (demandInput >> go) t' pos' more' lose' succ' -#if __GLASGOW_HASKELL__ >= 700 -{-# SPECIALIZE satisfySuspended :: (ChunkElem ByteString -> Bool) - -> State ByteString -> Pos -> More - -> Failure ByteString (State ByteString) r - -> Success ByteString (State ByteString) - (ChunkElem ByteString) r - -> IResult ByteString r #-} -#endif - --- | The parser @satisfyElem p@ succeeds for any chunk element for which the --- predicate @p@ returns 'True'. Returns the element that is --- actually parsed. -satisfyElem :: forall t . Chunk t - => (ChunkElem t -> Bool) -> Parser t (ChunkElem t) -satisfyElem p = Parser $ \t pos more lose succ -> - case bufferElemAt (undefined :: t) pos t of - Just (e, l) | p e -> succ t (pos + Pos l) more e - | otherwise -> lose t pos more [] "satisfyElem" - Nothing -> satisfySuspended p t pos more lose succ -{-# INLINE satisfyElem #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs deleted file mode 100644 index 0e00ed2c..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, - RecordWildCards, MagicHash, UnboxedTuples #-} - -module Data.Attoparsec.Internal.Fhthagn - ( - inlinePerformIO - ) where - -import GHC.Base (realWorld#) -import GHC.IO (IO(IO)) - --- | Just like unsafePerformIO, but we inline it. Big performance gains as --- it exposes lots of things to further inlining. /Very unsafe/. In --- particular, you should do no memory allocation inside an --- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@. -inlinePerformIO :: IO a -> a -inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r -{-# INLINE inlinePerformIO #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs deleted file mode 100644 index 9c7994e9..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs +++ /dev/null @@ -1,230 +0,0 @@ -{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings, - Rank2Types, RecordWildCards, TypeFamilies #-} --- | --- Module : Data.Attoparsec.Internal.Types --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient parser combinators, loosely based on the Parsec --- library. - -module Data.Attoparsec.Internal.Types - ( - Parser(..) - , State - , Failure - , Success - , Pos(..) - , IResult(..) - , More(..) - , (<>) - , Chunk(..) - ) where - -import Control.Applicative (Alternative(..), Applicative(..), (<$>)) -import Control.DeepSeq (NFData(rnf)) -import Control.Monad (MonadPlus(..)) -import Data.Word (Word8) -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.ByteString.Internal (w2c) -import Data.Monoid (Monoid(..)) -import Prelude hiding (getChar, succ) -import qualified Data.Attoparsec.ByteString.Buffer as B - -newtype Pos = Pos { fromPos :: Int } - deriving (Eq, Ord, Show, Num) - --- | The result of a parse. This is parameterised over the type @i@ --- of string that was processed. --- --- This type is an instance of 'Functor', where 'fmap' transforms the --- value in a 'Done' result. -data IResult i r = - Fail i [String] String - -- ^ The parse failed. The @i@ parameter is the input that had - -- not yet been consumed when the failure occurred. The - -- @[@'String'@]@ is a list of contexts in which the error - -- occurred. The 'String' is the message describing the error, if - -- any. - | Partial (i -> IResult i r) - -- ^ Supply this continuation with more input so that the parser - -- can resume. To indicate that no more input is available, pass - -- an empty string to the continuation. - -- - -- __Note__: if you get a 'Partial' result, do not call its - -- continuation more than once. - | Done i r - -- ^ The parse succeeded. The @i@ parameter is the input that had - -- not yet been consumed (if any) when the parse succeeded. - -instance (Show i, Show r) => Show (IResult i r) where - show (Fail t stk msg) = - unwords [ "Fail", show t, show stk, show msg] - show (Partial _) = "Partial _" - show (Done t r) = unwords ["Done", show t, show r] - -instance (NFData i, NFData r) => NFData (IResult i r) where - rnf (Fail t stk msg) = rnf t `seq` rnf stk `seq` rnf msg - rnf (Partial _) = () - rnf (Done t r) = rnf t `seq` rnf r - {-# INLINE rnf #-} - -instance Functor (IResult i) where - fmap _ (Fail t stk msg) = Fail t stk msg - fmap f (Partial k) = Partial (fmap f . k) - fmap f (Done t r) = Done t (f r) - --- | The core parser type. This is parameterised over the types @i@ --- of string being processed and @t@ of internal state representation. --- --- This type is an instance of the following classes: --- --- * 'Monad', where 'fail' throws an exception (i.e. fails) with an --- error message. --- --- * 'Functor' and 'Applicative', which follow the usual definitions. --- --- * 'MonadPlus', where 'mzero' fails (with no error message) and --- 'mplus' executes the right-hand parser if the left-hand one --- fails. When the parser on the right executes, the input is reset --- to the same state as the parser on the left started with. (In --- other words, attoparsec is a backtracking parser that supports --- arbitrary lookahead.) --- --- * 'Alternative', which follows 'MonadPlus'. -newtype Parser i a = Parser { - runParser :: forall r. - State i -> Pos -> More - -> Failure i (State i) r - -> Success i (State i) a r - -> IResult i r - } - -type family State i -type instance State ByteString = B.Buffer - -type Failure i t r = t -> Pos -> More -> [String] -> String - -> IResult i r -type Success i t a r = t -> Pos -> More -> a -> IResult i r - --- | Have we read all available input? -data More = Complete | Incomplete - deriving (Eq, Show) - -instance Monoid More where - mappend c@Complete _ = c - mappend _ m = m - mempty = Incomplete - -instance Monad (Parser i) where - fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg - where msg = "Failed reading: " ++ err - {-# INLINE fail #-} - - return = pure - {-# INLINE return #-} - - m >>= k = Parser $ \t !pos more lose succ -> - let succ' t' !pos' more' a = runParser (k a) t' pos' more' lose succ - in runParser m t pos more lose succ' - {-# INLINE (>>=) #-} - -plus :: Parser i a -> Parser i a -> Parser i a -plus f g = Parser $ \t pos more lose succ -> - let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ - in runParser f t pos more lose' succ - -instance MonadPlus (Parser i) where - mzero = fail "mzero" - {-# INLINE mzero #-} - mplus = plus - -instance Functor (Parser i) where - fmap f p = Parser $ \t pos more lose succ -> - let succ' t' pos' more' a = succ t' pos' more' (f a) - in runParser p t pos more lose succ' - {-# INLINE fmap #-} - -apP :: Parser i (a -> b) -> Parser i a -> Parser i b -apP d e = do - b <- d - a <- e - return (b a) -{-# INLINE apP #-} - -instance Applicative (Parser i) where - pure v = Parser $ \t pos more _lose succ -> succ t pos more v - {-# INLINE pure #-} - (<*>) = apP - {-# INLINE (<*>) #-} - - -- These definitions are equal to the defaults, but this - -- way the optimizer doesn't have to work so hard to figure - -- that out. - m *> k = m >>= \_ -> k - {-# INLINE (*>) #-} - x <* y = x >>= \a -> y >> return a - {-# INLINE (<*) #-} - -instance Monoid (Parser i a) where - mempty = fail "mempty" - {-# INLINE mempty #-} - mappend = plus - {-# INLINE mappend #-} - -instance Alternative (Parser i) where - empty = fail "empty" - {-# INLINE empty #-} - - (<|>) = plus - {-# INLINE (<|>) #-} - - many v = many_v - where many_v = some_v <|> pure [] - some_v = (:) <$> v <*> many_v - {-# INLINE many #-} - - some v = some_v - where - many_v = some_v <|> pure [] - some_v = (:) <$> v <*> many_v - {-# INLINE some #-} - -(<>) :: (Monoid m) => m -> m -> m -(<>) = mappend -{-# INLINE (<>) #-} - --- | A common interface for input chunks. -class Monoid c => Chunk c where - type ChunkElem c - -- | Test if the chunk is empty. - nullChunk :: c -> Bool - -- | Append chunk to a buffer. - pappendChunk :: State c -> c -> State c - -- | Position at the end of a buffer. The first argument is ignored. - atBufferEnd :: c -> State c -> Pos - -- | Return the buffer element at the given position along with its length. - bufferElemAt :: c -> Pos -> State c -> Maybe (ChunkElem c, Int) - -- | Map an element to the corresponding character. - -- The first argument is ignored. - chunkElemToChar :: c -> ChunkElem c -> Char - -instance Chunk ByteString where - type ChunkElem ByteString = Word8 - nullChunk = BS.null - {-# INLINE nullChunk #-} - pappendChunk = B.pappend - {-# INLINE pappendChunk #-} - atBufferEnd _ = Pos . B.length - {-# INLINE atBufferEnd #-} - bufferElemAt _ (Pos i) buf - | i < B.length buf = Just (B.unsafeIndex buf i, 1) - | otherwise = Nothing - {-# INLINE bufferElemAt #-} - chunkElemToChar _ = w2c - {-# INLINE chunkElemToChar #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs deleted file mode 100644 index 7438a912..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs +++ /dev/null @@ -1,137 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} --- | --- Module : Data.Attoparsec.Number --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- This module is deprecated, and both the module and 'Number' type --- will be removed in the next major release. Use the --- package --- and the 'Data.Scientific.Scientific' type instead. --- --- A simple number type, useful for parsing both exact and inexact --- quantities without losing much precision. -module Data.Attoparsec.Number - {-# DEPRECATED "This module will be removed in the next major release." #-} - ( - Number(..) - ) where - -import Control.DeepSeq (NFData(rnf)) -import Data.Data (Data) -import Data.Function (on) -import Data.Typeable (Typeable) - --- | A numeric type that can represent integers accurately, and --- floating point numbers to the precision of a 'Double'. --- --- /Note/: this type is deprecated, and will be removed in the next --- major release. Use the 'Data.Scientific.Scientific' type instead. -data Number = I !Integer - | D {-# UNPACK #-} !Double - deriving (Typeable, Data) -{-# DEPRECATED Number "Use Scientific instead." #-} - -instance Show Number where - show (I a) = show a - show (D a) = show a - -instance NFData Number where - rnf (I _) = () - rnf (D _) = () - {-# INLINE rnf #-} - -binop :: (Integer -> Integer -> a) -> (Double -> Double -> a) - -> Number -> Number -> a -binop _ d (D a) (D b) = d a b -binop i _ (I a) (I b) = i a b -binop _ d (D a) (I b) = d a (fromIntegral b) -binop _ d (I a) (D b) = d (fromIntegral a) b -{-# INLINE binop #-} - -instance Eq Number where - (==) = binop (==) (==) - {-# INLINE (==) #-} - - (/=) = binop (/=) (/=) - {-# INLINE (/=) #-} - -instance Ord Number where - (<) = binop (<) (<) - {-# INLINE (<) #-} - - (<=) = binop (<=) (<=) - {-# INLINE (<=) #-} - - (>) = binop (>) (>) - {-# INLINE (>) #-} - - (>=) = binop (>=) (>=) - {-# INLINE (>=) #-} - - compare = binop compare compare - {-# INLINE compare #-} - -instance Num Number where - (+) = binop (((I$!).) . (+)) (((D$!).) . (+)) - {-# INLINE (+) #-} - - (-) = binop (((I$!).) . (-)) (((D$!).) . (-)) - {-# INLINE (-) #-} - - (*) = binop (((I$!).) . (*)) (((D$!).) . (*)) - {-# INLINE (*) #-} - - abs (I a) = I $! abs a - abs (D a) = D $! abs a - {-# INLINE abs #-} - - negate (I a) = I $! negate a - negate (D a) = D $! negate a - {-# INLINE negate #-} - - signum (I a) = I $! signum a - signum (D a) = D $! signum a - {-# INLINE signum #-} - - fromInteger = (I$!) . fromInteger - {-# INLINE fromInteger #-} - -instance Real Number where - toRational (I a) = fromIntegral a - toRational (D a) = toRational a - {-# INLINE toRational #-} - -instance Fractional Number where - fromRational = (D$!) . fromRational - {-# INLINE fromRational #-} - - (/) = binop (((D$!).) . (/) `on` fromIntegral) - (((D$!).) . (/)) - {-# INLINE (/) #-} - - recip (I a) = D $! recip (fromIntegral a) - recip (D a) = D $! recip a - {-# INLINE recip #-} - -instance RealFrac Number where - properFraction (I a) = (fromIntegral a,0) - properFraction (D a) = case properFraction a of - (i,d) -> (i,D d) - {-# INLINE properFraction #-} - truncate (I a) = fromIntegral a - truncate (D a) = truncate a - {-# INLINE truncate #-} - round (I a) = fromIntegral a - round (D a) = round a - {-# INLINE round #-} - ceiling (I a) = fromIntegral a - ceiling (D a) = ceiling a - {-# INLINE ceiling #-} - floor (I a) = fromIntegral a - floor (D a) = floor a - {-# INLINE floor #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/LICENSE b/haddock-library/vendor/attoparsec-0.12.1.1/LICENSE deleted file mode 100644 index 97392a62..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -Copyright (c) Lennart Kolmodin - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: - -1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - -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. - -3. Neither the name of the author nor the names of his contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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. diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs new file mode 100644 index 00000000..bd3c5592 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs @@ -0,0 +1,23 @@ +-- | +-- Module : Data.Attoparsec +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient combinator parsing for +-- 'Data.ByteString.ByteString' strings, loosely based on the Parsec +-- library. +-- +-- This module is deprecated. Use "Data.Attoparsec.ByteString" +-- instead. + +module Data.Attoparsec + {-# DEPRECATED "This module will be removed in the next major release." #-} + ( + module Data.Attoparsec.ByteString + ) where + +import Data.Attoparsec.ByteString diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs new file mode 100644 index 00000000..84e567d9 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif +-- | +-- Module : Data.Attoparsec.ByteString +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient combinator parsing for 'B.ByteString' strings, +-- loosely based on the Parsec library. + +module Data.Attoparsec.ByteString + ( + -- * Differences from Parsec + -- $parsec + + -- * Incremental input + -- $incremental + + -- * Performance considerations + -- $performance + + -- * Parser types + I.Parser + , Result + , T.IResult(..) + , I.compareResults + + -- * Running parsers + , parse + , feed + , I.parseOnly + , parseWith + , parseTest + + -- ** Result conversion + , maybeResult + , eitherResult + + -- * Parsing individual bytes + , I.word8 + , I.anyWord8 + , I.notWord8 + , I.satisfy + , I.satisfyWith + , I.skip + + -- ** Lookahead + , I.peekWord8 + , I.peekWord8' + + -- ** Byte classes + , I.inClass + , I.notInClass + + -- * Efficient string handling + , I.string + , I.skipWhile + , I.take + , I.scan + , I.runScanner + , I.takeWhile + , I.takeWhile1 + , I.takeTill + + -- ** Consume all remaining input + , I.takeByteString + , I.takeLazyByteString + + -- * Combinators + , try + , () + , choice + , count + , option + , many' + , many1 + , many1' + , manyTill + , manyTill' + , sepBy + , sepBy' + , sepBy1 + , sepBy1' + , skipMany + , skipMany1 + , eitherP + , I.match + -- * State observation and manipulation functions + , I.endOfInput + , I.atEnd + ) where + +import Data.Attoparsec.Combinator +import Data.List (intercalate) +import qualified Data.Attoparsec.ByteString.Internal as I +import qualified Data.Attoparsec.Internal as I +import qualified Data.ByteString as B +import Data.Attoparsec.ByteString.Internal (Result, parse) +import qualified Data.Attoparsec.Internal.Types as T + +-- $parsec +-- +-- Compared to Parsec 3, attoparsec makes several tradeoffs. It is +-- not intended for, or ideal for, all possible uses. +-- +-- * While attoparsec can consume input incrementally, Parsec cannot. +-- Incremental input is a huge deal for efficient and secure network +-- and system programming, since it gives much more control to users +-- of the library over matters such as resource usage and the I/O +-- model to use. +-- +-- * Much of the performance advantage of attoparsec is gained via +-- high-performance parsers such as 'I.takeWhile' and 'I.string'. +-- If you use complicated combinators that return lists of bytes or +-- characters, there is less performance difference between the two +-- libraries. +-- +-- * Unlike Parsec 3, attoparsec does not support being used as a +-- monad transformer. +-- +-- * attoparsec is specialised to deal only with strict 'B.ByteString' +-- input. Efficiency concerns rule out both lists and lazy +-- bytestrings. The usual use for lazy bytestrings would be to +-- allow consumption of very large input without a large footprint. +-- For this need, attoparsec's incremental input provides an +-- excellent substitute, with much more control over when input +-- takes place. If you must use lazy bytestrings, see the +-- "Data.Attoparsec.ByteString.Lazy" module, which feeds lazy chunks +-- to a regular parser. +-- +-- * Parsec parsers can produce more helpful error messages than +-- attoparsec parsers. This is a matter of focus: attoparsec avoids +-- the extra book-keeping in favour of higher performance. + +-- $incremental +-- +-- attoparsec supports incremental input, meaning that you can feed it +-- a bytestring that represents only part of the expected total amount +-- of data to parse. If your parser reaches the end of a fragment of +-- input and could consume more input, it will suspend parsing and +-- return a 'T.Partial' continuation. +-- +-- Supplying the 'T.Partial' continuation with a bytestring will +-- resume parsing at the point where it was suspended, with the +-- bytestring you supplied used as new input at the end of the +-- existing input. You must be prepared for the result of the resumed +-- parse to be another 'T.Partial' continuation. +-- +-- To indicate that you have no more input, supply the 'T.Partial' +-- continuation with an empty bytestring. +-- +-- Remember that some parsing combinators will not return a result +-- until they reach the end of input. They may thus cause 'T.Partial' +-- results to be returned. +-- +-- If you do not need support for incremental input, consider using +-- the 'I.parseOnly' function to run your parser. It will never +-- prompt for more input. +-- +-- /Note/: incremental input does /not/ imply that attoparsec will +-- release portions of its internal state for garbage collection as it +-- proceeds. Its internal representation is equivalent to a single +-- 'ByteString': if you feed incremental input to a parser, it will +-- require memory proportional to the amount of input you supply. +-- (This is necessary to support arbitrary backtracking.) + +-- $performance +-- +-- If you write an attoparsec-based parser carefully, it can be +-- realistic to expect it to perform similarly to a hand-rolled C +-- parser (measuring megabytes parsed per second). +-- +-- To actually achieve high performance, there are a few guidelines +-- that it is useful to follow. +-- +-- Use the 'B.ByteString'-oriented parsers whenever possible, +-- e.g. 'I.takeWhile1' instead of 'many1' 'I.anyWord8'. There is +-- about a factor of 100 difference in performance between the two +-- kinds of parser. +-- +-- For very simple byte-testing predicates, write them by hand instead +-- of using 'I.inClass' or 'I.notInClass'. For instance, both of +-- these predicates test for an end-of-line byte, but the first is +-- much faster than the second: +-- +-- >endOfLine_fast w = w == 13 || w == 10 +-- >endOfLine_slow = inClass "\r\n" +-- +-- Make active use of benchmarking and profiling tools to measure, +-- find the problems with, and improve the performance of your parser. + +-- | Run a parser and print its result to standard output. +parseTest :: (Show a) => I.Parser a -> B.ByteString -> IO () +parseTest p s = print (parse p s) + +-- | Run a parser with an initial input string, and a monadic action +-- that can supply more input if needed. +parseWith :: Monad m => + (m B.ByteString) + -- ^ An action that will be executed to provide the parser + -- with more input, if necessary. The action must return an + -- 'B.empty' string when there is no more input available. + -> I.Parser a + -> B.ByteString + -- ^ Initial input for the parser. + -> m (Result a) +parseWith refill p s = step $ parse p s + where step (T.Partial k) = (step . k) =<< refill + step r = return r +{-# INLINE parseWith #-} + +-- | Convert a 'Result' value to a 'Maybe' value. A 'T.Partial' result +-- is treated as failure. +maybeResult :: Result r -> Maybe r +maybeResult (T.Done _ r) = Just r +maybeResult _ = Nothing + +-- | Convert a 'Result' value to an 'Either' value. A 'T.Partial' +-- result is treated as failure. +eitherResult :: Result r -> Either String r +eitherResult (T.Done _ r) = Right r +eitherResult (T.Fail _ [] msg) = Left msg +eitherResult (T.Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg) +eitherResult _ = Left "Result: incomplete input" diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs new file mode 100644 index 00000000..ac94dfcc --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs @@ -0,0 +1,156 @@ +{-# LANGUAGE BangPatterns #-} +-- | +-- Module : Data.Attoparsec.ByteString.Buffer +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : GHC +-- +-- An "immutable" buffer that supports cheap appends. +-- +-- A Buffer is divided into an immutable read-only zone, followed by a +-- mutable area that we've preallocated, but not yet written to. +-- +-- We overallocate at the end of a Buffer so that we can cheaply +-- append. Since a user of an existing Buffer cannot see past the end +-- of its immutable zone into the data that will change during an +-- append, this is safe. +-- +-- Once we run out of space at the end of a Buffer, we do the usual +-- doubling of the buffer size. +-- +-- The fact of having a mutable buffer really helps with performance, +-- but it does have a consequence: if someone misuses the Partial API +-- that attoparsec uses by calling the same continuation repeatedly +-- (which never makes sense in practice), they could overwrite data. +-- +-- Since the API *looks* pure, it should *act* pure, too, so we use +-- two generation counters (one mutable, one immutable) to track the +-- number of appends to a mutable buffer. If the counters ever get out +-- of sync, someone is appending twice to a mutable buffer, so we +-- duplicate the entire buffer in order to preserve the immutability +-- of its older self. +-- +-- While we could go a step further and gain protection against API +-- abuse on a multicore system, by use of an atomic increment +-- instruction to bump the mutable generation counter, that would be +-- very expensive, and feels like it would also be in the realm of the +-- ridiculous. Clients should never call a continuation more than +-- once; we lack a linear type system that could enforce this; and +-- there's only so far we should go to accommodate broken uses. + +module Data.Attoparsec.ByteString.Buffer + ( + Buffer + , buffer + , unbuffer + , pappend + , length + , unsafeIndex + , substring + , unsafeDrop + ) where + +import Control.Exception (assert) +import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr) +import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO) +import Data.List (foldl1') +import Data.Monoid as Mon (Monoid(..)) +import Data.Semigroup (Semigroup(..)) +import Data.Word (Word8) +import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) +import Foreign.Ptr (castPtr, plusPtr) +import Foreign.Storable (peek, peekByteOff, poke, sizeOf) +import GHC.ForeignPtr (mallocPlainForeignPtrBytes) +import Prelude hiding (length) + +-- If _cap is zero, this buffer is empty. +data Buffer = Buf { + _fp :: {-# UNPACK #-} !(ForeignPtr Word8) + , _off :: {-# UNPACK #-} !Int + , _len :: {-# UNPACK #-} !Int + , _cap :: {-# UNPACK #-} !Int + , _gen :: {-# UNPACK #-} !Int + } + +instance Show Buffer where + showsPrec p = showsPrec p . unbuffer + +-- | The initial 'Buffer' has no mutable zone, so we can avoid all +-- copies in the (hopefully) common case of no further input being fed +-- to us. +buffer :: ByteString -> Buffer +buffer (PS fp off len) = Buf fp off len len 0 + +unbuffer :: Buffer -> ByteString +unbuffer (Buf fp off len _ _) = PS fp off len + +instance Semigroup Buffer where + (Buf _ _ _ 0 _) <> b = b + a <> (Buf _ _ _ 0 _) = a + buf <> (Buf fp off len _ _) = append buf fp off len + +instance Monoid Buffer where + mempty = Buf nullForeignPtr 0 0 0 0 + + mappend = (<>) + + mconcat [] = Mon.mempty + mconcat xs = foldl1' mappend xs + +pappend :: Buffer -> ByteString -> Buffer +pappend (Buf _ _ _ 0 _) bs = buffer bs +pappend buf (PS fp off len) = append buf fp off len + +append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer +append (Buf fp0 off0 len0 cap0 gen0) !fp1 !off1 !len1 = + inlinePerformIO . withForeignPtr fp0 $ \ptr0 -> + withForeignPtr fp1 $ \ptr1 -> do + let genSize = sizeOf (0::Int) + newlen = len0 + len1 + gen <- if gen0 == 0 + then return 0 + else peek (castPtr ptr0) + if gen == gen0 && newlen <= cap0 + then do + let newgen = gen + 1 + poke (castPtr ptr0) newgen + memcpy (ptr0 `plusPtr` (off0+len0)) + (ptr1 `plusPtr` off1) + (fromIntegral len1) + return (Buf fp0 off0 newlen cap0 newgen) + else do + let newcap = newlen * 2 + fp <- mallocPlainForeignPtrBytes (newcap + genSize) + withForeignPtr fp $ \ptr_ -> do + let ptr = ptr_ `plusPtr` genSize + newgen = 1 + poke (castPtr ptr_) newgen + memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0) + memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1) + (fromIntegral len1) + return (Buf fp genSize newlen newcap newgen) + +length :: Buffer -> Int +length (Buf _ _ len _ _) = len +{-# INLINE length #-} + +unsafeIndex :: Buffer -> Int -> Word8 +unsafeIndex (Buf fp off len _ _) i = assert (i >= 0 && i < len) . + inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i) +{-# INLINE unsafeIndex #-} + +substring :: Int -> Int -> Buffer -> ByteString +substring s l (Buf fp off len _ _) = + assert (s >= 0 && s <= len) . + assert (l >= 0 && l <= len-s) $ + PS fp (off+s) l +{-# INLINE substring #-} + +unsafeDrop :: Int -> Buffer -> ByteString +unsafeDrop s (Buf fp off len _ _) = + assert (s >= 0 && s <= len) $ + PS fp (off+s) (len-s) +{-# INLINE unsafeDrop #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs new file mode 100644 index 00000000..7fafba40 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs @@ -0,0 +1,464 @@ +{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, TypeFamilies, + TypeSynonymInstances, GADTs #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} -- Imports internal modules +#endif +{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} + +-- | +-- Module : Data.Attoparsec.ByteString.Char8 +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient, character-oriented combinator parsing for +-- 'B.ByteString' strings, loosely based on the Parsec library. + +module Data.Attoparsec.ByteString.Char8 + ( + -- * Character encodings + -- $encodings + + -- * Parser types + Parser + , A.Result + , A.IResult(..) + , I.compareResults + + -- * Running parsers + , A.parse + , A.feed + , A.parseOnly + , A.parseWith + , A.parseTest + + -- ** Result conversion + , A.maybeResult + , A.eitherResult + + -- * Parsing individual characters + , char + , char8 + , anyChar + , notChar + , satisfy + + -- ** Lookahead + , peekChar + , peekChar' + + -- ** Special character parsers + , digit + , letter_iso8859_15 + , letter_ascii + , space + + -- ** Fast predicates + , isDigit + , isDigit_w8 + , isAlpha_iso8859_15 + , isAlpha_ascii + , isSpace + , isSpace_w8 + + -- *** Character classes + , inClass + , notInClass + + -- * Efficient string handling + , I.string + , I.stringCI + , skipSpace + , skipWhile + , I.take + , scan + , takeWhile + , takeWhile1 + , takeTill + + -- ** String combinators + -- $specalt + , (.*>) + , (<*.) + + -- ** Consume all remaining input + , I.takeByteString + , I.takeLazyByteString + + -- * Text parsing + , I.endOfLine + , isEndOfLine + , isHorizontalSpace + + -- * Numeric parsers + , decimal + , hexadecimal + , signed + + -- * Combinators + , try + , () + , choice + , count + , option + , many' + , many1 + , many1' + , manyTill + , manyTill' + , sepBy + , sepBy' + , sepBy1 + , sepBy1' + , skipMany + , skipMany1 + , eitherP + , I.match + -- * State observation and manipulation functions + , I.endOfInput + , I.atEnd + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative (pure, (*>), (<*), (<$>)) +import Data.Word (Word) +#endif +import Control.Applicative ((<|>)) +import Data.Attoparsec.ByteString.FastSet (charClass, memberChar) +import Data.Attoparsec.ByteString.Internal (Parser) +import Data.Attoparsec.Combinator +import Data.Bits (Bits, (.|.), shiftL) +import Data.ByteString.Internal (c2w, w2c) +import Data.Int (Int8, Int16, Int32, Int64) +import Data.String (IsString(..)) +import Data.Word (Word8, Word16, Word32, Word64) +import Prelude hiding (takeWhile) +import qualified Data.Attoparsec.ByteString as A +import qualified Data.Attoparsec.ByteString.Internal as I +import qualified Data.Attoparsec.Internal as I +import qualified Data.ByteString as B8 +import qualified Data.ByteString.Char8 as B + +instance (a ~ B.ByteString) => IsString (Parser a) where + fromString = I.string . B.pack + +-- $encodings +-- +-- This module is intended for parsing text that is +-- represented using an 8-bit character set, e.g. ASCII or +-- ISO-8859-15. It /does not/ make any attempt to deal with character +-- encodings, multibyte characters, or wide characters. In +-- particular, all attempts to use characters above code point U+00FF +-- will give wrong answers. +-- +-- Code points below U+0100 are simply translated to and from their +-- numeric values, so e.g. the code point U+00A4 becomes the byte +-- @0xA4@ (which is the Euro symbol in ISO-8859-15, but the generic +-- currency sign in ISO-8859-1). Haskell 'Char' values above U+00FF +-- are truncated, so e.g. U+1D6B7 is truncated to the byte @0xB7@. + +-- | Consume input as long as the predicate returns 'True', and return +-- the consumed input. +-- +-- This parser requires the predicate to succeed on at least one byte +-- of input: it will fail if the predicate never returns 'True' or if +-- there is no input left. +takeWhile1 :: (Char -> Bool) -> Parser B.ByteString +takeWhile1 p = I.takeWhile1 (p . w2c) +{-# INLINE takeWhile1 #-} + +-- | The parser @satisfy p@ succeeds for any byte for which the +-- predicate @p@ returns 'True'. Returns the byte that is actually +-- parsed. +-- +-- >digit = satisfy isDigit +-- > where isDigit c = c >= '0' && c <= '9' +satisfy :: (Char -> Bool) -> Parser Char +satisfy = I.satisfyWith w2c +{-# INLINE satisfy #-} + +-- | Match a letter, in the ISO-8859-15 encoding. +letter_iso8859_15 :: Parser Char +letter_iso8859_15 = satisfy isAlpha_iso8859_15 "letter_iso8859_15" +{-# INLINE letter_iso8859_15 #-} + +-- | Match a letter, in the ASCII encoding. +letter_ascii :: Parser Char +letter_ascii = satisfy isAlpha_ascii "letter_ascii" +{-# INLINE letter_ascii #-} + +-- | A fast alphabetic predicate for the ISO-8859-15 encoding +-- +-- /Note/: For all character encodings other than ISO-8859-15, and +-- almost all Unicode code points above U+00A3, this predicate gives +-- /wrong answers/. +isAlpha_iso8859_15 :: Char -> Bool +isAlpha_iso8859_15 c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || + (c >= '\166' && moby c) + where moby = notInClass "\167\169\171-\179\182\183\185\187\191\215\247" + {-# NOINLINE moby #-} +{-# INLINE isAlpha_iso8859_15 #-} + +-- | A fast alphabetic predicate for the ASCII encoding +-- +-- /Note/: For all character encodings other than ASCII, and +-- almost all Unicode code points above U+007F, this predicate gives +-- /wrong answers/. +isAlpha_ascii :: Char -> Bool +isAlpha_ascii c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') +{-# INLINE isAlpha_ascii #-} + +-- | Parse a single digit. +digit :: Parser Char +digit = satisfy isDigit "digit" +{-# INLINE digit #-} + +-- | A fast digit predicate. +isDigit :: Char -> Bool +isDigit c = c >= '0' && c <= '9' +{-# INLINE isDigit #-} + +-- | A fast digit predicate. +isDigit_w8 :: Word8 -> Bool +isDigit_w8 w = w - 48 <= 9 +{-# INLINE isDigit_w8 #-} + +-- | Match any character. +anyChar :: Parser Char +anyChar = satisfy $ const True +{-# INLINE anyChar #-} + +-- | Match any character, to perform lookahead. Returns 'Nothing' if +-- end of input has been reached. Does not consume any input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'many', because such parsers loop until a +-- failure occurs. Careless use will thus result in an infinite loop. +peekChar :: Parser (Maybe Char) +peekChar = (fmap w2c) `fmap` I.peekWord8 +{-# INLINE peekChar #-} + +-- | Match any character, to perform lookahead. Does not consume any +-- input, but will fail if end of input has been reached. +peekChar' :: Parser Char +peekChar' = w2c `fmap` I.peekWord8' +{-# INLINE peekChar' #-} + +-- | Fast predicate for matching ASCII space characters. +-- +-- /Note/: This predicate only gives correct answers for the ASCII +-- encoding. For instance, it does not recognise U+00A0 (non-breaking +-- space) as a space character, even though it is a valid ISO-8859-15 +-- byte. For a Unicode-aware and only slightly slower predicate, +-- use 'Data.Char.isSpace' +isSpace :: Char -> Bool +isSpace c = (c == ' ') || ('\t' <= c && c <= '\r') +{-# INLINE isSpace #-} + +-- | Fast 'Word8' predicate for matching ASCII space characters. +isSpace_w8 :: Word8 -> Bool +isSpace_w8 w = w == 32 || w - 9 <= 4 +{-# INLINE isSpace_w8 #-} + + +-- | Parse a space character. +-- +-- /Note/: This parser only gives correct answers for the ASCII +-- encoding. For instance, it does not recognise U+00A0 (non-breaking +-- space) as a space character, even though it is a valid ISO-8859-15 +-- byte. +space :: Parser Char +space = satisfy isSpace "space" +{-# INLINE space #-} + +-- | Match a specific character. +char :: Char -> Parser Char +char c = satisfy (== c) [c] +{-# INLINE char #-} + +-- | Match a specific character, but return its 'Word8' value. +char8 :: Char -> Parser Word8 +char8 c = I.satisfy (== c2w c) [c] +{-# INLINE char8 #-} + +-- | Match any character except the given one. +notChar :: Char -> Parser Char +notChar c = satisfy (/= c) "not " ++ [c] +{-# INLINE notChar #-} + +-- | Match any character in a set. +-- +-- >vowel = inClass "aeiou" +-- +-- Range notation is supported. +-- +-- >halfAlphabet = inClass "a-nA-N" +-- +-- To add a literal \'-\' to a set, place it at the beginning or end +-- of the string. +inClass :: String -> Char -> Bool +inClass s = (`memberChar` mySet) + where mySet = charClass s +{-# INLINE inClass #-} + +-- | Match any character not in a set. +notInClass :: String -> Char -> Bool +notInClass s = not . inClass s +{-# INLINE notInClass #-} + +-- | Consume input as long as the predicate returns 'True', and return +-- the consumed input. +-- +-- This parser does not fail. It will return an empty string if the +-- predicate returns 'False' on the first byte of input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'many', because such parsers loop until a +-- failure occurs. Careless use will thus result in an infinite loop. +takeWhile :: (Char -> Bool) -> Parser B.ByteString +takeWhile p = I.takeWhile (p . w2c) +{-# INLINE takeWhile #-} + +-- | A stateful scanner. The predicate consumes and transforms a +-- state argument, and each transformed state is passed to successive +-- invocations of the predicate on each byte of the input until one +-- returns 'Nothing' or the input ends. +-- +-- This parser does not fail. It will return an empty string if the +-- predicate returns 'Nothing' on the first byte of input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'many', because such parsers loop until a +-- failure occurs. Careless use will thus result in an infinite loop. +scan :: s -> (s -> Char -> Maybe s) -> Parser B.ByteString +scan s0 p = I.scan s0 (\s -> p s . w2c) +{-# INLINE scan #-} + +-- | Consume input as long as the predicate returns 'False' +-- (i.e. until it returns 'True'), and return the consumed input. +-- +-- This parser does not fail. It will return an empty string if the +-- predicate returns 'True' on the first byte of input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'many', because such parsers loop until a +-- failure occurs. Careless use will thus result in an infinite loop. +takeTill :: (Char -> Bool) -> Parser B.ByteString +takeTill p = I.takeTill (p . w2c) +{-# INLINE takeTill #-} + +-- | Skip past input for as long as the predicate returns 'True'. +skipWhile :: (Char -> Bool) -> Parser () +skipWhile p = I.skipWhile (p . w2c) +{-# INLINE skipWhile #-} + +-- | Skip over white space. +skipSpace :: Parser () +skipSpace = I.skipWhile isSpace_w8 +{-# INLINE skipSpace #-} + +-- $specalt +-- +-- If you enable the @OverloadedStrings@ language extension, you can +-- use the '*>' and '<*' combinators to simplify the common task of +-- matching a statically known string, then immediately parsing +-- something else. +-- +-- Instead of writing something like this: +-- +-- @ +--'I.string' \"foo\" '*>' wibble +-- @ +-- +-- Using @OverloadedStrings@, you can omit the explicit use of +-- 'I.string', and write a more compact version: +-- +-- @ +-- \"foo\" '*>' wibble +-- @ +-- +-- (Note: the '.*>' and '<*.' combinators that were originally +-- provided for this purpose are obsolete and unnecessary, and will be +-- removed in the next major version.) + +-- | /Obsolete/. A type-specialized version of '*>' for +-- 'B.ByteString'. Use '*>' instead. +(.*>) :: B.ByteString -> Parser a -> Parser a +s .*> f = I.string s *> f +{-# DEPRECATED (.*>) "This is no longer necessary, and will be removed. Use '*>' instead." #-} + +-- | /Obsolete/. A type-specialized version of '<*' for +-- 'B.ByteString'. Use '<*' instead. +(<*.) :: Parser a -> B.ByteString -> Parser a +f <*. s = f <* I.string s +{-# DEPRECATED (<*.) "This is no longer necessary, and will be removed. Use '<*' instead." #-} + +-- | A predicate that matches either a carriage return @\'\\r\'@ or +-- newline @\'\\n\'@ character. +isEndOfLine :: Word8 -> Bool +isEndOfLine w = w == 13 || w == 10 +{-# INLINE isEndOfLine #-} + +-- | A predicate that matches either a space @\' \'@ or horizontal tab +-- @\'\\t\'@ character. +isHorizontalSpace :: Word8 -> Bool +isHorizontalSpace w = w == 32 || w == 9 +{-# INLINE isHorizontalSpace #-} + +-- | Parse and decode an unsigned hexadecimal number. The hex digits +-- @\'a\'@ through @\'f\'@ may be upper or lower case. +-- +-- This parser does not accept a leading @\"0x\"@ string. +hexadecimal :: (Integral a, Bits a) => Parser a +hexadecimal = B8.foldl' step 0 `fmap` I.takeWhile1 isHexDigit + where + isHexDigit w = (w >= 48 && w <= 57) || + (w >= 97 && w <= 102) || + (w >= 65 && w <= 70) + step a w | w >= 48 && w <= 57 = (a `shiftL` 4) .|. fromIntegral (w - 48) + | w >= 97 = (a `shiftL` 4) .|. fromIntegral (w - 87) + | otherwise = (a `shiftL` 4) .|. fromIntegral (w - 55) +{-# SPECIALISE hexadecimal :: Parser Int #-} +{-# SPECIALISE hexadecimal :: Parser Int8 #-} +{-# SPECIALISE hexadecimal :: Parser Int16 #-} +{-# SPECIALISE hexadecimal :: Parser Int32 #-} +{-# SPECIALISE hexadecimal :: Parser Int64 #-} +{-# SPECIALISE hexadecimal :: Parser Integer #-} +{-# SPECIALISE hexadecimal :: Parser Word #-} +{-# SPECIALISE hexadecimal :: Parser Word8 #-} +{-# SPECIALISE hexadecimal :: Parser Word16 #-} +{-# SPECIALISE hexadecimal :: Parser Word32 #-} +{-# SPECIALISE hexadecimal :: Parser Word64 #-} + +-- | Parse and decode an unsigned decimal number. +decimal :: Integral a => Parser a +decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDigit_w8 + where step a w = a * 10 + fromIntegral (w - 48) +{-# SPECIALISE decimal :: Parser Int #-} +{-# SPECIALISE decimal :: Parser Int8 #-} +{-# SPECIALISE decimal :: Parser Int16 #-} +{-# SPECIALISE decimal :: Parser Int32 #-} +{-# SPECIALISE decimal :: Parser Int64 #-} +{-# SPECIALISE decimal :: Parser Integer #-} +{-# SPECIALISE decimal :: Parser Word #-} +{-# SPECIALISE decimal :: Parser Word8 #-} +{-# SPECIALISE decimal :: Parser Word16 #-} +{-# SPECIALISE decimal :: Parser Word32 #-} +{-# SPECIALISE decimal :: Parser Word64 #-} + +-- | Parse a number with an optional leading @\'+\'@ or @\'-\'@ sign +-- character. +signed :: Num a => Parser a -> Parser a +{-# SPECIALISE signed :: Parser Int -> Parser Int #-} +{-# SPECIALISE signed :: Parser Int8 -> Parser Int8 #-} +{-# SPECIALISE signed :: Parser Int16 -> Parser Int16 #-} +{-# SPECIALISE signed :: Parser Int32 -> Parser Int32 #-} +{-# SPECIALISE signed :: Parser Int64 -> Parser Int64 #-} +{-# SPECIALISE signed :: Parser Integer -> Parser Integer #-} +signed p = (negate <$> (char8 '-' *> p)) + <|> (char8 '+' *> p) + <|> p + diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs new file mode 100644 index 00000000..d15854c4 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE BangPatterns, MagicHash #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Attoparsec.ByteString.FastSet +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Fast set membership tests for 'Word8' and 8-bit 'Char' values. The +-- set representation is unboxed for efficiency. For small sets, we +-- test for membership using a binary search. For larger sets, we use +-- a lookup table. +-- +----------------------------------------------------------------------------- +module Data.Attoparsec.ByteString.FastSet + ( + -- * Data type + FastSet + -- * Construction + , fromList + , set + -- * Lookup + , memberChar + , memberWord8 + -- * Debugging + , fromSet + -- * Handy interface + , charClass + ) where + +import Data.Bits ((.&.), (.|.)) +import Foreign.Storable (peekByteOff, pokeByteOff) +import GHC.Base (Int(I#), iShiftRA#, narrow8Word#, shiftL#) +import GHC.Word (Word8(W8#)) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Internal as I +import qualified Data.ByteString.Unsafe as U + +data FastSet = Sorted { fromSet :: !B.ByteString } + | Table { fromSet :: !B.ByteString } + deriving (Eq, Ord) + +instance Show FastSet where + show (Sorted s) = "FastSet Sorted " ++ show (B8.unpack s) + show (Table _) = "FastSet Table" + +-- | The lower bound on the size of a lookup table. We choose this to +-- balance table density against performance. +tableCutoff :: Int +tableCutoff = 8 + +-- | Create a set. +set :: B.ByteString -> FastSet +set s | B.length s < tableCutoff = Sorted . B.sort $ s + | otherwise = Table . mkTable $ s + +fromList :: [Word8] -> FastSet +fromList = set . B.pack + +data I = I {-# UNPACK #-} !Int {-# UNPACK #-} !Word8 + +shiftR :: Int -> Int -> Int +shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#) + +shiftL :: Word8 -> Int -> Word8 +shiftL (W8# x#) (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#)) + +index :: Int -> I +index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7)) +{-# INLINE index #-} + +-- | Check the set for membership. +memberWord8 :: Word8 -> FastSet -> Bool +memberWord8 w (Table t) = + let I byte bit = index (fromIntegral w) + in U.unsafeIndex t byte .&. bit /= 0 +memberWord8 w (Sorted s) = search 0 (B.length s - 1) + where search lo hi + | hi < lo = False + | otherwise = + let mid = (lo + hi) `quot` 2 + in case compare w (U.unsafeIndex s mid) of + GT -> search (mid + 1) hi + LT -> search lo (mid - 1) + _ -> True + +-- | Check the set for membership. Only works with 8-bit characters: +-- characters above code point 255 will give wrong answers. +memberChar :: Char -> FastSet -> Bool +memberChar c = memberWord8 (I.c2w c) +{-# INLINE memberChar #-} + +mkTable :: B.ByteString -> B.ByteString +mkTable s = I.unsafeCreate 32 $ \t -> do + _ <- I.memset t 0 32 + U.unsafeUseAsCStringLen s $ \(p, l) -> + let loop n | n == l = return () + | otherwise = do + c <- peekByteOff p n :: IO Word8 + let I byte bit = index (fromIntegral c) + prev <- peekByteOff t byte :: IO Word8 + pokeByteOff t byte (prev .|. bit) + loop (n + 1) + in loop 0 + +charClass :: String -> FastSet +charClass = set . B8.pack . go + where go (a:'-':b:xs) = [a..b] ++ go xs + go (x:xs) = x : go xs + go _ = "" diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs new file mode 100644 index 00000000..4938ea87 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs @@ -0,0 +1,536 @@ +{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes, + RecordWildCards #-} +-- | +-- Module : Data.Attoparsec.ByteString.Internal +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient parser combinators for 'ByteString' strings, +-- loosely based on the Parsec library. + +module Data.Attoparsec.ByteString.Internal + ( + -- * Parser types + Parser + , Result + + -- * Running parsers + , parse + , parseOnly + + -- * Combinators + , module Data.Attoparsec.Combinator + + -- * Parsing individual bytes + , satisfy + , satisfyWith + , anyWord8 + , skip + , word8 + , notWord8 + + -- ** Lookahead + , peekWord8 + , peekWord8' + + -- ** Byte classes + , inClass + , notInClass + + -- * Parsing more complicated structures + , storable + + -- * Efficient string handling + , skipWhile + , string + , stringCI + , take + , scan + , runScanner + , takeWhile + , takeWhile1 + , takeTill + + -- ** Consume all remaining input + , takeByteString + , takeLazyByteString + + -- * Utilities + , endOfLine + , endOfInput + , match + , atEnd + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$>)) +#endif +import Control.Applicative ((<|>)) +import Control.Monad (when) +import Data.Attoparsec.ByteString.Buffer (Buffer, buffer) +import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8) +import Data.Attoparsec.Combinator (()) +import Data.Attoparsec.Internal +import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO) +import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success) +import Data.ByteString (ByteString) +import Data.List (intercalate) +import Data.Word (Word8) +import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Ptr (castPtr, minusPtr, plusPtr) +import Foreign.Storable (Storable(peek, sizeOf)) +import Prelude hiding (getChar, succ, take, takeWhile) +import qualified Data.Attoparsec.ByteString.Buffer as Buf +import qualified Data.Attoparsec.Internal.Types as T +import qualified Data.ByteString as B8 +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Internal as B +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Unsafe as B + +type Parser = T.Parser ByteString +type Result = IResult ByteString +type Failure r = T.Failure ByteString Buffer r +type Success a r = T.Success ByteString Buffer a r + +-- | The parser @satisfy p@ succeeds for any byte for which the +-- predicate @p@ returns 'True'. Returns the byte that is actually +-- parsed. +-- +-- >digit = satisfy isDigit +-- > where isDigit w = w >= 48 && w <= 57 +satisfy :: (Word8 -> Bool) -> Parser Word8 +satisfy p = do + h <- peekWord8' + if p h + then advance 1 >> return h + else fail "satisfy" +{-# INLINE satisfy #-} + +-- | The parser @skip p@ succeeds for any byte for which the predicate +-- @p@ returns 'True'. +-- +-- >skipDigit = skip isDigit +-- > where isDigit w = w >= 48 && w <= 57 +skip :: (Word8 -> Bool) -> Parser () +skip p = do + h <- peekWord8' + if p h + then advance 1 + else fail "skip" + +-- | The parser @satisfyWith f p@ transforms a byte, and succeeds if +-- the predicate @p@ returns 'True' on the transformed value. The +-- parser returns the transformed byte that was parsed. +satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a +satisfyWith f p = do + h <- peekWord8' + let c = f h + if p c + then advance 1 >> return c + else fail "satisfyWith" +{-# INLINE satisfyWith #-} + +storable :: Storable a => Parser a +storable = hack undefined + where + hack :: Storable b => b -> Parser b + hack dummy = do + (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy) + return . inlinePerformIO . withForeignPtr fp $ \p -> + peek (castPtr $ p `plusPtr` o) + +-- | Consume exactly @n@ bytes of input. +take :: Int -> Parser ByteString +take n0 = do + let n = max n0 0 + s <- ensure n + advance n >> return s +{-# INLINE take #-} + +-- | @string s@ parses a sequence of bytes that identically match +-- @s@. Returns the parsed string (i.e. @s@). This parser consumes no +-- input if it fails (even if a partial match). +-- +-- /Note/: The behaviour of this parser is different to that of the +-- similarly-named parser in Parsec, as this one is all-or-nothing. +-- To illustrate the difference, the following parser will fail under +-- Parsec given an input of @\"for\"@: +-- +-- >string "foo" <|> string "for" +-- +-- The reason for its failure is that the first branch is a +-- partial match, and will consume the letters @\'f\'@ and @\'o\'@ +-- before failing. In attoparsec, the above parser will /succeed/ on +-- that input, because the failed first branch will consume nothing. +string :: ByteString -> Parser ByteString +string s = string_ (stringSuspended id) id s +{-# INLINE string #-} + +-- ASCII-specific but fast, oh yes. +toLower :: Word8 -> Word8 +toLower w | w >= 65 && w <= 90 = w + 32 + | otherwise = w + +-- | Satisfy a literal string, ignoring case. +stringCI :: ByteString -> Parser ByteString +stringCI s = string_ (stringSuspended lower) lower s + where lower = B8.map toLower +{-# INLINE stringCI #-} + +string_ :: (forall r. ByteString -> ByteString -> Buffer -> Pos -> More + -> Failure r -> Success ByteString r -> Result r) + -> (ByteString -> ByteString) + -> ByteString -> Parser ByteString +string_ suspended f s0 = T.Parser $ \t pos more lose succ -> + let n = B.length s + s = f s0 + in if lengthAtLeast pos n t + then let t' = substring pos (Pos n) t + in if s == f t' + then succ t (pos + Pos n) more t' + else lose t pos more [] "string" + else let t' = Buf.unsafeDrop (fromPos pos) t + in if f t' `B.isPrefixOf` s + then suspended s (B.drop (B.length t') s) t pos more lose succ + else lose t pos more [] "string" +{-# INLINE string_ #-} + +stringSuspended :: (ByteString -> ByteString) + -> ByteString -> ByteString -> Buffer -> Pos -> More + -> Failure r + -> Success ByteString r + -> Result r +stringSuspended f s0 s t pos more lose succ = + runParser (demandInput_ >>= go) t pos more lose succ + where go s'0 = T.Parser $ \t' pos' more' lose' succ' -> + let m = B.length s + s' = f s'0 + n = B.length s' + in if n >= m + then if B.unsafeTake m s' == s + then let o = Pos (B.length s0) + in succ' t' (pos' + o) more' + (substring pos' o t') + else lose' t' pos' more' [] "string" + else if s' == B.unsafeTake n s + then stringSuspended f s0 (B.unsafeDrop n s) + t' pos' more' lose' succ' + else lose' t' pos' more' [] "string" + +-- | Skip past input for as long as the predicate returns 'True'. +skipWhile :: (Word8 -> Bool) -> Parser () +skipWhile p = go + where + go = do + t <- B8.takeWhile p <$> get + continue <- inputSpansChunks (B.length t) + when continue go +{-# INLINE skipWhile #-} + +-- | Consume input as long as the predicate returns 'False' +-- (i.e. until it returns 'True'), and return the consumed input. +-- +-- This parser does not fail. It will return an empty string if the +-- predicate returns 'True' on the first byte of input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'Control.Applicative.many', because such +-- parsers loop until a failure occurs. Careless use will thus result +-- in an infinite loop. +takeTill :: (Word8 -> Bool) -> Parser ByteString +takeTill p = takeWhile (not . p) +{-# INLINE takeTill #-} + +-- | Consume input as long as the predicate returns 'True', and return +-- the consumed input. +-- +-- This parser does not fail. It will return an empty string if the +-- predicate returns 'False' on the first byte of input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'Control.Applicative.many', because such +-- parsers loop until a failure occurs. Careless use will thus result +-- in an infinite loop. +takeWhile :: (Word8 -> Bool) -> Parser ByteString +takeWhile p = do + s <- B8.takeWhile p <$> get + continue <- inputSpansChunks (B.length s) + if continue + then takeWhileAcc p [s] + else return s +{-# INLINE takeWhile #-} + +takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString +takeWhileAcc p = go + where + go acc = do + s <- B8.takeWhile p <$> get + continue <- inputSpansChunks (B.length s) + if continue + then go (s:acc) + else return $ concatReverse (s:acc) +{-# INLINE takeWhileAcc #-} + +takeRest :: Parser [ByteString] +takeRest = go [] + where + go acc = do + input <- wantInput + if input + then do + s <- get + advance (B.length s) + go (s:acc) + else return (reverse acc) + +-- | Consume all remaining input and return it as a single string. +takeByteString :: Parser ByteString +takeByteString = B.concat `fmap` takeRest + +-- | Consume all remaining input and return it as a single string. +takeLazyByteString :: Parser L.ByteString +takeLazyByteString = L.fromChunks `fmap` takeRest + +data T s = T {-# UNPACK #-} !Int s + +scan_ :: (s -> [ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s) + -> Parser r +scan_ f s0 p = go [] s0 + where + go acc s1 = do + let scanner (B.PS fp off len) = + withForeignPtr fp $ \ptr0 -> do + let start = ptr0 `plusPtr` off + end = start `plusPtr` len + inner ptr !s + | ptr < end = do + w <- peek ptr + case p s w of + Just s' -> inner (ptr `plusPtr` 1) s' + _ -> done (ptr `minusPtr` start) s + | otherwise = done (ptr `minusPtr` start) s + done !i !s = return (T i s) + inner start s1 + bs <- get + let T i s' = inlinePerformIO $ scanner bs + !h = B.unsafeTake i bs + continue <- inputSpansChunks i + if continue + then go (h:acc) s' + else f s' (h:acc) +{-# INLINE scan_ #-} + +-- | A stateful scanner. The predicate consumes and transforms a +-- state argument, and each transformed state is passed to successive +-- invocations of the predicate on each byte of the input until one +-- returns 'Nothing' or the input ends. +-- +-- This parser does not fail. It will return an empty string if the +-- predicate returns 'Nothing' on the first byte of input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'Control.Applicative.many', because such +-- parsers loop until a failure occurs. Careless use will thus result +-- in an infinite loop. +scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString +scan = scan_ $ \_ chunks -> return $! concatReverse chunks +{-# INLINE scan #-} + +-- | Like 'scan', but generalized to return the final state of the +-- scanner. +runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s) +runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s) +{-# INLINE runScanner #-} + +-- | Consume input as long as the predicate returns 'True', and return +-- the consumed input. +-- +-- This parser requires the predicate to succeed on at least one byte +-- of input: it will fail if the predicate never returns 'True' or if +-- there is no input left. +takeWhile1 :: (Word8 -> Bool) -> Parser ByteString +takeWhile1 p = do + (`when` demandInput) =<< endOfChunk + s <- B8.takeWhile p <$> get + let len = B.length s + if len == 0 + then fail "takeWhile1" + else do + advance len + eoc <- endOfChunk + if eoc + then takeWhileAcc p [s] + else return s +{-# INLINE takeWhile1 #-} + +-- | Match any byte in a set. +-- +-- >vowel = inClass "aeiou" +-- +-- Range notation is supported. +-- +-- >halfAlphabet = inClass "a-nA-N" +-- +-- To add a literal @\'-\'@ to a set, place it at the beginning or end +-- of the string. +inClass :: String -> Word8 -> Bool +inClass s = (`memberWord8` mySet) + where mySet = charClass s + {-# NOINLINE mySet #-} +{-# INLINE inClass #-} + +-- | Match any byte not in a set. +notInClass :: String -> Word8 -> Bool +notInClass s = not . inClass s +{-# INLINE notInClass #-} + +-- | Match any byte. +anyWord8 :: Parser Word8 +anyWord8 = satisfy $ const True +{-# INLINE anyWord8 #-} + +-- | Match a specific byte. +word8 :: Word8 -> Parser Word8 +word8 c = satisfy (== c) show c +{-# INLINE word8 #-} + +-- | Match any byte except the given one. +notWord8 :: Word8 -> Parser Word8 +notWord8 c = satisfy (/= c) "not " ++ show c +{-# INLINE notWord8 #-} + +-- | Match any byte, to perform lookahead. Returns 'Nothing' if end of +-- input has been reached. Does not consume any input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'Control.Applicative.many', because such +-- parsers loop until a failure occurs. Careless use will thus result +-- in an infinite loop. +peekWord8 :: Parser (Maybe Word8) +peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ -> + case () of + _| pos_ < Buf.length t -> + let !w = Buf.unsafeIndex t pos_ + in succ t pos more (Just w) + | more == Complete -> + succ t pos more Nothing + | otherwise -> + let succ' t' pos' more' = let !w = Buf.unsafeIndex t' pos_ + in succ t' pos' more' (Just w) + lose' t' pos' more' = succ t' pos' more' Nothing + in prompt t pos more lose' succ' +{-# INLINE peekWord8 #-} + +-- | Match any byte, to perform lookahead. Does not consume any +-- input, but will fail if end of input has been reached. +peekWord8' :: Parser Word8 +peekWord8' = T.Parser $ \t pos more lose succ -> + if lengthAtLeast pos 1 t + then succ t pos more (Buf.unsafeIndex t (fromPos pos)) + else let succ' t' pos' more' bs' = succ t' pos' more' $! B.unsafeHead bs' + in ensureSuspended 1 t pos more lose succ' +{-# INLINE peekWord8' #-} + +-- | Match either a single newline character @\'\\n\'@, or a carriage +-- return followed by a newline character @\"\\r\\n\"@. +endOfLine :: Parser () +endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ()) + +-- | Terminal failure continuation. +failK :: Failure a +failK t (Pos pos) _more stack msg = Fail (Buf.unsafeDrop pos t) stack msg +{-# INLINE failK #-} + +-- | Terminal success continuation. +successK :: Success a a +successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a +{-# INLINE successK #-} + +-- | Run a parser. +parse :: Parser a -> ByteString -> Result a +parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK +{-# INLINE parse #-} + +-- | Run a parser that cannot be resupplied via a 'Partial' result. +-- +-- This function does not force a parser to consume all of its input. +-- Instead, any residual input will be discarded. To force a parser +-- to consume all of its input, use something like this: +-- +-- @ +--'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput') +-- @ +parseOnly :: Parser a -> ByteString -> Either String a +parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of + Fail _ [] err -> Left err + Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err) + Done _ a -> Right a + _ -> error "parseOnly: impossible error!" +{-# INLINE parseOnly #-} + +get :: Parser ByteString +get = T.Parser $ \t pos more _lose succ -> + succ t pos more (Buf.unsafeDrop (fromPos pos) t) +{-# INLINE get #-} + +endOfChunk :: Parser Bool +endOfChunk = T.Parser $ \t pos more _lose succ -> + succ t pos more (fromPos pos == Buf.length t) +{-# INLINE endOfChunk #-} + +inputSpansChunks :: Int -> Parser Bool +inputSpansChunks i = T.Parser $ \t pos_ more _lose succ -> + let pos = pos_ + Pos i + in if fromPos pos < Buf.length t || more == Complete + then succ t pos more False + else let lose' t' pos' more' = succ t' pos' more' False + succ' t' pos' more' = succ t' pos' more' True + in prompt t pos more lose' succ' +{-# INLINE inputSpansChunks #-} + +advance :: Int -> Parser () +advance n = T.Parser $ \t pos more _lose succ -> + succ t (pos + Pos n) more () +{-# INLINE advance #-} + +ensureSuspended :: Int -> Buffer -> Pos -> More + -> Failure r + -> Success ByteString r + -> Result r +ensureSuspended n t pos more lose succ = + runParser (demandInput >> go) t pos more lose succ + where go = T.Parser $ \t' pos' more' lose' succ' -> + if lengthAtLeast pos' n t' + then succ' t' pos' more' (substring pos (Pos n) t') + else runParser (demandInput >> go) t' pos' more' lose' succ' + +-- | If at least @n@ elements of input are available, return the +-- current input, otherwise fail. +ensure :: Int -> Parser ByteString +ensure n = T.Parser $ \t pos more lose succ -> + if lengthAtLeast pos n t + then succ t pos more (substring pos (Pos n) t) + -- The uncommon case is kept out-of-line to reduce code size: + else ensureSuspended n t pos more lose succ +{-# INLINE ensure #-} + +-- | Return both the result of a parse and the portion of the input +-- that was consumed while it was being parsed. +match :: Parser a -> Parser (ByteString, a) +match p = T.Parser $ \t pos more lose succ -> + let succ' t' pos' more' a = + succ t' pos' more' (substring pos (pos'-pos) t', a) + in runParser p t pos more lose succ' + +lengthAtLeast :: Pos -> Int -> Buffer -> Bool +lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n +{-# INLINE lengthAtLeast #-} + +substring :: Pos -> Pos -> Buffer -> ByteString +substring (Pos pos) (Pos n) = Buf.substring pos n +{-# INLINE substring #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs new file mode 100644 index 00000000..dde0c27a --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs @@ -0,0 +1,233 @@ +{-# LANGUAGE BangPatterns, CPP #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} -- Imports internal modules +#endif +-- | +-- Module : Data.Attoparsec.Combinator +-- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : portable +-- +-- Useful parser combinators, similar to those provided by Parsec. +module Data.Attoparsec.Combinator + ( + -- * Combinators + try + , () + , choice + , count + , option + , many' + , many1 + , many1' + , manyTill + , manyTill' + , sepBy + , sepBy' + , sepBy1 + , sepBy1' + , skipMany + , skipMany1 + , eitherP + , feed + , satisfyElem + , endOfInput + , atEnd + , lookAhead + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative (Applicative(..), (<$>)) +import Data.Monoid (Monoid(mappend)) +#endif +import Control.Applicative (Alternative(..), empty, liftA2, many, (<|>)) +import Control.Monad (MonadPlus(..)) +import Data.Attoparsec.Internal.Types (Parser(..), IResult(..)) +import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem) +import Data.ByteString (ByteString) +import Prelude hiding (succ) + +-- | Attempt a parse, and if it fails, rewind the input so that no +-- input appears to have been consumed. +-- +-- This combinator is provided for compatibility with Parsec. +-- attoparsec parsers always backtrack on failure. +try :: Parser i a -> Parser i a +try p = p +{-# INLINE try #-} + +-- | Name the parser, in case failure occurs. +() :: Parser i a + -> String -- ^ the name to use if parsing fails + -> Parser i a +p msg0 = Parser $ \t pos more lose succ -> + let lose' t' pos' more' strs msg = lose t' pos' more' (msg0:strs) msg + in runParser p t pos more lose' succ +{-# INLINE () #-} +infix 0 + +-- | @choice ps@ tries to apply the actions in the list @ps@ in order, +-- until one of them succeeds. Returns the value of the succeeding +-- action. +choice :: Alternative f => [f a] -> f a +choice = foldr (<|>) empty +{-# SPECIALIZE choice :: [Parser ByteString a] + -> Parser ByteString a #-} + +-- | @option x p@ tries to apply action @p@. If @p@ fails without +-- consuming input, it returns the value @x@, otherwise the value +-- returned by @p@. +-- +-- > priority = option 0 (digitToInt <$> digit) +option :: Alternative f => a -> f a -> f a +option x p = p <|> pure x +{-# SPECIALIZE option :: a -> Parser ByteString a -> Parser ByteString a #-} + +-- | A version of 'liftM2' that is strict in the result of its first +-- action. +liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c +liftM2' f a b = do + !x <- a + y <- b + return (f x y) +{-# INLINE liftM2' #-} + +-- | @many' p@ applies the action @p@ /zero/ or more times. Returns a +-- list of the returned values of @p@. The value returned by @p@ is +-- forced to WHNF. +-- +-- > word = many' letter +many' :: (MonadPlus m) => m a -> m [a] +many' p = many_p + where many_p = some_p `mplus` return [] + some_p = liftM2' (:) p many_p +{-# INLINE many' #-} + +-- | @many1 p@ applies the action @p@ /one/ or more times. Returns a +-- list of the returned values of @p@. +-- +-- > word = many1 letter +many1 :: Alternative f => f a -> f [a] +many1 p = liftA2 (:) p (many p) +{-# INLINE many1 #-} + +-- | @many1' p@ applies the action @p@ /one/ or more times. Returns a +-- list of the returned values of @p@. The value returned by @p@ is +-- forced to WHNF. +-- +-- > word = many1' letter +many1' :: (MonadPlus m) => m a -> m [a] +many1' p = liftM2' (:) p (many' p) +{-# INLINE many1' #-} + +-- | @sepBy p sep@ applies /zero/ or more occurrences of @p@, separated +-- by @sep@. Returns a list of the values returned by @p@. +-- +-- > commaSep p = p `sepBy` (char ',') +sepBy :: Alternative f => f a -> f s -> f [a] +sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure [] +{-# SPECIALIZE sepBy :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @sepBy' p sep@ applies /zero/ or more occurrences of @p@, separated +-- by @sep@. Returns a list of the values returned by @p@. The value +-- returned by @p@ is forced to WHNF. +-- +-- > commaSep p = p `sepBy'` (char ',') +sepBy' :: (MonadPlus m) => m a -> m s -> m [a] +sepBy' p s = scan `mplus` return [] + where scan = liftM2' (:) p ((s >> sepBy1' p s) `mplus` return []) +{-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @sepBy1 p sep@ applies /one/ or more occurrences of @p@, separated +-- by @sep@. Returns a list of the values returned by @p@. +-- +-- > commaSep p = p `sepBy1` (char ',') +sepBy1 :: Alternative f => f a -> f s -> f [a] +sepBy1 p s = scan + where scan = liftA2 (:) p ((s *> scan) <|> pure []) +{-# SPECIALIZE sepBy1 :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @sepBy1' p sep@ applies /one/ or more occurrences of @p@, separated +-- by @sep@. Returns a list of the values returned by @p@. The value +-- returned by @p@ is forced to WHNF. +-- +-- > commaSep p = p `sepBy1'` (char ',') +sepBy1' :: (MonadPlus m) => m a -> m s -> m [a] +sepBy1' p s = scan + where scan = liftM2' (:) p ((s >> scan) `mplus` return []) +{-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @manyTill p end@ applies action @p@ /zero/ or more times until +-- action @end@ succeeds, and returns the list of values returned by +-- @p@. This can be used to scan comments: +-- +-- > simpleComment = string "") +-- +-- (Note the overlapping parsers @anyChar@ and @string \"-->\"@. +-- While this will work, it is not very efficient, as it will cause a +-- lot of backtracking.) +manyTill :: Alternative f => f a -> f b -> f [a] +manyTill p end = scan + where scan = (end *> pure []) <|> liftA2 (:) p scan +{-# SPECIALIZE manyTill :: Parser ByteString a -> Parser ByteString b + -> Parser ByteString [a] #-} + +-- | @manyTill' p end@ applies action @p@ /zero/ or more times until +-- action @end@ succeeds, and returns the list of values returned by +-- @p@. This can be used to scan comments: +-- +-- > simpleComment = string "") +-- +-- (Note the overlapping parsers @anyChar@ and @string \"-->\"@. +-- While this will work, it is not very efficient, as it will cause a +-- lot of backtracking.) +-- +-- The value returned by @p@ is forced to WHNF. +manyTill' :: (MonadPlus m) => m a -> m b -> m [a] +manyTill' p end = scan + where scan = (end >> return []) `mplus` liftM2' (:) p scan +{-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b + -> Parser ByteString [a] #-} + +-- | Skip zero or more instances of an action. +skipMany :: Alternative f => f a -> f () +skipMany p = scan + where scan = (p *> scan) <|> pure () +{-# SPECIALIZE skipMany :: Parser ByteString a -> Parser ByteString () #-} + +-- | Skip one or more instances of an action. +skipMany1 :: Alternative f => f a -> f () +skipMany1 p = p *> skipMany p +{-# SPECIALIZE skipMany1 :: Parser ByteString a -> Parser ByteString () #-} + +-- | Apply the given action repeatedly, returning every result. +count :: Monad m => Int -> m a -> m [a] +count n p = sequence (replicate n p) +{-# INLINE count #-} + +-- | Combine two alternatives. +eitherP :: (Alternative f) => f a -> f b -> f (Either a b) +eitherP a b = (Left <$> a) <|> (Right <$> b) +{-# INLINE eitherP #-} + +-- | If a parser has returned a 'T.Partial' result, supply it with more +-- input. +feed :: Monoid i => IResult i r -> i -> IResult i r +feed (Fail t ctxs msg) d = Fail (mappend t d) ctxs msg +feed (Partial k) d = k d +feed (Done t r) d = Done (mappend t d) r +{-# INLINE feed #-} + +-- | Apply a parser without consuming any input. +lookAhead :: Parser i a -> Parser i a +lookAhead p = Parser $ \t pos more lose succ -> + let succ' t' _pos' more' = succ t' pos more' + in runParser p t pos more lose succ' +{-# INLINE lookAhead #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs new file mode 100644 index 00000000..ee758b26 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-} +-- | +-- Module : Data.Attoparsec.Internal +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient parser combinators, loosely based on the Parsec +-- library. + +module Data.Attoparsec.Internal + ( compareResults + , prompt + , demandInput + , demandInput_ + , wantInput + , endOfInput + , atEnd + , satisfyElem + , concatReverse + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$>)) +import Data.Monoid (Monoid, mconcat) +#endif +import Data.Attoparsec.Internal.Types +import Data.ByteString (ByteString) +import Prelude hiding (succ) + +-- | Compare two 'IResult' values for equality. +-- +-- If both 'IResult's are 'Partial', the result will be 'Nothing', as +-- they are incomplete and hence their equality cannot be known. +-- (This is why there is no 'Eq' instance for 'IResult'.) +compareResults :: (Eq i, Eq r) => IResult i r -> IResult i r -> Maybe Bool +compareResults (Fail t0 ctxs0 msg0) (Fail t1 ctxs1 msg1) = + Just (t0 == t1 && ctxs0 == ctxs1 && msg0 == msg1) +compareResults (Done t0 r0) (Done t1 r1) = + Just (t0 == t1 && r0 == r1) +compareResults (Partial _) (Partial _) = Nothing +compareResults _ _ = Just False + +-- | Ask for input. If we receive any, pass the augmented input to a +-- success continuation, otherwise to a failure continuation. +prompt :: Chunk t + => State t -> Pos -> More + -> (State t -> Pos -> More -> IResult t r) + -> (State t -> Pos -> More -> IResult t r) + -> IResult t r +prompt t pos _more lose succ = Partial $ \s -> + if nullChunk s + then lose t pos Complete + else succ (pappendChunk t s) pos Incomplete +{-# SPECIALIZE prompt :: State ByteString -> Pos -> More + -> (State ByteString -> Pos -> More + -> IResult ByteString r) + -> (State ByteString -> Pos -> More + -> IResult ByteString r) + -> IResult ByteString r #-} + +-- | Immediately demand more input via a 'Partial' continuation +-- result. +demandInput :: Chunk t => Parser t () +demandInput = Parser $ \t pos more lose succ -> + case more of + Complete -> lose t pos more [] "not enough input" + _ -> let lose' _ pos' more' = lose t pos' more' [] "not enough input" + succ' t' pos' more' = succ t' pos' more' () + in prompt t pos more lose' succ' +{-# SPECIALIZE demandInput :: Parser ByteString () #-} + +-- | Immediately demand more input via a 'Partial' continuation +-- result. Return the new input. +demandInput_ :: Chunk t => Parser t t +demandInput_ = Parser $ \t pos more lose succ -> + case more of + Complete -> lose t pos more [] "not enough input" + _ -> Partial $ \s -> + if nullChunk s + then lose t pos Complete [] "not enough input" + else succ (pappendChunk t s) pos more s +{-# SPECIALIZE demandInput_ :: Parser ByteString ByteString #-} + +-- | This parser always succeeds. It returns 'True' if any input is +-- available either immediately or on demand, and 'False' if the end +-- of all input has been reached. +wantInput :: forall t . Chunk t => Parser t Bool +wantInput = Parser $ \t pos more _lose succ -> + case () of + _ | pos < atBufferEnd (undefined :: t) t -> succ t pos more True + | more == Complete -> succ t pos more False + | otherwise -> let lose' t' pos' more' = succ t' pos' more' False + succ' t' pos' more' = succ t' pos' more' True + in prompt t pos more lose' succ' +{-# INLINE wantInput #-} + +-- | Match only if all input has been consumed. +endOfInput :: forall t . Chunk t => Parser t () +endOfInput = Parser $ \t pos more lose succ -> + case () of + _| pos < atBufferEnd (undefined :: t) t -> lose t pos more [] "endOfInput" + | more == Complete -> succ t pos more () + | otherwise -> + let lose' t' pos' more' _ctx _msg = succ t' pos' more' () + succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput" + in runParser demandInput t pos more lose' succ' +{-# SPECIALIZE endOfInput :: Parser ByteString () #-} + +-- | Return an indication of whether the end of input has been +-- reached. +atEnd :: Chunk t => Parser t Bool +atEnd = not <$> wantInput +{-# INLINE atEnd #-} + +satisfySuspended :: forall t r . Chunk t + => (ChunkElem t -> Bool) + -> State t -> Pos -> More + -> Failure t (State t) r + -> Success t (State t) (ChunkElem t) r + -> IResult t r +satisfySuspended p t pos more lose succ = + runParser (demandInput >> go) t pos more lose succ + where go = Parser $ \t' pos' more' lose' succ' -> + case bufferElemAt (undefined :: t) pos' t' of + Just (e, l) | p e -> succ' t' (pos' + Pos l) more' e + | otherwise -> lose' t' pos' more' [] "satisfyElem" + Nothing -> runParser (demandInput >> go) t' pos' more' lose' succ' +{-# SPECIALIZE satisfySuspended :: (ChunkElem ByteString -> Bool) + -> State ByteString -> Pos -> More + -> Failure ByteString (State ByteString) r + -> Success ByteString (State ByteString) + (ChunkElem ByteString) r + -> IResult ByteString r #-} + +-- | The parser @satisfyElem p@ succeeds for any chunk element for which the +-- predicate @p@ returns 'True'. Returns the element that is +-- actually parsed. +satisfyElem :: forall t . Chunk t + => (ChunkElem t -> Bool) -> Parser t (ChunkElem t) +satisfyElem p = Parser $ \t pos more lose succ -> + case bufferElemAt (undefined :: t) pos t of + Just (e, l) | p e -> succ t (pos + Pos l) more e + | otherwise -> lose t pos more [] "satisfyElem" + Nothing -> satisfySuspended p t pos more lose succ +{-# INLINE satisfyElem #-} + +-- | Concatenate a monoid after reversing its elements. Used to +-- glue together a series of textual chunks that have been accumulated +-- \"backwards\". +concatReverse :: Monoid m => [m] -> m +concatReverse [x] = x +concatReverse xs = mconcat (reverse xs) +{-# INLINE concatReverse #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs new file mode 100644 index 00000000..0e00ed2c --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, + RecordWildCards, MagicHash, UnboxedTuples #-} + +module Data.Attoparsec.Internal.Fhthagn + ( + inlinePerformIO + ) where + +import GHC.Base (realWorld#) +import GHC.IO (IO(IO)) + +-- | Just like unsafePerformIO, but we inline it. Big performance gains as +-- it exposes lots of things to further inlining. /Very unsafe/. In +-- particular, you should do no memory allocation inside an +-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@. +inlinePerformIO :: IO a -> a +inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r +{-# INLINE inlinePerformIO #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs new file mode 100644 index 00000000..96bc319e --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs @@ -0,0 +1,243 @@ +{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings, + Rank2Types, RecordWildCards, TypeFamilies #-} +-- | +-- Module : Data.Attoparsec.Internal.Types +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient parser combinators, loosely based on the Parsec +-- library. + +module Data.Attoparsec.Internal.Types + ( + Parser(..) + , State + , Failure + , Success + , Pos(..) + , IResult(..) + , More(..) + , (<>) + , Chunk(..) + ) where + +import Control.Applicative as App (Applicative(..), (<$>)) +import Control.Applicative (Alternative(..)) +import Control.DeepSeq (NFData(rnf)) +import Control.Monad (MonadPlus(..)) +import qualified Control.Monad.Fail as Fail (MonadFail(..)) +import Data.Monoid as Mon (Monoid(..)) +import Data.Semigroup (Semigroup(..)) +import Data.Word (Word8) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.ByteString.Internal (w2c) +import Prelude hiding (getChar, succ) +import qualified Data.Attoparsec.ByteString.Buffer as B + +newtype Pos = Pos { fromPos :: Int } + deriving (Eq, Ord, Show, Num) + +-- | The result of a parse. This is parameterised over the type @i@ +-- of string that was processed. +-- +-- This type is an instance of 'Functor', where 'fmap' transforms the +-- value in a 'Done' result. +data IResult i r = + Fail i [String] String + -- ^ The parse failed. The @i@ parameter is the input that had + -- not yet been consumed when the failure occurred. The + -- @[@'String'@]@ is a list of contexts in which the error + -- occurred. The 'String' is the message describing the error, if + -- any. + | Partial (i -> IResult i r) + -- ^ Supply this continuation with more input so that the parser + -- can resume. To indicate that no more input is available, pass + -- an empty string to the continuation. + -- + -- __Note__: if you get a 'Partial' result, do not call its + -- continuation more than once. + | Done i r + -- ^ The parse succeeded. The @i@ parameter is the input that had + -- not yet been consumed (if any) when the parse succeeded. + +instance (Show i, Show r) => Show (IResult i r) where + showsPrec d ir = showParen (d > 10) $ + case ir of + (Fail t stk msg) -> showString "Fail" . f t . f stk . f msg + (Partial _) -> showString "Partial _" + (Done t r) -> showString "Done" . f t . f r + where f :: Show a => a -> ShowS + f x = showChar ' ' . showsPrec 11 x + +instance (NFData i, NFData r) => NFData (IResult i r) where + rnf (Fail t stk msg) = rnf t `seq` rnf stk `seq` rnf msg + rnf (Partial _) = () + rnf (Done t r) = rnf t `seq` rnf r + {-# INLINE rnf #-} + +instance Functor (IResult i) where + fmap _ (Fail t stk msg) = Fail t stk msg + fmap f (Partial k) = Partial (fmap f . k) + fmap f (Done t r) = Done t (f r) + +-- | The core parser type. This is parameterised over the type @i@ +-- of string being processed. +-- +-- This type is an instance of the following classes: +-- +-- * 'Monad', where 'fail' throws an exception (i.e. fails) with an +-- error message. +-- +-- * 'Functor' and 'Applicative', which follow the usual definitions. +-- +-- * 'MonadPlus', where 'mzero' fails (with no error message) and +-- 'mplus' executes the right-hand parser if the left-hand one +-- fails. When the parser on the right executes, the input is reset +-- to the same state as the parser on the left started with. (In +-- other words, attoparsec is a backtracking parser that supports +-- arbitrary lookahead.) +-- +-- * 'Alternative', which follows 'MonadPlus'. +newtype Parser i a = Parser { + runParser :: forall r. + State i -> Pos -> More + -> Failure i (State i) r + -> Success i (State i) a r + -> IResult i r + } + +type family State i +type instance State ByteString = B.Buffer + +type Failure i t r = t -> Pos -> More -> [String] -> String + -> IResult i r +type Success i t a r = t -> Pos -> More -> a -> IResult i r + +-- | Have we read all available input? +data More = Complete | Incomplete + deriving (Eq, Show) + +instance Semigroup More where + c@Complete <> _ = c + _ <> m = m + +instance Mon.Monoid More where + mappend = (<>) + mempty = Incomplete + +instance Monad (Parser i) where + fail = Fail.fail + {-# INLINE fail #-} + + return = App.pure + {-# INLINE return #-} + + m >>= k = Parser $ \t !pos more lose succ -> + let succ' t' !pos' more' a = runParser (k a) t' pos' more' lose succ + in runParser m t pos more lose succ' + {-# INLINE (>>=) #-} + + (>>) = (*>) + {-# INLINE (>>) #-} + + +instance Fail.MonadFail (Parser i) where + fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg + where msg = "Failed reading: " ++ err + {-# INLINE fail #-} + +plus :: Parser i a -> Parser i a -> Parser i a +plus f g = Parser $ \t pos more lose succ -> + let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ + in runParser f t pos more lose' succ + +instance MonadPlus (Parser i) where + mzero = fail "mzero" + {-# INLINE mzero #-} + mplus = plus + +instance Functor (Parser i) where + fmap f p = Parser $ \t pos more lose succ -> + let succ' t' pos' more' a = succ t' pos' more' (f a) + in runParser p t pos more lose succ' + {-# INLINE fmap #-} + +apP :: Parser i (a -> b) -> Parser i a -> Parser i b +apP d e = do + b <- d + a <- e + return (b a) +{-# INLINE apP #-} + +instance Applicative (Parser i) where + pure v = Parser $ \t pos more _lose succ -> succ t pos more v + {-# INLINE pure #-} + (<*>) = apP + {-# INLINE (<*>) #-} + m *> k = m >>= \_ -> k + {-# INLINE (*>) #-} + x <* y = x >>= \a -> y >> pure a + {-# INLINE (<*) #-} + +instance Semigroup (Parser i a) where + (<>) = plus + {-# INLINE (<>) #-} + +instance Monoid (Parser i a) where + mempty = fail "mempty" + {-# INLINE mempty #-} + mappend = (<>) + {-# INLINE mappend #-} + +instance Alternative (Parser i) where + empty = fail "empty" + {-# INLINE empty #-} + + (<|>) = plus + {-# INLINE (<|>) #-} + + many v = many_v + where many_v = some_v <|> pure [] + some_v = (:) App.<$> v <*> many_v + {-# INLINE many #-} + + some v = some_v + where + many_v = some_v <|> pure [] + some_v = (:) <$> v <*> many_v + {-# INLINE some #-} + +-- | A common interface for input chunks. +class Monoid c => Chunk c where + type ChunkElem c + -- | Test if the chunk is empty. + nullChunk :: c -> Bool + -- | Append chunk to a buffer. + pappendChunk :: State c -> c -> State c + -- | Position at the end of a buffer. The first argument is ignored. + atBufferEnd :: c -> State c -> Pos + -- | Return the buffer element at the given position along with its length. + bufferElemAt :: c -> Pos -> State c -> Maybe (ChunkElem c, Int) + -- | Map an element to the corresponding character. + -- The first argument is ignored. + chunkElemToChar :: c -> ChunkElem c -> Char + +instance Chunk ByteString where + type ChunkElem ByteString = Word8 + nullChunk = BS.null + {-# INLINE nullChunk #-} + pappendChunk = B.pappend + {-# INLINE pappendChunk #-} + atBufferEnd _ = Pos . B.length + {-# INLINE atBufferEnd #-} + bufferElemAt _ (Pos i) buf + | i < B.length buf = Just (B.unsafeIndex buf i, 1) + | otherwise = Nothing + {-# INLINE bufferElemAt #-} + chunkElemToChar _ = w2c + {-# INLINE chunkElemToChar #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs new file mode 100644 index 00000000..d0970d90 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE DeriveDataTypeable #-} +-- | +-- Module : Data.Attoparsec.Number +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- This module is deprecated, and both the module and 'Number' type +-- will be removed in the next major release. Use the +-- package +-- and the 'Data.Scientific.Scientific' type instead. +-- +-- A simple number type, useful for parsing both exact and inexact +-- quantities without losing much precision. +module Data.Attoparsec.Number + {-# DEPRECATED "This module will be removed in the next major release." #-} + ( + Number(..) + ) where + +import Control.DeepSeq (NFData(rnf)) +import Data.Data (Data) +import Data.Function (on) +import Data.Typeable (Typeable) + +-- | A numeric type that can represent integers accurately, and +-- floating point numbers to the precision of a 'Double'. +-- +-- /Note/: this type is deprecated, and will be removed in the next +-- major release. Use the 'Data.Scientific.Scientific' type instead. +data Number = I !Integer + | D {-# UNPACK #-} !Double + deriving (Typeable, Data) +{-# DEPRECATED Number "Use Scientific instead." #-} + +instance Show Number where + show (I a) = show a + show (D a) = show a + +instance NFData Number where + rnf (I _) = () + rnf (D _) = () + {-# INLINE rnf #-} + +binop :: (Integer -> Integer -> a) -> (Double -> Double -> a) + -> Number -> Number -> a +binop _ d (D a) (D b) = d a b +binop i _ (I a) (I b) = i a b +binop _ d (D a) (I b) = d a (fromIntegral b) +binop _ d (I a) (D b) = d (fromIntegral a) b +{-# INLINE binop #-} + +instance Eq Number where + (==) = binop (==) (==) + {-# INLINE (==) #-} + + (/=) = binop (/=) (/=) + {-# INLINE (/=) #-} + +instance Ord Number where + (<) = binop (<) (<) + {-# INLINE (<) #-} + + (<=) = binop (<=) (<=) + {-# INLINE (<=) #-} + + (>) = binop (>) (>) + {-# INLINE (>) #-} + + (>=) = binop (>=) (>=) + {-# INLINE (>=) #-} + + compare = binop compare compare + {-# INLINE compare #-} + +instance Num Number where + (+) = binop (((I$!).) . (+)) (((D$!).) . (+)) + {-# INLINE (+) #-} + + (-) = binop (((I$!).) . (-)) (((D$!).) . (-)) + {-# INLINE (-) #-} + + (*) = binop (((I$!).) . (*)) (((D$!).) . (*)) + {-# INLINE (*) #-} + + abs (I a) = I $! abs a + abs (D a) = D $! abs a + {-# INLINE abs #-} + + negate (I a) = I $! negate a + negate (D a) = D $! negate a + {-# INLINE negate #-} + + signum (I a) = I $! signum a + signum (D a) = D $! signum a + {-# INLINE signum #-} + + fromInteger = (I$!) . fromInteger + {-# INLINE fromInteger #-} + +instance Real Number where + toRational (I a) = fromIntegral a + toRational (D a) = toRational a + {-# INLINE toRational #-} + +instance Fractional Number where + fromRational = (D$!) . fromRational + {-# INLINE fromRational #-} + + (/) = binop (((D$!).) . (/) `on` fromIntegral) + (((D$!).) . (/)) + {-# INLINE (/) #-} + + recip (I a) = D $! recip (fromIntegral a) + recip (D a) = D $! recip a + {-# INLINE recip #-} + +instance RealFrac Number where + properFraction (I a) = (fromIntegral a,0) + properFraction (D a) = case properFraction a of + (i,d) -> (i,D d) + {-# INLINE properFraction #-} + truncate (I a) = fromIntegral a + truncate (D a) = truncate a + {-# INLINE truncate #-} + round (I a) = fromIntegral a + round (D a) = round a + {-# INLINE round #-} + ceiling (I a) = fromIntegral a + ceiling (D a) = ceiling a + {-# INLINE ceiling #-} + floor (I a) = fromIntegral a + floor (D a) = floor a + {-# INLINE floor #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE b/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE new file mode 100644 index 00000000..97392a62 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) Lennart Kolmodin + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +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. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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. diff --git a/haddock.cabal b/haddock.cabal index 160316e9..fb16a2a9 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -47,7 +47,7 @@ executable haddock build-depends: base >= 4.3 && < 4.11 if flag(in-ghc-tree) - hs-source-dirs: haddock-api/src, haddock-library/vendor/attoparsec-0.12.1.1, haddock-library/src + hs-source-dirs: haddock-api/src, haddock-library/vendor/attoparsec-0.13.1.0, haddock-library/src cpp-options: -DIN_GHC_TREE build-depends: filepath, -- cgit v1.2.3 From c836dd4cb47d457b066b51b61a08f583a8c4466e Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Sat, 13 May 2017 12:48:10 +0200 Subject: Consequently use inClass and notInClass in haddock-library (#617) These allow attoparsec to do some clever lookup optimization --- haddock-library/src/Documentation/Haddock/Parser.hs | 21 +++++++++++++-------- .../src/Documentation/Haddock/Parser/Util.hs | 9 ++++++--- 2 files changed, 19 insertions(+), 11 deletions(-) (limited to 'haddock-library') diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index 123f5612..ddea2b9b 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -143,7 +143,7 @@ specialChar = "_/<@\"&'`# " -- to ensure that we have already given a chance to more meaningful parsers -- before capturing their characers. string' :: Parser (DocH mod a) -string' = DocString . unescape . decodeUtf8 <$> takeWhile1_ (`notElem` specialChar) +string' = DocString . unescape . decodeUtf8 <$> takeWhile1_ (notInClass specialChar) where unescape "" = "" unescape ('\\':x:xs) = x : unescape xs @@ -153,7 +153,7 @@ string' = DocString . unescape . decodeUtf8 <$> takeWhile1_ (`notElem` specialCh -- This is done to skip over any special characters belonging to other -- elements but which were not deemed meaningful at their positions. skipSpecialChar :: Parser (DocH mod a) -skipSpecialChar = DocString . return <$> satisfy (`elem` specialChar) +skipSpecialChar = DocString . return <$> satisfy (inClass specialChar) -- | Emphasis parser. -- @@ -215,7 +215,7 @@ moduleName = DocModule <$> (char '"' *> modid <* char '"') -- accept {small | large | digit | ' } here. But as we can't -- match on unicode characters, this is currently not possible. -- Note that we allow ‘#’ to suport anchors. - <*> (decodeUtf8 <$> takeWhile (`notElem` (" .&[{}(=*)+]!|@/;,^?\"\n"::String))) + <*> (decodeUtf8 <$> takeWhile (notInClass " .&[{}(=*)+]!|@/;,^?\"\n")) -- | Picture parser, surrounded by \<\< and \>\>. It's possible to specify -- a title for the picture. @@ -338,7 +338,7 @@ definitionList :: BS.ByteString -> Parser (DocH mod Identifier) definitionList indent = DocDefList <$> p where p = do - label <- "[" *> (parseStringBS <$> takeWhile1 (`notElem` ("]\n" :: String))) <* ("]" <* optional ":") + label <- "[" *> (parseStringBS <$> takeWhile1 (notInClass "]\n")) <* ("]" <* optional ":") c <- takeLine (cs, items) <- more indent p let contents = parseString . dropNLs . unlines $ c : cs @@ -561,7 +561,7 @@ autoUrl = mkLink <$> url url = mappend <$> ("http://" <|> "https://" <|> "ftp://") <*> takeWhile1 (not . isSpace) mkLink :: BS.ByteString -> DocH mod a mkLink s = case unsnoc s of - Just (xs, x) | x `elem` (",.!?" :: String) -> DocHyperlink (Hyperlink (decodeUtf8 xs) Nothing) `docAppend` DocString [x] + Just (xs, x) | inClass ",.!?" x -> DocHyperlink (Hyperlink (decodeUtf8 xs) Nothing) `docAppend` DocString [x] _ -> DocHyperlink (Hyperlink (decodeUtf8 s) Nothing) -- | Parses strings between identifier delimiters. Consumes all input that it @@ -570,8 +570,13 @@ autoUrl = mkLink <$> url parseValid :: Parser String parseValid = p some where - idChar = satisfy (`elem` ("_.!#$%&*+/<=>?@\\|-~:^"::String)) - <|> digit <|> letter_ascii + idChar = + satisfy (\c -> isAlpha_ascii c + || isDigit c + -- N.B. '-' is placed first otherwise attoparsec thinks + -- it belongs to a character class + || inClass "-_.!#$%&*+/<=>?@\\|~:^" c) + p p' = do vs' <- p' $ utf8String "⋆" <|> return <$> idChar let vs = concat vs' @@ -594,4 +599,4 @@ identifier = do e <- idDelim return $ DocIdentifier (o, vid, e) where - idDelim = char '\'' <|> char '`' + idDelim = satisfy (\c -> c == '\'' || c == '`') diff --git a/haddock-library/src/Documentation/Haddock/Parser/Util.hs b/haddock-library/src/Documentation/Haddock/Parser/Util.hs index d908ce18..ab5e5e9e 100644 --- a/haddock-library/src/Documentation/Haddock/Parser/Util.hs +++ b/haddock-library/src/Documentation/Haddock/Parser/Util.hs @@ -22,7 +22,7 @@ module Documentation.Haddock.Parser.Util ( import Control.Applicative import Control.Monad (mfilter) -import Documentation.Haddock.Parser.Monad +import Documentation.Haddock.Parser.Monad hiding (isHorizontalSpace) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS import Prelude hiding (takeWhile) @@ -40,11 +40,14 @@ unsnoc bs strip :: String -> String strip = (\f -> f . f) $ dropWhile isSpace . reverse +isHorizontalSpace :: Char -> Bool +isHorizontalSpace = inClass " \t\f\v\r" + skipHorizontalSpace :: Parser () -skipHorizontalSpace = skipWhile (`elem` " \t\f\v\r") +skipHorizontalSpace = skipWhile isHorizontalSpace takeHorizontalSpace :: Parser BS.ByteString -takeHorizontalSpace = takeWhile (`elem` " \t\f\v\r") +takeHorizontalSpace = takeWhile isHorizontalSpace makeLabeled :: (String -> Maybe String -> a) -> String -> a makeLabeled f input = case break isSpace $ removeEscapes $ strip input of -- cgit v1.2.3 From fdf1b017b07e12769a7ca605b41dc76842838855 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Tue, 30 May 2017 19:02:12 +0200 Subject: Make haddock-library and haddock-api warning free (#626) --- haddock-api/src/Haddock.hs | 12 ++++++------ haddock-api/src/Haddock/GhcUtils.hs | 4 ---- haddock-api/src/Haddock/Interface/Specialize.hs | 1 - haddock-library/src/Documentation/Haddock/Types.hs | 4 +++- 4 files changed, 9 insertions(+), 12 deletions(-) (limited to 'haddock-library') diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index f0e7e6c7..57ea5fea 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -398,12 +398,12 @@ withGhc' libDir flags ghcActs = runGhc (Just libDir) $ do ghcLink = NoLink } let dynflags'' = updOptLevel 0 $ gopt_unset dynflags' Opt_SplitObjs - defaultCleanupHandler dynflags'' $ do - -- ignore the following return-value, which is a list of packages - -- that may need to be re-linked: Haddock doesn't do any - -- dynamic or static linking at all! - _ <- setSessionDynFlags dynflags'' - ghcActs dynflags'' + + -- ignore the following return-value, which is a list of packages + -- that may need to be re-linked: Haddock doesn't do any + -- dynamic or static linking at all! + _ <- setSessionDynFlags dynflags'' + ghcActs dynflags'' where parseGhcFlags :: MonadIO m => DynFlags -> m DynFlags parseGhcFlags dynflags = do diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index c8e5ea8b..dcc1d834 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -17,17 +17,13 @@ module Haddock.GhcUtils where import Control.Arrow -import Data.Function import Exception import Outputable import Name import Lexeme import Module -import RdrName (GlobalRdrEnv) -import GhcMonad (withSession) import HscTypes -import UniqFM import GHC import Class diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index 8c28cd5a..da8c3e7b 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -27,7 +27,6 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set -import Data.Foldable -- | Instantiate all occurrences of given names with corresponding types. specialize :: forall name a. (Ord name, DataId name, NamedThing name) diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index 4d5bb68a..660878ff 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} +{-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} -- | -- Module : Documentation.Haddock.Types @@ -14,8 +14,10 @@ -- Exposes documentation data types used for (some) of Haddock. module Documentation.Haddock.Types where +#if !MIN_VERSION_base(4,8,0) import Data.Foldable import Data.Traversable +#endif -- | With the advent of 'Version', we may want to start attaching more -- meta-data to comments. We make a structure for this ahead of time -- cgit v1.2.3 From 49a00880ad9bf0405f7da393d9e91523ec70fd2e Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Sat, 8 Jul 2017 00:33:12 +0200 Subject: Avoid missing home module warning (#652) * Avoid missing home module warning * Update haddock-library.cabal --- haddock-api/haddock-api.cabal | 2 ++ haddock-library/haddock-library.cabal | 19 +++++++++++++++++-- haddock.cabal | 7 +++++++ 3 files changed, 26 insertions(+), 2 deletions(-) (limited to 'haddock-library') diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 15215cdb..504a0cae 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -113,6 +113,8 @@ test-suite spec other-modules: Haddock.Backends.Hyperlinker.ParserSpec + Haddock.Backends.Hyperlinker.Parser + Haddock.Backends.Hyperlinker.Types build-depends: base diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index a293039a..3b11761e 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -64,9 +64,24 @@ test-suite spec -DTEST other-modules: + Data.Attoparsec.ByteString + Data.Attoparsec.ByteString.Buffer + Data.Attoparsec.ByteString.Char8 + Data.Attoparsec.ByteString.FastSet + Data.Attoparsec.ByteString.Internal + Data.Attoparsec.Combinator + Data.Attoparsec.Internal + Data.Attoparsec.Internal.Fhthagn + Data.Attoparsec.Internal.Types + 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 - Documentation.Haddock.Parser.UtilSpec build-depends: base @@ -80,7 +95,7 @@ test-suite spec build-tool-depends: hspec-discover:hspec-discover - + source-repository head type: git subdir: haddock-library diff --git a/haddock.cabal b/haddock.cabal index e3c17a02..fa431dbc 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -126,11 +126,18 @@ executable haddock -- we pin down to a single haddock-api version. build-depends: haddock-api == 2.18.0 + other-modules: + ResponseFile + test-suite driver-test type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: Main.hs hs-source-dirs: driver-test, driver + other-modules: + ResponseFile + ResponseFileSpec + build-depends: base, hspec test-suite html-test -- cgit v1.2.3 From 8ed89b1899b32e94ca48f5c70f909d10e740c23a Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Thu, 20 Jul 2017 09:08:47 +0200 Subject: Fix compilation of lib:haddock-library w/ GHC < 8 --- haddock-library/haddock-library.cabal | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'haddock-library') diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 3b11761e..9b967c00 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -50,6 +50,12 @@ library Data.Attoparsec.Number Documentation.Haddock.Parser.Util + ghc-options: -Wall + if impl(ghc >= 8.0) + ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances + else + build-depends: semigroups ^>= 0.18.3, fail ^>= 4.9.0.0 + test-suite spec type: exitcode-stdio-1.0 default-language: Haskell2010 -- cgit v1.2.3 From 8064353244842c8a5b04d99cd5e6bb6430a9b51c Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Thu, 20 Jul 2017 09:20:38 +0200 Subject: Prepare 2.18.1 release (#657) --- CHANGES.md | 2 +- haddock-api/haddock-api.cabal | 2 +- haddock-library/haddock-library.cabal | 2 +- haddock.cabal | 6 +++--- 4 files changed, 6 insertions(+), 6 deletions(-) (limited to 'haddock-library') diff --git a/CHANGES.md b/CHANGES.md index 1cbaf62e..f8a07a6b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,4 @@ -## Changes in version 2.18.0 +## Changes in version 2.18.1 * Synopsis is working again (#599) diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 504a0cae..803eab3f 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -1,5 +1,5 @@ name: haddock-api -version: 2.18.0 +version: 2.18.1 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 9b967c00..c5ad4569 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -1,5 +1,5 @@ name: haddock-library -version: 1.4.3 +version: 1.4.4 synopsis: Library exposing some functionality of Haddock. description: Haddock is a documentation-generation tool for Haskell libraries. These modules expose some functionality of it diff --git a/haddock.cabal b/haddock.cabal index fa431dbc..b74bdcbf 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -1,5 +1,5 @@ name: haddock -version: 2.18.0 +version: 2.18.1 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries @@ -14,7 +14,7 @@ category: Documentation build-type: Simple cabal-version: >= 2.0 stability: experimental -tested-with: GHC==8.2.*, GHC==8.3 +tested-with: GHC==8.2.* extra-source-files: CHANGES.md @@ -124,7 +124,7 @@ executable haddock else -- in order for haddock's advertised version number to have proper meaning, -- we pin down to a single haddock-api version. - build-depends: haddock-api == 2.18.0 + build-depends: haddock-api == 2.18.1 other-modules: ResponseFile -- cgit v1.2.3 From 49f6fad5acd4d94b36e490ee333b521510311429 Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Thu, 20 Jul 2017 10:00:34 +0200 Subject: Avoid trivial use of LambdaCase otherwise we can't test w/ e.g. GHC 7.4.2 --- haddock-library/test/Documentation/Haddock/ParserSpec.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'haddock-library') diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs index 1169eb49..b63ece92 100644 --- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs +++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings, FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Documentation.Haddock.ParserSpec (main, spec) where @@ -57,7 +56,7 @@ spec = do "e" `shouldParseTo` "e" it "allows to backslash-escape characters except \\r" $ do - property $ \case + property $ \y -> case y of '\r' -> "\\\r" `shouldParseTo` DocString "\\" x -> ['\\', x] `shouldParseTo` DocString [x] -- cgit v1.2.3 From 3bf3d4c95c3b32ff350e127ee087c85d5bbb24c6 Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Thu, 20 Jul 2017 10:02:06 +0200 Subject: Refactor .cabal to use sub-lib for vendored lib A practical benefit is that we can control the build-depends and also avoid some recompilation between library and test-suite. --- haddock-library/haddock-library.cabal | 63 +++++++++++++++++++++++------------ 1 file changed, 42 insertions(+), 21 deletions(-) (limited to 'haddock-library') diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index c5ad4569..004011aa 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -24,9 +24,11 @@ library base >= 4.5 && < 4.11 , bytestring >= 0.9.2.1 && < 0.11 , transformers >= 0.3.0 && < 0.6 - , deepseq >= 1.3 && < 1.5 - hs-source-dirs: src, vendor/attoparsec-0.13.1.0 + -- internal sub-lib + build-depends: attoparsec + + hs-source-dirs: src ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 exposed-modules: @@ -37,10 +39,31 @@ library Documentation.Haddock.Utf8 other-modules: - Data.Attoparsec + Documentation.Haddock.Parser.Util + + ghc-options: -Wall + if impl(ghc >= 8.0) + ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances + +library attoparsec + default-language: Haskell2010 + + build-depends: + base >= 4.5 && < 4.11 + , bytestring >= 0.9.2.1 && < 0.11 + , deepseq >= 1.3 && < 1.5 + + hs-source-dirs: vendor/attoparsec-0.13.1.0 + + -- NB: haddock-library needs only small part of lib:attoparsec + -- internally, so we only bundle that subset here + exposed-modules: Data.Attoparsec.ByteString - Data.Attoparsec.ByteString.Buffer Data.Attoparsec.ByteString.Char8 + + other-modules: + Data.Attoparsec + Data.Attoparsec.ByteString.Buffer Data.Attoparsec.ByteString.FastSet Data.Attoparsec.ByteString.Internal Data.Attoparsec.Combinator @@ -48,7 +71,8 @@ library Data.Attoparsec.Internal.Fhthagn Data.Attoparsec.Internal.Types Data.Attoparsec.Number - Documentation.Haddock.Parser.Util + + ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 ghc-options: -Wall if impl(ghc >= 8.0) @@ -56,6 +80,7 @@ library else build-depends: semigroups ^>= 0.18.3, fail ^>= 4.9.0.0 + test-suite spec type: exitcode-stdio-1.0 default-language: Haskell2010 @@ -63,22 +88,12 @@ test-suite spec hs-source-dirs: test , src - , vendor/attoparsec-0.13.1.0 ghc-options: -Wall cpp-options: -DTEST other-modules: - Data.Attoparsec.ByteString - Data.Attoparsec.ByteString.Buffer - Data.Attoparsec.ByteString.Char8 - Data.Attoparsec.ByteString.FastSet - Data.Attoparsec.ByteString.Internal - Data.Attoparsec.Combinator - Data.Attoparsec.Internal - Data.Attoparsec.Internal.Fhthagn - Data.Attoparsec.Internal.Types Documentation.Haddock.Doc Documentation.Haddock.Parser Documentation.Haddock.Parser.Monad @@ -89,18 +104,24 @@ test-suite spec Documentation.Haddock.Utf8 Documentation.Haddock.Utf8Spec + build-depends: + base-compat ^>= 0.9.3 + , transformers >= 0.3.0 && < 0.6 + , hspec ^>= 2.4.4 + , QuickCheck ^>= 2.10 + + -- internal sub-lib + build-depends: attoparsec + + -- Versions for the dependencies below are transitively pinned by + -- dependency on haddock-library:lib:attoparsec build-depends: base , bytestring - , transformers , deepseq - , base-compat - , hspec - , QuickCheck == 2.* - build-tool-depends: - hspec-discover:hspec-discover + hspec-discover:hspec-discover ^>= 2.4.4 source-repository head type: git -- cgit v1.2.3 From bd13010fdc2180b2fad4170c7e94f5c7c721755c Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Thu, 20 Jul 2017 10:19:56 +0200 Subject: Drop obsolete/misleading `stability: experimental` This .cabal property has long been considered obsolete --- haddock-api/haddock-api.cabal | 1 - haddock-library/haddock-library.cabal | 1 - haddock.cabal | 1 - 3 files changed, 3 deletions(-) (limited to 'haddock-library') diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 2b9ea013..059d6282 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -13,7 +13,6 @@ copyright: (c) Simon Marlow, David Waern category: Documentation build-type: Simple cabal-version: >= 2.0 -stability: experimental extra-source-files: CHANGES.md diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 004011aa..1ff52a7b 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -15,7 +15,6 @@ bug-reports: https://github.com/haskell/haddock/issues category: Documentation build-type: Simple cabal-version: >= 2.0 -stability: experimental library default-language: Haskell2010 diff --git a/haddock.cabal b/haddock.cabal index b74bdcbf..be2efb27 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -13,7 +13,6 @@ copyright: (c) Simon Marlow, David Waern category: Documentation build-type: Simple cabal-version: >= 2.0 -stability: experimental tested-with: GHC==8.2.* extra-source-files: -- cgit v1.2.3 From c635a56f2a4ca6274f6a3a5acda0d7284aede2c3 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Thu, 27 Jul 2017 07:28:57 +0200 Subject: Bump haddock to 2.18.2, haddock-library to 1.4.5 --- CHANGES.md | 4 ++++ haddock-api/haddock-api.cabal | 2 +- haddock-library/haddock-library.cabal | 2 +- haddock.cabal | 4 ++-- 4 files changed, 8 insertions(+), 4 deletions(-) (limited to 'haddock-library') diff --git a/CHANGES.md b/CHANGES.md index f8a07a6b..aa8789c0 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,7 @@ +## Changes in version 2.18.2 + + * to be released + ## Changes in version 2.18.1 * Synopsis is working again (#599) diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 059d6282..de959955 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -1,5 +1,5 @@ name: haddock-api -version: 2.18.1 +version: 2.18.2 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 1ff52a7b..2e720d7b 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -1,5 +1,5 @@ name: haddock-library -version: 1.4.4 +version: 1.4.5 synopsis: Library exposing some functionality of Haddock. description: Haddock is a documentation-generation tool for Haskell libraries. These modules expose some functionality of it diff --git a/haddock.cabal b/haddock.cabal index 09650466..36c80f33 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -1,5 +1,5 @@ name: haddock -version: 2.18.1 +version: 2.18.2 synopsis: A documentation-generation tool for Haskell libraries description: This is Haddock, a tool for automatically generating documentation @@ -143,7 +143,7 @@ executable haddock else -- in order for haddock's advertised version number to have proper meaning, -- we pin down to a single haddock-api version. - build-depends: haddock-api == 2.18.1 + build-depends: haddock-api == 2.18.2 other-modules: ResponseFile -- cgit v1.2.3 From 3d3166d75c0012112a49fee4c2f6cbf82de383fa Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Mon, 31 Jul 2017 20:15:32 +0200 Subject: Move `DocMarkup` from haddock-api to haddock-library (#659) * Move `DocMarkup` from haddock-api to haddock-library * Move more markup related functions * Markup module * CHANGELOG --- CHANGES.md | 2 + haddock-api/haddock-api.cabal | 2 +- haddock-api/src/Documentation/Haddock.hs | 6 +- haddock-api/src/Haddock/Backends/Hoogle.hs | 1 + haddock-api/src/Haddock/Backends/LaTeX.hs | 1 + .../src/Haddock/Backends/Xhtml/DocMarkup.hs | 1 + haddock-api/src/Haddock/Types.hs | 32 +---------- haddock-api/src/Haddock/Utils.hs | 67 ---------------------- haddock-library/haddock-library.cabal | 3 +- .../src/Documentation/Haddock/Markup.hs | 59 +++++++++++++++++++ haddock-library/src/Documentation/Haddock/Types.hs | 27 +++++++++ 11 files changed, 100 insertions(+), 101 deletions(-) create mode 100644 haddock-library/src/Documentation/Haddock/Markup.hs (limited to 'haddock-library') diff --git a/CHANGES.md b/CHANGES.md index aa8789c0..bf60817a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,8 @@ * to be released + * Move markup related data types to haddock-library + ## Changes in version 2.18.1 * Synopsis is working again (#599) diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index de959955..6cde7266 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -42,7 +42,7 @@ library , Cabal ^>= 2.0.0 , ghc ^>= 8.2 , ghc-paths ^>= 0.1.0.9 - , haddock-library ^>= 1.4.4 + , haddock-library ^>= 1.4.5 , xhtml ^>= 3000.2.2 -- Versions for the dependencies below are transitively pinned by diff --git a/haddock-api/src/Documentation/Haddock.hs b/haddock-api/src/Documentation/Haddock.hs index 14605e92..10d6849a 100644 --- a/haddock-api/src/Documentation/Haddock.hs +++ b/haddock-api/src/Documentation/Haddock.hs @@ -39,7 +39,8 @@ module Documentation.Haddock ( DocH(..), Example(..), Hyperlink(..), - DocMarkup(..), + DocMarkup, + DocMarkupH(..), Documentation(..), ArgMap, AliasMap, @@ -69,12 +70,11 @@ module Documentation.Haddock ( withGhc ) where - +import Documentation.Haddock.Markup (markup) import Haddock.InterfaceFile import Haddock.Interface import Haddock.Types import Haddock.Options -import Haddock.Utils import Haddock diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 183b669e..3a9f6e43 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -18,6 +18,7 @@ module Haddock.Backends.Hoogle ( import BasicTypes (OverlapFlag(..), OverlapMode(..), SourceText(..)) import InstEnv (ClsInst(..)) +import Documentation.Haddock.Markup import Haddock.GhcUtils import Haddock.Types hiding (Version) import Haddock.Utils hiding (out) diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 18660b3f..1b248d2e 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -16,6 +16,7 @@ module Haddock.Backends.LaTeX ( ) where +import Documentation.Haddock.Markup import Haddock.Types import Haddock.Utils import Haddock.GhcUtils diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs index e36f9528..18c8a0ff 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -20,6 +20,7 @@ module Haddock.Backends.Xhtml.DocMarkup ( ) where import Data.List +import Documentation.Haddock.Markup import Haddock.Backends.Xhtml.Names import Haddock.Backends.Xhtml.Utils import Haddock.Types diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index bfc8e32b..de599bd8 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -189,7 +189,7 @@ data InstalledInterface = InstalledInterface , instSubMap :: Map Name [Name] , instBundledPatSynMap :: Map Name [Name] - + , instFixMap :: Map Name Fixity } @@ -443,6 +443,8 @@ type LDoc id = Located (Doc id) type Doc id = DocH (ModuleName, OccName) id type MDoc id = MetaDoc (ModuleName, OccName) id +type DocMarkup id a = DocMarkupH (ModuleName, OccName) id a + instance (NFData a, NFData mod) => NFData (DocH mod a) where rnf doc = case doc of @@ -494,34 +496,6 @@ exampleToString :: Example -> String exampleToString (Example expression result) = ">>> " ++ expression ++ "\n" ++ unlines result - -data DocMarkup id a = Markup - { markupEmpty :: a - , markupString :: String -> a - , markupParagraph :: a -> a - , markupAppend :: a -> a -> a - , markupIdentifier :: id -> a - , markupIdentifierUnchecked :: (ModuleName, OccName) -> a - , markupModule :: String -> a - , markupWarning :: a -> a - , markupEmphasis :: a -> a - , markupBold :: a -> a - , markupMonospaced :: a -> a - , markupUnorderedList :: [a] -> a - , markupOrderedList :: [a] -> a - , markupDefList :: [(a,a)] -> a - , markupCodeBlock :: a -> a - , markupHyperlink :: Hyperlink -> a - , markupAName :: String -> a - , markupPic :: Picture -> a - , markupMathInline :: String -> a - , markupMathDisplay :: String -> a - , markupProperty :: String -> a - , markupExample :: [Example] -> a - , markupHeader :: Header a -> a - } - - data HaddockModInfo name = HaddockModInfo { hmi_description :: Maybe (Doc name) , hmi_copyright :: Maybe String diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs index 404cfcf6..7a9d65a4 100644 --- a/haddock-api/src/Haddock/Utils.hs +++ b/haddock-api/src/Haddock/Utils.hs @@ -37,8 +37,6 @@ module Haddock.Utils ( html_xrefs_ref, html_xrefs_ref', -- * Doc markup - markup, - idMarkup, mkMeta, -- * List utilities @@ -448,71 +446,6 @@ spanWith p xs@(a:as) | Just b <- p a = let (bs,cs) = spanWith p as in (b:bs,cs) | otherwise = ([],xs) - ------------------------------------------------------------------------------ --- * Put here temporarily ------------------------------------------------------------------------------ - - -markup :: DocMarkup id a -> Doc 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)) - - -markupPair :: DocMarkup id a -> (Doc id, Doc id) -> (a, a) -markupPair m (a,b) = (markup m a, markup m b) - - --- | The identity markup -idMarkup :: DocMarkup a (Doc a) -idMarkup = Markup { - markupEmpty = DocEmpty, - markupString = DocString, - markupParagraph = DocParagraph, - markupAppend = DocAppend, - markupIdentifier = DocIdentifier, - markupIdentifierUnchecked = DocIdentifierUnchecked, - markupModule = DocModule, - markupWarning = DocWarning, - markupEmphasis = DocEmphasis, - markupBold = DocBold, - markupMonospaced = DocMonospaced, - markupUnorderedList = DocUnorderedList, - markupOrderedList = DocOrderedList, - markupDefList = DocDefList, - markupCodeBlock = DocCodeBlock, - markupHyperlink = DocHyperlink, - markupAName = DocAName, - markupPic = DocPic, - markupMathInline = DocMathInline, - markupMathDisplay = DocMathDisplay, - markupProperty = DocProperty, - markupExample = DocExamples, - markupHeader = DocHeader - } - - ----------------------------------------------------------------------------- -- * System tools ----------------------------------------------------------------------------- diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 2e720d7b..44834aa9 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -31,10 +31,11 @@ library ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 exposed-modules: + Documentation.Haddock.Doc + Documentation.Haddock.Markup Documentation.Haddock.Parser Documentation.Haddock.Parser.Monad Documentation.Haddock.Types - Documentation.Haddock.Doc Documentation.Haddock.Utf8 other-modules: diff --git a/haddock-library/src/Documentation/Haddock/Markup.hs b/haddock-library/src/Documentation/Haddock/Markup.hs new file mode 100644 index 00000000..b16cf049 --- /dev/null +++ b/haddock-library/src/Documentation/Haddock/Markup.hs @@ -0,0 +1,59 @@ +module Documentation.Haddock.Markup where + +import Documentation.Haddock.Types + +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)) + +markupPair :: DocMarkupH mod id a -> (DocH mod id, DocH mod id) -> (a, a) +markupPair m (a,b) = (markup m a, markup m b) + +-- | The identity markup +idMarkup :: DocMarkupH mod id (DocH mod id) +idMarkup = Markup { + markupEmpty = DocEmpty, + markupString = DocString, + markupParagraph = DocParagraph, + markupAppend = DocAppend, + markupIdentifier = DocIdentifier, + markupIdentifierUnchecked = DocIdentifierUnchecked, + markupModule = DocModule, + markupWarning = DocWarning, + markupEmphasis = DocEmphasis, + markupBold = DocBold, + markupMonospaced = DocMonospaced, + markupUnorderedList = DocUnorderedList, + markupOrderedList = DocOrderedList, + markupDefList = DocDefList, + markupCodeBlock = DocCodeBlock, + markupHyperlink = DocHyperlink, + markupAName = DocAName, + markupPic = DocPic, + markupMathInline = DocMathInline, + markupMathDisplay = DocMathDisplay, + markupProperty = DocProperty, + markupExample = DocExamples, + markupHeader = DocHeader + } diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index 660878ff..1e87edc0 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -80,3 +80,30 @@ data DocH mod id | DocExamples [Example] | DocHeader (Header (DocH mod id)) deriving (Eq, Show, Functor, Foldable, Traversable) + +data DocMarkupH mod id a = Markup + { markupEmpty :: a + , markupString :: String -> a + , markupParagraph :: a -> a + , markupAppend :: a -> a -> a + , markupIdentifier :: id -> a + , markupIdentifierUnchecked :: mod -> a + , markupModule :: String -> a + , markupWarning :: a -> a + , markupEmphasis :: a -> a + , markupBold :: a -> a + , markupMonospaced :: a -> a + , markupUnorderedList :: [a] -> a + , markupOrderedList :: [a] -> a + , markupDefList :: [(a,a)] -> a + , markupCodeBlock :: a -> a + , markupHyperlink :: Hyperlink -> a + , markupAName :: String -> a + , markupPic :: Picture -> a + , markupMathInline :: String -> a + , markupMathDisplay :: String -> a + , markupProperty :: String -> a + , markupExample :: [Example] -> a + , markupHeader :: Header a -> a + } + -- cgit v1.2.3 From 1ca3ff62bc3be0d9ad03eb7f531197c69182d3a0 Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Mon, 31 Jul 2017 20:35:49 +0200 Subject: Fixup haddock --- haddock-library/src/Documentation/Haddock/Parser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'haddock-library') diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index ddea2b9b..8dc2a801 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -14,7 +14,7 @@ -- library, the most commonly used combination of functions is going -- to be -- --- @'toRegular' . 'parseParas'@ +-- @'toRegular' . '_doc' . 'parseParas'@ module Documentation.Haddock.Parser ( parseString, parseParas , overIdentifier, toRegular, Identifier ) where -- cgit v1.2.3 From 619fd646518c08e7a9e34737eeb526d6e044f25a Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Mon, 31 Jul 2017 21:19:15 +0200 Subject: Changelog for haddock-library --- haddock-library/CHANGES.md | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 haddock-library/CHANGES.md (limited to 'haddock-library') diff --git a/haddock-library/CHANGES.md b/haddock-library/CHANGES.md new file mode 100644 index 00000000..bebb9982 --- /dev/null +++ b/haddock-library/CHANGES.md @@ -0,0 +1,3 @@ +## Changes in version 1.4.5 + + * Move markup related data types to haddock-library -- cgit v1.2.3 From 74d1173fa022cc8f520ff33c2620507522423e42 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Mon, 31 Jul 2017 21:50:24 +0200 Subject: Prepare haddock-library-1.4.5 release --- haddock-library/haddock-library.cabal | 3 ++- haddock-library/src/Documentation/Haddock/Markup.hs | 6 +++++- haddock-library/src/Documentation/Haddock/Types.hs | 8 ++++++++ 3 files changed, 15 insertions(+), 2 deletions(-) (limited to 'haddock-library') diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 44834aa9..0a07094b 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -15,7 +15,8 @@ bug-reports: https://github.com/haskell/haddock/issues category: Documentation build-type: Simple cabal-version: >= 2.0 - +extra-source-files: + CHANGES.md library default-language: Haskell2010 diff --git a/haddock-library/src/Documentation/Haddock/Markup.hs b/haddock-library/src/Documentation/Haddock/Markup.hs index b16cf049..1bf6c084 100644 --- a/haddock-library/src/Documentation/Haddock/Markup.hs +++ b/haddock-library/src/Documentation/Haddock/Markup.hs @@ -1,4 +1,8 @@ -module Documentation.Haddock.Markup where +-- | @since 1.4.5 +module Documentation.Haddock.Markup ( + markup + , idMarkup + ) where import Documentation.Haddock.Types diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index 1e87edc0..0ab6bb4c 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -81,6 +81,14 @@ data DocH mod id | DocHeader (Header (DocH mod id)) deriving (Eq, Show, Functor, Foldable, Traversable) +-- | '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). +-- Use 'Documentation.Haddock.Markup.markup' to apply a 'DocMarkupH' to +-- a 'DocH'. +-- +-- @since 1.4.5 +-- data DocMarkupH mod id a = Markup { markupEmpty :: a , markupString :: String -> a -- cgit v1.2.3 From 1732b91dcdb3eee32f2301fb400f96506bd9ccb4 Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Sun, 6 Aug 2017 12:43:25 +0200 Subject: Bump haddock-library --- haddock-library/haddock-library.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'haddock-library') diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 0a07094b..120af729 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -1,5 +1,5 @@ name: haddock-library -version: 1.4.5 +version: 1.4.6 synopsis: Library exposing some functionality of Haddock. description: Haddock is a documentation-generation tool for Haskell libraries. These modules expose some functionality of it -- cgit v1.2.3 From f1d326b53fbed5d37f2a83c66e73dbbc94a4354f Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Sun, 6 Aug 2017 13:18:02 +0200 Subject: Provide --show-interface option to dump interfaces (#645) * WIP: Provide --show-interface option to dump interfaces Like ghcs own --show-iface this flag dumps a binary interface file to stdout in a human (and machine) readable fashion. Currently it uses json as output format. * Fill all the jsonNull stubs * Rework Bifunctor instance of DocH, update changelog and documentation * replace changelog, bring DocMarkupH doc back * Update CHANGES.md * Update CHANGES.md * Move Control.Arrow up It would result in unused import if the Bifunctor instance is not generated. --- doc/invoking.rst | 5 + haddock-api/haddock-api.cabal | 1 + haddock-api/src/Haddock.hs | 7 ++ haddock-api/src/Haddock/Interface/Json.hs | 109 +++++++++++++++++++++ haddock-api/src/Haddock/Options.hs | 6 ++ haddock-library/CHANGES.md | 6 ++ haddock-library/src/Documentation/Haddock/Types.hs | 33 ++++++- haddock.cabal | 1 + 8 files changed, 167 insertions(+), 1 deletion(-) create mode 100644 haddock-api/src/Haddock/Interface/Json.hs (limited to 'haddock-library') diff --git a/doc/invoking.rst b/doc/invoking.rst index 83087bac..fc1e4410 100644 --- a/doc/invoking.rst +++ b/doc/invoking.rst @@ -88,6 +88,11 @@ The following options are available: :option:`--read-interface` option for more details. The interface file is in a binary format; don't try to read it. +.. option:: --show-interface= + + Dumps a binary interface file to stdout in a human readable fashion. + Uses json as output format. + .. [1] Haddock interface files are not the same as Haskell interface files, I just couldn't think of a better name. diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index ef4bb98c..d38e9149 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -73,6 +73,7 @@ library Haddock.Interface.Rename Haddock.Interface.Create Haddock.Interface.AttachInstances + Haddock.Interface.Json Haddock.Interface.LexParseRn Haddock.Interface.ParseModuleHeader Haddock.Interface.Specialize diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 57ea5fea..554cb416 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -32,6 +32,7 @@ import Haddock.Backends.LaTeX import Haddock.Backends.Hoogle import Haddock.Backends.Hyperlinker import Haddock.Interface +import Haddock.Interface.Json import Haddock.Parser import Haddock.Types import Haddock.Version @@ -68,6 +69,7 @@ import System.Directory (doesDirectoryExist) import GHC hiding (verbosity) import Config import DynFlags hiding (projectVersion, verbosity) +import ErrUtils import Packages import Panic (handleGhcException) import Module @@ -164,6 +166,11 @@ haddockWithGhc ghc args = handleTopExceptions $ do dflags <- getDynFlags + forM_ (optShowInterfaceFile flags) $ \path -> liftIO $ do + mIfaceFile <- readInterfaceFiles freshNameCache [(("", Nothing), path)] + forM_ mIfaceFile $ \(_, ifaceFile) -> do + putMsg dflags (renderJson (jsonInterfaceFile ifaceFile)) + if not (null files) then do (packages, ifaces, homeLinks) <- readPackagesAndProcessModules flags files diff --git a/haddock-api/src/Haddock/Interface/Json.hs b/haddock-api/src/Haddock/Interface/Json.hs new file mode 100644 index 00000000..9a569204 --- /dev/null +++ b/haddock-api/src/Haddock/Interface/Json.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE RecordWildCards #-} +module Haddock.Interface.Json ( + jsonInstalledInterface + , jsonInterfaceFile + , renderJson + ) where + +import BasicTypes +import Json +import Module +import Name +import Outputable + +import Control.Arrow +import Data.Map (Map) +import Data.Bifunctor +import qualified Data.Map as Map + +import Haddock.Types +import Haddock.InterfaceFile + +jsonInterfaceFile :: InterfaceFile -> JsonDoc +jsonInterfaceFile InterfaceFile{..} = + jsonObject [ ("link_env" , jsonMap nameStableString (jsonString . moduleNameString . moduleName) ifLinkEnv) + , ("inst_ifaces", jsonArray (map jsonInstalledInterface ifInstalledIfaces)) + ] + +jsonInstalledInterface :: InstalledInterface -> JsonDoc +jsonInstalledInterface InstalledInterface{..} = jsonObject properties + where + properties = + [ ("module" , jsonModule instMod) + , ("is_sig" , jsonBool instIsSig) + , ("info" , jsonHaddockModInfo instInfo) + , ("doc_map" , jsonMap nameStableString jsonMDoc instDocMap) + , ("arg_map" , jsonMap nameStableString (jsonMap show jsonMDoc) instArgMap) + , ("exports" , jsonArray (map jsonName instExports)) + , ("visible_exports" , jsonArray (map jsonName instVisibleExports)) + , ("options" , jsonArray (map (jsonString . show) instOptions)) + , ("sub_map" , jsonMap nameStableString (jsonArray . map jsonName) instSubMap) + , ("bundled_patsyns" , jsonMap nameStableString (jsonArray . map jsonName) instBundledPatSynMap) + , ("fix_map" , jsonMap nameStableString jsonFixity instFixMap) + ] + +jsonHaddockModInfo :: HaddockModInfo Name -> JsonDoc +jsonHaddockModInfo HaddockModInfo{..} = + jsonObject [ ("description" , jsonMaybe jsonDoc hmi_description) + , ("copyright" , jsonMaybe jsonString hmi_copyright) + , ("maintainer" , jsonMaybe jsonString hmi_maintainer) + , ("stability" , jsonMaybe jsonString hmi_stability) + , ("protability" , jsonMaybe jsonString hmi_portability) + , ("safety" , jsonMaybe jsonString hmi_safety) + , ("language" , jsonMaybe (jsonString . show) hmi_language) + , ("extensions" , jsonArray (map (jsonString . show) hmi_extensions)) + ] + +jsonMap :: (a -> String) -> (b -> JsonDoc) -> Map a b -> JsonDoc +jsonMap f g = jsonObject . map (f *** g) . Map.toList + +jsonMDoc :: MDoc Name -> JsonDoc +jsonMDoc MetaDoc{..} = + jsonObject [ ("meta", jsonObject [("version", jsonMaybe (jsonString . show) (_version _meta))]) + , ("doc", jsonDoc _doc) + ] + +jsonDoc :: Doc Name -> JsonDoc +jsonDoc doc = jsonString (show (bimap (moduleNameString . fst) nameStableString doc)) + +jsonModule :: Module -> JsonDoc +jsonModule = JSString . moduleStableString + +jsonName :: Name -> JsonDoc +jsonName = JSString . nameStableString + +jsonFixity :: Fixity -> JsonDoc +jsonFixity (Fixity _ prec dir) = + jsonObject [ ("prec" , jsonInt prec) + , ("direction" , jsonFixityDirection dir) + ] + +jsonFixityDirection :: FixityDirection -> JsonDoc +jsonFixityDirection InfixL = jsonString "infixl" +jsonFixityDirection InfixR = jsonString "infixr" +jsonFixityDirection InfixN = jsonString "infix" + +renderJson :: JsonDoc -> SDoc +renderJson = renderJSON + +jsonMaybe :: (a -> JsonDoc) -> Maybe a -> JsonDoc +jsonMaybe = maybe jsonNull + +jsonString :: String -> JsonDoc +jsonString = JSString + +jsonObject :: [(String, JsonDoc)] -> JsonDoc +jsonObject = JSObject + +jsonArray :: [JsonDoc] -> JsonDoc +jsonArray = JSArray + +jsonNull :: JsonDoc +jsonNull = JSNull + +jsonInt :: Int -> JsonDoc +jsonInt = JSInt + +jsonBool :: Bool -> JsonDoc +jsonBool = JSBool + diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs index 0449c829..d73d1a79 100644 --- a/haddock-api/src/Haddock/Options.hs +++ b/haddock-api/src/Haddock/Options.hs @@ -25,6 +25,7 @@ module Haddock.Options ( sourceUrls, wikiUrls, optDumpInterfaceFile, + optShowInterfaceFile, optLaTeXStyle, optMathjax, qualification, @@ -53,6 +54,7 @@ data Flag -- | Flag_DocBook | Flag_ReadInterface String | Flag_DumpInterface String + | Flag_ShowInterface String | Flag_Heading String | Flag_Html | Flag_Hoogle @@ -112,6 +114,8 @@ options backwardsCompat = "read an interface from FILE", Option ['D'] ["dump-interface"] (ReqArg Flag_DumpInterface "FILE") "write the resulting interface to FILE", + Option [] ["show-interface"] (ReqArg Flag_ShowInterface "FILE") + "print the interface in a human readable form", -- Option ['S'] ["docbook"] (NoArg Flag_DocBook) -- "output in DocBook XML", Option ['h'] ["html"] (NoArg Flag_Html) @@ -270,6 +274,8 @@ wikiUrls flags = optDumpInterfaceFile :: [Flag] -> Maybe FilePath optDumpInterfaceFile flags = optLast [ str | Flag_DumpInterface str <- flags ] +optShowInterfaceFile :: [Flag] -> Maybe FilePath +optShowInterfaceFile flags = optLast [ str | Flag_ShowInterface str <- flags ] optLaTeXStyle :: [Flag] -> Maybe String optLaTeXStyle flags = optLast [ str | Flag_LaTeXStyle str <- flags ] diff --git a/haddock-library/CHANGES.md b/haddock-library/CHANGES.md index bebb9982..c52908e1 100644 --- a/haddock-library/CHANGES.md +++ b/haddock-library/CHANGES.md @@ -1,3 +1,9 @@ +## Changes in version 1.4.6 + + * to be released + + * Bifunctor instance for DocH + ## Changes in version 1.4.5 * Move markup related data types to haddock-library diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index 0ab6bb4c..22cab425 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -19,6 +19,11 @@ import Data.Foldable import Data.Traversable #endif +#if MIN_VERSION_base(4,8,0) +import Control.Arrow ((***)) +import Data.Bifunctor +#endif + -- | With the advent of 'Version', we may want to start attaching more -- meta-data to comments. We make a structure for this ahead of time -- so we don't have to gut half the core each time we want to add such @@ -81,6 +86,33 @@ data DocH mod id | DocHeader (Header (DocH mod id)) deriving (Eq, Show, Functor, Foldable, Traversable) +#if MIN_VERSION_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) + bimap _ _ (DocString s) = DocString s + 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 (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 (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 _ _ (DocPic picture) = DocPic picture + bimap _ _ (DocMathInline s) = DocMathInline s + bimap _ _ (DocMathDisplay s) = DocMathDisplay s + bimap _ _ (DocAName s) = DocAName s + bimap _ _ (DocProperty s) = DocProperty s + bimap _ _ (DocExamples examples) = DocExamples examples + bimap f g (DocHeader (Header level title)) = DocHeader (Header level (bimap f g title)) +#endif + -- | '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). @@ -114,4 +146,3 @@ data DocMarkupH mod id a = Markup , markupExample :: [Example] -> a , markupHeader :: Header a -> a } - diff --git a/haddock.cabal b/haddock.cabal index 36c80f33..5ae3443c 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -106,6 +106,7 @@ executable haddock Documentation.Haddock Haddock Haddock.Interface + Haddock.Interface.Json Haddock.Interface.Rename Haddock.Interface.Create Haddock.Interface.AttachInstances -- cgit v1.2.3 From 2ad45f618b9ad2a7a5507e83c3990d93b752a3c0 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Wed, 16 Aug 2017 08:20:01 +0200 Subject: Bifoldable and Bitraversable for DocH and MetaDoc --- haddock-library/CHANGES.md | 2 +- haddock-library/src/Documentation/Haddock/Types.hs | 61 ++++++++++++++++++++++ 2 files changed, 62 insertions(+), 1 deletion(-) (limited to 'haddock-library') diff --git a/haddock-library/CHANGES.md b/haddock-library/CHANGES.md index c52908e1..53d17f5e 100644 --- a/haddock-library/CHANGES.md +++ b/haddock-library/CHANGES.md @@ -2,7 +2,7 @@ * to be released - * Bifunctor instance for DocH + * Bifunctor, Bifoldable and Bitraversable instances for DocH and MetaDoc ## Changes in version 1.4.5 diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index 22cab425..48b29075 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -24,6 +24,11 @@ import Control.Arrow ((***)) import Data.Bifunctor #endif +#if MIN_VERSION_base(4,10,0) +import Data.Bifoldable +import Data.Bitraversable +#endif + -- | With the advent of 'Version', we may want to start attaching more -- meta-data to comments. We make a structure for this ahead of time -- so we don't have to gut half the core each time we want to add such @@ -35,6 +40,19 @@ data MetaDoc mod id = , _doc :: DocH mod id } deriving (Eq, Show, Functor, Foldable, Traversable) +#if MIN_VERSION_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) +instance Bifoldable MetaDoc where + bifoldr f g z d = bifoldr f g z (_doc d) + +instance Bitraversable MetaDoc where + bitraverse f g (MetaDoc m d) = MetaDoc m <$> bitraverse f g d +#endif + overDoc :: (DocH a b -> DocH c d) -> MetaDoc a b -> MetaDoc c d overDoc f d = d { _doc = f $ _doc d } @@ -113,6 +131,49 @@ instance Bifunctor DocH where bimap f g (DocHeader (Header level title)) = DocHeader (Header level (bimap f g title)) #endif +#if MIN_VERSION_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 + bifoldr _ g z (DocIdentifier i) = g i z + bifoldr f _ z (DocIdentifierUnchecked m) = f m z + bifoldr f g z (DocWarning doc) = bifoldr f g z doc + bifoldr f g z (DocEmphasis doc) = bifoldr f g z doc + 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 (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 _ _ z _ = z + +instance Bitraversable DocH where + bitraverse _ _ DocEmpty = pure DocEmpty + bitraverse f g (DocAppend docA docB) = DocAppend <$> bitraverse f g docA <*> bitraverse f g docB + bitraverse _ _ (DocString s) = pure (DocString s) + 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 (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 (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 _ _ (DocPic picture) = pure (DocPic picture) + bitraverse _ _ (DocMathInline s) = pure (DocMathInline s) + bitraverse _ _ (DocMathDisplay s) = pure (DocMathDisplay s) + bitraverse _ _ (DocAName s) = pure (DocAName s) + bitraverse _ _ (DocProperty s) = pure (DocProperty s) + bitraverse _ _ (DocExamples examples) = pure (DocExamples examples) + bitraverse f g (DocHeader (Header level title)) = (DocHeader . Header level) <$> bitraverse f g title +#endif + -- | '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). -- cgit v1.2.3 From f7032e5e48c7a6635e1dca607a37a16c8893e94b Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Wed, 16 Aug 2017 09:06:40 +0200 Subject: Refactoring: Make doc renaming monadic This allows us to later throw warnings if can't find an identifier --- haddock-api/src/Haddock/Interface/Create.hs | 127 ++++++++++++--------- haddock-api/src/Haddock/Interface/LexParseRn.hs | 81 ++++++------- haddock-library/src/Documentation/Haddock/Types.hs | 3 + 3 files changed, 116 insertions(+), 95 deletions(-) (limited to 'haddock-library') diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 89f7f71b..87cdb01f 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -30,6 +30,7 @@ import Haddock.Backends.Hyperlinker.Types import Haddock.Backends.Hyperlinker.Ast as Hyperlinker import Haddock.Backends.Hyperlinker.Parser as Hyperlinker +import Data.Bitraversable import qualified Data.ByteString as BS import qualified Data.Map as M import Data.Map (Map) @@ -38,8 +39,6 @@ import Data.Maybe import Data.Monoid import Data.Ord import Control.Applicative -import Control.Arrow (second) -import Control.DeepSeq (force) import Control.Exception (evaluate) import Control.Monad import Data.Traversable @@ -109,7 +108,6 @@ createInterface tm flags modMap instIfaceMap = do exports | OptIgnoreExports `elem` opts = Nothing | otherwise = exports0 - warningMap = mkWarningMap dflags warnings gre exportedNames localBundledPatSyns :: Map Name [Name] localBundledPatSyns = @@ -134,8 +132,10 @@ createInterface tm flags modMap instIfaceMap = do -- Locations of all TH splices splices = [ l | L l (SpliceD _) <- hsmodDecls hsm ] - maps@(!docMap, !argMap, !subMap, !declMap, _) = - mkMaps dflags gre localInsts declsWithDocs + warningMap <- liftErrMsg (mkWarningMap dflags warnings gre exportedNames) + + maps@(!docMap, !argMap, !subMap, !declMap, _) <- + liftErrMsg (mkMaps dflags gre localInsts declsWithDocs) let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap)) @@ -161,7 +161,8 @@ createInterface tm flags modMap instIfaceMap = do let !aliases = mkAliasMap dflags $ tm_renamed_source tm - modWarn = moduleWarning dflags gre warnings + + modWarn <- liftErrMsg (moduleWarning dflags gre warnings) tokenizedSrc <- mkMaybeTokenizedSrc flags tm @@ -245,27 +246,29 @@ lookupModuleDyn dflags Nothing mdlName = -- Warnings ------------------------------------------------------------------------------- -mkWarningMap :: DynFlags -> Warnings -> GlobalRdrEnv -> [Name] -> WarningMap +mkWarningMap :: DynFlags -> Warnings -> GlobalRdrEnv -> [Name] -> ErrMsgM WarningMap mkWarningMap dflags warnings gre exps = case warnings of - NoWarnings -> M.empty - WarnAll _ -> M.empty + NoWarnings -> pure M.empty + WarnAll _ -> pure M.empty WarnSome ws -> - let ws' = [ (n, w) | (occ, w) <- ws, elt <- lookupGlobalRdrEnv gre occ + let ws' = [ (n, w) + | (occ, w) <- ws + , elt <- lookupGlobalRdrEnv gre occ , let n = gre_name elt, n `elem` exps ] - in M.fromList $ map (second $ parseWarning dflags gre) ws' + in M.fromList <$> traverse (bitraverse pure (parseWarning dflags gre)) ws' -moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> Maybe (Doc Name) -moduleWarning _ _ NoWarnings = Nothing -moduleWarning _ _ (WarnSome _) = Nothing -moduleWarning dflags gre (WarnAll w) = Just $ parseWarning dflags gre w +moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> ErrMsgM (Maybe (Doc Name)) +moduleWarning _ _ NoWarnings = pure Nothing +moduleWarning _ _ (WarnSome _) = pure Nothing +moduleWarning dflags gre (WarnAll w) = Just <$> parseWarning dflags gre w -parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> Doc Name -parseWarning dflags gre w = force $ case w of +parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name) +parseWarning dflags gre w = case w of DeprecatedTxt _ msg -> format "Deprecated: " (concatFS $ map (sl_fs . unLoc) msg) WarningTxt _ msg -> format "Warning: " (concatFS $ map (sl_fs . unLoc) msg) where format x xs = DocWarning . DocParagraph . DocAppend (DocString x) - . processDocString dflags gre $ HsDocString xs + <$> processDocString dflags gre (HsDocString xs) ------------------------------------------------------------------------------- @@ -313,16 +316,15 @@ mkMaps :: DynFlags -> GlobalRdrEnv -> [Name] -> [(LHsDecl Name, [HsDocString])] - -> Maps -mkMaps dflags gre instances decls = - let - (a, b, c, d) = unzip4 $ map mappings decls - in ( f' (map (nubByName fst) a) - , f (filterMapping (not . M.null) b) - , f (filterMapping (not . null) c) - , f (filterMapping (not . null) d) - , instanceMap - ) + -> ErrMsgM Maps +mkMaps dflags gre instances decls = do + (a, b, c, d) <- unzip4 <$> traverse mappings decls + pure ( f' (map (nubByName fst) a) + , f (filterMapping (not . M.null) b) + , f (filterMapping (not . null) c) + , f (filterMapping (not . null) d) + , instanceMap + ) where f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b f = M.fromListWith (<>) . concat @@ -334,35 +336,42 @@ mkMaps dflags gre instances decls = filterMapping p = map (filter (p . snd)) mappings :: (LHsDecl Name, [HsDocString]) - -> ( [(Name, MDoc Name)] - , [(Name, Map Int (MDoc Name))] - , [(Name, [Name])] - , [(Name, [LHsDecl Name])] - ) - mappings (ldecl, docStrs) = + -> ErrMsgM ( [(Name, MDoc Name)] + , [(Name, Map Int (MDoc Name))] + , [(Name, [Name])] + , [(Name, [LHsDecl Name])] + ) + mappings (ldecl, docStrs) = do let L l decl = ldecl declDoc :: [HsDocString] -> Map Int HsDocString - -> (Maybe (MDoc Name), Map Int (MDoc Name)) - declDoc strs m = - let doc' = processDocStrings dflags gre strs - m' = M.map (processDocStringParas dflags gre) m - in (doc', m') - (doc, args) = declDoc docStrs (typeDocs decl) + -> ErrMsgM (Maybe (MDoc Name), Map Int (MDoc Name)) + declDoc strs m = do + doc' <- processDocStrings dflags gre strs + m' <- traverse (processDocStringParas dflags gre) m + pure (doc', m') + + (doc, args) <- declDoc docStrs (typeDocs decl) + + let subs :: [(Name, [HsDocString], Map Int HsDocString)] subs = subordinates instanceMap decl - (subDocs, subArgs) = unzip $ map (\(_, strs, m) -> declDoc strs m) subs + + (subDocs, subArgs) <- unzip <$> traverse (\(_, strs, m) -> declDoc strs m) subs + + let ns = names l decl subNs = [ n | (n, _, _) <- subs ] dm = [ (n, d) | (n, Just d) <- zip ns (repeat doc) ++ zip subNs subDocs ] am = [ (n, args) | n <- ns ] ++ zip subNs subArgs sm = [ (n, subNs) | n <- ns ] cm = [ (n, [ldecl]) | n <- ns ++ subNs ] - in seqList ns `seq` - seqList subNs `seq` - doc `seq` - seqList subDocs `seq` - seqList subArgs `seq` - (dm, am, sm, cm) + + seqList ns `seq` + seqList subNs `seq` + doc `seq` + seqList subDocs `seq` + seqList subArgs `seq` + pure (dm, am, sm, cm) instanceMap :: Map SrcSpan Name instanceMap = M.fromList [ (getSrcSpan n, n) | n <- instances ] @@ -602,16 +611,20 @@ mkExportItems -- do so. -- NB: Pass in identity module, so we can look it up in index correctly moduleExports thisMod m dflags warnings gre exportedNames decls modMap instIfaceMap maps fixMap splices - lookupExport (IEGroup lev docStr) = return $ - return . ExportGroup lev "" $ processDocString dflags gre docStr + lookupExport (IEGroup lev docStr) = liftErrMsg $ do + doc <- processDocString dflags gre docStr + return [ExportGroup lev "" doc] - lookupExport (IEDoc docStr) = return $ - return . ExportDoc $ processDocStringParas dflags gre docStr + lookupExport (IEDoc docStr) = liftErrMsg $ do + doc <- processDocStringParas dflags gre docStr + return [ExportDoc doc] lookupExport (IEDocNamed str) = liftErrMsg $ - findNamedDoc str [ unL d | d <- decls ] >>= return . \case - Nothing -> [] - Just doc -> return . ExportDoc $ processDocStringParas dflags gre doc + findNamedDoc str [ unL d | d <- decls ] >>= \case + Nothing -> return [] + Just docStr -> do + doc <- processDocStringParas dflags gre docStr + return [ExportDoc doc] declWith :: [(HsDecl Name, DocForDecl Name)] -> Name -> ErrMsgGhc [ ExportItem Name ] declWith pats t = do @@ -924,9 +937,11 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap mkExportItem :: LHsDecl Name -> ErrMsgGhc (Maybe (ExportItem Name)) mkExportItem (L _ (DocD (DocGroup lev docStr))) = do - return . Just . ExportGroup lev "" $ processDocString dflags gre docStr + doc <- liftErrMsg (processDocString dflags gre docStr) + return . Just . ExportGroup lev "" $ doc mkExportItem (L _ (DocD (DocCommentNamed _ docStr))) = do - return . Just . ExportDoc $ processDocStringParas dflags gre docStr + doc <- liftErrMsg (processDocStringParas dflags gre docStr) + return . Just . ExportDoc $ doc mkExportItem (L l (ValD d)) | name:_ <- collectHsBindBinders d, Just [L _ (ValD _)] <- M.lookup name declMap = -- Top-level binding without type signature. diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs index 4f6b2c09..a38e7667 100644 --- a/haddock-api/src/Haddock/Interface/LexParseRn.hs +++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs @@ -34,20 +34,21 @@ import RdrName import RnEnv (dataTcOccs) processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString] - -> Maybe (MDoc Name) -processDocStrings dflags gre strs = - case metaDocConcat $ map (processDocStringParas dflags gre) strs of + -> ErrMsgM (Maybe (MDoc Name)) +processDocStrings dflags gre strs = do + mdoc <- metaDocConcat <$> traverse (processDocStringParas dflags gre) strs + case mdoc of -- We check that we don't have any version info to render instead -- of just checking if there is no comment: there may not be a -- comment but we still want to pass through any meta data. - MetaDoc { _meta = Meta { _version = Nothing }, _doc = DocEmpty } -> Nothing - x -> Just x + MetaDoc { _meta = Meta { _version = Nothing }, _doc = DocEmpty } -> pure Nothing + x -> pure (Just x) -processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> MDoc Name +processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (MDoc Name) processDocStringParas dflags gre (HsDocString fs) = - overDoc (rename dflags gre) $ parseParas dflags (unpackFS fs) + overDocF (rename dflags gre) $ parseParas dflags (unpackFS fs) -processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> Doc Name +processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (Doc Name) processDocString dflags gre (HsDocString fs) = rename dflags gre $ parseString dflags (unpackFS fs) @@ -60,9 +61,11 @@ processModuleHeader dflags gre safety mayStr = do Just (L _ (HsDocString fs)) -> do let str = unpackFS fs (hmi, doc) = parseModuleHeader dflags str - !descr = rename dflags gre <$> hmi_description hmi - hmi' = hmi { hmi_description = descr } - doc' = overDoc (rename dflags gre) doc + !descr <- case hmi_description hmi of + Just hmi_descr -> Just <$> rename dflags gre hmi_descr + Nothing -> pure Nothing + let hmi' = hmi { hmi_description = descr } + doc' <- overDocF (rename dflags gre) doc return (hmi', Just doc') let flags :: [LangExt.Extension] @@ -82,12 +85,12 @@ processModuleHeader dflags gre safety mayStr = do -- fallbacks in case we can't locate the identifiers. -- -- See the comments in the source for implementation commentary. -rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> Doc Name +rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> ErrMsgM (Doc Name) rename dflags gre = rn where rn d = case d of - DocAppend a b -> DocAppend (rn a) (rn b) - DocParagraph doc -> DocParagraph (rn doc) + DocAppend a b -> DocAppend <$> rn a <*> rn b + DocParagraph doc -> DocParagraph <$> rn doc DocIdentifier x -> do -- Generate the choices for the possible kind of thing this -- is. @@ -100,7 +103,7 @@ rename dflags gre = rn -- We found no names in the env so we start guessing. [] -> case choices of - [] -> DocMonospaced (DocString (showPpr dflags x)) + [] -> pure (DocMonospaced (DocString (showPpr dflags x))) -- There was nothing in the environment so we need to -- pick some default from what's available to us. We -- diverge here from the old way where we would default @@ -109,37 +112,37 @@ rename dflags gre = rn -- type constructor names (such as in #253). So now we -- only get type constructor links if they are actually -- in scope. - a:_ -> outOfScope dflags a + a:_ -> pure (outOfScope dflags a) -- There is only one name in the environment that matches so -- use it. - [a] -> DocIdentifier a + [a] -> pure (DocIdentifier a) -- But when there are multiple names available, default to -- type constructors: somewhat awfully GHC returns the -- values in the list positionally. - a:b:_ | isTyConName a -> DocIdentifier a - | otherwise -> DocIdentifier b + a:b:_ | isTyConName a -> pure (DocIdentifier a) + | otherwise -> pure (DocIdentifier b) - DocWarning doc -> DocWarning (rn doc) - DocEmphasis doc -> DocEmphasis (rn doc) - DocBold doc -> DocBold (rn doc) - DocMonospaced doc -> DocMonospaced (rn doc) - DocUnorderedList docs -> DocUnorderedList (map rn docs) - DocOrderedList docs -> DocOrderedList (map rn docs) - DocDefList list -> DocDefList [ (rn a, rn b) | (a, b) <- list ] - DocCodeBlock doc -> DocCodeBlock (rn doc) - DocIdentifierUnchecked x -> DocIdentifierUnchecked x - DocModule str -> DocModule str - DocHyperlink l -> DocHyperlink l - DocPic str -> DocPic str - DocMathInline str -> DocMathInline str - DocMathDisplay str -> DocMathDisplay str - DocAName str -> DocAName str - DocProperty p -> DocProperty p - DocExamples e -> DocExamples e - DocEmpty -> DocEmpty - DocString str -> DocString str - DocHeader (Header l t) -> DocHeader $ Header l (rn t) + DocWarning doc -> DocWarning <$> rn doc + DocEmphasis doc -> DocEmphasis <$> rn doc + DocBold doc -> DocBold <$> rn doc + DocMonospaced doc -> DocMonospaced <$> rn doc + DocUnorderedList docs -> DocUnorderedList <$> traverse rn docs + DocOrderedList docs -> DocOrderedList <$> traverse rn docs + DocDefList list -> DocDefList <$> traverse (\(a, b) -> (,) <$> rn a <*> rn b) list + DocCodeBlock doc -> DocCodeBlock <$> rn doc + DocIdentifierUnchecked x -> pure (DocIdentifierUnchecked x) + DocModule str -> pure (DocModule str) + DocHyperlink l -> pure (DocHyperlink l) + DocPic str -> pure (DocPic str) + DocMathInline str -> pure (DocMathInline str) + DocMathDisplay str -> pure (DocMathDisplay str) + DocAName str -> pure (DocAName str) + DocProperty p -> pure (DocProperty p) + DocExamples e -> pure (DocExamples e) + DocEmpty -> pure (DocEmpty) + DocString str -> pure (DocString str) + DocHeader (Header l t) -> DocHeader . Header l <$> rn t -- | Wrap an identifier that's out of scope (i.e. wasn't found in -- 'GlobalReaderEnv' during 'rename') in an appropriate doc. Currently diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index 48b29075..1e76c631 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -56,6 +56,9 @@ instance Bitraversable MetaDoc where overDoc :: (DocH a b -> DocH c d) -> MetaDoc a b -> MetaDoc c d overDoc f d = d { _doc = f $ _doc d } +overDocF :: Functor f => (DocH a b -> f (DocH c d)) -> MetaDoc a b -> f (MetaDoc c d) +overDocF f d = (\x -> d { _doc = x }) <$> f (_doc d) + type Version = [Int] data Hyperlink = Hyperlink -- cgit v1.2.3