Rewrite "uri" without "withRaw"

This commit is contained in:
Alexander Krotov 2018-11-01 12:29:41 +03:00
parent 65614a85bc
commit 3b9d4edcfc

View file

@ -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