Rewrite "uri" without "withRaw"
This commit is contained in:
parent
65614a85bc
commit
3b9d4edcfc
1 changed files with 16 additions and 17 deletions
|
@ -199,7 +199,7 @@ where
|
||||||
import Prelude
|
import Prelude
|
||||||
import Control.Monad.Identity
|
import Control.Monad.Identity
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Data.Char (chr, isAlphaNum, isAscii, isAsciiUpper, isHexDigit,
|
import Data.Char (chr, isAlphaNum, isAscii, isAsciiUpper,
|
||||||
isPunctuation, isSpace, ord, toLower, toUpper)
|
isPunctuation, isSpace, ord, toLower, toUpper)
|
||||||
import Data.Default
|
import Data.Default
|
||||||
import Data.List (intercalate, isSuffixOf, transpose)
|
import Data.List (intercalate, isSuffixOf, transpose)
|
||||||
|
@ -591,25 +591,24 @@ uri = try $ do
|
||||||
-- http://en.wikipedia.org/wiki/State_of_emergency_(disambiguation)
|
-- http://en.wikipedia.org/wiki/State_of_emergency_(disambiguation)
|
||||||
-- as a URL, while NOT picking up the closing paren in
|
-- as a URL, while NOT picking up the closing paren in
|
||||||
-- (http://wikipedia.org). So we include balanced parens in the URL.
|
-- (http://wikipedia.org). So we include balanced parens in the URL.
|
||||||
let isWordChar c = isAlphaNum c || c `elem` "#$%+/@\\_-&="
|
str <- concat <$> many1 (uriChunkBetween '(' ')'
|
||||||
let wordChar = satisfy isWordChar
|
<|> uriChunkBetween '{' '}'
|
||||||
let percentEscaped = try $ char '%' >> skipMany1 (satisfy isHexDigit)
|
<|> uriChunkBetween '[' ']'
|
||||||
let entity = () <$ characterReference
|
<|> uriChunk)
|
||||||
let punct = skipMany1 (char ',')
|
|
||||||
<|> () <$ satisfy (\c -> not (isSpace c) && c /= '<' && c /= '>')
|
|
||||||
let uriChunk = skipMany1 wordChar
|
|
||||||
<|> percentEscaped
|
|
||||||
<|> entity
|
|
||||||
<|> try (punct >>
|
|
||||||
lookAhead (void (satisfy isWordChar) <|> percentEscaped))
|
|
||||||
str <- snd <$> withRaw (skipMany1 ( () <$
|
|
||||||
(enclosed (char '(') (char ')') uriChunk
|
|
||||||
<|> enclosed (char '{') (char '}') uriChunk
|
|
||||||
<|> enclosed (char '[') (char ']') uriChunk)
|
|
||||||
<|> uriChunk))
|
|
||||||
str' <- option str $ char '/' >> return (str ++ "/")
|
str' <- option str $ char '/' >> return (str ++ "/")
|
||||||
let uri' = scheme ++ ":" ++ fromEntities str'
|
let uri' = scheme ++ ":" ++ fromEntities str'
|
||||||
return (uri', escapeURI uri')
|
return (uri', escapeURI uri')
|
||||||
|
where
|
||||||
|
wordChar = alphaNum <|> oneOf "#$%+/@\\_-&="
|
||||||
|
percentEscaped = try $ (:) <$> char '%' <*> many1 hexDigit
|
||||||
|
entity = try $ pure <$> characterReference
|
||||||
|
punct = try $ many1 (char ',') <|> fmap pure (satisfy (\c -> not (isSpace c) && c /= '<' && c /= '>'))
|
||||||
|
uriChunk = many1 wordChar
|
||||||
|
<|> percentEscaped
|
||||||
|
<|> entity
|
||||||
|
<|> try (punct <* lookAhead (void wordChar <|> void percentEscaped))
|
||||||
|
uriChunkBetween l r = try $ do chunk <- between (char l) (char r) uriChunk
|
||||||
|
return ([l] ++ chunk ++ [r])
|
||||||
|
|
||||||
mathInlineWith :: Stream s m Char => String -> String -> ParserT s st m String
|
mathInlineWith :: Stream s m Char => String -> String -> ParserT s st m String
|
||||||
mathInlineWith op cl = try $ do
|
mathInlineWith op cl = try $ do
|
||||||
|
|
Loading…
Add table
Reference in a new issue