{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}

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

-------------------------------------------------------------------------------

-------------------------------------------------------------------------------

-- | Strict URI Parser config. Follows RFC3986 as-specified. Use this
-- if you can be certain that your URIs are properly encoded or if you
-- want parsing to fail if they deviate from the spec at all.
strictURIParserOptions :: URIParserOptions
strictURIParserOptions :: URIParserOptions
strictURIParserOptions =
  URIParserOptions
    { upoLaxQueryParsing :: Bool
upoLaxQueryParsing = Bool
False
    }

-------------------------------------------------------------------------------

-- | Lax URI Parser config. Use this if you you want to handle common
-- deviations from the spec gracefully.
--
-- * Allows non-encoded [ and ] in query string
laxURIParserOptions :: URIParserOptions
laxURIParserOptions :: URIParserOptions
laxURIParserOptions =
  URIParserOptions
    { upoLaxQueryParsing :: Bool
upoLaxQueryParsing = Bool
True
    }

-------------------------------------------------------------------------------

-- | All normalization options disabled
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

-------------------------------------------------------------------------------

-- | The set of known default ports to schemes. Currently only
-- contains http\/80 and https\/443. Feel free to extend it if needed
-- with 'unoDefaultPorts'.
httpDefaultPorts :: M.Map Scheme Port
httpDefaultPorts :: Map Scheme Port
httpDefaultPorts =
  [(Scheme, Port)] -> Map Scheme Port
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)
    ]

-------------------------------------------------------------------------------

-- | Only normalizations deemed appropriate for all protocols by
-- RFC3986 enabled, namely:
--
-- * Downcase Scheme
-- * Downcase Host
-- * Remove Dot Segments
rfc3986Normalization :: URINormalizationOptions
rfc3986Normalization :: URINormalizationOptions
rfc3986Normalization =
  URINormalizationOptions
noNormalization
    { unoDowncaseScheme = True,
      unoDowncaseHost = True,
      unoRemoveDotSegments = True
    }

-------------------------------------------------------------------------------

-- | The same as 'rfc3986Normalization' but with additional enabled
-- features if you're working with HTTP URIs:
--
-- * Drop Default Port (with 'httpDefaultPorts')
-- * Drop Extra Slashes
httpNormalization :: URINormalizationOptions
httpNormalization :: URINormalizationOptions
httpNormalization =
  URINormalizationOptions
rfc3986Normalization
    { unoDropDefPort = True,
      unoSlashEmptyPath = True
    }

-------------------------------------------------------------------------------

-- | All options enabled
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 ref@ converts @ref@ to an absolute URI.
-- If @ref@ is already absolute, then it is unchanged.
toAbsolute :: Scheme -> URIRef a -> URIRef Absolute
toAbsolute :: forall a. Scheme -> URIRef a -> URIRef Absolute
toAbsolute Scheme
scheme RelativeRef {Maybe ByteString
Maybe Authority
ByteString
Query
rrAuthority :: Maybe Authority
rrPath :: ByteString
rrQuery :: Query
rrFragment :: Maybe ByteString
rrAuthority :: URIRef Relative -> Maybe Authority
rrPath :: URIRef Relative -> ByteString
rrQuery :: URIRef Relative -> Query
rrFragment :: URIRef Relative -> Maybe ByteString
..} = 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 {} = URIRef a
URIRef Absolute
uri

-------------------------------------------------------------------------------

-- | URI Serializer

-------------------------------------------------------------------------------

-- | Serialize a URI reference into a 'Builder'.
--
-- Example of serializing + converting to a lazy "Data.ByteString.Lazy.ByteString":
--
-- >>> BB.toLazyByteString $ serializeURIRef $ URI {uriScheme = Scheme {schemeBS = "http"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "www.example.org"}, authorityPort = Nothing}), uriPath = "/foo", uriQuery = Query {queryPairs = [("bar","baz")]}, uriFragment = Just "quux"}
-- "http://www.example.org/foo?bar=baz#quux"
serializeURIRef :: URIRef a -> Builder
serializeURIRef :: forall a. URIRef a -> Builder
serializeURIRef = URINormalizationOptions -> URIRef a -> Builder
forall a. URINormalizationOptions -> URIRef a -> Builder
normalizeURIRef URINormalizationOptions
noNormalization

-------------------------------------------------------------------------------

-- | Like 'serializeURIRef', with conversion into a strict 'ByteString'.
serializeURIRef' :: URIRef a -> ByteString
serializeURIRef' :: forall a. URIRef a -> ByteString
serializeURIRef' = Builder -> ByteString
BB.toByteString (Builder -> ByteString)
-> (URIRef a -> Builder) -> URIRef a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIRef a -> Builder
forall a. URIRef a -> Builder
serializeURIRef

-------------------------------------------------------------------------------

-- | Serialize a URI into a Builder.
serializeURI :: URIRef Absolute -> Builder
serializeURI :: URIRef Absolute -> Builder
serializeURI = URINormalizationOptions -> URIRef Absolute -> Builder
forall a. URINormalizationOptions -> URIRef a -> Builder
normalizeURIRef URINormalizationOptions
noNormalization
{-# DEPRECATED serializeURI "Use 'serializeURIRef' instead" #-}

-------------------------------------------------------------------------------

-- | Similar to 'serializeURIRef' but performs configurable degrees of
-- URI normalization. If your goal is the fastest serialization speed
-- possible, 'serializeURIRef' will be fine. If you intend on
-- comparing URIs (say for caching purposes), you'll want to use this.
normalizeURIRef :: URINormalizationOptions -> URIRef a -> Builder
normalizeURIRef :: forall a. URINormalizationOptions -> URIRef a -> Builder
normalizeURIRef URINormalizationOptions
o uri :: URIRef a
uri@URI {} = URINormalizationOptions -> URIRef Absolute -> Builder
normalizeURI URINormalizationOptions
o URIRef a
URIRef Absolute
uri
normalizeURIRef URINormalizationOptions
o uri :: URIRef a
uri@RelativeRef {} = URINormalizationOptions
-> Maybe Scheme -> URIRef Relative -> Builder
normalizeRelativeRef URINormalizationOptions
o Maybe Scheme
forall a. Maybe a
Nothing URIRef a
URIRef Relative
uri

-------------------------------------------------------------------------------
normalizeURIRef' :: URINormalizationOptions -> URIRef a -> ByteString
normalizeURIRef' :: forall a. URINormalizationOptions -> URIRef a -> ByteString
normalizeURIRef' URINormalizationOptions
o = Builder -> ByteString
BB.toByteString (Builder -> ByteString)
-> (URIRef a -> Builder) -> URIRef a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URINormalizationOptions -> URIRef a -> Builder
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
unoDowncaseScheme :: URINormalizationOptions -> Bool
unoDowncaseHost :: URINormalizationOptions -> Bool
unoRemoveDotSegments :: URINormalizationOptions -> Bool
unoDropDefPort :: URINormalizationOptions -> Bool
unoSlashEmptyPath :: URINormalizationOptions -> Bool
unoDowncaseScheme :: Bool
unoDowncaseHost :: Bool
unoDropDefPort :: Bool
unoSlashEmptyPath :: Bool
unoDropExtraSlashes :: Bool
unoSortParameters :: Bool
unoRemoveDotSegments :: Bool
unoDefaultPorts :: Map Scheme Port
unoDropExtraSlashes :: URINormalizationOptions -> Bool
unoSortParameters :: URINormalizationOptions -> Bool
..} URI {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriScheme :: Scheme
uriAuthority :: Maybe Authority
uriPath :: ByteString
uriQuery :: Query
uriFragment :: Maybe ByteString
uriScheme :: URIRef Absolute -> Scheme
uriAuthority :: URIRef Absolute -> Maybe Authority
uriPath :: URIRef Absolute -> ByteString
uriQuery :: URIRef Absolute -> Query
uriFragment :: URIRef Absolute -> Maybe ByteString
..} =
  Builder
scheme Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
BB.fromString [Char]
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> URINormalizationOptions
-> Maybe Scheme -> URIRef Relative -> Builder
normalizeRelativeRef URINormalizationOptions
o (Scheme -> Maybe Scheme
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 = ByteString -> ByteString
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 :: URINormalizationOptions -> Map Scheme Port
unoDowncaseScheme :: URINormalizationOptions -> Bool
unoDowncaseHost :: URINormalizationOptions -> Bool
unoRemoveDotSegments :: URINormalizationOptions -> Bool
unoDropDefPort :: URINormalizationOptions -> Bool
unoSlashEmptyPath :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: URINormalizationOptions -> Bool
unoSortParameters :: URINormalizationOptions -> Bool
unoDowncaseScheme :: Bool
unoDowncaseHost :: Bool
unoDropDefPort :: Bool
unoSlashEmptyPath :: Bool
unoDropExtraSlashes :: Bool
unoSortParameters :: Bool
unoRemoveDotSegments :: Bool
unoDefaultPorts :: Map Scheme Port
..} Maybe Scheme
mScheme RelativeRef {Maybe ByteString
Maybe Authority
ByteString
Query
rrAuthority :: URIRef Relative -> Maybe Authority
rrPath :: URIRef Relative -> ByteString
rrQuery :: URIRef Relative -> Query
rrFragment :: URIRef Relative -> Maybe ByteString
rrAuthority :: Maybe Authority
rrPath :: ByteString
rrQuery :: Query
rrFragment :: Maybe ByteString
..} =
  Builder
