aboutsummaryrefslogtreecommitdiff
path: root/haddock-library
diff options
context:
space:
mode:
authoralexbiehl <alex.biehl@gmail.com>2017-08-21 20:05:42 +0200
committeralexbiehl <alex.biehl@gmail.com>2017-08-21 20:05:42 +0200
commit7a71af839bd71992a36d97650004c73bf11fa436 (patch)
treee64afbc9df5c97fde6ac6433e42f28df8a4acf49 /haddock-library
parentc8a01b83be52e45d3890db173ffe7b09ccd4f351 (diff)
parent740458ac4d2acf197f2ef8dc94a66f9b160b9c3c (diff)
Merge remote-tracking branch 'origin/master' into ghc-head
Diffstat (limited to 'haddock-library')
-rw-r--r--haddock-library/CHANGES.md9
-rw-r--r--haddock-library/haddock-library.cabal88
-rw-r--r--haddock-library/src/Documentation/Haddock/Markup.hs63
-rw-r--r--haddock-library/src/Documentation/Haddock/Parser.hs23
-rw-r--r--haddock-library/src/Documentation/Haddock/Parser/Util.hs9
-rw-r--r--haddock-library/src/Documentation/Haddock/Types.hs134
-rw-r--r--haddock-library/test/Documentation/Haddock/ParserSpec.hs3
-rw-r--r--haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs)2
-rw-r--r--haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs)15
-rw-r--r--haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs)19
-rw-r--r--haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs)39
-rw-r--r--haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs)2
-rw-r--r--haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs)119
-rw-r--r--haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs)33
-rw-r--r--haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs)45
-rw-r--r--haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs)0
-rw-r--r--haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs)67
-rw-r--r--haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs)2
-rw-r--r--haddock-library/vendor/attoparsec-0.13.1.0/LICENSE (renamed from haddock-library/vendor/attoparsec-0.12.1.1/LICENSE)0
19 files changed, 514 insertions, 158 deletions
diff --git a/haddock-library/CHANGES.md b/haddock-library/CHANGES.md
new file mode 100644
index 00000000..53d17f5e
--- /dev/null
+++ b/haddock-library/CHANGES.md
@@ -0,0 +1,9 @@
+## Changes in version 1.4.6
+
+ * to be released
+
+ * Bifunctor, Bifoldable and Bitraversable instances for DocH and MetaDoc
+
+## Changes in version 1.4.5
+
+ * Move markup related data types to haddock-library
diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal
index cabfbc67..120af729 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.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
@@ -9,37 +9,62 @@ description: Haddock is a documentation-generation tool for Haskell
itself, see the ‘haddock’ package.
license: BSD3
license-file: LICENSE
-maintainer: Simon Hengel <sol@typeful.net>, Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>
+maintainer: Alex Biehl <alexbiehl@gmail.com>, Simon Hengel <sol@typeful.net>, Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>
homepage: http://www.haskell.org/haddock/
bug-reports: https://github.com/haskell/haddock/issues
category: Documentation
build-type: Simple
-cabal-version: >= 1.10
-stability: experimental
-
+cabal-version: >= 2.0
+extra-source-files:
+ CHANGES.md
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
- hs-source-dirs: src, vendor/attoparsec-0.12.1.1
+ -- internal sub-lib
+ build-depends: attoparsec
+
+ hs-source-dirs: src
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:
- 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
@@ -47,8 +72,15 @@ library
Data.Attoparsec.Internal.Fhthagn
Data.Attoparsec.Internal.Types
Data.Attoparsec.Number
- Documentation.Haddock.Parser.Util
- Documentation.Haddock.Utf8
+
+ ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2
+
+ 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
@@ -57,26 +89,40 @@ test-suite spec
hs-source-dirs:
test
, src
- , vendor/attoparsec-0.12.1.1
ghc-options: -Wall
cpp-options:
-DTEST
other-modules:
+ Documentation.Haddock.Doc
+ Documentation.Haddock.Parser
+ Documentation.Haddock.Parser.Monad
+ Documentation.Haddock.Parser.Util
+ Documentation.Haddock.Parser.UtilSpec
Documentation.Haddock.ParserSpec
+ Documentation.Haddock.Types
+ Documentation.Haddock.Utf8
Documentation.Haddock.Utf8Spec
- Documentation.Haddock.Parser.UtilSpec
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 ^>= 2.4.4
source-repository head
type: git
diff --git a/haddock-library/src/Documentation/Haddock/Markup.hs b/haddock-library/src/Documentation/Haddock/Markup.hs
new file mode 100644
index 00000000..1bf6c084
--- /dev/null
+++ b/haddock-library/src/Documentation/Haddock/Markup.hs
@@ -0,0 +1,63 @@
+-- | @since 1.4.5
+module Documentation.Haddock.Markup (
+ markup
+ , idMarkup
+ ) 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/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs
index 123f5612..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
@@ -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
diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs
index 4d5bb68a..1e76c631 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,20 @@
-- 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
+
+#if MIN_VERSION_base(4,8,0)
+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
@@ -28,9 +40,25 @@ 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 }
+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
@@ -78,3 +106,107 @@ data DocH mod id
| DocExamples [Example]
| 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
+
+#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).
+-- 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
+ , 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
+ }
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
"&#x65;" `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]
diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs
index 53d91190..bd3c5592 100644
--- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs
+++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs
@@ -1,6 +1,6 @@
-- |
-- Module : Data.Attoparsec
--- Copyright : Bryan O'Sullivan 2007-2014
+-- Copyright : Bryan O'Sullivan 2007-2015
-- License : BSD3
--
-- Maintainer : bos@serpentine.com
diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs
index da28b723..84e567d9 100644
--- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs
+++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs
@@ -1,6 +1,10 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
-- |
-- Module : Data.Attoparsec.ByteString
--- Copyright : Bryan O'Sullivan 2007-2014
+-- Copyright : Bryan O'Sullivan 2007-2015
-- License : BSD3
--
-- Maintainer : bos@serpentine.com
@@ -59,6 +63,7 @@ module Data.Attoparsec.ByteString
, I.skipWhile
, I.take
, I.scan
+ , I.runScanner
, I.takeWhile
, I.takeWhile1
, I.takeTill
@@ -92,6 +97,7 @@ module Data.Attoparsec.ByteString
) 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
@@ -218,6 +224,7 @@ 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"
+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.12.1.1/Data/Attoparsec/ByteString/Buffer.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs
index 5e32d022..ac94dfcc 100644
--- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs
+++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs
@@ -1,7 +1,7 @@
{-# LANGUAGE BangPatterns #-}
-- |
-- Module : Data.Attoparsec.ByteString.Buffer
--- Copyright : Bryan O'Sullivan 2007-2014
+-- Copyright : Bryan O'Sullivan 2007-2015
-- License : BSD3
--
-- Maintainer : bos@serpentine.com
@@ -57,7 +57,8 @@ 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.Monoid as Mon (Monoid(..))
+import Data.Semigroup (Semigroup(..))
import Data.Word (Word8)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (castPtr, plusPtr)
@@ -65,6 +66,7 @@ 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
@@ -85,18 +87,21 @@ 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 (Buf _ _ _ 0 _) b = b
- mappend a (Buf _ _ _ 0 _) = a
- mappend buf (Buf fp off len _ _) = append buf fp off len
+ mappend = (<>)
- mconcat [] = mempty
+ mconcat [] = Mon.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 _ _ _ 0 _) bs = buffer bs
pappend buf (PS fp off len) = append buf fp off len
append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer
diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs
index 576dded9..7fafba40 100644
--- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs
+++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs
@@ -1,10 +1,13 @@
-{-# LANGUAGE BangPatterns, FlexibleInstances, TypeFamilies,
+{-# 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-2014
+-- Copyright : Bryan O'Sullivan 2007-2015
-- License : BSD3
--
-- Maintainer : bos@serpentine.com
@@ -67,7 +70,7 @@ module Data.Attoparsec.ByteString.Char8
-- * Efficient string handling
, I.string
- , stringCI
+ , I.stringCI
, skipSpace
, skipWhile
, I.take
@@ -94,7 +97,6 @@ module Data.Attoparsec.ByteString.Char8
, decimal
, hexadecimal
, signed
- , Number(..)
-- * Combinators
, try
@@ -120,16 +122,19 @@ module Data.Attoparsec.ByteString.Char8
, I.atEnd
) where
-import Control.Applicative ((*>), (<*), (<$>), (<|>))
+#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.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 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
@@ -155,16 +160,6 @@ instance (a ~ B.ByteString) => IsString (Parser a) where
-- 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.
--
@@ -228,7 +223,7 @@ isDigit c = c >= '0' && c <= '9'
-- | A fast digit predicate.
isDigit_w8 :: Word8 -> Bool
-isDigit_w8 w = w >= 48 && w <= 57
+isDigit_w8 w = w - 48 <= 9
{-# INLINE isDigit_w8 #-}
-- | Match any character.
@@ -265,7 +260,7 @@ isSpace c = (c == ' ') || ('\t' <= c && c <= '\r')
-- | Fast 'Word8' predicate for matching ASCII space characters.
isSpace_w8 :: Word8 -> Bool
-isSpace_w8 w = (w == 32) || (9 <= w && w <= 13)
+isSpace_w8 w = w == 32 || w - 9 <= 4
{-# INLINE isSpace_w8 #-}
@@ -440,9 +435,8 @@ hexadecimal = B8.foldl' step 0 `fmap` I.takeWhile1 isHexDigit
-- | 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)
+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 #-}
@@ -467,3 +461,4 @@ signed :: Num a => Parser a -> Parser a
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.13.1.0/Data/Attoparsec/ByteString/FastSet.hs
index cb615167..d15854c4 100644
--- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs
+++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs
@@ -3,7 +3,7 @@
-----------------------------------------------------------------------------
-- |
-- Module : Data.Attoparsec.ByteString.FastSet
--- Copyright : Bryan O'Sullivan 2007-2014
+-- Copyright : Bryan O'Sullivan 2007-2015
-- License : BSD3
--
-- Maintainer : bos@serpentine.com
diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs
index f6ec3b32..4938ea87 100644
--- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs
+++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs
@@ -1,7 +1,8 @@
-{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings, RecordWildCards #-}
+{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes,
+ RecordWildCards #-}
-- |
-- Module : Data.Attoparsec.ByteString.Internal
--- Copyright : Bryan O'Sullivan 2007-2014
+-- Copyright : Bryan O'Sullivan 2007-2015
-- License : BSD3
--
-- Maintainer : bos@serpentine.com
@@ -46,7 +47,7 @@ module Data.Attoparsec.ByteString.Internal
-- * Efficient string handling
, skipWhile
, string
- , stringTransform
+ , stringCI
, take
, scan
, runScanner
@@ -65,7 +66,10 @@ module Data.Attoparsec.ByteString.Internal
, atEnd
) where
-import Control.Applicative ((<|>), (<$>))
+#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)
@@ -74,6 +78,7 @@ 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)
@@ -136,22 +141,15 @@ storable = hack undefined
hack :: Storable b => b -> Parser b
hack dummy = do
(fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy)
- return . B.inlinePerformIO . withForeignPtr fp $ \p ->
+ return . 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)
+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
@@ -170,13 +168,59 @@ take n = takeWith n (const True)
-- 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)
+string s = string_ (stringSuspended id) id s
{-# INLINE string #-}
-stringTransform :: (ByteString -> ByteString) -> ByteString
- -> Parser ByteString
-stringTransform f s = takeWith (B.length s) ((==f s) . f)
-{-# INLINE stringTransform #-}
+-- 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 ()
@@ -213,15 +257,24 @@ takeTill p = takeWhile (not . p)
-- 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 []
+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 (s:acc)
-{-# INLINE takeWhile #-}
+ else return $ concatReverse (s:acc)
+{-# INLINE takeWhileAcc #-}
takeRest :: Parser [ByteString]
takeRest = go []
@@ -285,16 +338,13 @@ scan_ f s0 p = go [] s0
-- 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
+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 -> return (B.concat (reverse xs), 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
@@ -314,8 +364,9 @@ takeWhile1 p = do
advance len
eoc <- endOfChunk
if eoc
- then (s<>) `fmap` takeWhile p
+ then takeWhileAcc p [s]
else return s
+{-# INLINE takeWhile1 #-}
-- | Match any byte in a set.
--
@@ -416,9 +467,10 @@ parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK
-- @
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!"
+ Fail _ [] err -> Left err
+ Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err)
+ Done _ a -> Right a
+ _ -> error "parseOnly: impossible error!"
{-# INLINE parseOnly #-}
get :: Parser ByteString
@@ -465,7 +517,6 @@ ensure n = T.Parser $ \t pos more lose succ ->
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
diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs
index 65788ce9..dde0c27a 100644
--- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs
+++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs
@@ -1,7 +1,10 @@
-{-# LANGUAGE BangPatterns #-}
+{-# 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-2014
+-- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2015
-- License : BSD3
--
-- Maintainer : bos@serpentine.com
@@ -33,15 +36,18 @@ module Data.Attoparsec.Combinator
, satisfyElem
, endOfInput
, atEnd
+ , lookAhead
) where
-import Control.Applicative (Alternative(..), Applicative(..), empty, liftA2,
- many, (<|>), (*>), (<$>))
+#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 Data.Monoid (Monoid(mappend))
import Prelude hiding (succ)
-- | Attempt a parse, and if it fails, rewind the input so that no
@@ -120,7 +126,7 @@ many1' p = liftM2' (:) p (many' p)
-- | @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 ",")
+-- > 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
@@ -130,7 +136,7 @@ sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure []
-- 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 ",")
+-- > 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 [])
@@ -140,7 +146,7 @@ sepBy' p s = scan `mplus` return []
-- | @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 ",")
+-- > 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 [])
@@ -151,7 +157,7 @@ sepBy1 p s = scan
-- 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 ",")
+-- > 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 [])
@@ -214,7 +220,14 @@ eitherP a b = (Left <$> a) <|> (Right <$> b)
-- | 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 (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.12.1.1/Data/Attoparsec/Internal.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs
index 371770a9..ee758b26 100644
--- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs
+++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-}
-- |
-- Module : Data.Attoparsec.Internal
--- Copyright : Bryan O'Sullivan 2007-2014
+-- Copyright : Bryan O'Sullivan 2007-2015
-- License : BSD3
--
-- Maintainer : bos@serpentine.com
@@ -15,17 +15,20 @@ module Data.Attoparsec.Internal
( compareResults
, prompt
, demandInput
+ , demandInput_
, wantInput
, endOfInput
, atEnd
, satisfyElem
+ , concatReverse
) where
+#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
-#if __GLASGOW_HASKELL__ >= 700
-import Data.ByteString (ByteString)
+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.
@@ -41,8 +44,8 @@ compareResults (Done t0 r0) (Done t1 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.
+-- | 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)
@@ -52,14 +55,12 @@ 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.
@@ -67,12 +68,22 @@ 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"
+ _ -> 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'
-#if __GLASGOW_HASKELL__ >= 700
{-# SPECIALIZE demandInput :: Parser ByteString () #-}
-#endif
+
+-- | 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
@@ -97,9 +108,7 @@ endOfInput = Parser $ \t pos more lose succ ->
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.
@@ -120,14 +129,12 @@ satisfySuspended p t pos more lose succ =
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
@@ -140,3 +147,11 @@ satisfyElem p = Parser $ \t pos more lose succ ->
| 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.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs
index 0e00ed2c..0e00ed2c 100644
--- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs
+++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs
diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs
index 9c7994e9..96bc319e 100644
--- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs
+++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs
@@ -2,7 +2,7 @@
Rank2Types, RecordWildCards, TypeFamilies #-}
-- |
-- Module : Data.Attoparsec.Internal.Types
--- Copyright : Bryan O'Sullivan 2007-2014
+-- Copyright : Bryan O'Sullivan 2007-2015
-- License : BSD3
--
-- Maintainer : bos@serpentine.com
@@ -25,14 +25,17 @@ module Data.Attoparsec.Internal.Types
, Chunk(..)
) where
-import Control.Applicative (Alternative(..), Applicative(..), (<$>))
+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 Data.Monoid (Monoid(..))
import Prelude hiding (getChar, succ)
import qualified Data.Attoparsec.ByteString.Buffer as B
@@ -63,10 +66,13 @@ data IResult i r =
-- 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]
+ 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
@@ -79,8 +85,8 @@ instance Functor (IResult i) where
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.
+-- | The core parser type. This is parameterised over the type @i@
+-- of string being processed.
--
-- This type is an instance of the following classes:
--
@@ -116,17 +122,19 @@ type Success i t a r = t -> Pos -> More -> a -> IResult i r
data More = Complete | Incomplete
deriving (Eq, Show)
-instance Monoid More where
- mappend c@Complete _ = c
- mappend _ m = m
- mempty = Incomplete
+instance Semigroup More where
+ c@Complete <> _ = c
+ _ <> m = m
+
+instance Mon.Monoid More where
+ mappend = (<>)
+ 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
+ fail = Fail.fail
{-# INLINE fail #-}
- return = pure
+ return = App.pure
{-# INLINE return #-}
m >>= k = Parser $ \t !pos more lose succ ->
@@ -134,6 +142,15 @@ instance Monad (Parser i) where
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
@@ -162,19 +179,19 @@ instance Applicative (Parser i) where
{-# 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
+ 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 = plus
+ mappend = (<>)
{-# INLINE mappend #-}
instance Alternative (Parser i) where
@@ -186,7 +203,7 @@ instance Alternative (Parser i) where
many v = many_v
where many_v = some_v <|> pure []
- some_v = (:) <$> v <*> many_v
+ some_v = (:) App.<$> v <*> many_v
{-# INLINE many #-}
some v = some_v
@@ -195,10 +212,6 @@ instance Alternative (Parser i) where
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
diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs
index 7438a912..d0970d90 100644
--- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs
+++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs
@@ -1,7 +1,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
-- |
-- Module : Data.Attoparsec.Number
--- Copyright : Bryan O'Sullivan 2007-2014
+-- Copyright : Bryan O'Sullivan 2007-2015
-- License : BSD3
--
-- Maintainer : bos@serpentine.com
diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/LICENSE b/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE
index 97392a62..97392a62 100644
--- a/haddock-library/vendor/attoparsec-0.12.1.1/LICENSE
+++ b/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE