1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
-- |
-- 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 where
import Control.Applicative
import Control.Monad (mfilter)
import Data.Attoparsec.ByteString.Char8 hiding (parse, take, endOfLine)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Prelude hiding (takeWhile)
-- | 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)
where
-- As we don't parse these any further, we don't do any processing to the
-- string so we at least remove escape character here. Perhaps we should
-- actually be parsing the label at the very least?
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
|