authority Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
path Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
query Builder -> Builder -> Builder
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 [ByteString] -> [ByteString] -> Bool
forall a. Eq a => a -> a -> Bool
== [ByteString
""] = ByteString -> Builder
BB.fromByteString ByteString
"/"
      | Bool
otherwise = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
c8 Char
'/') ((ByteString -> Builder) -> [ByteString] -> [Builder]
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 = ByteString -> ByteString
forall a. a -> a
id
    dropSegs :: [ByteString] -> [ByteString]
dropSegs [] = []
    dropSegs (ByteString
h : [ByteString]
t)
      | Bool
unoDropExtraSlashes = ByteString
h ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ((ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null) [ByteString]
t)
      | Bool
otherwise = ByteString
h ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
t
    authority :: Builder
authority = Builder -> (Authority -> Builder) -> Maybe Authority -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
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

-------------------------------------------------------------------------------
--TODO: this is probably ripe for benchmarking

-- | Algorithm described in
-- <https://tools.ietf.org/html/rfc3986#section-5.2.4>, reproduced
-- artlessly.
removeDotSegments :: ByteString -> ByteString
removeDotSegments :: ByteString -> ByteString
removeDotSegments ByteString
path = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat (RL ByteString -> [ByteString]
forall a. RL a -> [a]
rl2L (ByteString -> RL ByteString -> RL ByteString
go ByteString
path ([ByteString] -> RL ByteString
forall a. [a] -> RL a
RL [])))
  where
    go :: ByteString -> RL ByteString -> RL ByteString
go ByteString
inBuf RL ByteString
outBuf
      -- A. If the input buffer begins with prefix of ../ or ./ then
      -- remove the prefix from the input buffer
      | 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
      -- B. If the input buffer begins with a prefix of "/./" or "/.",
      -- where "." is a complete path segment, then replace that
      -- prefix with "/" in the input buffer. TODO: I think "a
      -- complete path segment" means its the whole thing?
      | 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 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"/." = ByteString -> RL ByteString -> RL ByteString
go ByteString
"/" RL ByteString
outBuf
      -- C. If the input buffer begins with a prefix of "/../" or
      -- "/..", where ".." is a complete path segment, then replace
      -- that prefix with "/" in the input buffer and remove the last
      -- segment and its preceding "/" (if any) from the output buffer
      | ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
"/../" ByteString
inBuf = ByteString -> RL ByteString -> RL ByteString
go (Int -> ByteString -> ByteString
BS8.drop Int
3 ByteString
inBuf) (RL ByteString -> RL ByteString
forall a. RL a -> RL a
unsnoc (RL ByteString -> RL ByteString
forall a. RL a -> RL a
unsnoc RL ByteString
outBuf))
      | ByteString
inBuf ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"/.." = ByteString -> RL ByteString -> RL ByteString
go ByteString
"/" (RL ByteString -> RL ByteString
forall a. RL a -> RL a
unsnoc (RL ByteString -> RL ByteString
forall a. RL a -> RL a
unsnoc RL ByteString
outBuf))
      -- D. If the input buffer consists only of "." or "..", then
      -- remove that from the input buffer
      | ByteString
inBuf ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"." = ByteString -> RL ByteString -> RL ByteString
go ByteString
forall a. Monoid a => a
mempty RL ByteString
outBuf
      | ByteString
inBuf ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
".." = ByteString -> RL ByteString -> RL ByteString
go ByteString
forall a. Monoid a => a
mempty RL ByteString
outBuf
      -- E. Move the first path segment in the input buffer to the end
      -- of the output buffer, including the initial "/" character (if
      -- any) and any subsequent characters up to, but not including,
      -- the next "/" character or the end of the input buffer.
      | 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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') ByteString
rest
           in ByteString -> RL ByteString -> RL ByteString
go ByteString
inBuf' (RL ByteString
outBuf RL ByteString -> ByteString -> RL ByteString
forall a. RL a -> a -> RL a
|> ByteString
"/" RL ByteString -> ByteString -> RL 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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') ByteString
inBuf
           in ByteString -> RL ByteString -> RL ByteString
go ByteString
inBuf' (RL ByteString
outBuf RL ByteString -> ByteString -> RL ByteString
forall a. RL a -> a -> RL a
|> ByteString
thisSeg)
        Maybe (Char, ByteString)
Nothing -> RL ByteString
outBuf

-------------------------------------------------------------------------------

-- | Like 'serializeURI', with conversion into a strict 'ByteString'.
serializeURI' :: URIRef Absolute -> ByteString
serializeURI' :: URIRef Absolute -> ByteString
serializeURI' = Builder -> ByteString
BB.toByteString (Builder -> ByteString)
-> (URIRef Absolute -> Builder) -> URIRef Absolute -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIRef Absolute -> Builder
serializeURI
{-# DEPRECATED serializeURI' "Use 'serializeURIRef'' instead" #-}

-------------------------------------------------------------------------------

-- | Like 'serializeURI', but do not render scheme.
serializeRelativeRef :: URIRef Relative -> Builder
serializeRelativeRef :: URIRef Relative -> Builder
serializeRelativeRef = URINormalizationOptions
-> Maybe Scheme -> URIRef Relative -> Builder
normalizeRelativeRef URINormalizationOptions
noNormalization Maybe Scheme
forall a. Maybe a
Nothing
{-# DEPRECATED serializeRelativeRef "Use 'serializeURIRef' instead" #-}

-------------------------------------------------------------------------------

-- | Like 'serializeRelativeRef', with conversion into a strict 'ByteString'.
serializeRelativeRef' :: URIRef Relative -> ByteString
serializeRelativeRef' :: URIRef Relative -> ByteString
serializeRelativeRef' = Builder -> ByteString
BB.toByteString (Builder -> ByteString)
-> (URIRef Relative -> Builder) -> URIRef Relative -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIRef Relative -> Builder
serializeRelativeRef
{-# DEPRECATED serializeRelativeRef' "Use 'serializeURIRef'' instead" #-}

-------------------------------------------------------------------------------

-- | Serialize the query part of a url
-- @serializeQuery opts mempty = ""@
-- @serializeQuery opts (Query [("a","b"),("c","d")]) = "?a=b&c=d"@
serializeQuery :: URINormalizationOptions -> Query -> Builder
serializeQuery :: URINormalizationOptions -> Query -> Builder
serializeQuery URINormalizationOptions
_ (Query []) = Builder
forall a. Monoid a => a
mempty
serializeQuery URINormalizationOptions {Bool
Map Scheme Port
unoDefaultPorts :: URINormalizationOptions -> Map Scheme Port
unoDowncaseScheme :: URINormalizationOptions -> Bool
unoDowncaseHost :: URINormalizationOptions -> Bool
unoRemoveDotSegments :: URINormalizationOptions -> Bool
unoDropDefPort :: URINormalizationOptions -> Bool
unoSlashEmptyPath :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: URINormalizationOptions -> Bool
unoSortParameters :: URINormalizationOptions -> Bool
unoDowncaseScheme :: Bool
unoDowncaseHost :: Bool
unoDropDefPort :: Bool
unoSlashEmptyPath :: Bool
unoDropExtraSlashes :: Bool
unoSortParameters :: Bool
unoRemoveDotSegments :: Bool
unoDefaultPorts :: Map Scheme Port
..} (Query [(ByteString, ByteString)]
ps) =
  Char -> Builder
c8 Char
'?' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
c8 Char
'&') (((ByteString, ByteString) -> Builder)
-> [(ByteString, ByteString)] -> [Builder]
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
c8 Char
'=' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
urlEncodeQuery ByteString
v
    ps' :: [(ByteString, ByteString)]
ps'
      | Bool
unoSortParameters = ((ByteString, ByteString) -> (ByteString, ByteString) -> Ordering)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString) -> (ByteString, ByteString) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (ByteString, ByteString) -> ByteString
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 (Builder -> ByteString)
-> (Query -> Builder) -> Query -> ByteString
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 = Builder -> (ByteString -> Builder) -> Maybe ByteString -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty (\ByteString
s -> Char -> Builder
c8 Char
'#' Builder -> Builder -> Builder
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 (Builder -> ByteString)
-> (Maybe ByteString -> Builder) -> Maybe ByteString -> ByteString
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 :: URINormalizationOptions -> Map Scheme Port
unoDowncaseScheme :: URINormalizationOptions -> Bool
unoDowncaseHost :: URINormalizationOptions -> Bool
unoRemoveDotSegments :: URINormalizationOptions -> Bool
unoDropDefPort :: URINormalizationOptions -> Bool
unoSlashEmptyPath :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: URINormalizationOptions -> Bool
unoSortParameters :: URINormalizationOptions -> Bool
unoDowncaseScheme :: Bool
unoDowncaseHost :: Bool
unoDropDefPort :: Bool
unoSlashEmptyPath :: Bool
unoDropExtraSlashes :: Bool
unoSortParameters :: Bool
unoRemoveDotSegments :: Bool
unoDefaultPorts :: Map Scheme Port
..} Maybe Scheme
mScheme Authority {Maybe UserInfo
Maybe Port
Host
authorityUserInfo :: Maybe UserInfo
authorityHost :: Host
authorityPort :: Maybe Port
authorityUserInfo :: Authority -> Maybe UserInfo
authorityHost :: Authority -> Host
authorityPort :: Authority -> Maybe Port
..} = [Char] -> Builder
BB.fromString [Char]
"//" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
userinfo Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
bs ByteString
host Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
port
  where
    userinfo :: Builder
userinfo = Builder -> (UserInfo -> Builder) -> Maybe UserInfo -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
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 = ByteString -> ByteString
forall a. a -> a
id
    port :: Builder
port = Builder -> (Port -> Builder) -> Maybe Port -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
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
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
BB.fromString (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
p)
    dropPort :: Maybe Scheme -> Port -> Maybe Port
dropPort Maybe Scheme
Nothing = Port -> Maybe Port
forall a. a -> Maybe a
Just
    dropPort (Just Scheme
scheme)
      | Bool
unoDropDefPort = Scheme -> Port -> Maybe Port
dropPort' Scheme
scheme
      | Bool
otherwise = Port -> Maybe Port
forall a. a -> Maybe a
Just
    dropPort' :: Scheme -> Port -> Maybe Port
dropPort' Scheme
s Port
p
      | Scheme -> Map Scheme Port -> Maybe Port
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Scheme
s Map Scheme Port
unoDefaultPorts Maybe Port -> Maybe Port -> Bool
forall a. Eq a => a -> a -> Bool
== Port -> Maybe Port
forall a. a -> Maybe a
Just Port
p = Maybe Port
forall a. Maybe a
Nothing
      | Bool
otherwise = Port -> Maybe Port
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 (Builder -> ByteString)
-> (Authority -> Builder) -> Authority -> ByteString
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
uiUsername :: ByteString
uiPassword :: ByteString
uiUsername :: UserInfo -> ByteString
uiPassword :: UserInfo -> ByteString
..} = ByteString -> Builder
bs ByteString
uiUsername Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
c8 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
bs ByteString
uiPassword Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
c8 Char
'@'

serializeUserInfo' :: UserInfo -> ByteString
serializeUserInfo' :: UserInfo -> ByteString
serializeUserInfo' = Builder -> ByteString
BB.toByteString (Builder -> ByteString)
-> (UserInfo -> Builder) -> UserInfo -> ByteString
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

-------------------------------------------------------------------------------

-- | Parse a strict ByteString into a URI or an error.
--
-- Example:
--
-- >>> parseURI strictURIParserOptions "http://www.example.org/foo?bar=baz#quux"
-- Right (URI {uriScheme = Scheme {schemeBS = "http"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "www.example.org"}, authorityPort = Nothing}), uriPath = "/foo", uriQuery = Query {queryPairs = [("bar","baz")]}, uriFragment = Just "quux"})
--
-- >>> parseURI strictURIParserOptions "$$$$://badurl.example.org"
-- Left (MalformedScheme NonAlphaLeading)
--
-- There are some urls that you'll encounter which defy the spec, such
-- as those with square brackets in the query string. If you must be
-- able to parse those, you can use "laxURIParserOptions" or specify your own
--
-- >>> parseURI strictURIParserOptions "http://www.example.org/foo?bar[]=baz"
-- Left MalformedQuery
--
-- >>> parseURI laxURIParserOptions "http://www.example.org/foo?bar[]=baz"
-- Right (URI {uriScheme = Scheme {schemeBS = "http"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "www.example.org"}, authorityPort = Nothing}), uriPath = "/foo", uriQuery = Query {queryPairs = [("bar[]","baz")]}, uriFragment = Nothing})
--
-- >>> let myLaxOptions = URIParserOptions { upoValidQueryChar = liftA2 (||) (upoValidQueryChar strictURIParserOptions) (inClass "[]")}
-- >>> parseURI myLaxOptions "http://www.example.org/foo?bar[]=baz"
-- Right (URI {uriScheme = Scheme {schemeBS = "http"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "www.example.org"}, authorityPort = Nothing}), uriPath = "/foo", uriQuery = Query {queryPairs = [("bar[]","baz")]}, uriFragment = Nothing})
parseURI :: URIParserOptions -> ByteString -> Either URIParseError (URIRef Absolute)
parseURI :: URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
opts = ([Char] -> URIParseError)
-> Parser' URIParseError (URIRef Absolute)
-> ByteString
-> Either URIParseError (URIRef Absolute)
forall e a.
Read e =>
([Char] -> e) -> Parser' e a -> ByteString -> Either e a
parseOnly' [Char] -> URIParseError
OtherError (URIParserOptions -> Parser' URIParseError (URIRef Absolute)
uriParser' URIParserOptions
opts)

