diff options
Diffstat (limited to 'haddock-library')
| -rw-r--r-- | haddock-library/CHANGES.md | 9 | ||||
| -rw-r--r-- | haddock-library/haddock-library.cabal | 88 | ||||
| -rw-r--r-- | haddock-library/src/Documentation/Haddock/Markup.hs | 63 | ||||
| -rw-r--r-- | haddock-library/src/Documentation/Haddock/Parser.hs | 23 | ||||
| -rw-r--r-- | haddock-library/src/Documentation/Haddock/Parser/Util.hs | 9 | ||||
| -rw-r--r-- | haddock-library/src/Documentation/Haddock/Types.hs | 134 | ||||
| -rw-r--r-- | haddock-library/test/Documentation/Haddock/ParserSpec.hs | 3 | ||||
| -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 "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] 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 |