{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module URI.ByteString.Internal where
import Blaze.ByteString.Builder (Builder)
import qualified Blaze.ByteString.Builder as BB
import qualified Blaze.ByteString.Builder.Char.Utf8 as BB
import Control.Applicative
import Control.Monad
import qualified Control.Monad.Fail as F
import Data.Attoparsec.ByteString
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.ByteString.Char8 as A (decimal)
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.Char (ord, toLower)
import Data.Ix
import Data.List (delete, intersperse,
sortBy, stripPrefix, (\\))
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid as Monoid (mempty)
import Data.Ord (comparing)
import Data.Semigroup as Semigroup
import Data.Word
import Text.Read (readMaybe)
import URI.ByteString.Types
strictURIParserOptions :: URIParserOptions
strictURIParserOptions :: URIParserOptions
strictURIParserOptions = URIParserOptions {
upoValidQueryChar :: Word8 -> Bool
upoValidQueryChar = Word8 -> Bool
validForQuery
}
laxURIParserOptions :: URIParserOptions
laxURIParserOptions :: URIParserOptions
laxURIParserOptions = URIParserOptions {
upoValidQueryChar :: Word8 -> Bool
upoValidQueryChar = Word8 -> Bool
validForQueryLax
}
noNormalization :: URINormalizationOptions
noNormalization :: URINormalizationOptions
noNormalization = Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Map Scheme Port
-> URINormalizationOptions
URINormalizationOptions Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Map Scheme Port
httpDefaultPorts
httpDefaultPorts :: M.Map Scheme Port
httpDefaultPorts :: Map Scheme Port
httpDefaultPorts = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (ByteString -> Scheme
Scheme ByteString
"http", Int -> Port
Port Int
80)
, (ByteString -> Scheme
Scheme ByteString
"https", Int -> Port
Port Int
443)
]
rfc3986Normalization :: URINormalizationOptions
rfc3986Normalization :: URINormalizationOptions
rfc3986Normalization = URINormalizationOptions
noNormalization { unoDowncaseScheme :: Bool
unoDowncaseScheme = Bool
True
, unoDowncaseHost :: Bool
unoDowncaseHost = Bool
True
, unoRemoveDotSegments :: Bool
unoRemoveDotSegments = Bool
True
}
httpNormalization :: URINormalizationOptions
httpNormalization :: URINormalizationOptions
httpNormalization = URINormalizationOptions
rfc3986Normalization { unoDropDefPort :: Bool
unoDropDefPort = Bool
True
, unoSlashEmptyPath :: Bool
unoSlashEmptyPath = Bool
True
}
aggressiveNormalization :: URINormalizationOptions
aggressiveNormalization :: URINormalizationOptions
aggressiveNormalization = Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Map Scheme Port
-> URINormalizationOptions
URINormalizationOptions Bool
True Bool
True Bool
True Bool
True Bool
True Bool
True Bool
True Map Scheme Port
httpDefaultPorts
toAbsolute :: Scheme -> URIRef a -> URIRef Absolute
toAbsolute :: forall a. Scheme -> URIRef a -> URIRef Absolute
toAbsolute Scheme
scheme (RelativeRef {Maybe ByteString
Maybe Authority
ByteString
Query
rrFragment :: URIRef Relative -> Maybe ByteString
rrQuery :: URIRef Relative -> Query
rrPath :: URIRef Relative -> ByteString
rrAuthority :: URIRef Relative -> Maybe Authority
rrFragment :: Maybe ByteString
rrQuery :: Query
rrPath :: ByteString
rrAuthority :: Maybe Authority
..}) = Scheme
-> Maybe Authority
-> ByteString
-> Query
-> Maybe ByteString
-> URIRef Absolute
URI Scheme
scheme Maybe Authority
rrAuthority ByteString
rrPath Query
rrQuery Maybe ByteString
rrFragment
toAbsolute Scheme
_ uri :: URIRef a
uri@(URI {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriFragment :: URIRef Absolute -> Maybe ByteString
uriQuery :: URIRef Absolute -> Query
uriPath :: URIRef Absolute -> ByteString
uriAuthority :: URIRef Absolute -> Maybe Authority
uriScheme :: URIRef Absolute -> Scheme
uriFragment :: Maybe ByteString
uriQuery :: Query
uriPath :: ByteString
uriAuthority :: Maybe Authority
uriScheme :: Scheme
..}) = URIRef a
uri
serializeURIRef :: URIRef a -> Builder
serializeURIRef :: forall a. URIRef a -> Builder
serializeURIRef = forall a. URINormalizationOptions -> URIRef a -> Builder
normalizeURIRef URINormalizationOptions
noNormalization
serializeURIRef' :: URIRef a -> ByteString
serializeURIRef' :: forall a. URIRef a -> ByteString
serializeURIRef' = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. URIRef a -> Builder
serializeURIRef
serializeURI :: URIRef Absolute -> Builder
serializeURI :: URIRef Absolute -> Builder
serializeURI = forall a. URINormalizationOptions -> URIRef a -> Builder
normalizeURIRef URINormalizationOptions
noNormalization
{-# DEPRECATED serializeURI "Use 'serializeURIRef' instead" #-}
normalizeURIRef :: URINormalizationOptions -> URIRef a -> Builder
normalizeURIRef :: forall a. URINormalizationOptions -> URIRef a -> Builder
normalizeURIRef URINormalizationOptions
o uri :: URIRef a
uri@(URI {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriFragment :: Maybe ByteString
uriQuery :: Query
uriPath :: ByteString
uriAuthority :: Maybe Authority
uriScheme :: Scheme
uriFragment :: URIRef Absolute -> Maybe ByteString
uriQuery :: URIRef Absolute -> Query
uriPath :: URIRef Absolute -> ByteString
uriAuthority :: URIRef Absolute -> Maybe Authority
uriScheme :: URIRef Absolute -> Scheme
..}) = URINormalizationOptions -> URIRef Absolute -> Builder
normalizeURI URINormalizationOptions
o URIRef a
uri
normalizeURIRef URINormalizationOptions
o uri :: URIRef a
uri@(RelativeRef {}) = URINormalizationOptions
-> Maybe Scheme -> URIRef Relative -> Builder
normalizeRelativeRef URINormalizationOptions
o forall a. Maybe a
Nothing URIRef a
uri
normalizeURIRef' :: URINormalizationOptions -> URIRef a -> ByteString
normalizeURIRef' :: forall a. URINormalizationOptions -> URIRef a -> ByteString
normalizeURIRef' URINormalizationOptions
o = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. URINormalizationOptions -> URIRef a -> Builder
normalizeURIRef URINormalizationOptions
o
normalizeURI :: URINormalizationOptions -> URIRef Absolute -> Builder
normalizeURI :: URINormalizationOptions -> URIRef Absolute -> Builder
normalizeURI o :: URINormalizationOptions
o@URINormalizationOptions {Bool
Map Scheme Port
unoDefaultPorts :: URINormalizationOptions -> Map Scheme Port
unoSortParameters :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: URINormalizationOptions -> Bool
unoDefaultPorts :: Map Scheme Port
unoRemoveDotSegments :: Bool
unoSortParameters :: Bool
unoDropExtraSlashes :: Bool
unoSlashEmptyPath :: Bool
unoDropDefPort :: Bool
unoDowncaseHost :: Bool
unoDowncaseScheme :: Bool
unoSlashEmptyPath :: URINormalizationOptions -> Bool
unoDropDefPort :: URINormalizationOptions -> Bool
unoRemoveDotSegments :: URINormalizationOptions -> Bool
unoDowncaseHost :: URINormalizationOptions -> Bool
unoDowncaseScheme :: URINormalizationOptions -> Bool
..} URI {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriFragment :: Maybe ByteString
uriQuery :: Query
uriPath :: ByteString
uriAuthority :: Maybe Authority
uriScheme :: Scheme
uriFragment :: URIRef Absolute -> Maybe ByteString
uriQuery :: URIRef Absolute -> Query
uriPath :: URIRef Absolute -> ByteString
uriAuthority :: URIRef Absolute -> Maybe Authority
uriScheme :: URIRef Absolute -> Scheme
..} =
Builder
scheme forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
BB.fromString [Char]
":" forall a. Semigroup a => a -> a -> a
<> URINormalizationOptions
-> Maybe Scheme -> URIRef Relative -> Builder
normalizeRelativeRef URINormalizationOptions
o (forall a. a -> Maybe a
Just Scheme
uriScheme) URIRef Relative
rr
where
scheme :: Builder
scheme = ByteString -> Builder
bs (ByteString -> ByteString
sCase (Scheme -> ByteString
schemeBS Scheme
uriScheme))
sCase :: ByteString -> ByteString
sCase
| Bool
unoDowncaseScheme = ByteString -> ByteString
downcaseBS
| Bool
otherwise = forall a. a -> a
id
rr :: URIRef Relative
rr = Maybe Authority
-> ByteString -> Query -> Maybe ByteString -> URIRef Relative
RelativeRef Maybe Authority
uriAuthority ByteString
uriPath Query
uriQuery Maybe ByteString
uriFragment
normalizeRelativeRef :: URINormalizationOptions -> Maybe Scheme -> URIRef Relative -> Builder
normalizeRelativeRef :: URINormalizationOptions
-> Maybe Scheme -> URIRef Relative -> Builder
normalizeRelativeRef o :: URINormalizationOptions
o@URINormalizationOptions {Bool
Map Scheme Port
unoDefaultPorts :: Map Scheme Port
unoRemoveDotSegments :: Bool
unoSortParameters :: Bool
unoDropExtraSlashes :: Bool
unoSlashEmptyPath :: Bool
unoDropDefPort :: Bool
unoDowncaseHost :: Bool
unoDowncaseScheme :: Bool
unoDefaultPorts :: URINormalizationOptions -> Map Scheme Port
unoSortParameters :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: URINormalizationOptions -> Bool
unoSlashEmptyPath :: URINormalizationOptions -> Bool
unoDropDefPort :: URINormalizationOptions -> Bool
unoRemoveDotSegments :: URINormalizationOptions -> Bool
unoDowncaseHost :: URINormalizationOptions -> Bool
unoDowncaseScheme :: URINormalizationOptions -> Bool
..} Maybe Scheme
mScheme RelativeRef {Maybe ByteString
Maybe Authority
ByteString
Query
rrFragment :: Maybe ByteString
rrQuery :: Query
rrPath :: ByteString
rrAuthority :: Maybe Authority
rrFragment :: URIRef Relative -> Maybe ByteString
rrQuery :: URIRef Relative -> Query
rrPath :: URIRef Relative -> ByteString
rrAuthority :: URIRef Relative -> Maybe Authority
..} =
Builder
authority forall a. Semigroup a => a -> a -> a
<> Builder
path forall a. Semigroup a => a -> a -> a
<> Builder
query forall a. Semigroup a => a -> a -> a
<> Builder
fragment
where
path :: Builder
path
| Bool
unoSlashEmptyPath Bool -> Bool -> Bool
&& ByteString -> Bool
BS.null ByteString
rrPath = ByteString -> Builder
BB.fromByteString ByteString
"/"
| [ByteString]
segs forall a. Eq a => a -> a -> Bool
== [ByteString
""] = ByteString -> Builder
BB.fromByteString ByteString
"/"
| Bool
otherwise = forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse (Char -> Builder
c8 Char
'/') (forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Builder
urlEncodePath [ByteString]
segs))
segs :: [ByteString]
segs = [ByteString] -> [ByteString]
dropSegs (Word8 -> ByteString -> [ByteString]
BS.split Word8
slash (ByteString -> ByteString
pathRewrite ByteString
rrPath))
pathRewrite :: ByteString -> ByteString
pathRewrite
| Bool
unoRemoveDotSegments = ByteString -> ByteString
removeDotSegments
| Bool
otherwise = forall a. a -> a
id
dropSegs :: [ByteString] -> [ByteString]
dropSegs [] = []
dropSegs (ByteString
h:[ByteString]
t)
| Bool
unoDropExtraSlashes = ByteString
hforall a. a -> [a] -> [a]
:(forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null) [ByteString]
t)
| Bool
otherwise = ByteString
hforall a. a -> [a] -> [a]
:[ByteString]
t
authority :: Builder
authority = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
Monoid.mempty (URINormalizationOptions -> Maybe Scheme -> Authority -> Builder
serializeAuthority URINormalizationOptions
o Maybe Scheme
mScheme) Maybe Authority
rrAuthority
query :: Builder
query = URINormalizationOptions -> Query -> Builder
serializeQuery URINormalizationOptions
o Query
rrQuery
fragment :: Builder
fragment = Maybe ByteString -> Builder
serializeFragment Maybe ByteString
rrFragment
removeDotSegments :: ByteString -> ByteString
removeDotSegments :: ByteString -> ByteString
removeDotSegments ByteString
path = forall a. Monoid a => [a] -> a
mconcat (forall a. RL a -> [a]
rl2L (ByteString -> RL ByteString -> RL ByteString
go ByteString
path (forall a. [a] -> RL a
RL [])))
where
go :: ByteString -> RL ByteString -> RL ByteString
go ByteString
inBuf RL ByteString
outBuf
| ByteString -> ByteString -> Bool
BS8.isPrefixOf ByteString
"../" ByteString
inBuf = ByteString -> RL ByteString -> RL ByteString
go (Int -> ByteString -> ByteString
BS8.drop Int
3 ByteString
inBuf) RL ByteString
outBuf
| ByteString -> ByteString -> Bool
BS8.isPrefixOf ByteString
"./" ByteString
inBuf = ByteString -> RL ByteString -> RL ByteString
go (Int -> ByteString -> ByteString
BS8.drop Int
2 ByteString
inBuf) RL ByteString
outBuf
| ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
"/./" ByteString
inBuf = ByteString -> RL ByteString -> RL ByteString
go (Int -> ByteString -> ByteString
BS8.drop Int
2 ByteString
inBuf) RL ByteString
outBuf
| ByteString
inBuf forall a. Eq a => a -> a -> Bool
== ByteString
"/." = ByteString -> RL ByteString -> RL ByteString
go ByteString
"/" RL ByteString
outBuf
| ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
"/../" ByteString
inBuf = ByteString -> RL ByteString -> RL ByteString
go (Int -> ByteString -> ByteString
BS8.drop Int
3 ByteString
inBuf) (forall a. RL a -> RL a
unsnoc (forall a. RL a -> RL a
unsnoc RL ByteString
outBuf))
| ByteString
inBuf forall a. Eq a => a -> a -> Bool
== ByteString
"/.." = ByteString -> RL ByteString -> RL ByteString
go ByteString
"/" (forall a. RL a -> RL a
unsnoc (forall a. RL a -> RL a
unsnoc RL ByteString
outBuf))
| ByteString
inBuf forall a. Eq a => a -> a -> Bool
== ByteString
"." = ByteString -> RL ByteString -> RL ByteString
go forall a. Monoid a => a
mempty RL ByteString
outBuf
| ByteString
inBuf forall a. Eq a => a -> a -> Bool
== ByteString
".." = ByteString -> RL ByteString -> RL ByteString
go forall a. Monoid a => a
mempty RL ByteString
outBuf
| Bool
otherwise = case ByteString -> Maybe (Char, ByteString)
BS8.uncons ByteString
inBuf of
Just (Char
'/', ByteString
rest) ->
let (ByteString
thisSeg, ByteString
inBuf') = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.span (forall a. Eq a => a -> a -> Bool
/= Char
'/') ByteString
rest
in ByteString -> RL ByteString -> RL ByteString
go ByteString
inBuf' (RL ByteString
outBuf forall a. RL a -> a -> RL a
|> ByteString
"/" forall a. RL a -> a -> RL a
|> ByteString
thisSeg)
Just (Char
_, ByteString
_) ->
let (ByteString
thisSeg, ByteString
inBuf') = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS8.span (forall a. Eq a => a -> a -> Bool
/= Char
'/') ByteString
inBuf
in ByteString -> RL ByteString -> RL ByteString
go ByteString
inBuf' (RL ByteString
outBuf forall a. RL a -> a -> RL a
|> ByteString
thisSeg)
Maybe (Char, ByteString)
Nothing -> RL ByteString
outBuf
serializeURI' :: URIRef Absolute -> ByteString
serializeURI' :: URIRef Absolute -> ByteString
serializeURI' = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIRef Absolute -> Builder
serializeURI
{-# DEPRECATED serializeURI' "Use 'serializeURIRef'' instead" #-}
serializeRelativeRef :: URIRef Relative -> Builder
serializeRelativeRef :: URIRef Relative -> Builder
serializeRelativeRef = URINormalizationOptions
-> Maybe Scheme -> URIRef Relative -> Builder
normalizeRelativeRef URINormalizationOptions
noNormalization forall a. Maybe a
Nothing
{-# DEPRECATED serializeRelativeRef "Use 'serializeURIRef' instead" #-}
serializeRelativeRef' :: URIRef Relative -> ByteString
serializeRelativeRef' :: URIRef Relative -> ByteString
serializeRelativeRef' = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIRef Relative -> Builder
serializeRelativeRef
{-# DEPRECATED serializeRelativeRef' "Use 'serializeURIRef'' instead" #-}
serializeQuery :: URINormalizationOptions -> Query -> Builder
serializeQuery :: URINormalizationOptions -> Query -> Builder
serializeQuery URINormalizationOptions
_ (Query []) = forall a. Monoid a => a
mempty
serializeQuery URINormalizationOptions {Bool
Map Scheme Port
unoDefaultPorts :: Map Scheme Port
unoRemoveDotSegments :: Bool
unoSortParameters :: Bool
unoDropExtraSlashes :: Bool
unoSlashEmptyPath :: Bool
unoDropDefPort :: Bool
unoDowncaseHost :: Bool
unoDowncaseScheme :: Bool
unoDefaultPorts :: URINormalizationOptions -> Map Scheme Port
unoSortParameters :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: URINormalizationOptions -> Bool
unoSlashEmptyPath :: URINormalizationOptions -> Bool
unoDropDefPort :: URINormalizationOptions -> Bool
unoRemoveDotSegments :: URINormalizationOptions -> Bool
unoDowncaseHost :: URINormalizationOptions -> Bool
unoDowncaseScheme :: URINormalizationOptions -> Bool
..} (Query [(ByteString, ByteString)]
ps) =
Char -> Builder
c8 Char
'?' forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse (Char -> Builder
c8 Char
'&') (forall a b. (a -> b) -> [a] -> [b]
map (ByteString, ByteString) -> Builder
serializePair [(ByteString, ByteString)]
ps'))
where
serializePair :: (ByteString, ByteString) -> Builder
serializePair (ByteString
k, ByteString
v) = ByteString -> Builder
urlEncodeQuery ByteString
k forall a. Semigroup a => a -> a -> a
<> Char -> Builder
c8 Char
'=' forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
urlEncodeQuery ByteString
v
ps' :: [(ByteString, ByteString)]
ps'
| Bool
unoSortParameters = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst) [(ByteString, ByteString)]
ps
| Bool
otherwise = [(ByteString, ByteString)]
ps
serializeQuery' :: URINormalizationOptions -> Query -> ByteString
serializeQuery' :: URINormalizationOptions -> Query -> ByteString
serializeQuery' URINormalizationOptions
opts = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. URINormalizationOptions -> Query -> Builder
serializeQuery URINormalizationOptions
opts
serializeFragment :: Maybe ByteString -> Builder
serializeFragment :: Maybe ByteString -> Builder
serializeFragment = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\ByteString
s -> Char -> Builder
c8 Char
'#' forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
bs ByteString
s)
serializeFragment' :: Maybe ByteString -> ByteString
serializeFragment' :: Maybe ByteString -> ByteString
serializeFragment' = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> Builder
serializeFragment
serializeAuthority :: URINormalizationOptions -> Maybe Scheme -> Authority -> Builder
serializeAuthority :: URINormalizationOptions -> Maybe Scheme -> Authority -> Builder
serializeAuthority URINormalizationOptions {Bool
Map Scheme Port
unoDefaultPorts :: Map Scheme Port
unoRemoveDotSegments :: Bool
unoSortParameters :: Bool
unoDropExtraSlashes :: Bool
unoSlashEmptyPath :: Bool
unoDropDefPort :: Bool
unoDowncaseHost :: Bool
unoDowncaseScheme :: Bool
unoDefaultPorts :: URINormalizationOptions -> Map Scheme Port
unoSortParameters :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: URINormalizationOptions -> Bool
unoSlashEmptyPath :: URINormalizationOptions -> Bool
unoDropDefPort :: URINormalizationOptions -> Bool
unoRemoveDotSegments :: URINormalizationOptions -> Bool
unoDowncaseHost :: URINormalizationOptions -> Bool
unoDowncaseScheme :: URINormalizationOptions -> Bool
..} Maybe Scheme
mScheme Authority {Maybe UserInfo
Maybe Port
Host
authorityPort :: Authority -> Maybe Port
authorityHost :: Authority -> Host
authorityUserInfo :: Authority -> Maybe UserInfo
authorityPort :: Maybe Port
authorityHost :: Host
authorityUserInfo :: Maybe UserInfo
..} = [Char] -> Builder
BB.fromString [Char]
"//" forall a. Semigroup a => a -> a -> a
<> Builder
userinfo forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
bs ByteString
host forall a. Semigroup a => a -> a -> a
<> Builder
port
where
userinfo :: Builder
userinfo = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty UserInfo -> Builder
serializeUserInfo Maybe UserInfo
authorityUserInfo
host :: ByteString
host = ByteString -> ByteString
hCase (Host -> ByteString
hostBS Host
authorityHost)
hCase :: ByteString -> ByteString
hCase
| Bool
unoDowncaseHost = ByteString -> ByteString
downcaseBS
| Bool
otherwise = forall a. a -> a
id
port :: Builder
port = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Port -> Builder
packPort Maybe Port
effectivePort
effectivePort :: Maybe Port
effectivePort = do
Port
p <- Maybe Port
authorityPort
Maybe Scheme -> Port -> Maybe Port
dropPort Maybe Scheme
mScheme Port
p
packPort :: Port -> Builder
packPort (Port Int
p) = Char -> Builder
c8 Char
':' forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
BB.fromString (forall a. Show a => a -> [Char]
show Int
p)
dropPort :: Maybe Scheme -> Port -> Maybe Port
dropPort Maybe Scheme
Nothing = forall a. a -> Maybe a
Just
dropPort (Just Scheme
scheme)
| Bool
unoDropDefPort = Scheme -> Port -> Maybe Port
dropPort' Scheme
scheme
| Bool
otherwise = forall a. a -> Maybe a
Just
dropPort' :: Scheme -> Port -> Maybe Port
dropPort' Scheme
s Port
p
| forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Scheme
s Map Scheme Port
unoDefaultPorts forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Port
p = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just Port
p
serializeAuthority' :: URINormalizationOptions -> Maybe Scheme -> Authority -> ByteString
serializeAuthority' :: URINormalizationOptions -> Maybe Scheme -> Authority -> ByteString
serializeAuthority' URINormalizationOptions
opts Maybe Scheme
mScheme = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. URINormalizationOptions -> Maybe Scheme -> Authority -> Builder
serializeAuthority URINormalizationOptions
opts Maybe Scheme
mScheme
serializeUserInfo :: UserInfo -> Builder
serializeUserInfo :: UserInfo -> Builder
serializeUserInfo UserInfo {ByteString
uiPassword :: UserInfo -> ByteString
uiUsername :: UserInfo -> ByteString
uiPassword :: ByteString
uiUsername :: ByteString
..} = ByteString -> Builder
bs ByteString
uiUsername forall a. Semigroup a => a -> a -> a
<> Char -> Builder
c8 Char
':' forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
bs ByteString
uiPassword forall a. Semigroup a => a -> a -> a
<> Char -> Builder
c8 Char
'@'
serializeUserInfo' :: UserInfo -> ByteString
serializeUserInfo' :: UserInfo -> ByteString
serializeUserInfo' = Builder -> ByteString
BB.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserInfo -> Builder
serializeUserInfo
bs :: ByteString -> Builder
bs :: ByteString -> Builder
bs = ByteString -> Builder
BB.fromByteString
c8 :: Char -> Builder
c8 :: Char -> Builder
c8 = Char -> Builder
BB.fromChar
parseURI :: URIParserOptions -> ByteString -> Either URIParseError (URIRef Absolute)
parseURI :: URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
opts = forall e a.
Read e =>
([Char] -> e) -> Parser' e a -> ByteString -> Either e a
parseOnly' [Char] -> URIParseError
OtherError (URIParserOptions -> URIParser (URIRef Absolute)
uriParser' URIParserOptions
opts)
parseRelativeRef :: URIParserOptions -> ByteString -> Either URIParseError (URIRef Relative)
parseRelativeRef :: URIParserOptions
-> ByteString -> Either URIParseError (URIRef Relative)
parseRelativeRef URIParserOptions
opts = forall e a.
Read e =>
([Char] -> e) -> Parser' e a -> ByteString -> Either e a
parseOnly' [Char] -> URIParseError
OtherError (URIParserOptions -> URIParser (URIRef Relative)
relativeRefParser' URIParserOptions
opts)
type URIParser = Parser' URIParseError
uriParser :: URIParserOptions -> Parser (URIRef Absolute)
uriParser :: URIParserOptions -> Parser (URIRef Absolute)
uriParser = forall e a. Parser' e a -> Parser a
unParser' forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions -> URIParser (URIRef Absolute)
uriParser'
uriParser' :: URIParserOptions -> URIParser (URIRef Absolute)
uriParser' :: URIParserOptions -> URIParser (URIRef Absolute)
uriParser' URIParserOptions
opts = do
Scheme
scheme <- URIParser Scheme
schemeParser
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Word8 -> Parser Word8
word8 Word8
colon forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` SchemaError -> URIParseError
MalformedScheme SchemaError
MissingColon
RelativeRef Maybe Authority
authority ByteString
path Query
query Maybe ByteString
fragment <- URIParserOptions -> URIParser (URIRef Relative)
relativeRefParser' URIParserOptions
opts
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Scheme
-> Maybe Authority
-> ByteString
-> Query
-> Maybe ByteString
-> URIRef Absolute
URI Scheme
scheme Maybe Authority
authority ByteString
path Query
query Maybe ByteString
fragment
relativeRefParser :: URIParserOptions -> Parser (URIRef Relative)
relativeRefParser :: URIParserOptions -> Parser (URIRef Relative)
relativeRefParser = forall e a. Parser' e a -> Parser a
unParser' forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions -> URIParser (URIRef Relative)
relativeRefParser'
relativeRefParser' :: URIParserOptions -> URIParser (URIRef Relative)
relativeRefParser' :: URIParserOptions -> URIParser (URIRef Relative)
relativeRefParser' URIParserOptions
opts = do
(Maybe Authority
authority, ByteString
path) <- Parser' URIParseError (Maybe Authority, ByteString)
hierPartParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser' URIParseError (Maybe Authority, ByteString)
rrPathParser
Query
query <- URIParserOptions -> URIParser Query
queryParser URIParserOptions
opts
Maybe ByteString
frag <- URIParser (Maybe ByteString)
mFragmentParser
case Maybe ByteString
frag of
Just ByteString
_ -> forall t. Chunk t => Parser t ()
endOfInput forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedFragment
Maybe ByteString
Nothing -> forall t. Chunk t => Parser t ()
endOfInput forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedQuery
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Authority
-> ByteString -> Query -> Maybe ByteString -> URIRef Relative
RelativeRef Maybe Authority
authority ByteString
path Query
query Maybe ByteString
frag
schemeParser :: URIParser Scheme
schemeParser :: URIParser Scheme
schemeParser = do
Word8
c <- (Word8 -> Bool) -> Parser Word8
satisfy Word8 -> Bool
isAlpha forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` SchemaError -> URIParseError
MalformedScheme SchemaError
NonAlphaLeading
ByteString
rest <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile Word8 -> Bool
isSchemeValid forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` SchemaError -> URIParseError
MalformedScheme SchemaError
InvalidChars
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Scheme
Scheme forall a b. (a -> b) -> a -> b
$ Word8
c Word8 -> ByteString -> ByteString
`BS.cons` ByteString
rest
where
isSchemeValid :: Word8 -> Bool
isSchemeValid = [Char] -> Word8 -> Bool
inClass forall a b. (a -> b) -> a -> b
$ [Char]
"-+." forall a. [a] -> [a] -> [a]
++ [Char]
alphaNum
hierPartParser :: URIParser (Maybe Authority, ByteString)
hierPartParser :: Parser' URIParseError (Maybe Authority, ByteString)
hierPartParser = Parser' URIParseError (Maybe Authority, ByteString)
authWithPathParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Parser' URIParseError (Maybe Authority, ByteString)
pathAbsoluteParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Parser' URIParseError (Maybe Authority, ByteString)
pathRootlessParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Parser' URIParseError (Maybe Authority, ByteString)
pathEmptyParser
rrPathParser :: URIParser (Maybe Authority, ByteString)
rrPathParser :: Parser' URIParseError (Maybe Authority, ByteString)
rrPathParser = (forall a. Maybe a
Nothing,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' URIParseError ByteString
firstRelRefSegmentParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser' URIParseError ByteString
pathParser)
authWithPathParser :: URIParser (Maybe Authority, ByteString)
authWithPathParser :: Parser' URIParseError (Maybe Authority, ByteString)
authWithPathParser = forall e. ByteString -> Parser' e ByteString
string' ByteString
"//" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URIParser (Maybe Authority)
mAuthorityParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser' URIParseError ByteString
pathParser)
pathAbsoluteParser :: URIParser (Maybe Authority, ByteString)
pathAbsoluteParser :: Parser' URIParseError (Maybe Authority, ByteString)
pathAbsoluteParser = forall e. ByteString -> Parser' e ByteString
string' ByteString
"/" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser' URIParseError (Maybe Authority, ByteString)
pathRootlessParser
pathRootlessParser :: URIParser (Maybe Authority, ByteString)
pathRootlessParser :: Parser' URIParseError (Maybe Authority, ByteString)
pathRootlessParser = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser' URIParseError ByteString
pathParser1
pathEmptyParser :: URIParser (Maybe Authority, ByteString)
pathEmptyParser :: Parser' URIParseError (Maybe Authority, ByteString)
pathEmptyParser = do
Maybe Word8
nextChar <- Parser (Maybe Word8)
peekWord8 forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` [Char] -> URIParseError
OtherError [Char]
"impossible peekWord8 error"
case Maybe Word8
nextChar of
Just Word8
c -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Char] -> Word8 -> Bool
notInClass [Char]
pchar Word8
c) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall {a}. (Maybe a, ByteString)
emptyCase
Maybe Word8
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall {a}. (Maybe a, ByteString)
emptyCase
where
emptyCase :: (Maybe a, ByteString)
emptyCase = (forall a. Maybe a
Nothing, forall a. Monoid a => a
mempty)
mAuthorityParser :: URIParser (Maybe Authority)
mAuthorityParser :: URIParser (Maybe Authority)
mAuthorityParser = forall e a. Parser' e a -> Parser' e (Maybe a)
mParse URIParser Authority
authorityParser
userInfoParser :: URIParser UserInfo
userInfoParser :: URIParser UserInfo
userInfoParser = (Parser ByteString UserInfo
uiTokenParser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser Word8
word8 Word8
atSym) forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedUserInfo
where
atSym :: Word8
atSym = Word8
64
uiTokenParser :: Parser ByteString UserInfo
uiTokenParser = do
ByteString
ui <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 Word8 -> Bool
validForUserInfo
let (ByteString
user, ByteString
passWithColon) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (forall a. Eq a => a -> a -> Bool
== Word8
colon) forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
urlDecode' ByteString
ui
let pass :: ByteString
pass = Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
passWithColon
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> UserInfo
UserInfo ByteString
user ByteString
pass
validForUserInfo :: Word8 -> Bool
validForUserInfo = [Char] -> Word8 -> Bool
inClass forall a b. (a -> b) -> a -> b
$ [Char]
pctEncoded forall a. [a] -> [a] -> [a]
++ [Char]
subDelims forall a. [a] -> [a] -> [a]
++ (Char
':' forall a. a -> [a] -> [a]
: [Char]
unreserved)
authorityParser :: URIParser Authority
authorityParser :: URIParser Authority
authorityParser = Maybe UserInfo -> Host -> Maybe Port -> Authority
Authority forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. Parser' e a -> Parser' e (Maybe a)
mParse URIParser UserInfo
userInfoParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> URIParser Host
hostParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> URIParser (Maybe Port)
mPortParser
hostParser :: URIParser Host
hostParser :: URIParser Host
hostParser = (ByteString -> Host
Host forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
parsers) forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedHost
where
parsers :: Parser ByteString
parsers = Parser ByteString
ipLiteralParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
ipV4Parser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
regNameParser
ipLiteralParser :: Parser ByteString
ipLiteralParser = Word8 -> Parser Word8
word8 Word8
oBracket forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser ByteString
ipVFutureParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
ipV6Parser) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser Word8
word8 Word8
cBracket
ipV6Parser :: Parser ByteString
ipV6Parser :: Parser ByteString
ipV6Parser = do
[ByteString]
leading <- Parser ByteString [ByteString]
h16s
[ByteString]
elided <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. a -> b -> a
const [ByteString
""]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByteString -> Parser ByteString
string ByteString
"::")
[ByteString]
trailing <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Word8 -> Bool) -> Parser ByteString
A.takeWhile (forall a. Eq a => a -> a -> Bool
/= Word8
colon) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser Word8
word8 Word8
colon)
(Int
finalChunkLen, Maybe ByteString
final) <- Parser ByteString (Int, Maybe ByteString)
finalChunk
let len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ByteString]
leading forall a. [a] -> [a] -> [a]
++ [ByteString]
trailing) forall a. Num a => a -> a -> a
+ Int
finalChunkLen
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Ord a => a -> a -> Bool
> Int
8) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Too many digits in IPv6 address"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
rejoin forall a b. (a -> b) -> a -> b
$ [[ByteString] -> ByteString
rejoin [ByteString]
leading] forall a. [a] -> [a] -> [a]
++ [ByteString]
elided forall a. [a] -> [a] -> [a]
++ [ByteString]
trailing forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe ByteString
final
where
finalChunk :: Parser ByteString (Int, Maybe ByteString)
finalChunk = forall a. a -> Maybe a -> a
fromMaybe (Int
0, forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString (Int, Maybe ByteString)
finalIpV4 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString (Int, Maybe ByteString)
finalH16)
finalH16 :: Parser ByteString (Int, Maybe ByteString)
finalH16 = (Int
1, ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
h16
finalIpV4 :: Parser ByteString (Int, Maybe ByteString)
finalIpV4 = (Int
2, ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
ipV4Parser
rejoin :: [ByteString] -> ByteString
rejoin = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
":"
h16s :: Parser ByteString [ByteString]
h16s = Parser ByteString
h16 forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Word8 -> Parser Word8
word8 Word8
colon
h16 :: Parser ByteString
h16 = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(Alternative m, Monad m) =>
Int -> Int -> m a -> m [a]
parseBetween Int
1 Int
4 ((Word8 -> Bool) -> Parser ByteString
A.takeWhile1 Word8 -> Bool
hexDigit)
ipVFutureParser :: Parser ByteString
ipVFutureParser :: Parser ByteString
ipVFutureParser = do
Word8
_ <- Word8 -> Parser Word8
word8 Word8
lowercaseV
ByteString
ds <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 Word8 -> Bool
hexDigit
Word8
_ <- Word8 -> Parser Word8
word8 Word8
period
ByteString
rest <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 forall a b. (a -> b) -> a -> b
$ [Char] -> Word8 -> Bool
inClass forall a b. (a -> b) -> a -> b
$ [Char]
subDelims forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ [Char]
unreserved
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString
"v" forall a. Semigroup a => a -> a -> a
<> ByteString
ds forall a. Semigroup a => a -> a -> a
<> ByteString
"." forall a. Semigroup a => a -> a -> a
<> ByteString
rest
where
lowercaseV :: Word8
lowercaseV = Word8
118
ipV4Parser :: Parser ByteString
ipV4Parser :: Parser ByteString
ipV4Parser = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Parser ByteString
decOctet
, Parser ByteString
dot
, Parser ByteString
decOctet
, Parser ByteString
dot
, Parser ByteString
decOctet
, Parser ByteString
dot
, Parser ByteString
decOctet]
where
decOctet :: Parser ByteString
decOctet :: Parser ByteString
decOctet = do
(ByteString
s,Int
num) <- forall a. Parser a -> Parser (ByteString, a)
A.match forall a. Integral a => Parser a
A.decimal
let len :: Int
len = ByteString -> Int
BS.length ByteString
s
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
len forall a. Ord a => a -> a -> Bool
<= Int
3
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Int
num forall a. Ord a => a -> a -> Bool
>= (Int
1 :: Int) Bool -> Bool -> Bool
&& Int
num forall a. Ord a => a -> a -> Bool
<= Int
255
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s
dot :: Parser ByteString
dot = ByteString -> Parser ByteString
string ByteString
"."
regNameParser :: Parser ByteString
regNameParser :: Parser ByteString
regNameParser = ByteString -> ByteString
urlDecode' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 ([Char] -> Word8 -> Bool
inClass [Char]
validForRegName)
where
validForRegName :: [Char]
validForRegName = [Char]
pctEncoded forall a. [a] -> [a] -> [a]
++ [Char]
subDelims forall a. [a] -> [a] -> [a]
++ [Char]
unreserved
mPortParser :: URIParser (Maybe Port)
mPortParser :: URIParser (Maybe Port)
mPortParser = forall e. Word8 -> Parser' e Word8
word8' Word8
colon forall e a b. Parser' e a -> Parser' e b -> Parser' e (Maybe b)
`thenJust` URIParser Port
portParser
portParser :: URIParser Port
portParser :: URIParser Port
portParser = (Int -> Port
Port forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Integral a => Parser a
A.decimal) forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPort
pathParser :: URIParser ByteString
pathParser :: Parser' URIParseError ByteString
pathParser = (Parser ByteString -> Parser ByteString [ByteString])
-> Parser' URIParseError ByteString
pathParser' forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many'
pathParser1 :: URIParser ByteString
pathParser1 :: Parser' URIParseError ByteString
pathParser1 = (Parser ByteString -> Parser ByteString [ByteString])
-> Parser' URIParseError ByteString
pathParser' forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many1'
pathParser' :: (Parser ByteString -> Parser [ByteString]) -> URIParser ByteString
pathParser' :: (Parser ByteString -> Parser ByteString [ByteString])
-> Parser' URIParseError ByteString
pathParser' Parser ByteString -> Parser ByteString [ByteString]
repeatParser = (ByteString -> ByteString
urlDecodeQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString -> Parser ByteString [ByteString]
repeatParser Parser ByteString
segmentParser) forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPath
where
segmentParser :: Parser ByteString
segmentParser = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ByteString -> Parser ByteString
string ByteString
"/", (Word8 -> Bool) -> Parser ByteString
A.takeWhile ([Char] -> Word8 -> Bool
inClass [Char]
pchar)]
firstRelRefSegmentParser :: URIParser ByteString
firstRelRefSegmentParser :: Parser' URIParseError ByteString
firstRelRefSegmentParser = (Word8 -> Bool) -> Parser ByteString
A.takeWhile ([Char] -> Word8 -> Bool
inClass ([Char]
pchar forall a. Eq a => [a] -> [a] -> [a]
\\ [Char]
":")) forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPath
queryParser :: URIParserOptions -> URIParser Query
queryParser :: URIParserOptions -> URIParser Query
queryParser URIParserOptions
opts = do
Maybe Word8
mc <- Parser (Maybe Word8)
peekWord8 forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` [Char] -> URIParseError
OtherError [Char]
"impossible peekWord8 error"
case Maybe Word8
mc of
Just Word8
c
| Word8
c forall a. Eq a => a -> a -> Bool
== Word8
question -> forall e. Int -> Parser' e ()
skip' Int
1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> URIParser Query
itemsParser
| Word8
c forall a. Eq a => a -> a -> Bool
== Word8
hash -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
| Bool
otherwise -> forall e a. Show e => e -> Parser' e a
fail' URIParseError
MalformedPath
Maybe Word8
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
where
itemsParser :: URIParser Query
itemsParser = [(ByteString, ByteString)] -> Query
Query forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall {b}. (ByteString, b) -> Bool
neQuery forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
A.sepBy' (URIParserOptions -> URIParser (ByteString, ByteString)
queryItemParser URIParserOptions
opts) (forall e. Word8 -> Parser' e Word8
word8' Word8
ampersand)
neQuery :: (ByteString, b) -> Bool
neQuery (ByteString
k, b
_) = Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
k)
queryItemParser :: URIParserOptions -> URIParser (ByteString, ByteString)
queryItemParser :: URIParserOptions -> URIParser (ByteString, ByteString)
queryItemParser URIParserOptions
opts = do
ByteString
s <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile (URIParserOptions -> Word8 -> Bool
upoValidQueryChar URIParserOptions
opts) forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedQuery
if ByteString -> Bool
BS.null ByteString
s
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)
else do
let (ByteString
k, ByteString
vWithEquals) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (forall a. Eq a => a -> a -> Bool
== Word8
equals) ByteString
s
let v :: ByteString
v = Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
vWithEquals
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
urlDecodeQuery ByteString
k, ByteString -> ByteString
urlDecodeQuery ByteString
v)
validForQuery :: Word8 -> Bool
validForQuery :: Word8 -> Bool
validForQuery = [Char] -> Word8 -> Bool
inClass (Char
'?'forall a. a -> [a] -> [a]
:Char
'/'forall a. a -> [a] -> [a]
:forall a. Eq a => a -> [a] -> [a]
delete Char
'&' [Char]
pchar)
validForQueryLax :: Word8 -> Bool
validForQueryLax :: Word8 -> Bool
validForQueryLax = [Char] -> Word8 -> Bool
notInClass [Char]
"&#"
mFragmentParser :: URIParser (Maybe ByteString)
mFragmentParser :: URIParser (Maybe ByteString)
mFragmentParser = forall e a. Parser' e a -> Parser' e (Maybe a)
mParse forall a b. (a -> b) -> a -> b
$ forall e. Word8 -> Parser' e Word8
word8' Word8
hash forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser' URIParseError ByteString
fragmentParser
fragmentParser :: URIParser ByteString
fragmentParser :: Parser' URIParseError ByteString
fragmentParser = forall e a. Parser a -> Parser' e a
Parser' forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> Parser ByteString
A.takeWhile Word8 -> Bool
validFragmentWord
where
validFragmentWord :: Word8 -> Bool
validFragmentWord = [Char] -> Word8 -> Bool
inClass (Char
'?'forall a. a -> [a] -> [a]
:Char
'/'forall a. a -> [a] -> [a]
:[Char]
pchar)
hexDigit :: Word8 -> Bool
hexDigit :: Word8 -> Bool
hexDigit = [Char] -> Word8 -> Bool
inClass [Char]
"0-9a-fA-F"
isAlpha :: Word8 -> Bool
isAlpha :: Word8 -> Bool
isAlpha = [Char] -> Word8 -> Bool
inClass [Char]
alpha
isDigit :: Word8 -> Bool
isDigit :: Word8 -> Bool
isDigit = [Char] -> Word8 -> Bool
inClass [Char]
digit
pchar :: String
pchar :: [Char]
pchar = [Char]
pctEncoded forall a. [a] -> [a] -> [a]
++ [Char]
subDelims forall a. [a] -> [a] -> [a]
++ [Char]
":@" forall a. [a] -> [a] -> [a]
++ [Char]
unreserved
unreserved :: String
unreserved :: [Char]
unreserved = [Char]
alphaNum forall a. [a] -> [a] -> [a]
++ [Char]
"~._-"
unreserved8 :: [Word8]
unreserved8 :: [Word8]
unreserved8 = forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
ord8 [Char]
unreserved
unreservedPath8 :: [Word8]
unreservedPath8 :: [Word8]
unreservedPath8 = [Word8]
unreserved8 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
ord8 [Char]
":@&=+$,"
ord8 :: Char -> Word8
ord8 :: Char -> Word8
ord8 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
pctEncoded :: String
pctEncoded :: [Char]
pctEncoded = [Char]
"%"
subDelims :: String
subDelims :: [Char]
subDelims = [Char]
"!$&'()*+,;="
alphaNum :: String
alphaNum :: [Char]
alphaNum = [Char]
alpha forall a. [a] -> [a] -> [a]
++ [Char]
digit
alpha :: String
alpha :: [Char]
alpha = [Char]
"a-zA-Z"
digit :: String
digit :: [Char]
digit = [Char]
"0-9"
colon :: Word8
colon :: Word8
colon = Word8
58
oBracket :: Word8
oBracket :: Word8
oBracket = Word8
91
cBracket :: Word8
cBracket :: Word8
cBracket = Word8
93
equals :: Word8
equals :: Word8
equals = Word8
61
question :: Word8
question :: Word8
question = Word8
63
ampersand :: Word8
ampersand :: Word8
ampersand = Word8
38
hash :: Word8
hash :: Word8
hash = Word8
35
period :: Word8
period :: Word8
period = Word8
46
slash :: Word8
slash :: Word8
slash = Word8
47
urlDecodeQuery :: ByteString -> ByteString
urlDecodeQuery :: ByteString -> ByteString
urlDecodeQuery = Bool -> ByteString -> ByteString
urlDecode Bool
plusToSpace
where
plusToSpace :: Bool
plusToSpace = Bool
True
urlDecode' :: ByteString -> ByteString
urlDecode' :: ByteString -> ByteString
urlDecode' = Bool -> ByteString -> ByteString
urlDecode Bool
plusToSpace
where
plusToSpace :: Bool
plusToSpace = Bool
False
newtype Parser' e a = Parser' { forall e a. Parser' e a -> Parser a
unParser' :: Parser a}
deriving ( forall a b. a -> Parser' e b -> Parser' e a
forall a b. (a -> b) -> Parser' e a -> Parser' e b
forall e a b. a -> Parser' e b -> Parser' e a
forall e a b. (a -> b) -> Parser' e a -> Parser' e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Parser' e b -> Parser' e a
$c<$ :: forall e a b. a -> Parser' e b -> Parser' e a
fmap :: forall a b. (a -> b) -> Parser' e a -> Parser' e b
$cfmap :: forall e a b. (a -> b) -> Parser' e a -> Parser' e b
Functor
, forall e. Functor (Parser' e)
forall a. a -> Parser' e a
forall e a. a -> Parser' e a
forall a b. Parser' e a -> Parser' e b -> Parser' e a
forall a b. Parser' e a -> Parser' e b -> Parser' e b
forall a b. Parser' e (a -> b) -> Parser' e a -> Parser' e b
forall e a b. Parser' e a -> Parser' e b -> Parser' e a
forall e a b. Parser' e a -> Parser' e b -> Parser' e b
forall e a b. Parser' e (a -> b) -> Parser' e a -> Parser' e b
forall a b c.
(a -> b -> c) -> Parser' e a -> Parser' e b -> Parser' e c
forall e a b c.
(a -> b -> c) -> Parser' e a -> Parser' e b -> Parser' e c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Parser' e a -> Parser' e b -> Parser' e a
$c<* :: forall e a b. Parser' e a -> Parser' e b -> Parser' e a
*> :: forall a b. Parser' e a -> Parser' e b -> Parser' e b
$c*> :: forall e a b. Parser' e a -> Parser' e b -> Parser' e b
liftA2 :: forall a b c.
(a -> b -> c) -> Parser' e a -> Parser' e b -> Parser' e c
$cliftA2 :: forall e a b c.
(a -> b -> c) -> Parser' e a -> Parser' e b -> Parser' e c
<*> :: forall a b. Parser' e (a -> b) -> Parser' e a -> Parser' e b
$c<*> :: forall e a b. Parser' e (a -> b) -> Parser' e a -> Parser' e b
pure :: forall a. a -> Parser' e a
$cpure :: forall e a. a -> Parser' e a
Applicative
, forall e. Applicative (Parser' e)
forall a. Parser' e a
forall a. Parser' e a -> Parser' e [a]
forall a. Parser' e a -> Parser' e a -> Parser' e a
forall e a. Parser' e a
forall e a. Parser' e a -> Parser' e [a]
forall e a. Parser' e a -> Parser' e a -> Parser' e a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. Parser' e a -> Parser' e [a]
$cmany :: forall e a. Parser' e a -> Parser' e [a]
some :: forall a. Parser' e a -> Parser' e [a]
$csome :: forall e a. Parser' e a -> Parser' e [a]
<|> :: forall a. Parser' e a -> Parser' e a -> Parser' e a
$c<|> :: forall e a. Parser' e a -> Parser' e a -> Parser' e a
empty :: forall a. Parser' e a
$cempty :: forall e a. Parser' e a
Alternative
, forall e. Applicative (Parser' e)
forall a. a -> Parser' e a
forall e a. a -> Parser' e a
forall a b. Parser' e a -> Parser' e b -> Parser' e b
forall a b. Parser' e a -> (a -> Parser' e b) -> Parser' e b
forall e a b. Parser' e a -> Parser' e b -> Parser' e b
forall e a b. Parser' e a -> (a -> Parser' e b) -> Parser' e b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Parser' e a
$creturn :: forall e a. a -> Parser' e a
>> :: forall a b. Parser' e a -> Parser' e b -> Parser' e b
$c>> :: forall e a b. Parser' e a -> Parser' e b -> Parser' e b
>>= :: forall a b. Parser' e a -> (a -> Parser' e b) -> Parser' e b
$c>>= :: forall e a b. Parser' e a -> (a -> Parser' e b) -> Parser' e b
Monad
, forall e. Monad (Parser' e)
forall e. Alternative (Parser' e)
forall a. Parser' e a
forall a. Parser' e a -> Parser' e a -> Parser' e a
forall e a. Parser' e a
forall e a. Parser' e a -> Parser' e a -> Parser' e a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. Parser' e a -> Parser' e a -> Parser' e a
$cmplus :: forall e a. Parser' e a -> Parser' e a -> Parser' e a
mzero :: forall a. Parser' e a
$cmzero :: forall e a. Parser' e a
MonadPlus
, NonEmpty (Parser' e a) -> Parser' e a
Parser' e a -> Parser' e a -> Parser' e a
forall b. Integral b => b -> Parser' e a -> Parser' e a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall e a. NonEmpty (Parser' e a) -> Parser' e a
forall e a. Parser' e a -> Parser' e a -> Parser' e a
forall e a b. Integral b => b -> Parser' e a -> Parser' e a
stimes :: forall b. Integral b => b -> Parser' e a -> Parser' e a
$cstimes :: forall e a b. Integral b => b -> Parser' e a -> Parser' e a
sconcat :: NonEmpty (Parser' e a) -> Parser' e a
$csconcat :: forall e a. NonEmpty (Parser' e a) -> Parser' e a
<> :: Parser' e a -> Parser' e a -> Parser' e a
$c<> :: forall e a. Parser' e a -> Parser' e a -> Parser' e a
Semigroup.Semigroup
, Parser' e a
[Parser' e a] -> Parser' e a
Parser' e a -> Parser' e a -> Parser' e a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall e a. Semigroup (Parser' e a)
forall e a. Parser' e a
forall e a. [Parser' e a] -> Parser' e a
forall e a. Parser' e a -> Parser' e a -> Parser' e a
mconcat :: [Parser' e a] -> Parser' e a
$cmconcat :: forall e a. [Parser' e a] -> Parser' e a
mappend :: Parser' e a -> Parser' e a -> Parser' e a
$cmappend :: forall e a. Parser' e a -> Parser' e a -> Parser' e a
mempty :: Parser' e a
$cmempty :: forall e a. Parser' e a
Monoid)
instance F.MonadFail (Parser' e) where
#if MIN_VERSION_attoparsec(0,13,1)
fail :: forall a. [Char] -> Parser' e a
fail [Char]
e = forall e a. Parser a -> Parser' e a
Parser' (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
F.fail [Char]
e)
#else
fail e = Parser' (fail e)
#endif
mParse :: Parser' e a -> Parser' e (Maybe a)
mParse :: forall e a. Parser' e a -> Parser' e (Maybe a)
mParse Parser' e a
p = forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' e a
p)
thenJust :: Parser' e a -> Parser' e b -> Parser' e (Maybe b)
thenJust :: forall e a b. Parser' e a -> Parser' e b -> Parser' e (Maybe b)
thenJust Parser' e a
p1 Parser' e b
p2 = Parser' e a
p1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' e b
p2) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
word8' :: Word8 -> Parser' e Word8
word8' :: forall e. Word8 -> Parser' e Word8
word8' = forall e a. Parser a -> Parser' e a
Parser' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Parser Word8
word8
skip' :: Int -> Parser' e ()
skip' :: forall e. Int -> Parser' e ()
skip' = forall e a. Parser a -> Parser' e a
Parser' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser ByteString
A.take
string' :: ByteString -> Parser' e ByteString
string' :: forall e. ByteString -> Parser' e ByteString
string' = forall e a. Parser a -> Parser' e a
Parser' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Parser ByteString
string
orFailWith :: (Show e) => Parser a -> e -> Parser' e a
orFailWith :: forall e a. Show e => Parser a -> e -> Parser' e a
orFailWith Parser a
p e
e = forall e a. Parser a -> Parser' e a
Parser' Parser a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e a. Show e => e -> Parser' e a
fail' e
e
fail' :: (Show e) => e -> Parser' e a
fail' :: forall e a. Show e => e -> Parser' e a
fail' = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show
parseBetween :: (Alternative m, Monad m) => Int -> Int -> m a -> m [a]
parseBetween :: forall (m :: * -> *) a.
(Alternative m, Monad m) =>
Int -> Int -> m a -> m [a]
parseBetween Int
a Int
b m a
f = forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [m [a]]
parsers
where
parsers :: [m [a]]
parsers = forall a b. (a -> b) -> [a] -> [b]
map (forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
`count` m a
f) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Ix a => (a, a) -> [a]
range (Int
a, Int
b)
parseOnly' :: (Read e)
=> (String -> e)
-> Parser' e a
-> ByteString
-> Either e a
parseOnly' :: forall e a.
Read e =>
([Char] -> e) -> Parser' e a -> ByteString -> Either e a
parseOnly' [Char] -> e
noParse (Parser' Parser a
p) = forall a b r. (a -> b) -> Either a r -> Either b r
fmapL [Char] -> e
readWithFallback forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either [Char] a
parseOnly Parser a
p
where
readWithFallback :: [Char] -> e
readWithFallback [Char]
s = forall a. a -> Maybe a -> a
fromMaybe ([Char] -> e
noParse [Char]
s) (forall a. Read a => [Char] -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
stripAttoparsecGarbage forall a b. (a -> b) -> a -> b
$ [Char]
s)
stripAttoparsecGarbage :: String -> String
stripAttoparsecGarbage :: [Char] -> [Char]
stripAttoparsecGarbage = forall a. Eq a => [a] -> [a] -> [a]
stripPrefix' [Char]
"Failed reading: "
stripPrefix' :: Eq a => [a] -> [a] -> [a]
stripPrefix' :: forall a. Eq a => [a] -> [a] -> [a]
stripPrefix' [a]
pfx [a]
s = forall a. a -> Maybe a -> a
fromMaybe [a]
s forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [a]
pfx [a]
s
fmapL :: (a -> b) -> Either a r -> Either b r
fmapL :: forall a b r. (a -> b) -> Either a r -> Either b r
fmapL a -> b
f = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall a b. b -> Either a b
Right
urlDecode
:: Bool
-> BS.ByteString
-> BS.ByteString
urlDecode :: Bool -> ByteString -> ByteString
urlDecode Bool
replacePlus ByteString
z = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN (ByteString -> Int
BS.length ByteString
z) ByteString -> Maybe (Word8, ByteString)
go ByteString
z
where
go :: ByteString -> Maybe (Word8, ByteString)
go ByteString
bs' =
case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs' of
Maybe (Word8, ByteString)
Nothing -> forall a. Maybe a
Nothing
Just (Word8
43, ByteString
ws) | Bool
replacePlus -> forall a. a -> Maybe a
Just (Word8
32, ByteString
ws)
Just (Word8
37, ByteString
ws) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (Word8
37, ByteString
ws) forall a b. (a -> b) -> a -> b
$ do
(Word8
x, ByteString
xs) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
ws
Word8
x' <- forall {a}. (Ord a, Num a) => a -> Maybe a
hexVal Word8
x
(Word8
y, ByteString
ys) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
xs
Word8
y' <- forall {a}. (Ord a, Num a) => a -> Maybe a
hexVal Word8
y
forall a. a -> Maybe a
Just (Word8 -> Word8 -> Word8
combine Word8
x' Word8
y', ByteString
ys)
Just (Word8
w, ByteString
ws) -> forall a. a -> Maybe a
Just (Word8
w, ByteString
ws)
hexVal :: a -> Maybe a
hexVal a
w
| a
48 forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w forall a. Ord a => a -> a -> Bool
<= a
57 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
w forall a. Num a => a -> a -> a
- a
48
| a
65 forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w forall a. Ord a => a -> a -> Bool
<= a
70 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
w forall a. Num a => a -> a -> a
- a
55
| a
97 forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w forall a. Ord a => a -> a -> Bool
<= a
102 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
w forall a. Num a => a -> a -> a
- a
87
| Bool
otherwise = forall a. Maybe a
Nothing
combine :: Word8 -> Word8 -> Word8
combine :: Word8 -> Word8 -> Word8
combine Word8
a Word8
b = forall a. Bits a => a -> Int -> a
shiftL Word8
a Int
4 forall a. Bits a => a -> a -> a
.|. Word8
b
urlEncode :: [Word8] -> ByteString -> Builder
urlEncode :: [Word8] -> ByteString -> Builder
urlEncode [Word8]
extraUnreserved = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Builder
encodeChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
where
encodeChar :: Word8 -> Builder
encodeChar Word8
ch | Word8 -> Bool
unreserved' Word8
ch = Word8 -> Builder
BB.fromWord8 Word8
ch
| Bool
otherwise = Word8 -> Builder
h2 Word8
ch
unreserved' :: Word8 -> Bool
unreserved' Word8
ch | Word8
ch forall a. Ord a => a -> a -> Bool
>= Word8
65 Bool -> Bool -> Bool
&& Word8
ch forall a. Ord a => a -> a -> Bool
<= Word8
90 = Bool
True
| Word8
ch forall a. Ord a => a -> a -> Bool
>= Word8
97 Bool -> Bool -> Bool
&& Word8
ch forall a. Ord a => a -> a -> Bool
<= Word8
122 = Bool
True
| Word8
ch forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
ch forall a. Ord a => a -> a -> Bool
<= Word8
57 = Bool
True
unreserved' Word8
c = Word8
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8]
extraUnreserved
h2 :: Word8 -> Builder
h2 Word8
v = let (Word8
a, Word8
b) = Word8
v forall a. Integral a => a -> a -> (a, a)
`divMod` Word8
16 in ByteString -> Builder
bs forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BS.pack [Word8
37, forall {a}. (Ord a, Num a) => a -> a
h Word8
a, forall {a}. (Ord a, Num a) => a -> a
h Word8
b]
h :: a -> a
h a
i | a
i forall a. Ord a => a -> a -> Bool
< a
10 = a
48 forall a. Num a => a -> a -> a
+ a
i
| Bool
otherwise = a
65 forall a. Num a => a -> a -> a
+ a
i forall a. Num a => a -> a -> a
- a
10
urlEncodeQuery :: ByteString -> Builder
urlEncodeQuery :: ByteString -> Builder
urlEncodeQuery = [Word8] -> ByteString -> Builder
urlEncode [Word8]
unreserved8
urlEncodePath :: ByteString -> Builder
urlEncodePath :: ByteString -> Builder
urlEncodePath = [Word8] -> ByteString -> Builder
urlEncode [Word8]
unreservedPath8
downcaseBS :: ByteString -> ByteString
downcaseBS :: ByteString -> ByteString
downcaseBS = (Char -> Char) -> ByteString -> ByteString
BS8.map Char -> Char
toLower
newtype RL a = RL [a] deriving (Int -> RL a -> [Char] -> [Char]
forall a. Show a => Int -> RL a -> [Char] -> [Char]
forall a. Show a => [RL a] -> [Char] -> [Char]
forall a. Show a => RL a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [RL a] -> [Char] -> [Char]
$cshowList :: forall a. Show a => [RL a] -> [Char] -> [Char]
show :: RL a -> [Char]
$cshow :: forall a. Show a => RL a -> [Char]
showsPrec :: Int -> RL a -> [Char] -> [Char]
$cshowsPrec :: forall a. Show a => Int -> RL a -> [Char] -> [Char]
Show)
(|>) :: RL a -> a -> RL a
RL [a]
as |> :: forall a. RL a -> a -> RL a
|> a
a = forall a. [a] -> RL a
RL (a
aforall a. a -> [a] -> [a]
:[a]
as)
rl2L :: RL a -> [a]
rl2L :: forall a. RL a -> [a]
rl2L (RL [a]
as) = forall a. [a] -> [a]
reverse [a]
as
unsnoc :: RL a -> RL a
unsnoc :: forall a. RL a -> RL a
unsnoc (RL []) = forall a. [a] -> RL a
RL []
unsnoc (RL (a
_:[a]
xs)) = forall a. [a] -> RL a
RL [a]
xs