-- | Like 'parseURI', but do not parse scheme.
parseRelativeRef :: URIParserOptions -> ByteString -> Either URIParseError (URIRef Relative)
parseRelativeRef :: URIParserOptions
-> ByteString -> Either URIParseError (URIRef Relative)
parseRelativeRef URIParserOptions
opts = ([Char] -> URIParseError)
-> Parser' URIParseError (URIRef Relative)
-> ByteString
-> Either URIParseError (URIRef Relative)
forall e a.
Read e =>
([Char] -> e) -> Parser' e a -> ByteString -> Either e a
parseOnly' [Char] -> URIParseError
OtherError (URIParserOptions -> Parser' URIParseError (URIRef Relative)
relativeRefParser' URIParserOptions
opts)

-------------------------------------------------------------------------------

-- | Convenience alias for a parser that can return URIParseError
type URIParser = Parser' URIParseError

-------------------------------------------------------------------------------

-- | Underlying attoparsec parser. Useful for composing with your own parsers.
uriParser :: URIParserOptions -> Parser (URIRef Absolute)
uriParser :: URIParserOptions -> Parser (URIRef Absolute)
uriParser = Parser' URIParseError (URIRef Absolute) -> Parser (URIRef Absolute)
forall e a. Parser' e a -> Parser a
unParser' (Parser' URIParseError (URIRef Absolute)
 -> Parser (URIRef Absolute))
