haddock-library-1.4.2/src/0000755000000000000000000000000012723656400013537 5ustar0000000000000000haddock-library-1.4.2/src/Documentation/0000755000000000000000000000000012723656400016350 5ustar0000000000000000haddock-library-1.4.2/src/Documentation/Haddock/0000755000000000000000000000000012723656400017705 5ustar0000000000000000haddock-library-1.4.2/src/Documentation/Haddock/Parser/0000755000000000000000000000000012724376220021141 5ustar0000000000000000haddock-library-1.4.2/test/0000755000000000000000000000000012723656400013727 5ustar0000000000000000haddock-library-1.4.2/test/Documentation/0000755000000000000000000000000012723656400016540 5ustar0000000000000000haddock-library-1.4.2/test/Documentation/Haddock/0000755000000000000000000000000012723656400020075 5ustar0000000000000000haddock-library-1.4.2/test/Documentation/Haddock/Parser/0000755000000000000000000000000012723656400021331 5ustar0000000000000000haddock-library-1.4.2/vendor/0000755000000000000000000000000012723656400014245 5ustar0000000000000000haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/0000755000000000000000000000000012723656400017266 5ustar0000000000000000haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/0000755000000000000000000000000012723656400020137 5ustar0000000000000000haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/Attoparsec/0000755000000000000000000000000012723656400022244 5ustar0000000000000000haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/0000755000000000000000000000000012723656400024336 5ustar0000000000000000haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/0000755000000000000000000000000012723656400024020 5ustar0000000000000000haddock-library-1.4.2/src/Documentation/Haddock/Parser.hs0000644000000000000000000005334512723656400021507 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} -- | -- Module : Documentation.Haddock.Parser -- Copyright : (c) Mateusz Kowalczyk 2013-2014, -- Simon Hengel 2013 -- License : BSD-like -- -- Maintainer : haddock@projects.haskell.org -- Stability : experimental -- Portability : portable -- -- Parser used for Haddock comments. For external users of this -- library, the most commonly used combination of functions is going -- to be -- -- @'toRegular' . 'parseParas'@ module Documentation.Haddock.Parser ( parseString, parseParas , overIdentifier, toRegular, Identifier ) where import Control.Applicative import Control.Arrow (first) import Control.Monad import qualified Data.ByteString.Char8 as BS import Data.Char (chr, isAsciiUpper) import Data.List (stripPrefix, intercalate, unfoldr) import Data.Maybe (fromMaybe) import Data.Monoid import Documentation.Haddock.Doc import Documentation.Haddock.Parser.Monad hiding (take, endOfLine) import Documentation.Haddock.Parser.Util import Documentation.Haddock.Types import Documentation.Haddock.Utf8 import Prelude hiding (takeWhile) -- $setup -- >>> :set -XOverloadedStrings -- | Identifier string surrounded with opening and closing quotes/backticks. type Identifier = (Char, String, Char) -- | Drops the quotes/backticks around all identifiers, as if they -- were valid but still 'String's. toRegular :: DocH mod Identifier -> DocH mod String toRegular = fmap (\(_, x, _) -> x) -- | Maps over 'DocIdentifier's over 'String' with potentially failing -- conversion using user-supplied function. If the conversion fails, -- the identifier is deemed to not be valid and is treated as a -- regular string. overIdentifier :: (String -> Maybe a) -> DocH mod Identifier -> DocH mod a overIdentifier f d = g d where g (DocIdentifier (o, x, e)) = case f x of Nothing -> DocString $ o : x ++ [e] Just x' -> DocIdentifier x' g DocEmpty = DocEmpty g (DocAppend x x') = DocAppend (g x) (g x') g (DocString x) = DocString x g (DocParagraph x) = DocParagraph $ g x g (DocIdentifierUnchecked x) = DocIdentifierUnchecked x g (DocModule x) = DocModule x g (DocWarning x) = DocWarning $ g x g (DocEmphasis x) = DocEmphasis $ g x g (DocMonospaced x) = DocMonospaced $ g x g (DocBold x) = DocBold $ g x g (DocUnorderedList x) = DocUnorderedList $ fmap g x g (DocOrderedList x) = DocOrderedList $ fmap g x g (DocDefList x) = DocDefList $ fmap (\(y, z) -> (g y, g z)) x g (DocCodeBlock x) = DocCodeBlock $ g x g (DocHyperlink x) = DocHyperlink x g (DocPic x) = DocPic x g (DocMathInline x) = DocMathInline x g (DocMathDisplay x) = DocMathDisplay x g (DocAName x) = DocAName x g (DocProperty x) = DocProperty x g (DocExamples x) = DocExamples x g (DocHeader (Header l x)) = DocHeader . Header l $ g x parse :: Parser a -> BS.ByteString -> (ParserState, a) parse p = either err id . parseOnly (p <* endOfInput) where err = error . ("Haddock.Parser.parse: " ++) -- | Main entry point to the parser. Appends the newline character -- to the input string. parseParas :: String -- ^ String to parse -> MetaDoc mod Identifier parseParas input = case parseParasState input of (state, a) -> MetaDoc { _meta = Meta { _version = parserStateSince state } , _doc = a } parseParasState :: String -> (ParserState, DocH mod Identifier) parseParasState = parse (p <* skipSpace) . encodeUtf8 . (++ "\n") . filter (/= '\r') where p :: Parser (DocH mod Identifier) p = docConcat <$> paragraph `sepBy` many (skipHorizontalSpace *> "\n") parseParagraphs :: String -> Parser (DocH mod Identifier) parseParagraphs input = case parseParasState input of (state, a) -> setParserState state >> return a -- | Parse a text paragraph. Actually just a wrapper over 'parseStringBS' which -- drops leading whitespace and encodes the string to UTF8 first. parseString :: String -> DocH mod Identifier parseString = parseStringBS . encodeUtf8 . dropWhile isSpace . filter (/= '\r') parseStringBS :: BS.ByteString -> DocH mod Identifier parseStringBS = snd . parse p where p :: Parser (DocH mod Identifier) p = docConcat <$> many (monospace <|> anchor <|> identifier <|> moduleName <|> picture <|> mathDisplay <|> mathInline <|> markdownImage <|> hyperlink <|> bold <|> emphasis <|> encodedChar <|> string' <|> skipSpecialChar) -- | Parses and processes -- -- -- >>> parseString "A" -- DocString "A" encodedChar :: Parser (DocH mod a) encodedChar = "&#" *> c <* ";" where c = DocString . return . chr <$> num num = hex <|> decimal hex = ("x" <|> "X") *> hexadecimal -- | List of characters that we use to delimit any special markup. -- Once we have checked for any of these and tried to parse the -- relevant markup, we can assume they are used as regular text. specialChar :: [Char] specialChar = "_/<@\"&'`# " -- | Plain, regular parser for text. Called as one of the last parsers -- to ensure that we have already given a chance to more meaningful parsers -- before capturing their characers. string' :: Parser (DocH mod a) string' = DocString . unescape . decodeUtf8 <$> takeWhile1_ (`notElem` specialChar) where unescape "" = "" unescape ('\\':x:xs) = x : unescape xs unescape (x:xs) = x : unescape xs -- | Skips a single special character and treats it as a plain string. -- 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) -- | Emphasis parser. -- -- >>> parseString "/Hello world/" -- DocEmphasis (DocString "Hello world") emphasis :: Parser (DocH mod Identifier) emphasis = DocEmphasis . parseStringBS <$> mfilter ('\n' `BS.notElem`) ("/" *> takeWhile1_ (/= '/') <* "/") -- | Bold parser. -- -- >>> parseString "__Hello world__" -- DocBold (DocString "Hello world") bold :: Parser (DocH mod Identifier) bold = DocBold . parseStringBS <$> disallowNewline ("__" *> takeUntil "__") disallowNewline :: Parser BS.ByteString -> Parser BS.ByteString disallowNewline = mfilter ('\n' `BS.notElem`) -- | Like `takeWhile`, but unconditionally take escaped characters. takeWhile_ :: (Char -> Bool) -> Parser BS.ByteString takeWhile_ p = scan False p_ where p_ escaped c | escaped = Just False | not $ p c = Nothing | otherwise = Just (c == '\\') -- | Like `takeWhile1`, but unconditionally take escaped characters. takeWhile1_ :: (Char -> Bool) -> Parser BS.ByteString takeWhile1_ = mfilter (not . BS.null) . takeWhile_ -- | Text anchors to allow for jumping around the generated documentation. -- -- >>> parseString "#Hello world#" -- DocAName "Hello world" anchor :: Parser (DocH mod a) anchor = DocAName . decodeUtf8 <$> disallowNewline ("#" *> takeWhile1_ (/= '#') <* "#") -- | Monospaced strings. -- -- >>> parseString "@cruel@" -- DocMonospaced (DocString "cruel") monospace :: Parser (DocH mod Identifier) monospace = DocMonospaced . parseStringBS <$> ("@" *> takeWhile1_ (/= '@') <* "@") -- | Module names: we try our reasonable best to only allow valid -- Haskell module names, with caveat about not matching on technically -- valid unicode symbols. moduleName :: Parser (DocH mod a) moduleName = DocModule <$> (char '"' *> modid <* char '"') where modid = intercalate "." <$> conid `sepBy1` "." conid = (:) <$> satisfy isAsciiUpper -- NOTE: According to Haskell 2010 we should actually only -- 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))) -- | Picture parser, surrounded by \<\< and \>\>. It's possible to specify -- a title for the picture. -- -- >>> parseString "<>" -- DocPic (Picture {pictureUri = "hello.png", pictureTitle = Nothing}) -- >>> parseString "<>" -- DocPic (Picture {pictureUri = "hello.png", pictureTitle = Just "world"}) picture :: Parser (DocH mod a) picture = DocPic . makeLabeled Picture . decodeUtf8 <$> disallowNewline ("<<" *> takeUntil ">>") -- | Inline math parser, surrounded by \\( and \\). -- -- >>> parseString "\\(\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\)" -- DocMathInline "\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}" mathInline :: Parser (DocH mod a) mathInline = DocMathInline . decodeUtf8 <$> disallowNewline ("\\(" *> takeUntil "\\)") -- | Display math parser, surrounded by \\[ and \\]. -- -- >>> parseString "\\[\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}\\]" -- DocMathDisplay "\\int_{-\\infty}^{\\infty} e^{-x^2/2} = \\sqrt{2\\pi}" mathDisplay :: Parser (DocH mod a) mathDisplay = DocMathDisplay . decodeUtf8 <$> ("\\[" *> takeUntil "\\]") markdownImage :: Parser (DocH mod a) markdownImage = fromHyperlink <$> ("!" *> linkParser) where fromHyperlink (Hyperlink url label) = DocPic (Picture url label) -- | Paragraph parser, called by 'parseParas'. paragraph :: Parser (DocH mod Identifier) paragraph = examples <|> do indent <- takeIndent choice [ since , unorderedList indent , orderedList indent , birdtracks , codeblock , property , header , textParagraphThatStartsWithMarkdownLink , definitionList indent , docParagraph <$> textParagraph ] since :: Parser (DocH mod a) since = ("@since " *> version <* skipHorizontalSpace <* endOfLine) >>= setSince >> return DocEmpty where version = decimal `sepBy1'` "." -- | Headers inside the comment denoted with @=@ signs, up to 6 levels -- deep. -- -- >>> snd <$> parseOnly header "= Hello" -- Right (DocHeader (Header {headerLevel = 1, headerTitle = DocString "Hello"})) -- >>> snd <$> parseOnly header "== World" -- Right (DocHeader (Header {headerLevel = 2, headerTitle = DocString "World"})) header :: Parser (DocH mod Identifier) header = do let psers = map (string . encodeUtf8 . concat . flip replicate "=") [6, 5 .. 1] pser = foldl1 (<|>) psers delim <- decodeUtf8 <$> pser line <- skipHorizontalSpace *> nonEmptyLine >>= return . parseString rest <- paragraph <|> return DocEmpty return $ DocHeader (Header (length delim) line) `docAppend` rest textParagraph :: Parser (DocH mod Identifier) textParagraph = parseString . intercalate "\n" <$> many1 nonEmptyLine textParagraphThatStartsWithMarkdownLink :: Parser (DocH mod Identifier) textParagraphThatStartsWithMarkdownLink = docParagraph <$> (docAppend <$> markdownLink <*> optionalTextParagraph) where optionalTextParagraph :: Parser (DocH mod Identifier) optionalTextParagraph = (docAppend <$> whitespace <*> textParagraph) <|> pure DocEmpty whitespace :: Parser (DocH mod a) whitespace = DocString <$> (f <$> takeHorizontalSpace <*> optional "\n") where f :: BS.ByteString -> Maybe BS.ByteString -> String f xs (fromMaybe "" -> x) | BS.null (xs <> x) = "" | otherwise = " " -- | Parses unordered (bullet) lists. unorderedList :: BS.ByteString -> Parser (DocH mod Identifier) unorderedList indent = DocUnorderedList <$> p where p = ("*" <|> "-") *> innerList indent p -- | Parses ordered lists (numbered or dashed). orderedList :: BS.ByteString -> Parser (DocH mod Identifier) orderedList indent = DocOrderedList <$> p where p = (paren <|> dot) *> innerList indent p dot = (decimal :: Parser Int) <* "." paren = "(" *> decimal <* ")" -- | Generic function collecting any further lines belonging to the -- list entry and recursively collecting any further lists in the -- same paragraph. Usually used as -- -- > someListFunction = listBeginning *> innerList someListFunction innerList :: BS.ByteString -> Parser [DocH mod Identifier] -> Parser [DocH mod Identifier] innerList indent item = do c <- takeLine (cs, items) <- more indent item let contents = docParagraph . parseString . dropNLs . unlines $ c : cs return $ case items of Left p -> [contents `docAppend` p] Right i -> contents : i -- | Parses definition lists. definitionList :: BS.ByteString -> Parser (DocH mod Identifier) definitionList indent = DocDefList <$> p where p = do label <- "[" *> (parseStringBS <$> takeWhile1 (`notElem` ("]\n" :: String))) <* ("]" <* optional ":") c <- takeLine (cs, items) <- more indent p let contents = parseString . dropNLs . unlines $ c : cs return $ case items of Left x -> [(label, contents `docAppend` x)] Right i -> (label, contents) : i -- | Drops all trailing newlines. dropNLs :: String -> String dropNLs = reverse . dropWhile (== '\n') . reverse -- | Main worker for 'innerList' and 'definitionList'. -- We need the 'Either' here to be able to tell in the respective functions -- whether we're dealing with the next list or a nested paragraph. more :: Monoid a => BS.ByteString -> Parser a -> Parser ([String], Either (DocH mod Identifier) a) more indent item = innerParagraphs indent <|> moreListItems indent item <|> moreContent indent item <|> pure ([], Right mempty) -- | Used by 'innerList' and 'definitionList' to parse any nested paragraphs. innerParagraphs :: BS.ByteString -> Parser ([String], Either (DocH mod Identifier) a) innerParagraphs indent = (,) [] . Left <$> ("\n" *> indentedParagraphs indent) -- | Attempts to fetch the next list if possibly. Used by 'innerList' and -- 'definitionList' to recursively grab lists that aren't separated by a whole -- paragraph. moreListItems :: BS.ByteString -> Parser a -> Parser ([String], Either (DocH mod Identifier) a) moreListItems indent item = (,) [] . Right <$> indentedItem where indentedItem = string indent *> skipSpace *> item -- | Helper for 'innerList' and 'definitionList' which simply takes -- a line of text and attempts to parse more list content with 'more'. moreContent :: Monoid a => BS.ByteString -> Parser a -> Parser ([String], Either (DocH mod Identifier) a) moreContent indent item = first . (:) <$> nonEmptyLine <*> more indent item -- | Parses an indented paragraph. -- The indentation is 4 spaces. indentedParagraphs :: BS.ByteString -> Parser (DocH mod Identifier) indentedParagraphs indent = (concat <$> dropFrontOfPara indent') >>= parseParagraphs where indent' = string $ BS.append indent " " -- | Grab as many fully indented paragraphs as we can. dropFrontOfPara :: Parser BS.ByteString -> Parser [String] dropFrontOfPara sp = do currentParagraph <- some (sp *> takeNonEmptyLine) followingParagraphs <- skipHorizontalSpace *> nextPar -- we have more paragraphs to take <|> skipHorizontalSpace *> nlList -- end of the ride, remember the newline <|> endOfInput *> return [] -- nothing more to take at all return (currentParagraph ++ followingParagraphs) where nextPar = (++) <$> nlList <*> dropFrontOfPara sp nlList = "\n" *> return ["\n"] nonSpace :: BS.ByteString -> Parser BS.ByteString nonSpace xs | not $ any (not . isSpace) $ decodeUtf8 xs = fail "empty line" | otherwise = return xs -- | Takes a non-empty, not fully whitespace line. -- -- Doesn't discard the trailing newline. takeNonEmptyLine :: Parser String takeNonEmptyLine = do (++ "\n") . decodeUtf8 <$> (takeWhile1 (/= '\n') >>= nonSpace) <* "\n" -- | Takes indentation of first non-empty line. -- -- More precisely: skips all whitespace-only lines and returns indentation -- (horizontal space, might be empty) of that non-empty line. takeIndent :: Parser BS.ByteString takeIndent = do indent <- takeHorizontalSpace "\n" *> takeIndent <|> return indent -- | Blocks of text of the form: -- -- >> foo -- >> bar -- >> baz -- birdtracks :: Parser (DocH mod a) birdtracks = DocCodeBlock . DocString . intercalate "\n" . stripSpace <$> many1 line where line = skipHorizontalSpace *> ">" *> takeLine stripSpace :: [String] -> [String] stripSpace = fromMaybe <*> mapM strip' where strip' (' ':xs') = Just xs' strip' "" = Just "" strip' _ = Nothing -- | Parses examples. Examples are a paragraph level entitity (separated by an empty line). -- Consecutive examples are accepted. examples :: Parser (DocH mod a) examples = DocExamples <$> (many (skipHorizontalSpace *> "\n") *> go) where go :: Parser [Example] go = do prefix <- decodeUtf8 <$> takeHorizontalSpace <* ">>>" expr <- takeLine (rs, es) <- resultAndMoreExamples return (makeExample prefix expr rs : es) where resultAndMoreExamples :: Parser ([String], [Example]) resultAndMoreExamples = moreExamples <|> result <|> pure ([], []) where moreExamples :: Parser ([String], [Example]) moreExamples = (,) [] <$> go result :: Parser ([String], [Example]) result = first . (:) <$> nonEmptyLine <*> resultAndMoreExamples makeExample :: String -> String -> [String] -> Example makeExample prefix expression res = Example (strip expression) result where result = map (substituteBlankLine . tryStripPrefix) res tryStripPrefix xs = fromMaybe xs (stripPrefix prefix xs) substituteBlankLine "" = "" substituteBlankLine xs = xs nonEmptyLine :: Parser String nonEmptyLine = mfilter (any (not . isSpace)) takeLine takeLine :: Parser String takeLine = decodeUtf8 <$> takeWhile (/= '\n') <* endOfLine endOfLine :: Parser () endOfLine = void "\n" <|> endOfInput -- | Property parser. -- -- >>> snd <$> parseOnly property "prop> hello world" -- Right (DocProperty "hello world") property :: Parser (DocH mod a) property = DocProperty . strip . decodeUtf8 <$> ("prop>" *> takeWhile1 (/= '\n')) -- | -- Paragraph level codeblock. Anything between the two delimiting \@ is parsed -- for markup. codeblock :: Parser (DocH mod Identifier) codeblock = DocCodeBlock . parseStringBS . dropSpaces <$> ("@" *> skipHorizontalSpace *> "\n" *> block' <* "@") where dropSpaces xs = let rs = decodeUtf8 xs in case splitByNl rs of [] -> xs ys -> case last ys of ' ':_ -> case mapM dropSpace ys of Nothing -> xs Just zs -> encodeUtf8 $ intercalate "\n" zs _ -> xs -- This is necessary because ‘lines’ swallows up a trailing newline -- and we lose information about whether the last line belongs to @ or to -- text which we need to decide whether we actually want to be dropping -- anything at all. splitByNl = unfoldr (\x -> case x of '\n':s -> Just (span (/= '\n') s) _ -> Nothing) . ('\n' :) dropSpace "" = Just "" dropSpace (' ':xs) = Just xs dropSpace _ = Nothing block' = scan False p where p isNewline c | isNewline && c == '@' = Nothing | isNewline && isSpace c = Just isNewline | otherwise = Just $ c == '\n' hyperlink :: Parser (DocH mod a) hyperlink = DocHyperlink . makeLabeled Hyperlink . decodeUtf8 <$> disallowNewline ("<" *> takeUntil ">") <|> autoUrl <|> markdownLink markdownLink :: Parser (DocH mod a) markdownLink = DocHyperlink <$> linkParser linkParser :: Parser Hyperlink linkParser = flip Hyperlink <$> label <*> (whitespace *> url) where label :: Parser (Maybe String) label = Just . strip . decode <$> ("[" *> takeUntil "]") whitespace :: Parser () whitespace = skipHorizontalSpace <* optional ("\n" *> skipHorizontalSpace) url :: Parser String url = rejectWhitespace (decode <$> ("(" *> takeUntil ")")) rejectWhitespace :: MonadPlus m => m String -> m String rejectWhitespace = mfilter (all (not . isSpace)) decode :: BS.ByteString -> String decode = removeEscapes . decodeUtf8 -- | Looks for URL-like things to automatically hyperlink even if they -- weren't marked as links. autoUrl :: Parser (DocH mod a) autoUrl = mkLink <$> url where 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] _ -> DocHyperlink (Hyperlink (decodeUtf8 s) Nothing) -- | Parses strings between identifier delimiters. Consumes all input that it -- deems to be valid in an identifier. Note that it simply blindly consumes -- characters and does no actual validation itself. parseValid :: Parser String parseValid = p some where idChar = satisfy (`elem` ("_.!#$%&*+/<=>?@\\|-~:^"::String)) <|> digit <|> letter_ascii p p' = do vs' <- p' $ utf8String "⋆" <|> return <$> idChar let vs = concat vs' c <- peekChar' case c of '`' -> return vs '\'' -> (\x -> vs ++ "'" ++ x) <$> ("'" *> p many') <|> return vs _ -> fail "outofvalid" -- | Parses UTF8 strings from ByteString streams. utf8String :: String -> Parser String utf8String x = decodeUtf8 <$> string (encodeUtf8 x) -- | Parses identifiers with help of 'parseValid'. Asks GHC for -- 'String' from the string it deems valid. identifier :: Parser (DocH mod Identifier) identifier = do o <- idDelim vid <- parseValid e <- idDelim return $ DocIdentifier (o, vid, e) where idDelim = char '\'' <|> char '`' haddock-library-1.4.2/src/Documentation/Haddock/Parser/Monad.hs0000644000000000000000000000761512724376220022544 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-} module Documentation.Haddock.Parser.Monad ( module Documentation.Haddock.Parser.Monad , Attoparsec.isDigit , Attoparsec.isDigit_w8 , Attoparsec.isAlpha_iso8859_15 , Attoparsec.isAlpha_ascii , Attoparsec.isSpace , Attoparsec.isSpace_w8 , Attoparsec.inClass , Attoparsec.notInClass , Attoparsec.isEndOfLine , Attoparsec.isHorizontalSpace , Attoparsec.choice , Attoparsec.count , Attoparsec.option , Attoparsec.many' , Attoparsec.many1 , Attoparsec.many1' , Attoparsec.manyTill , Attoparsec.manyTill' , Attoparsec.sepBy , Attoparsec.sepBy' , Attoparsec.sepBy1 , Attoparsec.sepBy1' , Attoparsec.skipMany , Attoparsec.skipMany1 , Attoparsec.eitherP ) where import Control.Applicative import Control.Monad import Data.String import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LB import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec import Control.Monad.Trans.State import qualified Control.Monad.Trans.Class as Trans import Data.Word import Data.Bits import Data.Tuple import Documentation.Haddock.Types (Version) newtype ParserState = ParserState { parserStateSince :: Maybe Version } deriving (Eq, Show) initialParserState :: ParserState initialParserState = ParserState Nothing newtype Parser a = Parser (StateT ParserState Attoparsec.Parser a) deriving (Functor, Applicative, Alternative, Monad, MonadPlus) instance (a ~ ByteString) => IsString (Parser a) where fromString = lift . fromString parseOnly :: Parser a -> ByteString -> Either String (ParserState, a) parseOnly (Parser p) = fmap swap . Attoparsec.parseOnly (runStateT p initialParserState) lift :: Attoparsec.Parser a -> Parser a lift = Parser . Trans.lift setParserState :: ParserState -> Parser () setParserState = Parser . put setSince :: Version -> Parser () setSince since = Parser $ modify (\st -> st {parserStateSince = Just since}) char :: Char -> Parser Char char = lift . Attoparsec.char char8 :: Char -> Parser Word8 char8 = lift . Attoparsec.char8 anyChar :: Parser Char anyChar = lift Attoparsec.anyChar notChar :: Char -> Parser Char notChar = lift . Attoparsec.notChar satisfy :: (Char -> Bool) -> Parser Char satisfy = lift . Attoparsec.satisfy peekChar :: Parser (Maybe Char) peekChar = lift Attoparsec.peekChar peekChar' :: Parser Char peekChar' = lift Attoparsec.peekChar' digit :: Parser Char digit = lift Attoparsec.digit letter_iso8859_15 :: Parser Char letter_iso8859_15 = lift Attoparsec.letter_iso8859_15 letter_ascii :: Parser Char letter_ascii = lift Attoparsec.letter_ascii space :: Parser Char space = lift Attoparsec.space string :: ByteString -> Parser ByteString string = lift . Attoparsec.string stringCI :: ByteString -> Parser ByteString stringCI = lift . Attoparsec.stringCI skipSpace :: Parser () skipSpace = lift Attoparsec.skipSpace skipWhile :: (Char -> Bool) -> Parser () skipWhile = lift . Attoparsec.skipWhile take :: Int -> Parser ByteString take = lift . Attoparsec.take scan :: s -> (s -> Char -> Maybe s) -> Parser ByteString scan s = lift . Attoparsec.scan s takeWhile :: (Char -> Bool) -> Parser ByteString takeWhile = lift . Attoparsec.takeWhile takeWhile1 :: (Char -> Bool) -> Parser ByteString takeWhile1 = lift . Attoparsec.takeWhile1 takeTill :: (Char -> Bool) -> Parser ByteString takeTill = lift . Attoparsec.takeTill takeByteString :: Parser ByteString takeByteString = lift Attoparsec.takeByteString takeLazyByteString :: Parser LB.ByteString takeLazyByteString = lift Attoparsec.takeLazyByteString endOfLine :: Parser () endOfLine = lift Attoparsec.endOfLine decimal :: Integral a => Parser a decimal = lift Attoparsec.decimal hexadecimal :: (Integral a, Bits a) => Parser a hexadecimal = lift Attoparsec.hexadecimal endOfInput :: Parser () endOfInput = lift Attoparsec.endOfInput atEnd :: Parser Bool atEnd = lift Attoparsec.atEnd haddock-library-1.4.2/src/Documentation/Haddock/Types.hs0000644000000000000000000000436512723656400021355 0ustar0000000000000000{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} -- | -- Module : Documentation.Haddock.Types -- Copyright : (c) Simon Marlow 2003-2006, -- David Waern 2006-2009, -- Mateusz Kowalczyk 2013 -- License : BSD-like -- -- Maintainer : haddock@projects.haskellorg -- Stability : experimental -- Portability : portable -- -- Exposes documentation data types used for (some) of Haddock. module Documentation.Haddock.Types where import Data.Foldable import Data.Traversable -- | With the advent of 'Version', we may want to start attaching more -- meta-data to comments. We make a structure for this ahead of time -- so we don't have to gut half the core each time we want to add such -- info. newtype Meta = Meta { _version :: Maybe Version } deriving (Eq, Show) data MetaDoc mod id = MetaDoc { _meta :: Meta , _doc :: DocH mod id } deriving (Eq, Show, Functor, Foldable, Traversable) overDoc :: (DocH a b -> DocH c d) -> MetaDoc a b -> MetaDoc c d overDoc f d = d { _doc = f $ _doc d } type Version = [Int] data Hyperlink = Hyperlink { hyperlinkUrl :: String , hyperlinkLabel :: Maybe String } deriving (Eq, Show) data Picture = Picture { pictureUri :: String , pictureTitle :: Maybe String } deriving (Eq, Show) data Header id = Header { headerLevel :: Int , headerTitle :: id } deriving (Eq, Show, Functor, Foldable, Traversable) data Example = Example { exampleExpression :: String , exampleResult :: [String] } deriving (Eq, Show) data DocH mod id = DocEmpty | DocAppend (DocH mod id) (DocH mod id) | DocString String | DocParagraph (DocH mod id) | DocIdentifier id | DocIdentifierUnchecked mod | DocModule String | DocWarning (DocH mod id) | DocEmphasis (DocH mod id) | DocMonospaced (DocH mod id) | DocBold (DocH mod id) | DocUnorderedList [DocH mod id] | DocOrderedList [DocH mod id] | DocDefList [(DocH mod id, DocH mod id)] | DocCodeBlock (DocH mod id) | DocHyperlink Hyperlink | DocPic Picture | DocMathInline String | DocMathDisplay String | DocAName String | DocProperty String | DocExamples [Example] | DocHeader (Header (DocH mod id)) deriving (Eq, Show, Functor, Foldable, Traversable) haddock-library-1.4.2/src/Documentation/Haddock/Doc.hs0000644000000000000000000000702712723656400020754 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} module Documentation.Haddock.Doc (docParagraph, docAppend, docConcat, metaDocConcat, metaDocAppend, emptyMetaDoc, metaAppend, metaConcat) where import Control.Applicative ((<|>), empty) import Documentation.Haddock.Types import Data.Char (isSpace) docConcat :: [DocH mod id] -> DocH mod id docConcat = foldr docAppend DocEmpty -- | Concat using 'metaAppend'. metaConcat :: [Meta] -> Meta metaConcat = foldr metaAppend emptyMeta -- | Like 'docConcat' but also joins the 'Meta' info. metaDocConcat :: [MetaDoc mod id] -> MetaDoc mod id metaDocConcat = foldr metaDocAppend emptyMetaDoc -- | We do something perhaps unexpected here and join the meta info -- in ‘reverse’: this results in the metadata from the ‘latest’ -- paragraphs taking precedence. metaDocAppend :: MetaDoc mod id -> MetaDoc mod id -> MetaDoc mod id metaDocAppend (MetaDoc { _meta = m, _doc = d }) (MetaDoc { _meta = m', _doc = d' }) = MetaDoc { _meta = m' `metaAppend` m, _doc = d `docAppend` d' } -- | This is not a monoidal append, it uses '<|>' for the '_version'. metaAppend :: Meta -> Meta -> Meta metaAppend (Meta { _version = v }) (Meta { _version = v' }) = Meta { _version = v <|> v' } emptyMetaDoc :: MetaDoc mod id emptyMetaDoc = MetaDoc { _meta = emptyMeta, _doc = DocEmpty } emptyMeta :: Meta emptyMeta = Meta { _version = empty } docAppend :: DocH mod id -> DocH mod id -> DocH mod id docAppend (DocDefList ds1) (DocDefList ds2) = DocDefList (ds1++ds2) docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d) = DocAppend (DocDefList (ds1++ds2)) d docAppend (DocOrderedList ds1) (DocOrderedList ds2) = DocOrderedList (ds1 ++ ds2) docAppend (DocOrderedList ds1) (DocAppend (DocOrderedList ds2) d) = DocAppend (DocOrderedList (ds1++ds2)) d docAppend (DocUnorderedList ds1) (DocUnorderedList ds2) = DocUnorderedList (ds1 ++ ds2) docAppend (DocUnorderedList ds1) (DocAppend (DocUnorderedList ds2) d) = DocAppend (DocUnorderedList (ds1++ds2)) d docAppend DocEmpty d = d docAppend d DocEmpty = d docAppend (DocString s1) (DocString s2) = DocString (s1 ++ s2) docAppend (DocAppend d (DocString s1)) (DocString s2) = DocAppend d (DocString (s1 ++ s2)) docAppend (DocString s1) (DocAppend (DocString s2) d) = DocAppend (DocString (s1 ++ s2)) d docAppend d1 d2 = DocAppend d1 d2 -- again to make parsing easier - we spot a paragraph whose only item -- is a DocMonospaced and make it into a DocCodeBlock docParagraph :: DocH mod id -> DocH mod id docParagraph (DocMonospaced p) = DocCodeBlock (docCodeBlock p) docParagraph (DocAppend (DocString s1) (DocMonospaced p)) | all isSpace s1 = DocCodeBlock (docCodeBlock p) docParagraph (DocAppend (DocString s1) (DocAppend (DocMonospaced p) (DocString s2))) | all isSpace s1 && all isSpace s2 = DocCodeBlock (docCodeBlock p) docParagraph (DocAppend (DocMonospaced p) (DocString s2)) | all isSpace s2 = DocCodeBlock (docCodeBlock p) docParagraph p = DocParagraph p -- Drop trailing whitespace from @..@ code blocks. Otherwise this: -- -- -- @ -- -- foo -- -- @ -- -- turns into (DocCodeBlock "\nfoo\n ") which when rendered in HTML -- gives an extra vertical space after the code block. The single space -- on the final line seems to trigger the extra vertical space. -- docCodeBlock :: DocH mod id -> DocH mod id docCodeBlock (DocString s) = DocString (reverse $ dropWhile (`elem` " \t") $ reverse s) docCodeBlock (DocAppend l r) = DocAppend l (docCodeBlock r) docCodeBlock d = d haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs0000644000000000000000000000113712723656400022602 0ustar0000000000000000-- | -- Module : Data.Attoparsec -- Copyright : Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : unknown -- -- Simple, efficient combinator parsing for -- 'Data.ByteString.ByteString' strings, loosely based on the Parsec -- library. -- -- This module is deprecated. Use "Data.Attoparsec.ByteString" -- instead. module Data.Attoparsec {-# DEPRECATED "This module will be removed in the next major release." #-} ( module Data.Attoparsec.ByteString ) where import Data.Attoparsec.ByteString haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs0000644000000000000000000001615212723656400024677 0ustar0000000000000000-- | -- Module : Data.Attoparsec.ByteString -- Copyright : Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : unknown -- -- Simple, efficient combinator parsing for 'B.ByteString' strings, -- loosely based on the Parsec library. module Data.Attoparsec.ByteString ( -- * Differences from Parsec -- $parsec -- * Incremental input -- $incremental -- * Performance considerations -- $performance -- * Parser types I.Parser , Result , T.IResult(..) , I.compareResults -- * Running parsers , parse , feed , I.parseOnly , parseWith , parseTest -- ** Result conversion , maybeResult , eitherResult -- * Parsing individual bytes , I.word8 , I.anyWord8 , I.notWord8 , I.satisfy , I.satisfyWith , I.skip -- ** Lookahead , I.peekWord8 , I.peekWord8' -- ** Byte classes , I.inClass , I.notInClass -- * Efficient string handling , I.string , I.skipWhile , I.take , I.scan , I.takeWhile , I.takeWhile1 , I.takeTill -- ** Consume all remaining input , I.takeByteString , I.takeLazyByteString -- * Combinators , try , () , choice , count , option , many' , many1 , many1' , manyTill , manyTill' , sepBy , sepBy' , sepBy1 , sepBy1' , skipMany , skipMany1 , eitherP , I.match -- * State observation and manipulation functions , I.endOfInput , I.atEnd ) where import Data.Attoparsec.Combinator import qualified Data.Attoparsec.ByteString.Internal as I import qualified Data.Attoparsec.Internal as I import qualified Data.ByteString as B import Data.Attoparsec.ByteString.Internal (Result, parse) import qualified Data.Attoparsec.Internal.Types as T -- $parsec -- -- Compared to Parsec 3, attoparsec makes several tradeoffs. It is -- not intended for, or ideal for, all possible uses. -- -- * While attoparsec can consume input incrementally, Parsec cannot. -- Incremental input is a huge deal for efficient and secure network -- and system programming, since it gives much more control to users -- of the library over matters such as resource usage and the I/O -- model to use. -- -- * Much of the performance advantage of attoparsec is gained via -- high-performance parsers such as 'I.takeWhile' and 'I.string'. -- If you use complicated combinators that return lists of bytes or -- characters, there is less performance difference between the two -- libraries. -- -- * Unlike Parsec 3, attoparsec does not support being used as a -- monad transformer. -- -- * attoparsec is specialised to deal only with strict 'B.ByteString' -- input. Efficiency concerns rule out both lists and lazy -- bytestrings. The usual use for lazy bytestrings would be to -- allow consumption of very large input without a large footprint. -- For this need, attoparsec's incremental input provides an -- excellent substitute, with much more control over when input -- takes place. If you must use lazy bytestrings, see the -- "Data.Attoparsec.ByteString.Lazy" module, which feeds lazy chunks -- to a regular parser. -- -- * Parsec parsers can produce more helpful error messages than -- attoparsec parsers. This is a matter of focus: attoparsec avoids -- the extra book-keeping in favour of higher performance. -- $incremental -- -- attoparsec supports incremental input, meaning that you can feed it -- a bytestring that represents only part of the expected total amount -- of data to parse. If your parser reaches the end of a fragment of -- input and could consume more input, it will suspend parsing and -- return a 'T.Partial' continuation. -- -- Supplying the 'T.Partial' continuation with a bytestring will -- resume parsing at the point where it was suspended, with the -- bytestring you supplied used as new input at the end of the -- existing input. You must be prepared for the result of the resumed -- parse to be another 'T.Partial' continuation. -- -- To indicate that you have no more input, supply the 'T.Partial' -- continuation with an empty bytestring. -- -- Remember that some parsing combinators will not return a result -- until they reach the end of input. They may thus cause 'T.Partial' -- results to be returned. -- -- If you do not need support for incremental input, consider using -- the 'I.parseOnly' function to run your parser. It will never -- prompt for more input. -- -- /Note/: incremental input does /not/ imply that attoparsec will -- release portions of its internal state for garbage collection as it -- proceeds. Its internal representation is equivalent to a single -- 'ByteString': if you feed incremental input to a parser, it will -- require memory proportional to the amount of input you supply. -- (This is necessary to support arbitrary backtracking.) -- $performance -- -- If you write an attoparsec-based parser carefully, it can be -- realistic to expect it to perform similarly to a hand-rolled C -- parser (measuring megabytes parsed per second). -- -- To actually achieve high performance, there are a few guidelines -- that it is useful to follow. -- -- Use the 'B.ByteString'-oriented parsers whenever possible, -- e.g. 'I.takeWhile1' instead of 'many1' 'I.anyWord8'. There is -- about a factor of 100 difference in performance between the two -- kinds of parser. -- -- For very simple byte-testing predicates, write them by hand instead -- of using 'I.inClass' or 'I.notInClass'. For instance, both of -- these predicates test for an end-of-line byte, but the first is -- much faster than the second: -- -- >endOfLine_fast w = w == 13 || w == 10 -- >endOfLine_slow = inClass "\r\n" -- -- Make active use of benchmarking and profiling tools to measure, -- find the problems with, and improve the performance of your parser. -- | Run a parser and print its result to standard output. parseTest :: (Show a) => I.Parser a -> B.ByteString -> IO () parseTest p s = print (parse p s) -- | Run a parser with an initial input string, and a monadic action -- that can supply more input if needed. parseWith :: Monad m => (m B.ByteString) -- ^ An action that will be executed to provide the parser -- with more input, if necessary. The action must return an -- 'B.empty' string when there is no more input available. -> I.Parser a -> B.ByteString -- ^ Initial input for the parser. -> m (Result a) parseWith refill p s = step $ parse p s where step (T.Partial k) = (step . k) =<< refill step r = return r {-# INLINE parseWith #-} -- | Convert a 'Result' value to a 'Maybe' value. A 'T.Partial' result -- is treated as failure. maybeResult :: Result r -> Maybe r maybeResult (T.Done _ r) = Just r maybeResult _ = Nothing -- | Convert a 'Result' value to an 'Either' value. A 'T.Partial' -- result is treated as failure. eitherResult :: Result r -> Either String r eitherResult (T.Done _ r) = Right r eitherResult (T.Fail _ _ msg) = Left msg eitherResult _ = Left "Result: incomplete input" haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs0000644000000000000000000001235412723656400026110 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} -- | -- Module : Data.Attoparsec.ByteString.Buffer -- Copyright : Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : GHC -- -- An "immutable" buffer that supports cheap appends. -- -- A Buffer is divided into an immutable read-only zone, followed by a -- mutable area that we've preallocated, but not yet written to. -- -- We overallocate at the end of a Buffer so that we can cheaply -- append. Since a user of an existing Buffer cannot see past the end -- of its immutable zone into the data that will change during an -- append, this is safe. -- -- Once we run out of space at the end of a Buffer, we do the usual -- doubling of the buffer size. -- -- The fact of having a mutable buffer really helps with performance, -- but it does have a consequence: if someone misuses the Partial API -- that attoparsec uses by calling the same continuation repeatedly -- (which never makes sense in practice), they could overwrite data. -- -- Since the API *looks* pure, it should *act* pure, too, so we use -- two generation counters (one mutable, one immutable) to track the -- number of appends to a mutable buffer. If the counters ever get out -- of sync, someone is appending twice to a mutable buffer, so we -- duplicate the entire buffer in order to preserve the immutability -- of its older self. -- -- While we could go a step further and gain protection against API -- abuse on a multicore system, by use of an atomic increment -- instruction to bump the mutable generation counter, that would be -- very expensive, and feels like it would also be in the realm of the -- ridiculous. Clients should never call a continuation more than -- once; we lack a linear type system that could enforce this; and -- there's only so far we should go to accommodate broken uses. module Data.Attoparsec.ByteString.Buffer ( Buffer , buffer , unbuffer , pappend , length , unsafeIndex , substring , unsafeDrop ) where import Control.Exception (assert) import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr) import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO) import Data.List (foldl1') import Data.Monoid (Monoid(..)) import Data.Word (Word8) import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) import Foreign.Ptr (castPtr, plusPtr) import Foreign.Storable (peek, peekByteOff, poke, sizeOf) import GHC.ForeignPtr (mallocPlainForeignPtrBytes) import Prelude hiding (length) data Buffer = Buf { _fp :: {-# UNPACK #-} !(ForeignPtr Word8) , _off :: {-# UNPACK #-} !Int , _len :: {-# UNPACK #-} !Int , _cap :: {-# UNPACK #-} !Int , _gen :: {-# UNPACK #-} !Int } instance Show Buffer where showsPrec p = showsPrec p . unbuffer -- | The initial 'Buffer' has no mutable zone, so we can avoid all -- copies in the (hopefully) common case of no further input being fed -- to us. buffer :: ByteString -> Buffer buffer (PS fp off len) = Buf fp off len len 0 unbuffer :: Buffer -> ByteString unbuffer (Buf fp off len _ _) = PS fp off len instance Monoid Buffer where mempty = Buf nullForeignPtr 0 0 0 0 mappend (Buf _ _ _ 0 _) b = b mappend a (Buf _ _ _ 0 _) = a mappend buf (Buf fp off len _ _) = append buf fp off len mconcat [] = mempty mconcat xs = foldl1' mappend xs pappend :: Buffer -> ByteString -> Buffer pappend (Buf _ _ _ 0 _) (PS fp off len) = Buf fp off len 0 0 pappend buf (PS fp off len) = append buf fp off len append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer append (Buf fp0 off0 len0 cap0 gen0) !fp1 !off1 !len1 = inlinePerformIO . withForeignPtr fp0 $ \ptr0 -> withForeignPtr fp1 $ \ptr1 -> do let genSize = sizeOf (0::Int) newlen = len0 + len1 gen <- if gen0 == 0 then return 0 else peek (castPtr ptr0) if gen == gen0 && newlen <= cap0 then do let newgen = gen + 1 poke (castPtr ptr0) newgen memcpy (ptr0 `plusPtr` (off0+len0)) (ptr1 `plusPtr` off1) (fromIntegral len1) return (Buf fp0 off0 newlen cap0 newgen) else do let newcap = newlen * 2 fp <- mallocPlainForeignPtrBytes (newcap + genSize) withForeignPtr fp $ \ptr_ -> do let ptr = ptr_ `plusPtr` genSize newgen = 1 poke (castPtr ptr_) newgen memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0) memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1) (fromIntegral len1) return (Buf fp genSize newlen newcap newgen) length :: Buffer -> Int length (Buf _ _ len _ _) = len {-# INLINE length #-} unsafeIndex :: Buffer -> Int -> Word8 unsafeIndex (Buf fp off len _ _) i = assert (i >= 0 && i < len) . inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i) {-# INLINE unsafeIndex #-} substring :: Int -> Int -> Buffer -> ByteString substring s l (Buf fp off len _ _) = assert (s >= 0 && s <= len) . assert (l >= 0 && l <= len-s) $ PS fp (off+s) l {-# INLINE substring #-} unsafeDrop :: Int -> Buffer -> ByteString unsafeDrop s (Buf fp off len _ _) = assert (s >= 0 && s <= len) $ PS fp (off+s) (len-s) {-# INLINE unsafeDrop #-} haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs0000644000000000000000000003511112723656400025640 0ustar0000000000000000{-# LANGUAGE BangPatterns, FlexibleInstances, TypeFamilies, TypeSynonymInstances, GADTs #-} {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} -- | -- Module : Data.Attoparsec.ByteString.Char8 -- Copyright : Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : unknown -- -- Simple, efficient, character-oriented combinator parsing for -- 'B.ByteString' strings, loosely based on the Parsec library. module Data.Attoparsec.ByteString.Char8 ( -- * Character encodings -- $encodings -- * Parser types Parser , A.Result , A.IResult(..) , I.compareResults -- * Running parsers , A.parse , A.feed , A.parseOnly , A.parseWith , A.parseTest -- ** Result conversion , A.maybeResult , A.eitherResult -- * Parsing individual characters , char , char8 , anyChar , notChar , satisfy -- ** Lookahead , peekChar , peekChar' -- ** Special character parsers , digit , letter_iso8859_15 , letter_ascii , space -- ** Fast predicates , isDigit , isDigit_w8 , isAlpha_iso8859_15 , isAlpha_ascii , isSpace , isSpace_w8 -- *** Character classes , inClass , notInClass -- * Efficient string handling , I.string , stringCI , skipSpace , skipWhile , I.take , scan , takeWhile , takeWhile1 , takeTill -- ** String combinators -- $specalt , (.*>) , (<*.) -- ** Consume all remaining input , I.takeByteString , I.takeLazyByteString -- * Text parsing , I.endOfLine , isEndOfLine , isHorizontalSpace -- * Numeric parsers , decimal , hexadecimal , signed , Number(..) -- * Combinators , try , () , choice , count , option , many' , many1 , many1' , manyTill , manyTill' , sepBy , sepBy' , sepBy1 , sepBy1' , skipMany , skipMany1 , eitherP , I.match -- * State observation and manipulation functions , I.endOfInput , I.atEnd ) where import Control.Applicative ((*>), (<*), (<$>), (<|>)) import Data.Attoparsec.ByteString.FastSet (charClass, memberChar) import Data.Attoparsec.ByteString.Internal (Parser) import Data.Attoparsec.Combinator import Data.Attoparsec.Number (Number(..)) import Data.Bits (Bits, (.|.), shiftL) import Data.ByteString.Internal (c2w, w2c) import Data.Int (Int8, Int16, Int32, Int64) import Data.String (IsString(..)) import Data.Word import Prelude hiding (takeWhile) import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString.Internal as I import qualified Data.Attoparsec.Internal as I import qualified Data.ByteString as B8 import qualified Data.ByteString.Char8 as B instance (a ~ B.ByteString) => IsString (Parser a) where fromString = I.string . B.pack -- $encodings -- -- This module is intended for parsing text that is -- represented using an 8-bit character set, e.g. ASCII or -- ISO-8859-15. It /does not/ make any attempt to deal with character -- encodings, multibyte characters, or wide characters. In -- particular, all attempts to use characters above code point U+00FF -- will give wrong answers. -- -- Code points below U+0100 are simply translated to and from their -- numeric values, so e.g. the code point U+00A4 becomes the byte -- @0xA4@ (which is the Euro symbol in ISO-8859-15, but the generic -- currency sign in ISO-8859-1). Haskell 'Char' values above U+00FF -- are truncated, so e.g. U+1D6B7 is truncated to the byte @0xB7@. -- ASCII-specific but fast, oh yes. toLower :: Word8 -> Word8 toLower w | w >= 65 && w <= 90 = w + 32 | otherwise = w -- | Satisfy a literal string, ignoring case. stringCI :: B.ByteString -> Parser B.ByteString stringCI = I.stringTransform (B8.map toLower) {-# INLINE stringCI #-} -- | Consume input as long as the predicate returns 'True', and return -- the consumed input. -- -- This parser requires the predicate to succeed on at least one byte -- of input: it will fail if the predicate never returns 'True' or if -- there is no input left. takeWhile1 :: (Char -> Bool) -> Parser B.ByteString takeWhile1 p = I.takeWhile1 (p . w2c) {-# INLINE takeWhile1 #-} -- | The parser @satisfy p@ succeeds for any byte for which the -- predicate @p@ returns 'True'. Returns the byte that is actually -- parsed. -- -- >digit = satisfy isDigit -- > where isDigit c = c >= '0' && c <= '9' satisfy :: (Char -> Bool) -> Parser Char satisfy = I.satisfyWith w2c {-# INLINE satisfy #-} -- | Match a letter, in the ISO-8859-15 encoding. letter_iso8859_15 :: Parser Char letter_iso8859_15 = satisfy isAlpha_iso8859_15 "letter_iso8859_15" {-# INLINE letter_iso8859_15 #-} -- | Match a letter, in the ASCII encoding. letter_ascii :: Parser Char letter_ascii = satisfy isAlpha_ascii "letter_ascii" {-# INLINE letter_ascii #-} -- | A fast alphabetic predicate for the ISO-8859-15 encoding -- -- /Note/: For all character encodings other than ISO-8859-15, and -- almost all Unicode code points above U+00A3, this predicate gives -- /wrong answers/. isAlpha_iso8859_15 :: Char -> Bool isAlpha_iso8859_15 c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || (c >= '\166' && moby c) where moby = notInClass "\167\169\171-\179\182\183\185\187\191\215\247" {-# NOINLINE moby #-} {-# INLINE isAlpha_iso8859_15 #-} -- | A fast alphabetic predicate for the ASCII encoding -- -- /Note/: For all character encodings other than ASCII, and -- almost all Unicode code points above U+007F, this predicate gives -- /wrong answers/. isAlpha_ascii :: Char -> Bool isAlpha_ascii c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') {-# INLINE isAlpha_ascii #-} -- | Parse a single digit. digit :: Parser Char digit = satisfy isDigit "digit" {-# INLINE digit #-} -- | A fast digit predicate. isDigit :: Char -> Bool isDigit c = c >= '0' && c <= '9' {-# INLINE isDigit #-} -- | A fast digit predicate. isDigit_w8 :: Word8 -> Bool isDigit_w8 w = w >= 48 && w <= 57 {-# INLINE isDigit_w8 #-} -- | Match any character. anyChar :: Parser Char anyChar = satisfy $ const True {-# INLINE anyChar #-} -- | Match any character, to perform lookahead. Returns 'Nothing' if -- end of input has been reached. Does not consume any input. -- -- /Note/: Because this parser does not fail, do not use it with -- combinators such as 'many', because such parsers loop until a -- failure occurs. Careless use will thus result in an infinite loop. peekChar :: Parser (Maybe Char) peekChar = (fmap w2c) `fmap` I.peekWord8 {-# INLINE peekChar #-} -- | Match any character, to perform lookahead. Does not consume any -- input, but will fail if end of input has been reached. peekChar' :: Parser Char peekChar' = w2c `fmap` I.peekWord8' {-# INLINE peekChar' #-} -- | Fast predicate for matching ASCII space characters. -- -- /Note/: This predicate only gives correct answers for the ASCII -- encoding. For instance, it does not recognise U+00A0 (non-breaking -- space) as a space character, even though it is a valid ISO-8859-15 -- byte. For a Unicode-aware and only slightly slower predicate, -- use 'Data.Char.isSpace' isSpace :: Char -> Bool isSpace c = (c == ' ') || ('\t' <= c && c <= '\r') {-# INLINE isSpace #-} -- | Fast 'Word8' predicate for matching ASCII space characters. isSpace_w8 :: Word8 -> Bool isSpace_w8 w = (w == 32) || (9 <= w && w <= 13) {-# INLINE isSpace_w8 #-} -- | Parse a space character. -- -- /Note/: This parser only gives correct answers for the ASCII -- encoding. For instance, it does not recognise U+00A0 (non-breaking -- space) as a space character, even though it is a valid ISO-8859-15 -- byte. space :: Parser Char space = satisfy isSpace "space" {-# INLINE space #-} -- | Match a specific character. char :: Char -> Parser Char char c = satisfy (== c) [c] {-# INLINE char #-} -- | Match a specific character, but return its 'Word8' value. char8 :: Char -> Parser Word8 char8 c = I.satisfy (== c2w c) [c] {-# INLINE char8 #-} -- | Match any character except the given one. notChar :: Char -> Parser Char notChar c = satisfy (/= c) "not " ++ [c] {-# INLINE notChar #-} -- | Match any character in a set. -- -- >vowel = inClass "aeiou" -- -- Range notation is supported. -- -- >halfAlphabet = inClass "a-nA-N" -- -- To add a literal \'-\' to a set, place it at the beginning or end -- of the string. inClass :: String -> Char -> Bool inClass s = (`memberChar` mySet) where mySet = charClass s {-# INLINE inClass #-} -- | Match any character not in a set. notInClass :: String -> Char -> Bool notInClass s = not . inClass s {-# INLINE notInClass #-} -- | Consume input as long as the predicate returns 'True', and return -- the consumed input. -- -- This parser does not fail. It will return an empty string if the -- predicate returns 'False' on the first byte of input. -- -- /Note/: Because this parser does not fail, do not use it with -- combinators such as 'many', because such parsers loop until a -- failure occurs. Careless use will thus result in an infinite loop. takeWhile :: (Char -> Bool) -> Parser B.ByteString takeWhile p = I.takeWhile (p . w2c) {-# INLINE takeWhile #-} -- | A stateful scanner. The predicate consumes and transforms a -- state argument, and each transformed state is passed to successive -- invocations of the predicate on each byte of the input until one -- returns 'Nothing' or the input ends. -- -- This parser does not fail. It will return an empty string if the -- predicate returns 'Nothing' on the first byte of input. -- -- /Note/: Because this parser does not fail, do not use it with -- combinators such as 'many', because such parsers loop until a -- failure occurs. Careless use will thus result in an infinite loop. scan :: s -> (s -> Char -> Maybe s) -> Parser B.ByteString scan s0 p = I.scan s0 (\s -> p s . w2c) {-# INLINE scan #-} -- | Consume input as long as the predicate returns 'False' -- (i.e. until it returns 'True'), and return the consumed input. -- -- This parser does not fail. It will return an empty string if the -- predicate returns 'True' on the first byte of input. -- -- /Note/: Because this parser does not fail, do not use it with -- combinators such as 'many', because such parsers loop until a -- failure occurs. Careless use will thus result in an infinite loop. takeTill :: (Char -> Bool) -> Parser B.ByteString takeTill p = I.takeTill (p . w2c) {-# INLINE takeTill #-} -- | Skip past input for as long as the predicate returns 'True'. skipWhile :: (Char -> Bool) -> Parser () skipWhile p = I.skipWhile (p . w2c) {-# INLINE skipWhile #-} -- | Skip over white space. skipSpace :: Parser () skipSpace = I.skipWhile isSpace_w8 {-# INLINE skipSpace #-} -- $specalt -- -- If you enable the @OverloadedStrings@ language extension, you can -- use the '*>' and '<*' combinators to simplify the common task of -- matching a statically known string, then immediately parsing -- something else. -- -- Instead of writing something like this: -- -- @ --'I.string' \"foo\" '*>' wibble -- @ -- -- Using @OverloadedStrings@, you can omit the explicit use of -- 'I.string', and write a more compact version: -- -- @ -- \"foo\" '*>' wibble -- @ -- -- (Note: the '.*>' and '<*.' combinators that were originally -- provided for this purpose are obsolete and unnecessary, and will be -- removed in the next major version.) -- | /Obsolete/. A type-specialized version of '*>' for -- 'B.ByteString'. Use '*>' instead. (.*>) :: B.ByteString -> Parser a -> Parser a s .*> f = I.string s *> f {-# DEPRECATED (.*>) "This is no longer necessary, and will be removed. Use '*>' instead." #-} -- | /Obsolete/. A type-specialized version of '<*' for -- 'B.ByteString'. Use '<*' instead. (<*.) :: Parser a -> B.ByteString -> Parser a f <*. s = f <* I.string s {-# DEPRECATED (<*.) "This is no longer necessary, and will be removed. Use '<*' instead." #-} -- | A predicate that matches either a carriage return @\'\\r\'@ or -- newline @\'\\n\'@ character. isEndOfLine :: Word8 -> Bool isEndOfLine w = w == 13 || w == 10 {-# INLINE isEndOfLine #-} -- | A predicate that matches either a space @\' \'@ or horizontal tab -- @\'\\t\'@ character. isHorizontalSpace :: Word8 -> Bool isHorizontalSpace w = w == 32 || w == 9 {-# INLINE isHorizontalSpace #-} -- | Parse and decode an unsigned hexadecimal number. The hex digits -- @\'a\'@ through @\'f\'@ may be upper or lower case. -- -- This parser does not accept a leading @\"0x\"@ string. hexadecimal :: (Integral a, Bits a) => Parser a hexadecimal = B8.foldl' step 0 `fmap` I.takeWhile1 isHexDigit where isHexDigit w = (w >= 48 && w <= 57) || (w >= 97 && w <= 102) || (w >= 65 && w <= 70) step a w | w >= 48 && w <= 57 = (a `shiftL` 4) .|. fromIntegral (w - 48) | w >= 97 = (a `shiftL` 4) .|. fromIntegral (w - 87) | otherwise = (a `shiftL` 4) .|. fromIntegral (w - 55) {-# SPECIALISE hexadecimal :: Parser Int #-} {-# SPECIALISE hexadecimal :: Parser Int8 #-} {-# SPECIALISE hexadecimal :: Parser Int16 #-} {-# SPECIALISE hexadecimal :: Parser Int32 #-} {-# SPECIALISE hexadecimal :: Parser Int64 #-} {-# SPECIALISE hexadecimal :: Parser Integer #-} {-# SPECIALISE hexadecimal :: Parser Word #-} {-# SPECIALISE hexadecimal :: Parser Word8 #-} {-# SPECIALISE hexadecimal :: Parser Word16 #-} {-# SPECIALISE hexadecimal :: Parser Word32 #-} {-# SPECIALISE hexadecimal :: Parser Word64 #-} -- | Parse and decode an unsigned decimal number. decimal :: Integral a => Parser a decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDig where isDig w = w >= 48 && w <= 57 step a w = a * 10 + fromIntegral (w - 48) {-# SPECIALISE decimal :: Parser Int #-} {-# SPECIALISE decimal :: Parser Int8 #-} {-# SPECIALISE decimal :: Parser Int16 #-} {-# SPECIALISE decimal :: Parser Int32 #-} {-# SPECIALISE decimal :: Parser Int64 #-} {-# SPECIALISE decimal :: Parser Integer #-} {-# SPECIALISE decimal :: Parser Word #-} {-# SPECIALISE decimal :: Parser Word8 #-} {-# SPECIALISE decimal :: Parser Word16 #-} {-# SPECIALISE decimal :: Parser Word32 #-} {-# SPECIALISE decimal :: Parser Word64 #-} -- | Parse a number with an optional leading @\'+\'@ or @\'-\'@ sign -- character. signed :: Num a => Parser a -> Parser a {-# SPECIALISE signed :: Parser Int -> Parser Int #-} {-# SPECIALISE signed :: Parser Int8 -> Parser Int8 #-} {-# SPECIALISE signed :: Parser Int16 -> Parser Int16 #-} {-# SPECIALISE signed :: Parser Int32 -> Parser Int32 #-} {-# SPECIALISE signed :: Parser Int64 -> Parser Int64 #-} {-# SPECIALISE signed :: Parser Integer -> Parser Integer #-} signed p = (negate <$> (char8 '-' *> p)) <|> (char8 '+' *> p) <|> p haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs0000644000000000000000000000716712723656400026256 0ustar0000000000000000{-# LANGUAGE BangPatterns, MagicHash #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Attoparsec.ByteString.FastSet -- Copyright : Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : unknown -- -- Fast set membership tests for 'Word8' and 8-bit 'Char' values. The -- set representation is unboxed for efficiency. For small sets, we -- test for membership using a binary search. For larger sets, we use -- a lookup table. -- ----------------------------------------------------------------------------- module Data.Attoparsec.ByteString.FastSet ( -- * Data type FastSet -- * Construction , fromList , set -- * Lookup , memberChar , memberWord8 -- * Debugging , fromSet -- * Handy interface , charClass ) where import Data.Bits ((.&.), (.|.)) import Foreign.Storable (peekByteOff, pokeByteOff) import GHC.Base (Int(I#), iShiftRA#, narrow8Word#, shiftL#) import GHC.Word (Word8(W8#)) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Internal as I import qualified Data.ByteString.Unsafe as U data FastSet = Sorted { fromSet :: !B.ByteString } | Table { fromSet :: !B.ByteString } deriving (Eq, Ord) instance Show FastSet where show (Sorted s) = "FastSet Sorted " ++ show (B8.unpack s) show (Table _) = "FastSet Table" -- | The lower bound on the size of a lookup table. We choose this to -- balance table density against performance. tableCutoff :: Int tableCutoff = 8 -- | Create a set. set :: B.ByteString -> FastSet set s | B.length s < tableCutoff = Sorted . B.sort $ s | otherwise = Table . mkTable $ s fromList :: [Word8] -> FastSet fromList = set . B.pack data I = I {-# UNPACK #-} !Int {-# UNPACK #-} !Word8 shiftR :: Int -> Int -> Int shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#) shiftL :: Word8 -> Int -> Word8 shiftL (W8# x#) (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#)) index :: Int -> I index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7)) {-# INLINE index #-} -- | Check the set for membership. memberWord8 :: Word8 -> FastSet -> Bool memberWord8 w (Table t) = let I byte bit = index (fromIntegral w) in U.unsafeIndex t byte .&. bit /= 0 memberWord8 w (Sorted s) = search 0 (B.length s - 1) where search lo hi | hi < lo = False | otherwise = let mid = (lo + hi) `quot` 2 in case compare w (U.unsafeIndex s mid) of GT -> search (mid + 1) hi LT -> search lo (mid - 1) _ -> True -- | Check the set for membership. Only works with 8-bit characters: -- characters above code point 255 will give wrong answers. memberChar :: Char -> FastSet -> Bool memberChar c = memberWord8 (I.c2w c) {-# INLINE memberChar #-} mkTable :: B.ByteString -> B.ByteString mkTable s = I.unsafeCreate 32 $ \t -> do _ <- I.memset t 0 32 U.unsafeUseAsCStringLen s $ \(p, l) -> let loop n | n == l = return () | otherwise = do c <- peekByteOff p n :: IO Word8 let I byte bit = index (fromIntegral c) prev <- peekByteOff t byte :: IO Word8 pokeByteOff t byte (prev .|. bit) loop (n + 1) in loop 0 charClass :: String -> FastSet charClass = set . B8.pack . go where go (a:'-':b:xs) = [a..b] ++ go xs go (x:xs) = x : go xs go _ = "" haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs0000644000000000000000000003661512723656400026461 0ustar0000000000000000{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings, RecordWildCards #-} -- | -- Module : Data.Attoparsec.ByteString.Internal -- Copyright : Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : unknown -- -- Simple, efficient parser combinators for 'ByteString' strings, -- loosely based on the Parsec library. module Data.Attoparsec.ByteString.Internal ( -- * Parser types Parser , Result -- * Running parsers , parse , parseOnly -- * Combinators , module Data.Attoparsec.Combinator -- * Parsing individual bytes , satisfy , satisfyWith , anyWord8 , skip , word8 , notWord8 -- ** Lookahead , peekWord8 , peekWord8' -- ** Byte classes , inClass , notInClass -- * Parsing more complicated structures , storable -- * Efficient string handling , skipWhile , string , stringTransform , take , scan , runScanner , takeWhile , takeWhile1 , takeTill -- ** Consume all remaining input , takeByteString , takeLazyByteString -- * Utilities , endOfLine , endOfInput , match , atEnd ) where import Control.Applicative ((<|>), (<$>)) import Control.Monad (when) import Data.Attoparsec.ByteString.Buffer (Buffer, buffer) import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8) import Data.Attoparsec.Combinator (()) import Data.Attoparsec.Internal import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO) import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success) import Data.ByteString (ByteString) import Data.Word (Word8) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr (castPtr, minusPtr, plusPtr) import Foreign.Storable (Storable(peek, sizeOf)) import Prelude hiding (getChar, succ, take, takeWhile) import qualified Data.Attoparsec.ByteString.Buffer as Buf import qualified Data.Attoparsec.Internal.Types as T import qualified Data.ByteString as B8 import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Unsafe as B type Parser = T.Parser ByteString type Result = IResult ByteString type Failure r = T.Failure ByteString Buffer r type Success a r = T.Success ByteString Buffer a r -- | The parser @satisfy p@ succeeds for any byte for which the -- predicate @p@ returns 'True'. Returns the byte that is actually -- parsed. -- -- >digit = satisfy isDigit -- > where isDigit w = w >= 48 && w <= 57 satisfy :: (Word8 -> Bool) -> Parser Word8 satisfy p = do h <- peekWord8' if p h then advance 1 >> return h else fail "satisfy" {-# INLINE satisfy #-} -- | The parser @skip p@ succeeds for any byte for which the predicate -- @p@ returns 'True'. -- -- >skipDigit = skip isDigit -- > where isDigit w = w >= 48 && w <= 57 skip :: (Word8 -> Bool) -> Parser () skip p = do h <- peekWord8' if p h then advance 1 else fail "skip" -- | The parser @satisfyWith f p@ transforms a byte, and succeeds if -- the predicate @p@ returns 'True' on the transformed value. The -- parser returns the transformed byte that was parsed. satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a satisfyWith f p = do h <- peekWord8' let c = f h if p c then advance 1 >> return c else fail "satisfyWith" {-# INLINE satisfyWith #-} storable :: Storable a => Parser a storable = hack undefined where hack :: Storable b => b -> Parser b hack dummy = do (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy) return . B.inlinePerformIO . withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o) -- | Consume @n@ bytes of input, but succeed only if the predicate -- returns 'True'. takeWith :: Int -> (ByteString -> Bool) -> Parser ByteString takeWith n0 p = do let n = max n0 0 s <- ensure n if p s then advance n >> return s else fail "takeWith" -- | Consume exactly @n@ bytes of input. take :: Int -> Parser ByteString take n = takeWith n (const True) {-# INLINE take #-} -- | @string s@ parses a sequence of bytes that identically match -- @s@. Returns the parsed string (i.e. @s@). This parser consumes no -- input if it fails (even if a partial match). -- -- /Note/: The behaviour of this parser is different to that of the -- similarly-named parser in Parsec, as this one is all-or-nothing. -- To illustrate the difference, the following parser will fail under -- Parsec given an input of @\"for\"@: -- -- >string "foo" <|> string "for" -- -- The reason for its failure is that the first branch is a -- partial match, and will consume the letters @\'f\'@ and @\'o\'@ -- before failing. In attoparsec, the above parser will /succeed/ on -- that input, because the failed first branch will consume nothing. string :: ByteString -> Parser ByteString string s = takeWith (B.length s) (==s) {-# INLINE string #-} stringTransform :: (ByteString -> ByteString) -> ByteString -> Parser ByteString stringTransform f s = takeWith (B.length s) ((==f s) . f) {-# INLINE stringTransform #-} -- | Skip past input for as long as the predicate returns 'True'. skipWhile :: (Word8 -> Bool) -> Parser () skipWhile p = go where go = do t <- B8.takeWhile p <$> get continue <- inputSpansChunks (B.length t) when continue go {-# INLINE skipWhile #-} -- | Consume input as long as the predicate returns 'False' -- (i.e. until it returns 'True'), and return the consumed input. -- -- This parser does not fail. It will return an empty string if the -- predicate returns 'True' on the first byte of input. -- -- /Note/: Because this parser does not fail, do not use it with -- combinators such as 'Control.Applicative.many', because such -- parsers loop until a failure occurs. Careless use will thus result -- in an infinite loop. takeTill :: (Word8 -> Bool) -> Parser ByteString takeTill p = takeWhile (not . p) {-# INLINE takeTill #-} -- | Consume input as long as the predicate returns 'True', and return -- the consumed input. -- -- This parser does not fail. It will return an empty string if the -- predicate returns 'False' on the first byte of input. -- -- /Note/: Because this parser does not fail, do not use it with -- combinators such as 'Control.Applicative.many', because such -- parsers loop until a failure occurs. Careless use will thus result -- in an infinite loop. takeWhile :: (Word8 -> Bool) -> Parser ByteString takeWhile p = (B.concat . reverse) `fmap` go [] where go acc = do s <- B8.takeWhile p <$> get continue <- inputSpansChunks (B.length s) if continue then go (s:acc) else return (s:acc) {-# INLINE takeWhile #-} takeRest :: Parser [ByteString] takeRest = go [] where go acc = do input <- wantInput if input then do s <- get advance (B.length s) go (s:acc) else return (reverse acc) -- | Consume all remaining input and return it as a single string. takeByteString :: Parser ByteString takeByteString = B.concat `fmap` takeRest -- | Consume all remaining input and return it as a single string. takeLazyByteString :: Parser L.ByteString takeLazyByteString = L.fromChunks `fmap` takeRest data T s = T {-# UNPACK #-} !Int s scan_ :: (s -> [ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s) -> Parser r scan_ f s0 p = go [] s0 where go acc s1 = do let scanner (B.PS fp off len) = withForeignPtr fp $ \ptr0 -> do let start = ptr0 `plusPtr` off end = start `plusPtr` len inner ptr !s | ptr < end = do w <- peek ptr case p s w of Just s' -> inner (ptr `plusPtr` 1) s' _ -> done (ptr `minusPtr` start) s | otherwise = done (ptr `minusPtr` start) s done !i !s = return (T i s) inner start s1 bs <- get let T i s' = inlinePerformIO $ scanner bs !h = B.unsafeTake i bs continue <- inputSpansChunks i if continue then go (h:acc) s' else f s' (h:acc) {-# INLINE scan_ #-} -- | A stateful scanner. The predicate consumes and transforms a -- state argument, and each transformed state is passed to successive -- invocations of the predicate on each byte of the input until one -- returns 'Nothing' or the input ends. -- -- This parser does not fail. It will return an empty string if the -- predicate returns 'Nothing' on the first byte of input. -- -- /Note/: Because this parser does not fail, do not use it with -- combinators such as 'Control.Applicative.many', because such -- parsers loop until a failure occurs. Careless use will thus result -- in an infinite loop. scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString scan = scan_ $ \_ chunks -> case chunks of [x] -> return x xs -> return $! B.concat $ reverse xs {-# INLINE scan #-} -- | Like 'scan', but generalized to return the final state of the -- scanner. runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s) runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s) {-# INLINE runScanner #-} -- | Consume input as long as the predicate returns 'True', and return -- the consumed input. -- -- This parser requires the predicate to succeed on at least one byte -- of input: it will fail if the predicate never returns 'True' or if -- there is no input left. takeWhile1 :: (Word8 -> Bool) -> Parser ByteString takeWhile1 p = do (`when` demandInput) =<< endOfChunk s <- B8.takeWhile p <$> get let len = B.length s if len == 0 then fail "takeWhile1" else do advance len eoc <- endOfChunk if eoc then (s<>) `fmap` takeWhile p else return s -- | Match any byte in a set. -- -- >vowel = inClass "aeiou" -- -- Range notation is supported. -- -- >halfAlphabet = inClass "a-nA-N" -- -- To add a literal @\'-\'@ to a set, place it at the beginning or end -- of the string. inClass :: String -> Word8 -> Bool inClass s = (`memberWord8` mySet) where mySet = charClass s {-# NOINLINE mySet #-} {-# INLINE inClass #-} -- | Match any byte not in a set. notInClass :: String -> Word8 -> Bool notInClass s = not . inClass s {-# INLINE notInClass #-} -- | Match any byte. anyWord8 :: Parser Word8 anyWord8 = satisfy $ const True {-# INLINE anyWord8 #-} -- | Match a specific byte. word8 :: Word8 -> Parser Word8 word8 c = satisfy (== c) show c {-# INLINE word8 #-} -- | Match any byte except the given one. notWord8 :: Word8 -> Parser Word8 notWord8 c = satisfy (/= c) "not " ++ show c {-# INLINE notWord8 #-} -- | Match any byte, to perform lookahead. Returns 'Nothing' if end of -- input has been reached. Does not consume any input. -- -- /Note/: Because this parser does not fail, do not use it with -- combinators such as 'Control.Applicative.many', because such -- parsers loop until a failure occurs. Careless use will thus result -- in an infinite loop. peekWord8 :: Parser (Maybe Word8) peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ -> case () of _| pos_ < Buf.length t -> let !w = Buf.unsafeIndex t pos_ in succ t pos more (Just w) | more == Complete -> succ t pos more Nothing | otherwise -> let succ' t' pos' more' = let !w = Buf.unsafeIndex t' pos_ in succ t' pos' more' (Just w) lose' t' pos' more' = succ t' pos' more' Nothing in prompt t pos more lose' succ' {-# INLINE peekWord8 #-} -- | Match any byte, to perform lookahead. Does not consume any -- input, but will fail if end of input has been reached. peekWord8' :: Parser Word8 peekWord8' = T.Parser $ \t pos more lose succ -> if lengthAtLeast pos 1 t then succ t pos more (Buf.unsafeIndex t (fromPos pos)) else let succ' t' pos' more' bs' = succ t' pos' more' $! B.unsafeHead bs' in ensureSuspended 1 t pos more lose succ' {-# INLINE peekWord8' #-} -- | Match either a single newline character @\'\\n\'@, or a carriage -- return followed by a newline character @\"\\r\\n\"@. endOfLine :: Parser () endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ()) -- | Terminal failure continuation. failK :: Failure a failK t (Pos pos) _more stack msg = Fail (Buf.unsafeDrop pos t) stack msg {-# INLINE failK #-} -- | Terminal success continuation. successK :: Success a a successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a {-# INLINE successK #-} -- | Run a parser. parse :: Parser a -> ByteString -> Result a parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK {-# INLINE parse #-} -- | Run a parser that cannot be resupplied via a 'Partial' result. -- -- This function does not force a parser to consume all of its input. -- Instead, any residual input will be discarded. To force a parser -- to consume all of its input, use something like this: -- -- @ --'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput') -- @ parseOnly :: Parser a -> ByteString -> Either String a parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of Fail _ _ err -> Left err Done _ a -> Right a _ -> error "parseOnly: impossible error!" {-# INLINE parseOnly #-} get :: Parser ByteString get = T.Parser $ \t pos more _lose succ -> succ t pos more (Buf.unsafeDrop (fromPos pos) t) {-# INLINE get #-} endOfChunk :: Parser Bool endOfChunk = T.Parser $ \t pos more _lose succ -> succ t pos more (fromPos pos == Buf.length t) {-# INLINE endOfChunk #-} inputSpansChunks :: Int -> Parser Bool inputSpansChunks i = T.Parser $ \t pos_ more _lose succ -> let pos = pos_ + Pos i in if fromPos pos < Buf.length t || more == Complete then succ t pos more False else let lose' t' pos' more' = succ t' pos' more' False succ' t' pos' more' = succ t' pos' more' True in prompt t pos more lose' succ' {-# INLINE inputSpansChunks #-} advance :: Int -> Parser () advance n = T.Parser $ \t pos more _lose succ -> succ t (pos + Pos n) more () {-# INLINE advance #-} ensureSuspended :: Int -> Buffer -> Pos -> More -> Failure r -> Success ByteString r -> Result r ensureSuspended n t pos more lose succ = runParser (demandInput >> go) t pos more lose succ where go = T.Parser $ \t' pos' more' lose' succ' -> if lengthAtLeast pos' n t' then succ' t' pos' more' (substring pos (Pos n) t') else runParser (demandInput >> go) t' pos' more' lose' succ' -- | If at least @n@ elements of input are available, return the -- current input, otherwise fail. ensure :: Int -> Parser ByteString ensure n = T.Parser $ \t pos more lose succ -> if lengthAtLeast pos n t then succ t pos more (substring pos (Pos n) t) -- The uncommon case is kept out-of-line to reduce code size: else ensureSuspended n t pos more lose succ -- Non-recursive so the bounds check can be inlined: {-# INLINE ensure #-} -- | Return both the result of a parse and the portion of the input -- that was consumed while it was being parsed. match :: Parser a -> Parser (ByteString, a) match p = T.Parser $ \t pos more lose succ -> let succ' t' pos' more' a = succ t' pos' more' (substring pos (pos'-pos) t', a) in runParser p t pos more lose succ' lengthAtLeast :: Pos -> Int -> Buffer -> Bool lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n {-# INLINE lengthAtLeast #-} substring :: Pos -> Pos -> Buffer -> ByteString substring (Pos pos) (Pos n) = Buf.substring pos n {-# INLINE substring #-} haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs0000644000000000000000000001702112723656400024676 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} -- | -- Module : Data.Attoparsec.Combinator -- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Useful parser combinators, similar to those provided by Parsec. module Data.Attoparsec.Combinator ( -- * Combinators try , () , choice , count , option , many' , many1 , many1' , manyTill , manyTill' , sepBy , sepBy' , sepBy1 , sepBy1' , skipMany , skipMany1 , eitherP , feed , satisfyElem , endOfInput , atEnd ) where import Control.Applicative (Alternative(..), Applicative(..), empty, liftA2, many, (<|>), (*>), (<$>)) import Control.Monad (MonadPlus(..)) import Data.Attoparsec.Internal.Types (Parser(..), IResult(..)) import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem) import Data.ByteString (ByteString) import Data.Monoid (Monoid(mappend)) import Prelude hiding (succ) -- | Attempt a parse, and if it fails, rewind the input so that no -- input appears to have been consumed. -- -- This combinator is provided for compatibility with Parsec. -- attoparsec parsers always backtrack on failure. try :: Parser i a -> Parser i a try p = p {-# INLINE try #-} -- | Name the parser, in case failure occurs. () :: Parser i a -> String -- ^ the name to use if parsing fails -> Parser i a p msg0 = Parser $ \t pos more lose succ -> let lose' t' pos' more' strs msg = lose t' pos' more' (msg0:strs) msg in runParser p t pos more lose' succ {-# INLINE () #-} infix 0 -- | @choice ps@ tries to apply the actions in the list @ps@ in order, -- until one of them succeeds. Returns the value of the succeeding -- action. choice :: Alternative f => [f a] -> f a choice = foldr (<|>) empty {-# SPECIALIZE choice :: [Parser ByteString a] -> Parser ByteString a #-} -- | @option x p@ tries to apply action @p@. If @p@ fails without -- consuming input, it returns the value @x@, otherwise the value -- returned by @p@. -- -- > priority = option 0 (digitToInt <$> digit) option :: Alternative f => a -> f a -> f a option x p = p <|> pure x {-# SPECIALIZE option :: a -> Parser ByteString a -> Parser ByteString a #-} -- | A version of 'liftM2' that is strict in the result of its first -- action. liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c liftM2' f a b = do !x <- a y <- b return (f x y) {-# INLINE liftM2' #-} -- | @many' p@ applies the action @p@ /zero/ or more times. Returns a -- list of the returned values of @p@. The value returned by @p@ is -- forced to WHNF. -- -- > word = many' letter many' :: (MonadPlus m) => m a -> m [a] many' p = many_p where many_p = some_p `mplus` return [] some_p = liftM2' (:) p many_p {-# INLINE many' #-} -- | @many1 p@ applies the action @p@ /one/ or more times. Returns a -- list of the returned values of @p@. -- -- > word = many1 letter many1 :: Alternative f => f a -> f [a] many1 p = liftA2 (:) p (many p) {-# INLINE many1 #-} -- | @many1' p@ applies the action @p@ /one/ or more times. Returns a -- list of the returned values of @p@. The value returned by @p@ is -- forced to WHNF. -- -- > word = many1' letter many1' :: (MonadPlus m) => m a -> m [a] many1' p = liftM2' (:) p (many' p) {-# INLINE many1' #-} -- | @sepBy p sep@ applies /zero/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@. -- -- > commaSep p = p `sepBy` (symbol ",") sepBy :: Alternative f => f a -> f s -> f [a] sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure [] {-# SPECIALIZE sepBy :: Parser ByteString a -> Parser ByteString s -> Parser ByteString [a] #-} -- | @sepBy' p sep@ applies /zero/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@. The value -- returned by @p@ is forced to WHNF. -- -- > commaSep p = p `sepBy'` (symbol ",") sepBy' :: (MonadPlus m) => m a -> m s -> m [a] sepBy' p s = scan `mplus` return [] where scan = liftM2' (:) p ((s >> sepBy1' p s) `mplus` return []) {-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s -> Parser ByteString [a] #-} -- | @sepBy1 p sep@ applies /one/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@. -- -- > commaSep p = p `sepBy1` (symbol ",") sepBy1 :: Alternative f => f a -> f s -> f [a] sepBy1 p s = scan where scan = liftA2 (:) p ((s *> scan) <|> pure []) {-# SPECIALIZE sepBy1 :: Parser ByteString a -> Parser ByteString s -> Parser ByteString [a] #-} -- | @sepBy1' p sep@ applies /one/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@. The value -- returned by @p@ is forced to WHNF. -- -- > commaSep p = p `sepBy1'` (symbol ",") sepBy1' :: (MonadPlus m) => m a -> m s -> m [a] sepBy1' p s = scan where scan = liftM2' (:) p ((s >> scan) `mplus` return []) {-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s -> Parser ByteString [a] #-} -- | @manyTill p end@ applies action @p@ /zero/ or more times until -- action @end@ succeeds, and returns the list of values returned by -- @p@. This can be used to scan comments: -- -- > simpleComment = string "") -- -- (Note the overlapping parsers @anyChar@ and @string \"-->\"@. -- While this will work, it is not very efficient, as it will cause a -- lot of backtracking.) manyTill :: Alternative f => f a -> f b -> f [a] manyTill p end = scan where scan = (end *> pure []) <|> liftA2 (:) p scan {-# SPECIALIZE manyTill :: Parser ByteString a -> Parser ByteString b -> Parser ByteString [a] #-} -- | @manyTill' p end@ applies action @p@ /zero/ or more times until -- action @end@ succeeds, and returns the list of values returned by -- @p@. This can be used to scan comments: -- -- > simpleComment = string "") -- -- (Note the overlapping parsers @anyChar@ and @string \"-->\"@. -- While this will work, it is not very efficient, as it will cause a -- lot of backtracking.) -- -- The value returned by @p@ is forced to WHNF. manyTill' :: (MonadPlus m) => m a -> m b -> m [a] manyTill' p end = scan where scan = (end >> return []) `mplus` liftM2' (:) p scan {-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b -> Parser ByteString [a] #-} -- | Skip zero or more instances of an action. skipMany :: Alternative f => f a -> f () skipMany p = scan where scan = (p *> scan) <|> pure () {-# SPECIALIZE skipMany :: Parser ByteString a -> Parser ByteString () #-} -- | Skip one or more instances of an action. skipMany1 :: Alternative f => f a -> f () skipMany1 p = p *> skipMany p {-# SPECIALIZE skipMany1 :: Parser ByteString a -> Parser ByteString () #-} -- | Apply the given action repeatedly, returning every result. count :: Monad m => Int -> m a -> m [a] count n p = sequence (replicate n p) {-# INLINE count #-} -- | Combine two alternatives. eitherP :: (Alternative f) => f a -> f b -> f (Either a b) eitherP a b = (Left <$> a) <|> (Right <$> b) {-# INLINE eitherP #-} -- | If a parser has returned a 'T.Partial' result, supply it with more -- input. feed :: Monoid i => IResult i r -> i -> IResult i r feed f@(Fail _ _ _) _ = f feed (Partial k) d = k d feed (Done t r) d = Done (mappend t d) r {-# INLINE feed #-} haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs0000644000000000000000000001300712723656400024355 0ustar0000000000000000{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-} -- | -- Module : Data.Attoparsec.Internal -- Copyright : Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : unknown -- -- Simple, efficient parser combinators, loosely based on the Parsec -- library. module Data.Attoparsec.Internal ( compareResults , prompt , demandInput , wantInput , endOfInput , atEnd , satisfyElem ) where import Control.Applicative ((<$>)) #if __GLASGOW_HASKELL__ >= 700 import Data.ByteString (ByteString) #endif import Data.Attoparsec.Internal.Types import Prelude hiding (succ) -- | Compare two 'IResult' values for equality. -- -- If both 'IResult's are 'Partial', the result will be 'Nothing', as -- they are incomplete and hence their equality cannot be known. -- (This is why there is no 'Eq' instance for 'IResult'.) compareResults :: (Eq i, Eq r) => IResult i r -> IResult i r -> Maybe Bool compareResults (Fail t0 ctxs0 msg0) (Fail t1 ctxs1 msg1) = Just (t0 == t1 && ctxs0 == ctxs1 && msg0 == msg1) compareResults (Done t0 r0) (Done t1 r1) = Just (t0 == t1 && r0 == r1) compareResults (Partial _) (Partial _) = Nothing compareResults _ _ = Just False -- | Ask for input. If we receive any, pass it to a success -- continuation, otherwise to a failure continuation. prompt :: Chunk t => State t -> Pos -> More -> (State t -> Pos -> More -> IResult t r) -> (State t -> Pos -> More -> IResult t r) -> IResult t r prompt t pos _more lose succ = Partial $ \s -> if nullChunk s then lose t pos Complete else succ (pappendChunk t s) pos Incomplete #if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE prompt :: State ByteString -> Pos -> More -> (State ByteString -> Pos -> More -> IResult ByteString r) -> (State ByteString -> Pos -> More -> IResult ByteString r) -> IResult ByteString r #-} #endif -- | Immediately demand more input via a 'Partial' continuation -- result. demandInput :: Chunk t => Parser t () demandInput = Parser $ \t pos more lose succ -> case more of Complete -> lose t pos more [] "not enough input" _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input" succ' t' pos' more' = succ t' pos' more' () in prompt t pos more lose' succ' #if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE demandInput :: Parser ByteString () #-} #endif -- | This parser always succeeds. It returns 'True' if any input is -- available either immediately or on demand, and 'False' if the end -- of all input has been reached. wantInput :: forall t . Chunk t => Parser t Bool wantInput = Parser $ \t pos more _lose succ -> case () of _ | pos < atBufferEnd (undefined :: t) t -> succ t pos more True | more == Complete -> succ t pos more False | otherwise -> let lose' t' pos' more' = succ t' pos' more' False succ' t' pos' more' = succ t' pos' more' True in prompt t pos more lose' succ' {-# INLINE wantInput #-} -- | Match only if all input has been consumed. endOfInput :: forall t . Chunk t => Parser t () endOfInput = Parser $ \t pos more lose succ -> case () of _| pos < atBufferEnd (undefined :: t) t -> lose t pos more [] "endOfInput" | more == Complete -> succ t pos more () | otherwise -> let lose' t' pos' more' _ctx _msg = succ t' pos' more' () succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput" in runParser demandInput t pos more lose' succ' #if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE endOfInput :: Parser ByteString () #-} #endif -- | Return an indication of whether the end of input has been -- reached. atEnd :: Chunk t => Parser t Bool atEnd = not <$> wantInput {-# INLINE atEnd #-} satisfySuspended :: forall t r . Chunk t => (ChunkElem t -> Bool) -> State t -> Pos -> More -> Failure t (State t) r -> Success t (State t) (ChunkElem t) r -> IResult t r satisfySuspended p t pos more lose succ = runParser (demandInput >> go) t pos more lose succ where go = Parser $ \t' pos' more' lose' succ' -> case bufferElemAt (undefined :: t) pos' t' of Just (e, l) | p e -> succ' t' (pos' + Pos l) more' e | otherwise -> lose' t' pos' more' [] "satisfyElem" Nothing -> runParser (demandInput >> go) t' pos' more' lose' succ' #if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE satisfySuspended :: (ChunkElem ByteString -> Bool) -> State ByteString -> Pos -> More -> Failure ByteString (State ByteString) r -> Success ByteString (State ByteString) (ChunkElem ByteString) r -> IResult ByteString r #-} #endif -- | The parser @satisfyElem p@ succeeds for any chunk element for which the -- predicate @p@ returns 'True'. Returns the element that is -- actually parsed. satisfyElem :: forall t . Chunk t => (ChunkElem t -> Bool) -> Parser t (ChunkElem t) satisfyElem p = Parser $ \t pos more lose succ -> case bufferElemAt (undefined :: t) pos t of Just (e, l) | p e -> succ t (pos + Pos l) more e | otherwise -> lose t pos more [] "satisfyElem" Nothing -> satisfySuspended p t pos more lose succ {-# INLINE satisfyElem #-} haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs0000644000000000000000000000117412723656400025736 0ustar0000000000000000{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, RecordWildCards, MagicHash, UnboxedTuples #-} module Data.Attoparsec.Internal.Fhthagn ( inlinePerformIO ) where import GHC.Base (realWorld#) import GHC.IO (IO(IO)) -- | Just like unsafePerformIO, but we inline it. Big performance gains as -- it exposes lots of things to further inlining. /Very unsafe/. In -- particular, you should do no memory allocation inside an -- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@. inlinePerformIO :: IO a -> a inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r {-# INLINE inlinePerformIO #-} haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs0000644000000000000000000001622412723656400025465 0ustar0000000000000000{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings, Rank2Types, RecordWildCards, TypeFamilies #-} -- | -- Module : Data.Attoparsec.Internal.Types -- Copyright : Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : unknown -- -- Simple, efficient parser combinators, loosely based on the Parsec -- library. module Data.Attoparsec.Internal.Types ( Parser(..) , State , Failure , Success , Pos(..) , IResult(..) , More(..) , (<>) , Chunk(..) ) where import Control.Applicative (Alternative(..), Applicative(..), (<$>)) import Control.DeepSeq (NFData(rnf)) import Control.Monad (MonadPlus(..)) import Data.Word (Word8) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.ByteString.Internal (w2c) import Data.Monoid (Monoid(..)) import Prelude hiding (getChar, succ) import qualified Data.Attoparsec.ByteString.Buffer as B newtype Pos = Pos { fromPos :: Int } deriving (Eq, Ord, Show, Num) -- | The result of a parse. This is parameterised over the type @i@ -- of string that was processed. -- -- This type is an instance of 'Functor', where 'fmap' transforms the -- value in a 'Done' result. data IResult i r = Fail i [String] String -- ^ The parse failed. The @i@ parameter is the input that had -- not yet been consumed when the failure occurred. The -- @[@'String'@]@ is a list of contexts in which the error -- occurred. The 'String' is the message describing the error, if -- any. | Partial (i -> IResult i r) -- ^ Supply this continuation with more input so that the parser -- can resume. To indicate that no more input is available, pass -- an empty string to the continuation. -- -- __Note__: if you get a 'Partial' result, do not call its -- continuation more than once. | Done i r -- ^ The parse succeeded. The @i@ parameter is the input that had -- not yet been consumed (if any) when the parse succeeded. instance (Show i, Show r) => Show (IResult i r) where show (Fail t stk msg) = unwords [ "Fail", show t, show stk, show msg] show (Partial _) = "Partial _" show (Done t r) = unwords ["Done", show t, show r] instance (NFData i, NFData r) => NFData (IResult i r) where rnf (Fail t stk msg) = rnf t `seq` rnf stk `seq` rnf msg rnf (Partial _) = () rnf (Done t r) = rnf t `seq` rnf r {-# INLINE rnf #-} instance Functor (IResult i) where fmap _ (Fail t stk msg) = Fail t stk msg fmap f (Partial k) = Partial (fmap f . k) fmap f (Done t r) = Done t (f r) -- | The core parser type. This is parameterised over the types @i@ -- of string being processed and @t@ of internal state representation. -- -- This type is an instance of the following classes: -- -- * 'Monad', where 'fail' throws an exception (i.e. fails) with an -- error message. -- -- * 'Functor' and 'Applicative', which follow the usual definitions. -- -- * 'MonadPlus', where 'mzero' fails (with no error message) and -- 'mplus' executes the right-hand parser if the left-hand one -- fails. When the parser on the right executes, the input is reset -- to the same state as the parser on the left started with. (In -- other words, attoparsec is a backtracking parser that supports -- arbitrary lookahead.) -- -- * 'Alternative', which follows 'MonadPlus'. newtype Parser i a = Parser { runParser :: forall r. State i -> Pos -> More -> Failure i (State i) r -> Success i (State i) a r -> IResult i r } type family State i type instance State ByteString = B.Buffer type Failure i t r = t -> Pos -> More -> [String] -> String -> IResult i r type Success i t a r = t -> Pos -> More -> a -> IResult i r -- | Have we read all available input? data More = Complete | Incomplete deriving (Eq, Show) instance Monoid More where mappend c@Complete _ = c mappend _ m = m mempty = Incomplete instance Monad (Parser i) where fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg where msg = "Failed reading: " ++ err {-# INLINE fail #-} return = pure {-# INLINE return #-} m >>= k = Parser $ \t !pos more lose succ -> let succ' t' !pos' more' a = runParser (k a) t' pos' more' lose succ in runParser m t pos more lose succ' {-# INLINE (>>=) #-} plus :: Parser i a -> Parser i a -> Parser i a plus f g = Parser $ \t pos more lose succ -> let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ in runParser f t pos more lose' succ instance MonadPlus (Parser i) where mzero = fail "mzero" {-# INLINE mzero #-} mplus = plus instance Functor (Parser i) where fmap f p = Parser $ \t pos more lose succ -> let succ' t' pos' more' a = succ t' pos' more' (f a) in runParser p t pos more lose succ' {-# INLINE fmap #-} apP :: Parser i (a -> b) -> Parser i a -> Parser i b apP d e = do b <- d a <- e return (b a) {-# INLINE apP #-} instance Applicative (Parser i) where pure v = Parser $ \t pos more _lose succ -> succ t pos more v {-# INLINE pure #-} (<*>) = apP {-# INLINE (<*>) #-} -- These definitions are equal to the defaults, but this -- way the optimizer doesn't have to work so hard to figure -- that out. m *> k = m >>= \_ -> k {-# INLINE (*>) #-} x <* y = x >>= \a -> y >> return a {-# INLINE (<*) #-} instance Monoid (Parser i a) where mempty = fail "mempty" {-# INLINE mempty #-} mappend = plus {-# INLINE mappend #-} instance Alternative (Parser i) where empty = fail "empty" {-# INLINE empty #-} (<|>) = plus {-# INLINE (<|>) #-} many v = many_v where many_v = some_v <|> pure [] some_v = (:) <$> v <*> many_v {-# INLINE many #-} some v = some_v where many_v = some_v <|> pure [] some_v = (:) <$> v <*> many_v {-# INLINE some #-} (<>) :: (Monoid m) => m -> m -> m (<>) = mappend {-# INLINE (<>) #-} -- | A common interface for input chunks. class Monoid c => Chunk c where type ChunkElem c -- | Test if the chunk is empty. nullChunk :: c -> Bool -- | Append chunk to a buffer. pappendChunk :: State c -> c -> State c -- | Position at the end of a buffer. The first argument is ignored. atBufferEnd :: c -> State c -> Pos -- | Return the buffer element at the given position along with its length. bufferElemAt :: c -> Pos -> State c -> Maybe (ChunkElem c, Int) -- | Map an element to the corresponding character. -- The first argument is ignored. chunkElemToChar :: c -> ChunkElem c -> Char instance Chunk ByteString where type ChunkElem ByteString = Word8 nullChunk = BS.null {-# INLINE nullChunk #-} pappendChunk = B.pappend {-# INLINE pappendChunk #-} atBufferEnd _ = Pos . B.length {-# INLINE atBufferEnd #-} bufferElemAt _ (Pos i) buf | i < B.length buf = Just (B.unsafeIndex buf i, 1) | otherwise = Nothing {-# INLINE bufferElemAt #-} chunkElemToChar _ = w2c {-# INLINE chunkElemToChar #-} haddock-library-1.4.2/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs0000644000000000000000000000724112723656400024034 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} -- | -- Module : Data.Attoparsec.Number -- Copyright : Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : unknown -- -- This module is deprecated, and both the module and 'Number' type -- will be removed in the next major release. Use the -- package -- and the 'Data.Scientific.Scientific' type instead. -- -- A simple number type, useful for parsing both exact and inexact -- quantities without losing much precision. module Data.Attoparsec.Number {-# DEPRECATED "This module will be removed in the next major release." #-} ( Number(..) ) where import Control.DeepSeq (NFData(rnf)) import Data.Data (Data) import Data.Function (on) import Data.Typeable (Typeable) -- | A numeric type that can represent integers accurately, and -- floating point numbers to the precision of a 'Double'. -- -- /Note/: this type is deprecated, and will be removed in the next -- major release. Use the 'Data.Scientific.Scientific' type instead. data Number = I !Integer | D {-# UNPACK #-} !Double deriving (Typeable, Data) {-# DEPRECATED Number "Use Scientific instead." #-} instance Show Number where show (I a) = show a show (D a) = show a instance NFData Number where rnf (I _) = () rnf (D _) = () {-# INLINE rnf #-} binop :: (Integer -> Integer -> a) -> (Double -> Double -> a) -> Number -> Number -> a binop _ d (D a) (D b) = d a b binop i _ (I a) (I b) = i a b binop _ d (D a) (I b) = d a (fromIntegral b) binop _ d (I a) (D b) = d (fromIntegral a) b {-# INLINE binop #-} instance Eq Number where (==) = binop (==) (==) {-# INLINE (==) #-} (/=) = binop (/=) (/=) {-# INLINE (/=) #-} instance Ord Number where (<) = binop (<) (<) {-# INLINE (<) #-} (<=) = binop (<=) (<=) {-# INLINE (<=) #-} (>) = binop (>) (>) {-# INLINE (>) #-} (>=) = binop (>=) (>=) {-# INLINE (>=) #-} compare = binop compare compare {-# INLINE compare #-} instance Num Number where (+) = binop (((I$!).) . (+)) (((D$!).) . (+)) {-# INLINE (+) #-} (-) = binop (((I$!).) . (-)) (((D$!).) . (-)) {-# INLINE (-) #-} (*) = binop (((I$!).) . (*)) (((D$!).) . (*)) {-# INLINE (*) #-} abs (I a) = I $! abs a abs (D a) = D $! abs a {-# INLINE abs #-} negate (I a) = I $! negate a negate (D a) = D $! negate a {-# INLINE negate #-} signum (I a) = I $! signum a signum (D a) = D $! signum a {-# INLINE signum #-} fromInteger = (I$!) . fromInteger {-# INLINE fromInteger #-} instance Real Number where toRational (I a) = fromIntegral a toRational (D a) = toRational a {-# INLINE toRational #-} instance Fractional Number where fromRational = (D$!) . fromRational {-# INLINE fromRational #-} (/) = binop (((D$!).) . (/) `on` fromIntegral) (((D$!).) . (/)) {-# INLINE (/) #-} recip (I a) = D $! recip (fromIntegral a) recip (D a) = D $! recip a {-# INLINE recip #-} instance RealFrac Number where properFraction (I a) = (fromIntegral a,0) properFraction (D a) = case properFraction a of (i,d) -> (i,D d) {-# INLINE properFraction #-} truncate (I a) = fromIntegral a truncate (D a) = truncate a {-# INLINE truncate #-} round (I a) = fromIntegral a round (D a) = round a {-# INLINE round #-} ceiling (I a) = fromIntegral a ceiling (D a) = ceiling a {-# INLINE ceiling #-} floor (I a) = fromIntegral a floor (D a) = floor a {-# INLINE floor #-} haddock-library-1.4.2/src/Documentation/Haddock/Parser/Util.hs0000644000000000000000000000461712723656400022422 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | -- Module : Documentation.Haddock.Parser.Util -- Copyright : (c) Mateusz Kowalczyk 2013-2014, -- Simon Hengel 2013 -- License : BSD-like -- -- Maintainer : haddock@projects.haskell.org -- Stability : experimental -- Portability : portable -- -- Various utility functions used by the parser. module Documentation.Haddock.Parser.Util ( unsnoc , strip , takeUntil , removeEscapes , makeLabeled , takeHorizontalSpace , skipHorizontalSpace ) where import Control.Applicative import Control.Monad (mfilter) import Documentation.Haddock.Parser.Monad import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS import Prelude hiding (takeWhile) #if MIN_VERSION_bytestring(0,10,2) import Data.ByteString.Char8 (unsnoc) #else unsnoc :: ByteString -> Maybe (ByteString, Char) unsnoc bs | BS.null bs = Nothing | otherwise = Just (BS.init bs, BS.last bs) #endif -- | Remove all leading and trailing whitespace strip :: String -> String strip = (\f -> f . f) $ dropWhile isSpace . reverse skipHorizontalSpace :: Parser () skipHorizontalSpace = skipWhile (`elem` " \t\f\v\r") takeHorizontalSpace :: Parser BS.ByteString takeHorizontalSpace = takeWhile (`elem` " \t\f\v\r") makeLabeled :: (String -> Maybe String -> a) -> String -> a makeLabeled f input = case break isSpace $ removeEscapes $ strip input of (uri, "") -> f uri Nothing (uri, label) -> f uri (Just $ dropWhile isSpace label) -- | Remove escapes from given string. -- -- Only do this if you do not process (read: parse) the input any further. removeEscapes :: String -> String removeEscapes "" = "" removeEscapes ('\\':'\\':xs) = '\\' : removeEscapes xs removeEscapes ('\\':xs) = removeEscapes xs removeEscapes (x:xs) = x : removeEscapes xs takeUntil :: ByteString -> Parser ByteString takeUntil end_ = dropEnd <$> requireEnd (scan (False, end) p) >>= gotSome where end = BS.unpack end_ p :: (Bool, String) -> Char -> Maybe (Bool, String) p acc c = case acc of (True, _) -> Just (False, end) (_, []) -> Nothing (_, x:xs) | x == c -> Just (False, xs) _ -> Just (c == '\\', end) dropEnd = BS.reverse . BS.drop (length end) . BS.reverse requireEnd = mfilter (BS.isSuffixOf end_) gotSome xs | BS.null xs = fail "didn't get any content" | otherwise = return xs haddock-library-1.4.2/src/Documentation/Haddock/Utf8.hs0000644000000000000000000000541412723656400021073 0ustar0000000000000000module Documentation.Haddock.Utf8 (encodeUtf8, decodeUtf8) where import Data.Bits ((.|.), (.&.), shiftL, shiftR) import qualified Data.ByteString as BS import Data.Char (chr, ord) import Data.Word (Word8) -- | Helper that encodes and packs a 'String' into a 'BS.ByteString' encodeUtf8 :: String -> BS.ByteString encodeUtf8 = BS.pack . encode -- | Helper that unpacks and decodes a 'BS.ByteString' into a 'String' decodeUtf8 :: BS.ByteString -> String decodeUtf8 = decode . BS.unpack -- Copy/pasted functions from Codec.Binary.UTF8.String for encoding/decoding -- | Character to use when 'encode' or 'decode' fail for a byte. replacementCharacter :: Char replacementCharacter = '\xfffd' -- | Encode a Haskell String to a list of Word8 values, in UTF8 format. encode :: String -> [Word8] encode = concatMap (map fromIntegral . go . ord) where go oc | oc <= 0x7f = [oc] | oc <= 0x7ff = [ 0xc0 + (oc `shiftR` 6) , 0x80 + oc .&. 0x3f ] | oc <= 0xffff = [ 0xe0 + (oc `shiftR` 12) , 0x80 + ((oc `shiftR` 6) .&. 0x3f) , 0x80 + oc .&. 0x3f ] | otherwise = [ 0xf0 + (oc `shiftR` 18) , 0x80 + ((oc `shiftR` 12) .&. 0x3f) , 0x80 + ((oc `shiftR` 6) .&. 0x3f) , 0x80 + oc .&. 0x3f ] -- | Decode a UTF8 string packed into a list of Word8 values, directly to String decode :: [Word8] -> String decode [ ] = "" decode (c:cs) | c < 0x80 = chr (fromEnum c) : decode cs | c < 0xc0 = replacementCharacter : decode cs | c < 0xe0 = multi1 | c < 0xf0 = multi_byte 2 0xf 0x800 | c < 0xf8 = multi_byte 3 0x7 0x10000 | c < 0xfc = multi_byte 4 0x3 0x200000 | c < 0xfe = multi_byte 5 0x1 0x4000000 | otherwise = replacementCharacter : decode cs where multi1 = case cs of c1 : ds | c1 .&. 0xc0 == 0x80 -> let d = ((fromEnum c .&. 0x1f) `shiftL` 6) .|. fromEnum (c1 .&. 0x3f) in if d >= 0x000080 then toEnum d : decode ds else replacementCharacter : decode ds _ -> replacementCharacter : decode cs multi_byte :: Int -> Word8 -> Int -> String multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask)) where aux 0 rs acc | overlong <= acc && acc <= 0x10ffff && (acc < 0xd800 || 0xdfff < acc) && (acc < 0xfffe || 0xffff < acc) = chr acc : decode rs | otherwise = replacementCharacter : decode rs aux n (r:rs) acc | r .&. 0xc0 == 0x80 = aux (n-1) rs $ shiftL acc 6 .|. fromEnum (r .&. 0x3f) aux _ rs _ = replacementCharacter : decode rs haddock-library-1.4.2/test/Spec.hs0000644000000000000000000000005412723656400015154 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} haddock-library-1.4.2/test/Documentation/Haddock/ParserSpec.hs0000644000000000000000000010175112723656400022505 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Documentation.Haddock.ParserSpec (main, spec) where import Data.String import qualified Documentation.Haddock.Parser as Parse import Documentation.Haddock.Types import Documentation.Haddock.Doc (docAppend) import Test.Hspec import Test.QuickCheck infixr 6 <> (<>) :: Doc id -> Doc id -> Doc id (<>) = docAppend type Doc id = DocH () id instance IsString (Doc String) where fromString = DocString instance IsString a => IsString (Maybe a) where fromString = Just . fromString parseParas :: String -> MetaDoc () String parseParas = overDoc Parse.toRegular . Parse.parseParas parseString :: String -> Doc String parseString = Parse.toRegular . Parse.parseString hyperlink :: String -> Maybe String -> Doc String hyperlink url = DocHyperlink . Hyperlink url main :: IO () main = hspec spec spec :: Spec spec = do describe "parseString" $ do let infix 1 `shouldParseTo` shouldParseTo :: String -> Doc String -> Expectation shouldParseTo input ast = parseString input `shouldBe` ast it "is total" $ do property $ \xs -> (length . show . parseString) xs `shouldSatisfy` (> 0) context "when parsing text" $ do it "can handle unicode" $ do "灼眼のシャナ" `shouldParseTo` "灼眼のシャナ" it "accepts numeric character references" $ do "foo bar baz λ" `shouldParseTo` "foo bar baz λ" it "accepts hexadecimal character references" $ do "e" `shouldParseTo` "e" it "allows to backslash-escape characters except \\r" $ do property $ \case '\r' -> "\\\r" `shouldParseTo` DocString "\\" x -> ['\\', x] `shouldParseTo` DocString [x] context "when parsing strings contaning numeric character references" $ do it "will implicitly convert digits to characters" $ do "AAAA" `shouldParseTo` "AAAA" "灼眼のシャナ" `shouldParseTo` "灼眼のシャナ" it "will implicitly convert hex encoded characters" $ do "eeee" `shouldParseTo` "eeee" context "when parsing identifiers" $ do it "parses identifiers enclosed within single ticks" $ do "'foo'" `shouldParseTo` DocIdentifier "foo" it "parses identifiers enclosed within backticks" $ do "`foo`" `shouldParseTo` DocIdentifier "foo" it "parses a word with an one of the delimiters in it as DocString" $ do "don't" `shouldParseTo` "don't" it "doesn't pass pairs of delimiters with spaces between them" $ do "hel'lo w'orld" `shouldParseTo` "hel'lo w'orld" it "don't use apostrophe's in the wrong place's" $ do " don't use apostrophe's in the wrong place's" `shouldParseTo` "don't use apostrophe's in the wrong place's" it "doesn't parse empty identifiers" $ do "``" `shouldParseTo` "``" it "can parse infix identifiers" $ do "``infix``" `shouldParseTo` "`" <> DocIdentifier "infix" <> "`" context "when parsing URLs" $ do it "parses a URL" $ do "" `shouldParseTo` hyperlink "http://example.com/" Nothing it "accepts an optional label" $ do "" `shouldParseTo` hyperlink "http://example.com/" "some link" it "does not accept newlines in label" $ do "" `shouldParseTo` "" -- new behaviour test, this will be now consistent with other markup it "allows us to escape > inside the URL" $ do "le.com>" `shouldParseTo` hyperlink "http://examp>le.com" Nothing "mp\\>le.com>" `shouldParseTo` hyperlink "http://exa>mp>le.com" Nothing -- Likewise in label "oo>" `shouldParseTo` hyperlink "http://example.com" "f>oo" it "parses inline URLs" $ do "foo bar" `shouldParseTo` "foo " <> hyperlink "http://example.com/" Nothing <> " bar" it "doesn't allow for multi-line link tags" $ do "" `shouldParseTo` "" context "when parsing markdown links" $ do it "parses a simple link" $ do "[some label](url)" `shouldParseTo` hyperlink "url" "some label" it "allows whitespace between label and URL" $ do "[some label] \t (url)" `shouldParseTo` hyperlink "url" "some label" it "allows newlines in label" $ do "[some\n\nlabel](url)" `shouldParseTo` hyperlink "url" "some\n\nlabel" it "allows escaping in label" $ do "[some\\] label](url)" `shouldParseTo` hyperlink "url" "some] label" it "strips leading and trailing whitespace from label" $ do "[ some label ](url)" `shouldParseTo` hyperlink "url" "some label" it "rejects whitespace in URL" $ do "[some label]( url)" `shouldParseTo` "[some label]( url)" context "when URL is on a separate line" $ do it "allows URL to be on a separate line" $ do "[some label]\n(url)" `shouldParseTo` hyperlink "url" "some label" it "allows leading whitespace" $ do "[some label]\n \t (url)" `shouldParseTo` hyperlink "url" "some label" it "rejects additional newlines" $ do "[some label]\n\n(url)" `shouldParseTo` "[some label]\n\n(url)" context "when autolinking URLs" $ do it "autolinks HTTP URLs" $ do "http://example.com/" `shouldParseTo` hyperlink "http://example.com/" Nothing it "autolinks HTTPS URLs" $ do "https://www.example.com/" `shouldParseTo` hyperlink "https://www.example.com/" Nothing it "autolinks FTP URLs" $ do "ftp://example.com/" `shouldParseTo` hyperlink "ftp://example.com/" Nothing it "does not include a trailing comma" $ do "http://example.com/, Some other sentence." `shouldParseTo` hyperlink "http://example.com/" Nothing <> ", Some other sentence." it "does not include a trailing dot" $ do "http://example.com/. Some other sentence." `shouldParseTo` hyperlink "http://example.com/" Nothing <> ". Some other sentence." it "does not include a trailing exclamation mark" $ do "http://example.com/! Some other sentence." `shouldParseTo` hyperlink "http://example.com/" Nothing <> "! Some other sentence." it "does not include a trailing question mark" $ do "http://example.com/? Some other sentence." `shouldParseTo` hyperlink "http://example.com/" Nothing <> "? Some other sentence." it "autolinks URLs occuring mid-sentence with multiple ‘/’s" $ do "foo https://example.com/example bar" `shouldParseTo` "foo " <> hyperlink "https://example.com/example" Nothing <> " bar" context "when parsing images" $ do let image :: String -> Maybe String -> Doc String image uri = DocPic . Picture uri it "accepts markdown syntax for images" $ do "![label](url)" `shouldParseTo` image "url" "label" it "accepts Unicode" $ do "![灼眼のシャナ](url)" `shouldParseTo` image "url" "灼眼のシャナ" it "supports deprecated picture syntax" $ do "<>" `shouldParseTo` image "baz" Nothing it "supports title for deprecated picture syntax" $ do "<>" `shouldParseTo` image "b" "a z" context "when parsing display math" $ do it "accepts markdown syntax for display math containing newlines" $ do "\\[\\pi\n\\pi\\]" `shouldParseTo` DocMathDisplay "\\pi\n\\pi" context "when parsing anchors" $ do it "parses a single word anchor" $ do "#foo#" `shouldParseTo` DocAName "foo" it "parses a multi word anchor" $ do "#foo bar#" `shouldParseTo` DocAName "foo bar" it "parses a unicode anchor" $ do "#灼眼のシャナ#" `shouldParseTo` DocAName "灼眼のシャナ" it "does not accept newlines in anchors" $ do "#foo\nbar#" `shouldParseTo` "#foo\nbar#" it "accepts anchors mid-paragraph" $ do "Hello #someAnchor# world!" `shouldParseTo` "Hello " <> DocAName "someAnchor" <> " world!" it "does not accept empty anchors" $ do "##" `shouldParseTo` "##" context "when parsing emphasised text" $ do it "emphasises a word on its own" $ do "/foo/" `shouldParseTo` DocEmphasis "foo" it "emphasises inline correctly" $ do "foo /bar/ baz" `shouldParseTo` "foo " <> DocEmphasis "bar" <> " baz" it "emphasises unicode" $ do "/灼眼のシャナ/" `shouldParseTo` DocEmphasis "灼眼のシャナ" it "does not emphasise multi-line strings" $ do " /foo\nbar/" `shouldParseTo` "/foo\nbar/" it "does not emphasise the empty string" $ do "//" `shouldParseTo` "//" it "parses escaped slashes literally" $ do "/foo\\/bar/" `shouldParseTo` DocEmphasis "foo/bar" it "recognizes other markup constructs within emphasised text" $ do "/foo @bar@ baz/" `shouldParseTo` DocEmphasis ("foo " <> DocMonospaced "bar" <> " baz") it "allows other markup inside of emphasis" $ do "/__inner bold__/" `shouldParseTo` DocEmphasis (DocBold "inner bold") it "doesn't mangle inner markup unicode" $ do "/__灼眼のシャナ A__/" `shouldParseTo` DocEmphasis (DocBold "灼眼のシャナ A") it "properly converts HTML escape sequences" $ do "/AAAA/" `shouldParseTo` DocEmphasis "AAAA" it "allows to escape the emphasis delimiter inside of emphasis" $ do "/empha\\/sis/" `shouldParseTo` DocEmphasis "empha/sis" context "when parsing monospaced text" $ do it "parses simple monospaced text" $ do "@foo@" `shouldParseTo` DocMonospaced "foo" it "parses inline monospaced text" $ do "foo @bar@ baz" `shouldParseTo` "foo " <> DocMonospaced "bar" <> " baz" it "allows to escape @" $ do "@foo \\@ bar@" `shouldParseTo` DocMonospaced "foo @ bar" it "accepts unicode" $ do "@foo 灼眼のシャナ bar@" `shouldParseTo` DocMonospaced "foo 灼眼のシャナ bar" it "accepts other markup in monospaced text" $ do "@/foo/@" `shouldParseTo` DocMonospaced (DocEmphasis "foo") it "requires the closing @" $ do "@foo /bar/ baz" `shouldParseTo` "@foo " <> DocEmphasis "bar" <> " baz" context "when parsing bold strings" $ do it "allows for a bold string on its own" $ do "__bold string__" `shouldParseTo` DocBold "bold string" it "bolds inline correctly" $ do "hello __everyone__ there" `shouldParseTo` "hello " <> DocBold "everyone" <> " there" it "bolds unicode" $ do "__灼眼のシャナ__" `shouldParseTo` DocBold "灼眼のシャナ" it "does not do __multi-line\\n bold__" $ do " __multi-line\n bold__" `shouldParseTo` "__multi-line\n bold__" it "allows other markup inside of bold" $ do "__/inner emphasis/__" `shouldParseTo` (DocBold $ DocEmphasis "inner emphasis") it "doesn't mangle inner markup unicode" $ do "__/灼眼のシャナ A/__" `shouldParseTo` (DocBold $ DocEmphasis "灼眼のシャナ A") it "properly converts HTML escape sequences" $ do "__AAAA__" `shouldParseTo` DocBold "AAAA" it "allows to escape the bold delimiter inside of bold" $ do "__bo\\__ld__" `shouldParseTo` DocBold "bo__ld" it "doesn't allow for empty bold" $ do "____" `shouldParseTo` "____" context "when parsing module strings" $ do it "should parse a module on its own" $ do "\"Module\"" `shouldParseTo` DocModule "Module" it "should parse a module inline" $ do "This is a \"Module\"." `shouldParseTo` "This is a " <> DocModule "Module" <> "." it "can accept a simple module name" $ do "\"Hello\"" `shouldParseTo` DocModule "Hello" it "can accept a module name with dots" $ do "\"Hello.World\"" `shouldParseTo` DocModule "Hello.World" it "can accept a module name with unicode" $ do "\"Hello.Worldλ\"" `shouldParseTo` DocModule "Hello.Worldλ" it "parses a module name with a trailing dot as regular quoted string" $ do "\"Hello.\"" `shouldParseTo` "\"Hello.\"" it "parses a module name with a space as regular quoted string" $ do "\"Hello World\"" `shouldParseTo` "\"Hello World\"" it "parses a module name with invalid characters as regular quoted string" $ do "\"Hello&[{}(=*)+]!\"" `shouldParseTo` "\"Hello&[{}(=*)+]!\"" it "accepts a module name with unicode" $ do "\"Foo.Barλ\"" `shouldParseTo` DocModule "Foo.Barλ" it "treats empty module name as regular double quotes" $ do "\"\"" `shouldParseTo` "\"\"" it "accepts anchor reference syntax as DocModule" $ do "\"Foo#bar\"" `shouldParseTo` DocModule "Foo#bar" it "accepts old anchor reference syntax as DocModule" $ do "\"Foo\\#bar\"" `shouldParseTo` DocModule "Foo\\#bar" describe "parseParas" $ do let infix 1 `shouldParseTo` shouldParseTo :: String -> Doc String -> Expectation shouldParseTo input ast = _doc (parseParas input) `shouldBe` ast it "is total" $ do property $ \xs -> (length . show . parseParas) xs `shouldSatisfy` (> 0) context "when parsing @since" $ do it "adds specified version to the result" $ do parseParas "@since 0.5.0" `shouldBe` MetaDoc { _meta = Meta { _version = Just [0,5,0] } , _doc = DocEmpty } it "ignores trailing whitespace" $ do parseParas "@since 0.5.0 \t " `shouldBe` MetaDoc { _meta = Meta { _version = Just [0,5,0] } , _doc = DocEmpty } it "does not allow trailing input" $ do parseParas "@since 0.5.0 foo" `shouldBe` MetaDoc { _meta = Meta { _version = Nothing } , _doc = DocParagraph "@since 0.5.0 foo" } context "when given multiple times" $ do it "gives last occurrence precedence" $ do (parseParas . unlines) [ "@since 0.5.0" , "@since 0.6.0" , "@since 0.7.0" ] `shouldBe` MetaDoc { _meta = Meta { _version = Just [0,7,0] } , _doc = DocEmpty } context "when parsing text paragraphs" $ do let filterSpecial = filter (`notElem` (".(=#-[*`\v\f\n\t\r\\\"'_/@<> " :: String)) it "parses an empty paragraph" $ do "" `shouldParseTo` DocEmpty it "parses a simple text paragraph" $ do "foo bar baz" `shouldParseTo` DocParagraph "foo bar baz" it "accepts markup in text paragraphs" $ do "foo /bar/ baz" `shouldParseTo` DocParagraph ("foo " <> DocEmphasis "bar" <> " baz") it "preserve all regular characters" $ do property $ \xs -> let input = filterSpecial xs in (not . null) input ==> input `shouldParseTo` DocParagraph (DocString input) it "separates paragraphs by empty lines" $ do unlines [ "foo" , " \t " , "bar" ] `shouldParseTo` DocParagraph "foo" <> DocParagraph "bar" context "when a pragraph only contains monospaced text" $ do it "turns it into a code block" $ do "@foo@" `shouldParseTo` DocCodeBlock "foo" context "when a paragraph starts with a markdown link" $ do it "correctly parses it as a text paragraph (not a definition list)" $ do "[label](url)" `shouldParseTo` DocParagraph (hyperlink "url" "label") it "can be followed by an other paragraph" $ do "[label](url)\n\nfoobar" `shouldParseTo` DocParagraph (hyperlink "url" "label") <> DocParagraph "foobar" context "when paragraph contains additional text" $ do it "accepts more text after the link" $ do "[label](url) foo bar baz" `shouldParseTo` DocParagraph (hyperlink "url" "label" <> " foo bar baz") it "accepts a newline right after the markdown link" $ do "[label](url)\nfoo bar baz" `shouldParseTo` DocParagraph (hyperlink "url" "label" <> " foo bar baz") it "can be followed by an other paragraph" $ do "[label](url)foo\n\nbar" `shouldParseTo` DocParagraph (hyperlink "url" "label" <> "foo") <> DocParagraph "bar" context "when parsing birdtracks" $ do it "parses them as a code block" $ do unlines [ ">foo" , ">bar" , ">baz" ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" it "ignores leading whitespace" $ do unlines [ " >foo" , " \t >bar" , " >baz" ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz" it "strips one leading space from each line of the block" $ do unlines [ "> foo" , "> bar" , "> baz" ] `shouldParseTo` DocCodeBlock "foo\n bar\nbaz" it "ignores empty lines when stripping spaces" $ do unlines [ "> foo" , ">" , "> bar" ] `shouldParseTo` DocCodeBlock "foo\n\nbar" context "when any non-empty line does not start with a space" $ do it "does not strip any spaces" $ do unlines [ ">foo" , "> bar" ] `shouldParseTo` DocCodeBlock "foo\n bar" it "ignores nested markup" $ do unlines [ ">/foo/" ] `shouldParseTo` DocCodeBlock "/foo/" it "treats them as regular text inside text paragraphs" $ do unlines [ "foo" , ">bar" ] `shouldParseTo` DocParagraph "foo\n>bar" context "when parsing code blocks" $ do it "accepts a simple code block" $ do unlines [ "@" , "foo" , "bar" , "baz" , "@" ] `shouldParseTo` DocCodeBlock "foo\nbar\nbaz\n" it "ignores trailing whitespace after the opening @" $ do unlines [ "@ " , "foo" , "@" ] `shouldParseTo` DocCodeBlock "foo\n" it "rejects code blocks that are not closed" $ do unlines [ "@" , "foo" ] `shouldParseTo` DocParagraph "@\nfoo" it "accepts nested markup" $ do unlines [ "@" , "/foo/" , "@" ] `shouldParseTo` DocCodeBlock (DocEmphasis "foo" <> "\n") it "allows to escape the @" $ do unlines [ "@" , "foo" , "\\@" , "bar" , "@" ] `shouldParseTo` DocCodeBlock "foo\n@\nbar\n" it "accepts horizontal space before the @" $ do unlines [ " @" , "foo" , "" , "bar" , "@" ] `shouldParseTo` DocCodeBlock "foo\n\nbar\n" it "strips a leading space from a @ block if present" $ do unlines [ " @" , " hello" , " world" , " @" ] `shouldParseTo` DocCodeBlock "hello\nworld\n" unlines [ " @" , " hello" , "" , " world" , " @" ] `shouldParseTo` DocCodeBlock "hello\n\nworld\n" it "only drops whitespace if there's some before closing @" $ do unlines [ "@" , " Formatting" , " matters." , "@" ] `shouldParseTo` DocCodeBlock " Formatting\n matters.\n" it "accepts unicode" $ do "@foo 灼眼のシャナ bar@" `shouldParseTo` DocCodeBlock "foo 灼眼のシャナ bar" it "requires the closing @" $ do "@foo /bar/ baz" `shouldParseTo` DocParagraph ("@foo " <> DocEmphasis "bar" <> " baz") context "when parsing examples" $ do it "parses a simple example" $ do ">>> foo" `shouldParseTo` DocExamples [Example "foo" []] it "parses an example with result" $ do unlines [ ">>> foo" , "bar" , "baz" ] `shouldParseTo` DocExamples [Example "foo" ["bar", "baz"]] it "parses consecutive examples" $ do unlines [ ">>> fib 5" , "5" , ">>> fib 10" , "55" ] `shouldParseTo` DocExamples [ Example "fib 5" ["5"] , Example "fib 10" ["55"] ] it ("requires an example to be separated" ++ " from a previous paragraph by an empty line") $ do "foobar\n\n>>> fib 10\n55" `shouldParseTo` DocParagraph "foobar" <> DocExamples [Example "fib 10" ["55"]] it "parses bird-tracks inside of paragraphs as plain strings" $ do let xs = "foo\n>>> bar" xs `shouldParseTo` DocParagraph (DocString xs) it "skips empty lines in front of an example" $ do "\n \n\n>>> foo" `shouldParseTo` DocExamples [Example "foo" []] it "terminates example on empty line" $ do unlines [ ">>> foo" , "bar" , " " , "baz" ] `shouldParseTo` DocExamples [Example "foo" ["bar"]] <> DocParagraph "baz" it "parses a result as an empty result" $ do unlines [ ">>> foo" , "bar" , "" , "baz" ] `shouldParseTo` DocExamples [Example "foo" ["bar", "", "baz"]] it "accepts unicode in examples" $ do ">>> 灼眼\nシャナ" `shouldParseTo` DocExamples [Example "灼眼" ["シャナ"]] context "when prompt is prefixed by whitespace" $ do it "strips the exact same amount of whitespace from result lines" $ do unlines [ " >>> foo" , " bar" , " baz" ] `shouldParseTo` DocExamples [Example "foo" ["bar", "baz"]] it "preserves additional whitespace" $ do unlines [ " >>> foo" , " bar" ] `shouldParseTo` DocExamples [Example "foo" [" bar"]] it "keeps original if stripping is not possible" $ do unlines [ " >>> foo" , " bar" ] `shouldParseTo` DocExamples [Example "foo" [" bar"]] context "when parsing paragraphs nested in lists" $ do it "can nest the same type of list" $ do "* foo\n\n * bar" `shouldParseTo` DocUnorderedList [ DocParagraph "foo" <> DocUnorderedList [DocParagraph "bar"]] it "can nest another type of list inside" $ do "* foo\n\n 1. bar" `shouldParseTo` DocUnorderedList [ DocParagraph "foo" <> DocOrderedList [DocParagraph "bar"]] it "can nest a code block inside" $ do "* foo\n\n @foo bar baz@" `shouldParseTo` DocUnorderedList [ DocParagraph "foo" <> DocCodeBlock "foo bar baz"] "* foo\n\n @\n foo bar baz\n @" `shouldParseTo` DocUnorderedList [ DocParagraph "foo" <> DocCodeBlock "foo bar baz\n"] it "can nest more than one level" $ do "* foo\n\n * bar\n\n * baz\n qux" `shouldParseTo` DocUnorderedList [ DocParagraph "foo" <> DocUnorderedList [ DocParagraph "bar" <> DocUnorderedList [DocParagraph "baz\nqux"] ] ] it "won't fail on not fully indented paragraph" $ do "* foo\n\n * bar\n\n * qux\nquux" `shouldParseTo` DocUnorderedList [ DocParagraph "foo" <> DocUnorderedList [ DocParagraph "bar" ] , DocParagraph "qux\nquux"] it "can nest definition lists" $ do "[a]: foo\n\n [b]: bar\n\n [c]: baz\n qux" `shouldParseTo` DocDefList [ ("a", "foo" <> DocDefList [ ("b", "bar" <> DocDefList [("c", "baz\nqux")]) ]) ] it "can come back to top level with a different list" $ do "* foo\n\n * bar\n\n1. baz" `shouldParseTo` DocUnorderedList [ DocParagraph "foo" <> DocUnorderedList [ DocParagraph "bar" ] ] <> DocOrderedList [ DocParagraph "baz" ] it "allows arbitrary initial indent of a list" $ do unlines [ " * foo" , " * bar" , "" , " * quux" , "" , " * baz" ] `shouldParseTo` DocUnorderedList [ DocParagraph "foo" , DocParagraph "bar" <> DocUnorderedList [ DocParagraph "quux" ] , DocParagraph "baz" ] it "definition lists can come back to top level with a different list" $ do "[foo]: foov\n\n [bar]: barv\n\n1. baz" `shouldParseTo` DocDefList [ ("foo", "foov" <> DocDefList [ ("bar", "barv") ]) ] <> DocOrderedList [ DocParagraph "baz" ] it "list order is preserved in presence of nesting + extra text" $ do "1. Foo\n\n > Some code\n\n2. Bar\n\nSome text" `shouldParseTo` DocOrderedList [ DocParagraph "Foo" <> DocCodeBlock "Some code" , DocParagraph "Bar" ] <> DocParagraph (DocString "Some text") "1. Foo\n\n2. Bar\n\nSome text" `shouldParseTo` DocOrderedList [ DocParagraph "Foo" , DocParagraph "Bar" ] <> DocParagraph (DocString "Some text") context "when parsing properties" $ do it "can parse a single property" $ do "prop> 23 == 23" `shouldParseTo` DocProperty "23 == 23" it "can parse multiple subsequent properties" $ do unlines [ "prop> 23 == 23" , "prop> 42 == 42" ] `shouldParseTo` DocProperty "23 == 23" <> DocProperty "42 == 42" it "accepts unicode in properties" $ do "prop> 灼眼のシャナ ≡ 愛" `shouldParseTo` DocProperty "灼眼のシャナ ≡ 愛" it "can deal with whitespace before and after the prop> prompt" $ do " prop> xs == (reverse $ reverse xs) " `shouldParseTo` DocProperty "xs == (reverse $ reverse xs)" context "when parsing unordered lists" $ do it "parses a simple list" $ do unlines [ " * one" , " * two" , " * three" ] `shouldParseTo` DocUnorderedList [ DocParagraph "one" , DocParagraph "two" , DocParagraph "three" ] it "ignores empty lines between list items" $ do unlines [ "* one" , "" , "* two" ] `shouldParseTo` DocUnorderedList [ DocParagraph "one" , DocParagraph "two" ] it "accepts an empty list item" $ do "*" `shouldParseTo` DocUnorderedList [DocParagraph DocEmpty] it "accepts multi-line list items" $ do unlines [ "* point one" , " more one" , "* point two" , "more two" ] `shouldParseTo` DocUnorderedList [ DocParagraph "point one\n more one" , DocParagraph "point two\nmore two" ] it "accepts markup in list items" $ do "* /foo/" `shouldParseTo` DocUnorderedList [DocParagraph (DocEmphasis "foo")] it "requires empty lines between list and other paragraphs" $ do unlines [ "foo" , "" , "* bar" , "" , "baz" ] `shouldParseTo` DocParagraph "foo" <> DocUnorderedList [DocParagraph "bar"] <> DocParagraph "baz" context "when parsing ordered lists" $ do it "parses a simple list" $ do unlines [ " 1. one" , " (1) two" , " 3. three" ] `shouldParseTo` DocOrderedList [ DocParagraph "one" , DocParagraph "two" , DocParagraph "three" ] it "ignores empty lines between list items" $ do unlines [ "1. one" , "" , "2. two" ] `shouldParseTo` DocOrderedList [ DocParagraph "one" , DocParagraph "two" ] it "accepts an empty list item" $ do "1." `shouldParseTo` DocOrderedList [DocParagraph DocEmpty] it "accepts multi-line list items" $ do unlines [ "1. point one" , " more one" , "1. point two" , "more two" ] `shouldParseTo` DocOrderedList [ DocParagraph "point one\n more one" , DocParagraph "point two\nmore two" ] it "accepts markup in list items" $ do "1. /foo/" `shouldParseTo` DocOrderedList [DocParagraph (DocEmphasis "foo")] it "requires empty lines between list and other paragraphs" $ do unlines [ "foo" , "" , "1. bar" , "" , "baz" ] `shouldParseTo` DocParagraph "foo" <> DocOrderedList [DocParagraph "bar"] <> DocParagraph "baz" context "when parsing definition lists" $ do it "parses a simple list" $ do unlines [ " [foo]: one" , " [bar]: two" , " [baz]: three" ] `shouldParseTo` DocDefList [ ("foo", "one") , ("bar", "two") , ("baz", "three") ] it "ignores empty lines between list items" $ do unlines [ "[foo]: one" , "" , "[bar]: two" ] `shouldParseTo` DocDefList [ ("foo", "one") , ("bar", "two") ] it "accepts an empty list item" $ do "[foo]:" `shouldParseTo` DocDefList [("foo", DocEmpty)] it "accepts multi-line list items" $ do unlines [ "[foo]: point one" , " more one" , "[bar]: point two" , "more two" ] `shouldParseTo` DocDefList [ ("foo", "point one\n more one") , ("bar", "point two\nmore two") ] it "accepts markup in list items" $ do "[foo]: /foo/" `shouldParseTo` DocDefList [("foo", DocEmphasis "foo")] it "accepts markup for the label" $ do "[/foo/]: bar" `shouldParseTo` DocDefList [(DocEmphasis "foo", "bar")] it "requires empty lines between list and other paragraphs" $ do unlines [ "foo" , "" , "[foo]: bar" , "" , "baz" ] `shouldParseTo` DocParagraph "foo" <> DocDefList [("foo", "bar")] <> DocParagraph "baz" it "dose not require the colon (deprecated - this will be removed in a future release)" $ do unlines [ " [foo] one" , " [bar] two" , " [baz] three" ] `shouldParseTo` DocDefList [ ("foo", "one") , ("bar", "two") , ("baz", "three") ] context "when parsing consecutive paragraphs" $ do it "will not capture irrelevant consecutive lists" $ do unlines [ " * bullet" , "" , "" , " - different bullet" , "" , "" , " (1) ordered" , " " , " 2. different bullet" , " " , " [cat]: kitten" , " " , " [pineapple]: fruit" ] `shouldParseTo` DocUnorderedList [ DocParagraph "bullet" , DocParagraph "different bullet"] <> DocOrderedList [ DocParagraph "ordered" , DocParagraph "different bullet" ] <> DocDefList [ ("cat", "kitten") , ("pineapple", "fruit") ] context "when parsing function documentation headers" $ do it "can parse a simple header" $ do "= Header 1\nHello." `shouldParseTo` (DocHeader (Header 1 "Header 1")) <> DocParagraph "Hello." it "allow consecutive headers" $ do "= Header 1\n== Header 2" `shouldParseTo` DocHeader (Header 1 "Header 1") <> DocHeader (Header 2 "Header 2") it "accepts markup in the header" $ do "= /Header/ __1__\nFoo" `shouldParseTo` DocHeader (Header 1 (DocEmphasis "Header" <> " " <> DocBold "1")) <> DocParagraph "Foo" haddock-library-1.4.2/test/Documentation/Haddock/Utf8Spec.hs0000644000000000000000000000050512723656400022072 0ustar0000000000000000module Documentation.Haddock.Utf8Spec (main, spec) where import Test.Hspec import Test.QuickCheck import Documentation.Haddock.Utf8 main :: IO () main = hspec spec spec :: Spec spec = do describe "decodeUtf8" $ do it "is inverse to encodeUtf8" $ do property $ \xs -> (decodeUtf8 . encodeUtf8) xs `shouldBe` xs haddock-library-1.4.2/test/Documentation/Haddock/Parser/UtilSpec.hs0000644000000000000000000000134312723656400023416 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Documentation.Haddock.Parser.UtilSpec (main, spec) where import Documentation.Haddock.Parser.Monad import Documentation.Haddock.Parser.Util import Data.Either.Compat (isLeft) import Test.Hspec import Control.Applicative main :: IO () main = hspec spec spec :: Spec spec = do describe "takeUntil" $ do it "takes everything until a specified byte sequence" $ do snd <$> parseOnly (takeUntil "end") "someend" `shouldBe` Right "some" it "requires the end sequence" $ do snd <$> parseOnly (takeUntil "end") "someen" `shouldSatisfy` isLeft it "takes escaped bytes unconditionally" $ do snd <$> parseOnly (takeUntil "end") "some\\endend" `shouldBe` Right "some\\end" haddock-library-1.4.2/LICENSE0000644000000000000000000000235412723656400013761 0ustar0000000000000000Copyright 2002-2010, Simon Marlow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. haddock-library-1.4.2/Setup.hs0000644000000000000000000000005612723656400014405 0ustar0000000000000000import Distribution.Simple main = defaultMain haddock-library-1.4.2/haddock-library.cabal0000644000000000000000000000470712724377540017011 0ustar0000000000000000name: haddock-library version: 1.4.2 synopsis: Library exposing some functionality of Haddock. description: Haddock is a documentation-generation tool for Haskell libraries. These modules expose some functionality of it without pulling in the GHC dependency. Please note that the API is likely to change so specify upper bounds in your project if you can't release often. For interacting with Haddock itself, see the ‘haddock’ package. license: BSD3 license-file: LICENSE maintainer: Simon Hengel , Mateusz Kowalczyk 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 library default-language: Haskell2010 build-depends: base >= 4.5 && < 4.10 , bytestring , transformers , deepseq hs-source-dirs: src, vendor/attoparsec-0.12.1.1 ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 exposed-modules: Documentation.Haddock.Parser Documentation.Haddock.Parser.Monad Documentation.Haddock.Types Documentation.Haddock.Doc other-modules: Data.Attoparsec Data.Attoparsec.ByteString Data.Attoparsec.ByteString.Buffer Data.Attoparsec.ByteString.Char8 Data.Attoparsec.ByteString.FastSet Data.Attoparsec.ByteString.Internal Data.Attoparsec.Combinator Data.Attoparsec.Internal Data.Attoparsec.Internal.Fhthagn Data.Attoparsec.Internal.Types Data.Attoparsec.Number Documentation.Haddock.Parser.Util Documentation.Haddock.Utf8 test-suite spec type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: Spec.hs hs-source-dirs: test , src , vendor/attoparsec-0.12.1.1 ghc-options: -Wall cpp-options: -DTEST other-modules: Documentation.Haddock.ParserSpec Documentation.Haddock.Utf8Spec Documentation.Haddock.Parser.UtilSpec build-depends: base , bytestring , transformers , deepseq , base-compat , hspec , QuickCheck == 2.* source-repository head type: git subdir: haddock-library location: https://github.com/haskell/haddock.git