-> (URIParserOptions -> Parser' URIParseError (URIRef Absolute))
-> URIParserOptions
-> Parser (URIRef Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions -> Parser' URIParseError (URIRef Absolute)
uriParser'

-------------------------------------------------------------------------------

-- | Toplevel parser for URIs
uriParser' :: URIParserOptions -> URIParser (URIRef Absolute)
uriParser' :: URIParserOptions -> Parser' URIParseError (URIRef Absolute)
uriParser' URIParserOptions
opts = do
  Scheme
scheme <- URIParser Scheme
schemeParser
  Parser' URIParseError Word8 -> Parser' URIParseError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser' URIParseError Word8 -> Parser' URIParseError ())
-> Parser' URIParseError Word8 -> Parser' URIParseError ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser Word8
word8 Word8
colon Parser Word8 -> URIParseError -> Parser' URIParseError Word8
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` SchemaError -> URIParseError
MalformedScheme SchemaError
MissingColon
  (Maybe Authority
authority, ByteString
path) <- URIParser (Maybe Authority, ByteString)
hierPartParser
  Query
query <- URIParserOptions -> URIParser Query
queryParser URIParserOptions
opts
  Maybe ByteString
frag <- URIParser (Maybe ByteString)
mFragmentParser
  case Maybe ByteString
frag of
    Just ByteString
_ -> Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput Parser ByteString () -> URIParseError -> Parser' URIParseError ()
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedFragment
    Maybe ByteString
Nothing -> Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput Parser ByteString () -> URIParseError -> Parser' URIParseError ()
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedQuery
  URIRef Absolute -> Parser' URIParseError (URIRef Absolute)
forall a. a -> Parser' URIParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return (URIRef Absolute -> Parser' URIParseError (URIRef Absolute))
-> URIRef Absolute -> Parser' URIParseError (URIRef Absolute)
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
frag

-------------------------------------------------------------------------------

-- | Underlying attoparsec parser. Useful for composing with your own parsers.
relativeRefParser :: URIParserOptions -> Parser (URIRef Relative)
relativeRefParser :: URIParserOptions -> Parser (URIRef Relative)
relativeRefParser = Parser' URIParseError (URIRef Relative) -> Parser (URIRef Relative)
forall e a. Parser' e a -> Parser a
unParser' (Parser' URIParseError (URIRef Relative)
 -> Parser (URIRef Relative))
-> (URIParserOptions -> Parser' URIParseError (URIRef Relative))
-> URIParserOptions
-> Parser (URIRef Relative)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIParserOptions -> Parser' URIParseError (URIRef Relative)
relativeRefParser'

-------------------------------------------------------------------------------

-- | Toplevel parser for relative refs
relativeRefParser' :: URIParserOptions -> URIParser (URIRef Relative)
relativeRefParser' :: URIParserOptions -> Parser' URIParseError (URIRef Relative)
relativeRefParser' URIParserOptions
opts = do
  (Maybe Authority
authority, ByteString
path) <- URIParser (Maybe Authority, ByteString)
relativePartParser
  Query
query <- URIParserOptions -> URIParser Query
queryParser URIParserOptions
opts
  Maybe ByteString
frag <- URIParser (Maybe ByteString)
mFragmentParser
  case Maybe ByteString
frag of
    Just ByteString
_ -> Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput Parser ByteString () -> URIParseError -> Parser' URIParseError ()
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedFragment
    Maybe ByteString
Nothing -> Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput Parser ByteString () -> URIParseError -> Parser' URIParseError ()
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedQuery
  URIRef Relative -> Parser' URIParseError (URIRef Relative)
forall a. a -> Parser' URIParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return (URIRef Relative -> Parser' URIParseError (URIRef Relative))
-> URIRef Relative -> Parser' URIParseError (URIRef Relative)
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

-------------------------------------------------------------------------------

-- | Parser for scheme, e.g. "http", "https", etc.
schemeParser :: URIParser Scheme
schemeParser :: URIParser Scheme
schemeParser = do
  Word8
c <- (Word8 -> Bool) -> Parser Word8
satisfy Word8 -> Bool
isAlpha Parser Word8 -> URIParseError -> Parser' URIParseError Word8
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 Parser ByteString
-> URIParseError -> Parser' URIParseError ByteString
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` SchemaError -> URIParseError
MalformedScheme SchemaError
InvalidChars
  Scheme -> URIParser Scheme
forall a. a -> Parser' URIParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scheme -> URIParser Scheme) -> Scheme -> URIParser Scheme
forall a b. (a -> b) -> a -> b
$ ByteString -> Scheme
Scheme (ByteString -> Scheme) -> ByteString -> 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 ([Char] -> Word8 -> Bool) -> [Char] -> Word8 -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"-+." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
alphaNum

-------------------------------------------------------------------------------

-- | Corresponds to 'hier-part' in RFC 3986 section 3.
hierPartParser :: URIParser (Maybe Authority, ByteString)
hierPartParser :: URIParser (Maybe Authority, ByteString)
hierPartParser =
  URIParser (Maybe Authority, ByteString)
authWithPathParser
    URIParser (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
forall a.
Parser' URIParseError a
-> Parser' URIParseError a -> Parser' URIParseError a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Maybe Authority
forall a. Maybe a
Nothing,) (ByteString -> (Maybe Authority, ByteString))
-> Parser' URIParseError ByteString
-> URIParser (Maybe Authority, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
pathAbsoluteParser Parser ByteString
-> URIParseError -> Parser' URIParseError ByteString
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPath)
    URIParser (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
forall a.
Parser' URIParseError a
-> Parser' URIParseError a -> Parser' URIParseError a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Maybe Authority
forall a. Maybe a
Nothing,) (ByteString -> (Maybe Authority, ByteString))
-> Parser' URIParseError ByteString
-> URIParser (Maybe Authority, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
pathRootlessParser Parser ByteString
-> URIParseError -> Parser' URIParseError ByteString
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPath)
    URIParser (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
forall a.
Parser' URIParseError a
-> Parser' URIParseError a -> Parser' URIParseError a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Maybe Authority
forall a. Maybe a
Nothing,) (ByteString -> (Maybe Authority, ByteString))
-> Parser' URIParseError ByteString
-> URIParser (Maybe Authority, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
pathEmptyParser    Parser ByteString
-> URIParseError -> Parser' URIParseError ByteString
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPath)

-------------------------------------------------------------------------------

-- | Corresponds to 'relative-part' in RFC 3986 section 4.2.
relativePartParser :: URIParser (Maybe Authority, ByteString)
relativePartParser :: URIParser (Maybe Authority, ByteString)
relativePartParser =
  URIParser (Maybe Authority, ByteString)
authWithPathParser
    URIParser (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
forall a.
Parser' URIParseError a
-> Parser' URIParseError a -> Parser' URIParseError a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Maybe Authority
forall a. Maybe a
Nothing,) (ByteString -> (Maybe Authority, ByteString))
-> Parser' URIParseError ByteString
-> URIParser (Maybe Authority, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
pathAbsoluteParser Parser ByteString
-> URIParseError -> Parser' URIParseError ByteString
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPath)
    URIParser (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
forall a.
Parser' URIParseError a
-> Parser' URIParseError a -> Parser' URIParseError a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Maybe Authority
forall a. Maybe a
Nothing,) (ByteString -> (Maybe Authority, ByteString))
-> Parser' URIParseError ByteString
-> URIParser (Maybe Authority, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
pathNoSchemeParser Parser ByteString
-> URIParseError -> Parser' URIParseError ByteString
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPath)
    URIParser (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
forall a.
Parser' URIParseError a
-> Parser' URIParseError a -> Parser' URIParseError a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Maybe Authority
forall a. Maybe a
Nothing,) (ByteString -> (Maybe Authority, ByteString))
-> Parser' URIParseError ByteString
-> URIParser (Maybe Authority, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
pathEmptyParser    Parser ByteString
-> URIParseError -> Parser' URIParseError ByteString
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPath)

-------------------------------------------------------------------------------

-- | See the "authority path-abempty" grammar in the RFC
authWithPathParser :: URIParser (Maybe Authority, ByteString)
authWithPathParser :: URIParser (Maybe Authority, ByteString)
authWithPathParser = ByteString -> Parser' URIParseError ByteString
forall e. ByteString -> Parser' e ByteString
string' ByteString
"//" Parser' URIParseError ByteString
-> URIParser (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
forall a b.
Parser' URIParseError a
-> Parser' URIParseError b -> Parser' URIParseError b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((,) (Maybe Authority -> ByteString -> (Maybe Authority, ByteString))
-> Parser' URIParseError (Maybe Authority)
-> Parser'
     URIParseError (ByteString -> (Maybe Authority, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' URIParseError (Maybe Authority)
mAuthorityParser Parser' URIParseError (ByteString -> (Maybe Authority, ByteString))
-> Parser' URIParseError ByteString
-> URIParser (Maybe Authority, ByteString)
forall a b.
Parser' URIParseError (a -> b)
-> Parser' URIParseError a -> Parser' URIParseError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString
pathAbEmptyParser Parser ByteString
-> URIParseError -> Parser' URIParseError ByteString
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPath))

-------------------------------------------------------------------------------

-- | See the "path-abempty" grammar in the RFC.
pathAbEmptyParser :: Parser ByteString
pathAbEmptyParser :: Parser ByteString
pathAbEmptyParser = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString -> Parser ByteString [ByteString]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many' ([Parser ByteString] -> Parser ByteString
forall a (t :: * -> *) (m :: * -> *).
(Semigroup a, Monoid a, Traversable t, Monad m) =>
t (m a) -> m a
sequenceM [ByteString -> Parser ByteString
string ByteString
"/", Parser ByteString
segmentParser])

-------------------------------------------------------------------------------

-- | See the "path-absolute" grammar in the RFC. Essentially a special
-- case of rootless.
pathAbsoluteParser :: Parser ByteString
pathAbsoluteParser :: Parser ByteString
pathAbsoluteParser = [Parser ByteString] -> Parser ByteString
forall a (t :: * -> *) (m :: * -> *).
(Semigroup a, Monoid a, Traversable t, Monad m) =>
t (m a) -> m a
sequenceM [ByteString -> Parser ByteString
string ByteString
"/", Parser ByteString
pathRootlessParser]

-------------------------------------------------------------------------------

-- | See the "path-noscheme" grammar in the RFC.
pathNoSchemeParser :: Parser ByteString
pathNoSchemeParser :: Parser ByteString
pathNoSchemeParser = [Parser ByteString] -> Parser ByteString
forall a (t :: * -> *) (m :: * -> *).
(Semigroup a, Monoid a, Traversable t, Monad m) =>
t (m a) -> m a
sequenceM [Parser ByteString
segmentNZNCParser, Parser ByteString
pathAbEmptyParser]

-------------------------------------------------------------------------------

-- | See the "path-rootless" grammar in the RFC.
pathRootlessParser :: Parser ByteString
pathRootlessParser :: Parser ByteString
pathRootlessParser = [Parser ByteString] -> Parser ByteString
forall a (t :: * -> *) (m :: * -> *).
(Semigroup a, Monoid a, Traversable t, Monad m) =>
t (m a) -> m a
sequenceM [Parser ByteString
segmentNZParser, Parser ByteString
pathAbEmptyParser]

-------------------------------------------------------------------------------

-- | See the "path-empty" grammar in the RFC. Must not be followed
-- with a path-valid char.
pathEmptyParser :: Parser ByteString
pathEmptyParser :: Parser ByteString
pathEmptyParser = (ByteString -> ByteString -> ByteString
forall a b. a -> b -> a
const ByteString
BS.empty (ByteString -> ByteString)
-> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
pcharNotParser) Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> () -> ByteString
forall a b. a -> b -> a
const ByteString
BS.empty (() -> ByteString) -> Parser ByteString () -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput)

-------------------------------------------------------------------------------

-- | Parser whe
mAuthorityParser :: URIParser (Maybe Authority)
mAuthorityParser :: Parser' URIParseError (Maybe Authority)
mAuthorityParser = Parser' URIParseError Authority
-> Parser' URIParseError (Maybe Authority)
forall e a. Parser' e a -> Parser' e (Maybe a)
mParse Parser' URIParseError Authority
authorityParser

-------------------------------------------------------------------------------

-- | Parses the user info section of a URL (i.e. for HTTP Basic
-- Authentication). Note that this will decode any percent-encoded
-- data.
userInfoParser :: URIParser UserInfo
userInfoParser :: URIParser UserInfo
userInfoParser = (Parser ByteString UserInfo
uiTokenParser Parser ByteString UserInfo
-> Parser Word8 -> Parser ByteString UserInfo
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser Word8
word8 Word8
atSym) Parser ByteString UserInfo -> URIParseError -> URIParser UserInfo
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
user <- Parser ByteString -> Parser ByteString
forall a (m :: * -> *).
(Monoid a, Semigroup a, MonadPlus m) =>
m a -> m a
manyC (Parser ByteString
pctEncodedParser Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser ByteString
satisfyClass ([Char]
subDelims [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unreserved))
      ByteString
pass <- Parser ByteString
passParser Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BS.empty
      UserInfo -> Parser ByteString UserInfo
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (UserInfo -> Parser ByteString UserInfo)
-> UserInfo -> Parser ByteString UserInfo
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> UserInfo
UserInfo ByteString
user ByteString
pass
    passParser :: Parser ByteString
passParser = do
      ByteString
_ <- ByteString -> Parser ByteString
string ByteString
":"
      Parser ByteString -> Parser ByteString
forall a (m :: * -> *).
(Monoid a, Semigroup a, MonadPlus m) =>
m a -> m a
manyC (Parser ByteString
pctEncodedParser Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser ByteString
satisfyClass ([Char]
subDelims [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unreserved))

-------------------------------------------------------------------------------

-- | Authority consists of host and port
authorityParser :: URIParser Authority
authorityParser :: Parser' URIParseError Authority
authorityParser = Maybe UserInfo -> Host -> Maybe Port -> Authority
Authority (Maybe UserInfo -> Host -> Maybe Port -> Authority)
-> Parser' URIParseError (Maybe UserInfo)
-> Parser' URIParseError (Host -> Maybe Port -> Authority)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URIParser UserInfo -> Parser' URIParseError (Maybe UserInfo)
forall e a. Parser' e a -> Parser' e (Maybe a)
mParse URIParser UserInfo
userInfoParser Parser' URIParseError (Host -> Maybe Port -> Authority)
-> Parser' URIParseError Host
-> Parser' URIParseError (Maybe Port -> Authority)
forall a b.
Parser' URIParseError (a -> b)
-> Parser' URIParseError a -> Parser' URIParseError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser' URIParseError Host
hostParser Parser' URIParseError (Maybe Port -> Authority)
-> Parser' URIParseError (Maybe Port)
-> Parser' URIParseError Authority
forall a b.
Parser' URIParseError (a -> b)
-> Parser' URIParseError a -> Parser' URIParseError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser' URIParseError (Maybe Port)
mPortParser

-------------------------------------------------------------------------------

-- | Parser that can handle IPV6/Future literals, IPV4, and domain names.
hostParser :: URIParser Host
hostParser :: Parser' URIParseError Host
hostParser = (ByteString -> Host
Host (ByteString -> Host) -> Parser ByteString -> Parser ByteString Host
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
parsers) Parser ByteString Host
-> URIParseError -> Parser' URIParseError Host
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedHost
  where
    parsers :: Parser ByteString
parsers = Parser ByteString
ipLiteralParser Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
ipV4Parser Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
regNameParser
    ipLiteralParser :: Parser ByteString
ipLiteralParser = Word8 -> Parser Word8
word8 Word8
oBracket Parser Word8 -> Parser ByteString -> Parser ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser ByteString
ipVFutureParser Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
ipV6Parser) Parser ByteString -> Parser Word8 -> Parser ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser Word8
word8 Word8
cBracket

-------------------------------------------------------------------------------

-- | Parses IPV6 addresses. See relevant section in RFC.
ipV6Parser :: Parser ByteString
ipV6Parser :: Parser ByteString
ipV6Parser = do
  [ByteString]
leading <- Parser ByteString [ByteString]
h16s
  [ByteString]
elided <- [ByteString]
-> (ByteString -> [ByteString]) -> Maybe ByteString -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([ByteString] -> ByteString -> [ByteString]
forall a b. a -> b -> a
const [ByteString
""]) (Maybe ByteString -> [ByteString])
-> Parser ByteString (Maybe ByteString)
-> Parser ByteString [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString -> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByteString -> Parser ByteString
string ByteString
"::")
  [ByteString]
trailing <- Parser ByteString -> Parser ByteString [ByteString]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Word8 -> Bool) -> Parser ByteString
A.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
colon) Parser ByteString -> Parser Word8 -> Parser ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
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 = [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ByteString]
leading [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
trailing) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
finalChunkLen
  Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
8) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Parser ByteString ()
forall a. [Char] -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Too many digits in IPv6 address"
  ByteString -> Parser ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Parser ByteString)
-> ByteString -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
rejoin ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [[ByteString] -> ByteString
rejoin [ByteString]
leading] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
elided [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
trailing [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ Maybe ByteString -> [ByteString]
forall a. Maybe a -> [a]
maybeToList Maybe ByteString
final
  where
    finalChunk :: Parser ByteString (Int, Maybe ByteString)
finalChunk = (Int, Maybe ByteString)
-> Maybe (Int, Maybe ByteString) -> (Int, Maybe ByteString)
forall a. a -> Maybe a -> a
fromMaybe (Int
0, Maybe ByteString
forall a. Maybe a
Nothing) (Maybe (Int, Maybe ByteString) -> (Int, Maybe ByteString))
-> Parser ByteString (Maybe (Int, Maybe ByteString))
-> Parser ByteString (Int, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Int, Maybe ByteString)
-> Parser ByteString (Maybe (Int, Maybe ByteString))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString (Int, Maybe ByteString)
finalIpV4 Parser ByteString (Int, Maybe ByteString)
-> Parser ByteString (Int, Maybe ByteString)
-> Parser ByteString (Int, Maybe ByteString)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
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,) (Maybe ByteString -> (Int, Maybe ByteString))
-> (ByteString -> Maybe ByteString)
-> ByteString
-> (Int, Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> (Int, Maybe ByteString))
-> Parser ByteString -> Parser ByteString (Int, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
h16
    finalIpV4 :: Parser ByteString (Int, Maybe ByteString)
finalIpV4 = (Int
2,) (Maybe ByteString -> (Int, Maybe ByteString))
-> (ByteString -> Maybe ByteString)
-> ByteString
-> (Int, Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> (Int, Maybe ByteString))
-> Parser ByteString -> Parser ByteString (Int, Maybe ByteString)
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 Parser ByteString -> Parser Word8 -> Parser ByteString [ByteString]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Word8 -> Parser Word8
word8 Word8
colon
    h16 :: Parser ByteString
h16 = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Parser ByteString -> Parser ByteString [ByteString]
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)

-------------------------------------------------------------------------------

-- | Parses IPVFuture addresses. See relevant section in RFC.
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 ((Word8 -> Bool) -> Parser ByteString)
-> (Word8 -> Bool) -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> Word8 -> Bool
inClass ([Char] -> Word8 -> Bool) -> [Char] -> Word8 -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
subDelims [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unreserved
  ByteString -> Parser ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Parser ByteString)
-> ByteString -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
"v" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
ds ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
rest
  where
    lowercaseV :: Word8
lowercaseV = Word8
118

-------------------------------------------------------------------------------

-- | Parses a valid IPV4 address
ipV4Parser :: Parser ByteString
ipV4Parser :: Parser ByteString
ipV4Parser =
  [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
    ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser ByteString] -> Parser ByteString [ByteString]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [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) <- Parser Int -> Parser (ByteString, Int)
forall a. Parser a -> Parser (ByteString, a)
A.match Parser Int
forall a. Integral a => Parser a
A.decimal
      let len :: Int
len = ByteString -> Int
BS.length ByteString
s
      Bool -> Parser ByteString ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ByteString ()) -> Bool -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3
      Bool -> Parser ByteString ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ByteString ()) -> Bool -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
1 :: Int) Bool -> Bool -> Bool
&& Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
255
      ByteString -> Parser ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s
    dot :: Parser ByteString
dot = ByteString -> Parser ByteString
string ByteString
"."

-------------------------------------------------------------------------------

-- | This corresponds to the hostname, e.g. www.example.org
regNameParser :: Parser ByteString
regNameParser :: Parser ByteString
regNameParser = Parser ByteString -> Parser ByteString
forall a (m :: * -> *).
(Monoid a, Semigroup a, MonadPlus m) =>
m a -> m a
many1C (Parser ByteString
pctEncodedParser Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser ByteString
satisfyClass ([Char]
subDelims [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
unreserved))

-------------------------------------------------------------------------------

-- | Only parse a port if the colon signifier is there.
mPortParser :: URIParser (Maybe Port)
mPortParser :: Parser' URIParseError (Maybe Port)
mPortParser = Word8 -> Parser' URIParseError Word8
forall e. Word8 -> Parser' e Word8
word8' Word8
colon Parser' URIParseError Word8
-> Parser' URIParseError Port -> Parser' URIParseError (Maybe Port)
forall e a b. Parser' e a -> Parser' e b -> Parser' e (Maybe b)
`thenJust` Parser' URIParseError Port
portParser

-------------------------------------------------------------------------------

-- | Parses port number from the hostname. Colon separator must be
-- handled elsewhere.
portParser :: URIParser Port
portParser :: Parser' URIParseError Port
portParser = (Int -> Port
Port (Int -> Port) -> Parser Int -> Parser ByteString Port
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
forall a. Integral a => Parser a
A.decimal) Parser ByteString Port
-> URIParseError -> Parser' URIParseError Port
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPort


-------------------------------------------------------------------------------


segmentParser :: Parser ByteString
segmentParser :: Parser ByteString
segmentParser = Parser ByteString -> Parser ByteString
forall a (m :: * -> *).
(Monoid a, Semigroup a, MonadPlus m) =>
m a -> m a
manyC Parser ByteString
pcharParser

segmentNZParser :: Parser ByteString
segmentNZParser :: Parser ByteString
segmentNZParser = Parser ByteString -> Parser ByteString
forall a (m :: * -> *).
(Monoid a, Semigroup a, MonadPlus m) =>
m a -> m a
many1C Parser ByteString
pcharParser

segmentNZNCParser :: Parser ByteString
segmentNZNCParser :: Parser ByteString
segmentNZNCParser = Parser ByteString -> Parser ByteString
forall a (m :: * -> *).
(Monoid a, Semigroup a, MonadPlus m) =>
m a -> m a
many1C (Parser ByteString
pctEncodedParser Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser ByteString
satisfyClass ([Char]
subDelims [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"@" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
unreserved))


-------------------------------------------------------------------------------

-- | This parser is being a bit pragmatic. The query section in the
-- spec does not identify the key/value format used in URIs, but that
-- is what most users are expecting to see. One alternative could be
-- to just expose the query string as a string and offer functions on
-- URI to parse a query string to a Query.
queryParser :: URIParserOptions -> URIParser Query
queryParser :: URIParserOptions -> URIParser Query
queryParser URIParserOptions
opts = do
  Maybe Word8
mc <- Parser (Maybe Word8)
peekWord8 Parser (Maybe Word8)
-> URIParseError -> Parser' URIParseError (Maybe Word8)
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
question -> Int -> Parser' URIParseError ()
forall e. Int -> Parser' e ()
skip' Int
1 Parser' URIParseError () -> URIParser Query -> URIParser Query
forall a b.
Parser' URIParseError a
-> Parser' URIParseError b -> Parser' URIParseError b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> URIParser Query
itemsParser
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
hash -> Query -> URIParser Query
forall a. a -> Parser' URIParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Query
forall a. Monoid a => a
mempty
      | Bool
otherwise -> URIParseError -> URIParser Query
forall e a. Show e => e -> Parser' e a
fail' URIParseError
MalformedPath
    Maybe Word8
_ -> Query -> URIParser Query
forall a. a -> Parser' URIParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Query
forall a. Monoid a => a
mempty
  where
    itemsParser :: URIParser Query
itemsParser = [(ByteString, ByteString)] -> Query
Query ([(ByteString, ByteString)] -> Query)
-> ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> [(ByteString, ByteString)]
-> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, ByteString) -> Bool)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ByteString, ByteString) -> Bool
forall {b}. (ByteString, b) -> Bool
neQuery ([(ByteString, ByteString)] -> Query)
-> Parser' URIParseError [(ByteString, ByteString)]
-> URIParser Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' URIParseError (ByteString, ByteString)
-> Parser' URIParseError Word8
-> Parser' URIParseError [(ByteString, ByteString)]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
A.sepBy' (URIParserOptions -> Parser' URIParseError (ByteString, ByteString)
queryItemParser URIParserOptions
opts) (Word8 -> Parser' URIParseError Word8
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)

-------------------------------------------------------------------------------

-- | When parsing a single query item string like "foo=bar", turns it
-- into a key/value pair as per convention, with the value being
-- optional. & separators need to be handled further up.
queryItemParser :: URIParserOptions -> URIParser (ByteString, ByteString)
queryItemParser :: URIParserOptions -> Parser' URIParseError (ByteString, ByteString)
queryItemParser URIParserOptions
opts = (Parser (ByteString, ByteString)
-> URIParseError -> Parser' URIParseError (ByteString, ByteString)
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedQuery) (Parser (ByteString, ByteString)
 -> Parser' URIParseError (ByteString, ByteString))
-> Parser (ByteString, ByteString)
-> Parser' URIParseError (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ do
  let parser :: Parser ByteString
parser = if URIParserOptions -> Bool
upoLaxQueryParsing URIParserOptions
opts then Parser ByteString
queryLaxItemParser else Parser ByteString
queryItemParser'
  ByteString
k <- Parser ByteString -> Parser ByteString
forall a (m :: * -> *).
(Monoid a, Semigroup a, MonadPlus m) =>
m a -> m a
manyC Parser ByteString
parser
  if ByteString -> Bool
BS.null ByteString
k
    then (ByteString, ByteString) -> Parser (ByteString, ByteString)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
forall a. Monoid a => a
mempty, ByteString
forall a. Monoid a => a
mempty)
    else do
      Parser (Maybe Word8)
A.peekWord8 Parser (Maybe Word8)
-> (Maybe Word8 -> Parser (ByteString, ByteString))
-> Parser (ByteString, ByteString)
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Word8
61 -> do
          ByteString
_ <- ByteString -> Parser ByteString
string ByteString
"="
          ByteString
v <- Parser ByteString -> Parser ByteString
forall a (m :: * -> *).
(Monoid a, Semigroup a, MonadPlus m) =>
m a -> m a
manyC Parser ByteString
parser
          (ByteString, ByteString) -> Parser (ByteString, ByteString)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
k, ByteString
v)
        Maybe Word8
_ -> (ByteString, ByteString) -> Parser (ByteString, ByteString)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
k, ByteString
forall a. Monoid a => a
mempty)

-------------------------------------------------------------------------------
queryItemParser' :: Parser ByteString
queryItemParser' :: Parser ByteString
queryItemParser' = Parser ByteString
pctEncodedParser Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser ByteString
satisfyClass (Char
'?' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'/' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: (Char -> [Char] -> [Char]
forall a. Eq a => a -> [a] -> [a]
delete Char
'=' ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Char -> [Char] -> [Char]
forall a. Eq a => a -> [a] -> [a]
delete Char
'&' ([Char]
subDelims [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":@" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unreserved)))

-------------------------------------------------------------------------------
queryLaxItemParser :: Parser ByteString
queryLaxItemParser :: Parser ByteString
queryLaxItemParser = Parser ByteString
pctEncodedParser Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser ByteString
satisfyNotClass [Char]
"&#="

-------------------------------------------------------------------------------

-- | Only parses a fragment if the # signifiier is there
mFragmentParser :: URIParser (Maybe ByteString)
mFragmentParser :: URIParser (Maybe ByteString)
mFragmentParser = Parser' URIParseError ByteString -> URIParser (Maybe ByteString)
forall e a. Parser' e a -> Parser' e (Maybe a)
mParse (Parser' URIParseError ByteString -> URIParser (Maybe ByteString))
-> Parser' URIParseError ByteString -> URIParser (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser' URIParseError Word8
forall e. Word8 -> Parser' e Word8
word8' Word8
hash Parser' URIParseError Word8
-> Parser' URIParseError ByteString
-> Parser' URIParseError ByteString
forall a b.
Parser' URIParseError a
-> Parser' URIParseError b -> Parser' URIParseError b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser' URIParseError ByteString
fragmentParser

-------------------------------------------------------------------------------

-- | The final piece of a uri, e.g. #fragment, minus the #.
fragmentParser :: URIParser ByteString
fragmentParser :: Parser' URIParseError ByteString
fragmentParser = Parser ByteString -> Parser' URIParseError ByteString
forall e a. Parser a -> Parser' e a
Parser' (Parser ByteString -> Parser' URIParseError ByteString)
-> Parser ByteString -> Parser' URIParseError ByteString
forall a b. (a -> b) -> a -> b
$ Parser ByteString -> Parser ByteString
forall a (m :: * -> *).
(Monoid a, Semigroup a, MonadPlus m) =>
m a -> m a
manyC (Parser ByteString
pcharParser Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser ByteString
satisfyClass [Char
'?', Char
'/'])

-------------------------------------------------------------------------------

-- | Grammar Components

-------------------------------------------------------------------------------

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

-------------------------------------------------------------------------------

pcharParser :: Parser ByteString
pcharParser :: Parser ByteString
pcharParser = Parser ByteString
pctEncodedParser Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser ByteString
satisfyClass ([Char]
subDelims [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":@" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unreserved)

pcharNotParser :: Parser ByteString
pcharNotParser :: Parser ByteString
pcharNotParser = Parser ByteString
notPctEncodedParser Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser ByteString
satisfyNotClass ([Char]
subDelims [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":@" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unreserved)
 where
  notPctEncodedParser :: Parser ByteString
notPctEncodedParser = do
    Maybe Word8
w <- Parser (Maybe Word8)
peekWord8
    case Maybe Word8
w of
      Just Word8
37 -> [Char] -> Parser ByteString
satisfyNotClass ([Char]
subDelims [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":@" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unreserved)
      Maybe Word8
_       -> [Char] -> Parser ByteString
forall a. [Char] -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"not percent encoded"

-------------------------------------------------------------------------------
-- Very important!  When concatenating this to other strings to make larger
-- character classes, you must put this at the end because the '-' character
-- is treated as a range unless it's at the beginning or end.
unreserved :: String
unreserved :: [Char]
unreserved = [Char]
alphaNum [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"~._-"

-------------------------------------------------------------------------------
unreserved8 :: [Word8]
unreserved8 :: [Word8]
unreserved8 = (Char -> Word8) -> [Char] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
ord8 [Char]
unreserved

-------------------------------------------------------------------------------
unreservedPath8 :: [Word8]
unreservedPath8 :: [Word8]
unreservedPath8 = [Word8]
unreserved8 [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ (Char -> Word8) -> [Char] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
ord8 [Char]
":@&=+$,"

-------------------------------------------------------------------------------
ord8 :: Char -> Word8
ord8 :: Char -> Word8
ord8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

-------------------------------------------------------------------------------

-- | pc-encoded technically is % HEXDIG HEXDIG but that's handled by
-- the previous alphaNum constraint. May need to double back with a
-- parser to ensure pct-encoded never exceeds 2 hexdigs after
pctEncoded :: String
pctEncoded :: [Char]
pctEncoded = [Char]
"%"

pctEncodedParser :: Parser ByteString
pctEncodedParser :: Parser ByteString
pctEncodedParser = ByteString -> Parser ByteString
string ByteString
"%" Parser ByteString -> Parser ByteString -> Parser ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Word8 -> ByteString
decode (Word8 -> Word8 -> ByteString)
-> Parser Word8 -> Parser ByteString (Word8 -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser Word8
A.satisfy Word8 -> Bool
hexDigit Parser ByteString (Word8 -> ByteString)
-> Parser Word8 -> Parser ByteString
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word8 -> Bool) -> Parser Word8
A.satisfy Word8 -> Bool
hexDigit)
 where
  decode :: Word8 -> Word8 -> ByteString
decode Word8
w1 Word8
w2 = Word8 -> ByteString
BS.singleton (Word8 -> ByteString) -> Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8
forall {a}. Bits a => a -> a -> a
combine (Word8 -> Word8
forall {a}. (Ord a, Num a, Show a) => a -> a
hexVal Word8
w1) (Word8 -> Word8
forall {a}. (Ord a, Num a, Show a) => a -> a
hexVal Word8
w2)
  hexVal :: a -> a
hexVal a
w
    | a
48 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
57  = a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
48 -- 0 - 9
    | a
65 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
70  = a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
55 -- A - F
    | a
97 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
102 = a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
87 -- a - f
    | Bool
otherwise           = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"Not a hex value: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall a. Show a => a -> [Char]
show a
w
  combine :: a -> a -> a
combine a
a a
b = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
a Int
4 a -> a -> a
forall {a}. Bits a => a -> a -> a
.|. a
b


-------------------------------------------------------------------------------
subDelims :: String
subDelims :: [Char]
subDelims = [Char]
"!$&'()*+,;="

-------------------------------------------------------------------------------
alphaNum :: String
alphaNum :: [Char]
alphaNum = [Char]
alpha [Char] -> [Char] -> [Char]
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

-------------------------------------------------------------------------------

-- | Parsing with Strongly-Typed Errors

-------------------------------------------------------------------------------

-- | A parser with a specific error type. Attoparsec unfortunately
-- throws all errors into strings, which cannot be handled well
-- programmatically without doing something silly like parsing error
-- messages. This wrapper attempts to concentrate these errors into
-- one type.
newtype Parser' e a = Parser' {forall e a. Parser' e a -> Parser a
unParser' :: Parser a}
  deriving
    ( (forall a b. (a -> b) -> Parser' e a -> Parser' e b)
-> (forall a b. a -> Parser' e b -> Parser' e a)
-> Functor (Parser' e)
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
$cfmap :: forall e a b. (a -> b) -> Parser' e a -> Parser' e b
fmap :: forall a b. (a -> b) -> Parser' e a -> Parser' e b
$c<$ :: forall e a b. a -> Parser' e b -> Parser' e a
<$ :: forall a b. a -> Parser' e b -> Parser' e a
Functor,
      Functor (Parser' e)
Functor (Parser' e) =>
(forall a. a -> Parser' e a)
-> (forall 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 a b. Parser' e a -> Parser' e b -> Parser' e b)
-> (forall a b. Parser' e a -> Parser' e b -> Parser' e a)
-> Applicative (Parser' e)
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
$cpure :: forall e a. a -> Parser' e a
pure :: forall a. a -> Parser' e a
$c<*> :: forall e a b. Parser' e (a -> b) -> Parser' e a -> Parser' e b
<*> :: forall a b. Parser' e (a -> b) -> Parser' e a -> Parser' e b
$cliftA2 :: forall e a b c.
(a -> b -> c) -> Parser' e a -> Parser' e b -> Parser' e c
liftA2 :: forall a b c.
(a -> b -> c) -> Parser' e a -> Parser' e b -> Parser' e c
$c*> :: forall e a b. Parser' e a -> Parser' e b -> Parser' e b
*> :: 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 a
<* :: forall a b. Parser' e a -> Parser' e b -> Parser' e a
Applicative,
      Applicative (Parser' e)
Applicative (Parser' e) =>
(forall a. Parser' e a)
-> (forall a. Parser' e a -> Parser' e a -> Parser' e a)
-> (forall a. Parser' e a -> Parser' e [a])
-> (forall a. Parser' e a -> Parser' e [a])
-> Alternative (Parser' e)
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
$cempty :: forall e a. Parser' e a
empty :: forall a. Parser' e a
$c<|> :: forall e a. Parser' e a -> Parser' e a -> Parser' e a
<|> :: forall a. Parser' e a -> Parser' e a -> Parser' e a
$csome :: forall e a. Parser' e a -> Parser' e [a]
some :: forall a. Parser' e a -> Parser' e [a]
$cmany :: forall e a. Parser' e a -> Parser' e [a]
many :: forall a. Parser' e a -> Parser' e [a]
Alternative,
      Applicative (Parser' e)
Applicative (Parser' e) =>
(forall a b. Parser' e a -> (a -> Parser' e b) -> Parser' e b)
-> (forall a b. Parser' e a -> Parser' e b -> Parser' e b)
-> (forall a. a -> Parser' e a)
-> Monad (Parser' e)
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
$c>>= :: forall e a b. Parser' e a -> (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 -> Parser' e b -> Parser' e b
>> :: forall a b. Parser' e a -> Parser' e b -> Parser' e b
$creturn :: forall e a. a -> Parser' e a
return :: forall a. a -> Parser' e a
Monad,
      Monad (Parser' e)
Alternative (Parser' e)
(Alternative (Parser' e), Monad (Parser' e)) =>
(forall a. Parser' e a)
-> (forall a. Parser' e a -> Parser' e a -> Parser' e a)
-> MonadPlus (Parser' e)
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
$cmzero :: forall e a. Parser' e a
mzero :: forall a. Parser' e a
$cmplus :: forall e a. Parser' e a -> Parser' e a -> Parser' e a
mplus :: forall a. Parser' e a -> Parser' e a -> Parser' e a
MonadPlus,
      NonEmpty (Parser' e a) -> Parser' e a
Parser' e a -> Parser' e a -> Parser' e a
(Parser' e a -> Parser' e a -> Parser' e a)
-> (NonEmpty (Parser' e a) -> Parser' e a)
-> (forall b. Integral b => b -> Parser' e a -> Parser' e a)
-> Semigroup (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
$c<> :: forall e a. Parser' e a -> Parser' e a -> Parser' e a
<> :: Parser' e a -> Parser' e a -> Parser' e a
$csconcat :: forall e a. NonEmpty (Parser' e a) -> Parser' e a
sconcat :: NonEmpty (Parser' e a) -> Parser' e a
$cstimes :: 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
Semigroup.Semigroup,
      Semigroup (Parser' e a)
Parser' e a
Semigroup (Parser' e a) =>
Parser' e a
-> (Parser' e a -> Parser' e a -> Parser' e a)
-> ([Parser' e a] -> Parser' e a)
-> Monoid (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
$cmempty :: forall e a. Parser' e a
mempty :: Parser' e a
$cmappend :: forall e a. Parser' e a -> Parser' e a -> Parser' e a
mappend :: Parser' e a -> Parser' e a -> Parser' e a
$cmconcat :: forall e a. [Parser' e a] -> Parser' e a
mconcat :: [Parser' e a] -> Parser' e a
Monoid
    )

#if MIN_VERSION_attoparsec(0,13,1)
instance F.MonadFail (Parser' e) where
  fail :: forall a. [Char] -> Parser' e a
fail [Char]
e = Parser a -> Parser' e a
forall e a. Parser a -> Parser' e a
Parser' ([Char] -> Parser a
forall a. [Char] -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
F.fail [Char]
e)
#else
instance F.MonadFail (Parser' e) where
  fail e = Parser' (fail e)
#endif

-------------------------------------------------------------------------------

-- | Use with caution. Catch a parser failing and return Nothing.
mParse :: Parser' e a -> Parser' e (Maybe a)
mParse :: forall e a. Parser' e a -> Parser' e (Maybe a)
mParse Parser' e a
p = Maybe a -> Parser' e (Maybe a) -> Parser' e (Maybe a)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser' e a -> Parser' e (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' e a
p)

-------------------------------------------------------------------------------

-- | If the first parser succeeds, discard the result and use the
-- second parser (which may fail). If the first parser fails, return
-- Nothing. This is used to check a benign precondition that indicates
-- the presence of a parsible token, i.e. ? preceding a query.
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 Parser' e a -> Parser' e (Maybe b) -> Parser' e (Maybe b)
forall a b. Parser' e a -> Parser' e b -> Parser' e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> Parser' e b -> Parser' e (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' e b
p2) Parser' e (Maybe b) -> Parser' e (Maybe b) -> Parser' e (Maybe b)
forall a. Parser' e a -> Parser' e a -> Parser' e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe b -> Parser' e (Maybe b)
forall a. a -> Parser' e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing

-------------------------------------------------------------------------------

-- | Lift a word8 Parser into a strongly error typed parser. This will
-- generate a "stringy" error message if it fails, so you should
-- probably be prepared to exit with a nicer error further up.
word8' :: Word8 -> Parser' e Word8
word8' :: forall e. Word8 -> Parser' e Word8
word8' = Parser Word8 -> Parser' e Word8
forall e a. Parser a -> Parser' e a
Parser' (Parser Word8 -> Parser' e Word8)
-> (Word8 -> Parser Word8) -> Word8 -> Parser' e Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Parser Word8
word8

-------------------------------------------------------------------------------

-- | Skip exactly 1 character. Fails if the character isn't
-- there. Generates a "stringy" error.
skip' :: Int -> Parser' e ()
skip' :: forall e. Int -> Parser' e ()
skip' = Parser ByteString () -> Parser' e ()
forall e a. Parser a -> Parser' e a
Parser' (Parser ByteString () -> Parser' e ())
-> (Int -> Parser ByteString ()) -> Int -> Parser' e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString -> Parser ByteString ())
-> (Int -> Parser ByteString) -> Int -> Parser ByteString ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser ByteString
A.take

-------------------------------------------------------------------------------

-- | Lifted version of the string token parser. Same caveats about
-- "stringy" errors apply.
string' :: ByteString -> Parser' e ByteString
string' :: forall e. ByteString -> Parser' e ByteString
string' = Parser ByteString -> Parser' e ByteString
forall e a. Parser a -> Parser' e a
Parser' (Parser ByteString -> Parser' e ByteString)
-> (ByteString -> Parser ByteString)
-> ByteString
-> Parser' e ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Parser ByteString
string

-------------------------------------------------------------------------------

-- | Combinator for tunnelling more specific error types through the
-- attoparsec machinery using read/show.
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 = Parser a -> Parser' e a
forall e a. Parser a -> Parser' e a
Parser' Parser a
p Parser' e a -> Parser' e a -> Parser' e a
forall a. Parser' e a -> Parser' e a -> Parser' e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> e -> Parser' e a
forall e a. Show e => e -> Parser' e a
fail' e
e

-------------------------------------------------------------------------------

-- | Should be preferred to fail'
fail' :: (Show e) => e -> Parser' e a
fail' :: forall e a. Show e => e -> Parser' e a
fail' = [Char] -> Parser' e a
forall a. [Char] -> Parser' e a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser' e a) -> (e -> [Char]) -> e -> Parser' e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> [Char]
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 = [m [a]] -> m [a]
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [m [a]]
parsers
  where
    parsers :: [m [a]]
parsers = (Int -> m [a]) -> [Int] -> [m [a]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> m a -> m [a]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
`count` m a
f) ([Int] -> [m [a]]) -> [Int] -> [m [a]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Int]
forall a. Ix a => (a, a) -> [a]
range (Int
a, Int
b)

-------------------------------------------------------------------------------

-- | Stronger-typed variation of parseOnly'. Consumes all input.
parseOnly' ::
  (Read e) =>
  -- | Fallback if we can't parse a failure message for the sake of totality.
  (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) = ([Char] -> e) -> Either [Char] a -> Either e a
forall a b r. (a -> b) -> Either a r -> Either b r
fmapL [Char] -> e
readWithFallback (Either [Char] a -> Either e a)
-> (ByteString -> Either [Char] a) -> ByteString -> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ByteString -> Either [Char] a
forall a. Parser a -> ByteString -> Either [Char] a
parseOnly Parser a
p
  where
    readWithFallback :: [Char] -> e
readWithFallback [Char]
s = e -> Maybe e -> e
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> e
noParse [Char]
s) ([Char] -> Maybe e
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe e) -> ([Char] -> [Char]) -> [Char] -> Maybe e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
stripAttoparsecGarbage ([Char] -> Maybe e) -> [Char] -> Maybe e
forall a b. (a -> b) -> a -> b
$ [Char]
s)

-------------------------------------------------------------------------------

-- | Our pal Control.Monad.fail is how attoparsec propagates
-- errors. If you throw an error string with fail (your only choice),
-- it will *always* prepend it with "Failed reading: ". At least in
-- this version. That may change to something else and break this workaround.
stripAttoparsecGarbage :: String -> String
stripAttoparsecGarbage :: [Char] -> [Char]
stripAttoparsecGarbage = [Char] -> [Char] -> [Char]
forall a. Eq a => [a] -> [a] -> [a]
stripPrefix' [Char]
"Failed reading: "

-------------------------------------------------------------------------------

-- | stripPrefix where it is a noop if the prefix doesn't exist.
stripPrefix' :: Eq a => [a] -> [a] -> [a]
stripPrefix' :: forall a. Eq a => [a] -> [a] -> [a]
stripPrefix' [a]
pfx [a]
s = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a]
s (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> Maybe [a]
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 = (a -> Either b r) -> (r -> Either b r) -> Either a r -> Either b r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (b -> Either b r
forall a b. a -> Either a b
Left (b -> Either b r) -> (a -> b) -> a -> Either b r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) r -> Either b r
forall a b. b -> Either a b
Right

-------------------------------------------------------------------------------
--TODO: keep an eye on perf here. seems like a good use case for a DList. the word8 list could be a set/hashset

-- | Percent-encoding for URLs. Specify a list of additional
-- unreserved characters to permit.
urlEncode :: [Word8] -> ByteString -> Builder
urlEncode :: [Word8] -> ByteString -> Builder
urlEncode [Word8]
extraUnreserved = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (ByteString -> [Builder]) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Builder) -> [Word8] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Builder
encodeChar ([Word8] -> [Builder])
-> (ByteString -> [Word8]) -> ByteString -> [Builder]
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
65 Bool -> Bool -> Bool
&& Word8
ch Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
90 = Bool
True -- A-Z
      | Word8
ch Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
97 Bool -> Bool -> Bool
&& Word8
ch Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
122 = Bool
True -- a-z
      | Word8
ch Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
ch Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57 = Bool
True -- 0-9
    unreserved' Word8
c = Word8
c Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word8
16 in ByteString -> Builder
bs (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BS.pack [Word8
37, Word8 -> Word8
forall {a}. (Ord a, Num a) => a -> a
h Word8
a, Word8 -> Word8
forall {a}. (Ord a, Num a) => a -> a
h Word8
b] -- percent (%)
    h :: a -> a
h a
i
      | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10 = a
48 a -> a -> a
forall a. Num a => a -> a -> a
+ a
i -- zero (0)
      | Bool
otherwise = a
65 a -> a -> a
forall a. Num a => a -> a -> a
+ a
i a -> a -> a
forall a. Num a => a -> a -> a
- a
10 -- 65: A

-------------------------------------------------------------------------------

-- | Encode a ByteString for use in the query section of a URL
urlEncodeQuery :: ByteString -> Builder
urlEncodeQuery :: ByteString -> Builder
urlEncodeQuery = [Word8] -> ByteString -> Builder
urlEncode [Word8]
unreserved8

-------------------------------------------------------------------------------

-- | Encode a ByteString for use in the path section of a URL
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

-------------------------------------------------------------------------------

-- | Simple data structure to get O(1) prepends on a list and defers the O(n)
newtype RL a = RL [a] deriving (Int -> RL a -> [Char] -> [Char]
[RL a] -> [Char] -> [Char]
RL a -> [Char]
(Int -> RL a -> [Char] -> [Char])
-> (RL a -> [Char]) -> ([RL a] -> [Char] -> [Char]) -> Show (RL a)
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
$cshowsPrec :: forall a. Show a => Int -> RL a -> [Char] -> [Char]
showsPrec :: Int -> RL a -> [Char] -> [Char]
$cshow :: forall a. Show a => RL a -> [Char]
show :: RL a -> [Char]
$cshowList :: forall a. Show a => [RL a] -> [Char] -> [Char]
showList :: [RL a] -> [Char] -> [Char]
Show)

(|>) :: RL a -> a -> RL a
RL [a]
as |> :: forall a. RL a -> a -> RL a
|> a
a = [a] -> RL a
forall a. [a] -> RL a
RL (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)

rl2L :: RL a -> [a]
rl2L :: forall a. RL a -> [a]
rl2L (RL [a]
as) = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
as

unsnoc :: RL a -> RL a
unsnoc :: forall a. RL a -> RL a
unsnoc (RL []) = [a] -> RL a
forall a. [a] -> RL a
RL []
unsnoc (RL (a
_ : [a]
xs)) = [a] -> RL a
forall a. [a] -> RL a
RL [a]
xs


sequenceM :: (Semigroup a, Monoid a, Traversable t, Monad m) => t (m a) -> m a
sequenceM :: forall a (t :: * -> *) (m :: * -> *).
(Semigroup a, Monoid a, Traversable t, Monad m) =>
t (m a) -> m a
sequenceM = (t a -> a) -> m (t a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a -> a) -> a -> t a -> a
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) a
forall a. Monoid a => a
mempty) (m (t a) -> m a) -> (t (m a) -> m (t a)) -> t (m a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (m a) -> m (t a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => t (m a) -> m (t a)
sequence

satisfy' :: (Word8 -> Bool) -> Parser ByteString
satisfy' :: (Word8 -> Bool) -> Parser ByteString
satisfy' Word8 -> Bool
f = Word8 -> ByteString
BS.singleton (Word8 -> ByteString) -> Parser Word8 -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser Word8
A.satisfy Word8 -> Bool
f

many1C :: (Monoid a, Semigroup a, MonadPlus m) => m a -> m a
many1C :: forall a (m :: * -> *).
(Monoid a, Semigroup a, MonadPlus m) =>
m a -> m a
many1C = ([a] -> a) -> m [a] -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a. Monoid a => [a] -> a
mconcat (m [a] -> m a) -> (m a -> m [a]) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1

manyC :: (Monoid a, Semigroup a, MonadPlus m) => m a -> m a
manyC :: forall a (m :: * -> *).
(Monoid a, Semigroup a, MonadPlus m) =>
m a -> m a
manyC = ([a] -> a) -> m [a] -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a. Monoid a => [a] -> a
mconcat (m [a] -> m a) -> (m a -> m [a]) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many'

satisfyClass :: String -> Parser ByteString
satisfyClass :: [Char] -> Parser ByteString
satisfyClass = (Word8 -> Bool) -> Parser ByteString
satisfy' ((Word8 -> Bool) -> Parser ByteString)
-> ([Char] -> Word8 -> Bool) -> [Char] -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Word8 -> Bool
inClass

satisfyNotClass :: String -> Parser ByteString
satisfyNotClass :: [Char] -> Parser ByteString
satisfyNotClass = (Word8 -> Bool) -> Parser ByteString
satisfy' ((Word8 -> Bool) -> Parser ByteString)
-> ([Char] -> Word8 -> Bool) -> [Char] -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Word8 -> Bool
notInClass