{-# LANGUAGE CPP                        #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TupleSections              #-}
module URI.ByteString.Internal where

-------------------------------------------------------------------------------
import           Blaze.ByteString.Builder           (Builder)
import qualified Blaze.ByteString.Builder           as BB
import qualified Blaze.ByteString.Builder.Char.Utf8 as BB
import           Control.Applicative
import           Control.Monad
import qualified Control.Monad.Fail                 as F
import           Data.Attoparsec.ByteString
import qualified Data.Attoparsec.ByteString         as A
import qualified Data.Attoparsec.ByteString.Char8   as A (decimal)
import           Data.Bits
import           Data.ByteString                    (ByteString)
import qualified Data.ByteString                    as BS
import qualified Data.ByteString.Char8              as BS8
import           Data.Char                          (ord, toLower)
import           Data.Ix
import           Data.List                          (delete, intersperse,
                                                     sortBy, stripPrefix, (\\))
import qualified Data.Map.Strict                    as M
import           Data.Maybe
import           Data.Monoid                        as Monoid (mempty)
import           Data.Ord                           (comparing)
import           Data.Semigroup                     as Semigroup
import           Data.Word
import           Text.Read                          (readMaybe)
-------------------------------------------------------------------------------
import           URI.ByteString.Types
-------------------------------------------------------------------------------


-------------------------------------------------------------------------------
-- | 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 {
      upoValidQueryChar :: Word8 -> Bool
upoValidQueryChar = Word8 -> Bool
validForQuery
    }


-------------------------------------------------------------------------------
-- | 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 {
      upoValidQueryChar :: Word8 -> Bool
upoValidQueryChar = Word8 -> Bool
validForQueryLax
    }


-------------------------------------------------------------------------------
-- | 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
rrFragment :: URIRef Relative -> Maybe ByteString
rrQuery :: URIRef Relative -> Query
rrPath :: URIRef Relative -> ByteString
rrAuthority :: URIRef Relative -> Maybe Authority
..}) = Scheme
-> Maybe Authority
-> ByteString
-> Query
-> Maybe ByteString
-> URIRef Absolute
URI Scheme
scheme Maybe Authority
rrAuthority ByteString
rrPath Query
rrQuery Maybe ByteString
rrFragment
toAbsolute Scheme
_ uri :: URIRef a
uri@(URI {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriScheme :: Scheme
uriAuthority :: Maybe Authority
uriPath :: ByteString
uriQuery :: Query
uriFragment :: Maybe ByteString
uriFragment :: URIRef Absolute -> Maybe ByteString
uriQuery :: URIRef Absolute -> Query
uriPath :: URIRef Absolute -> ByteString
uriAuthority :: URIRef Absolute -> Maybe Authority
uriScheme :: URIRef Absolute -> Scheme
..}) = 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 {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriFragment :: URIRef Absolute -> Maybe ByteString
uriQuery :: URIRef Absolute -> Query
uriPath :: URIRef Absolute -> ByteString
uriAuthority :: URIRef Absolute -> Maybe Authority
uriScheme :: URIRef Absolute -> Scheme
uriScheme :: Scheme
uriAuthority :: Maybe Authority
uriPath :: ByteString
uriQuery :: Query
uriFragment :: Maybe ByteString
..})       = 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
unoSortParameters :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: URINormalizationOptions -> Bool
..} URI {Maybe ByteString
Maybe Authority
ByteString
Query
Scheme
uriFragment :: URIRef Absolute -> Maybe ByteString
uriQuery :: URIRef Absolute -> Query
uriPath :: URIRef Absolute -> ByteString
uriAuthority :: URIRef Absolute -> Maybe Authority
uriScheme :: URIRef Absolute -> Scheme
uriScheme :: Scheme
uriAuthority :: Maybe Authority
uriPath :: ByteString
uriQuery :: Query
uriFragment :: 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
unoSortParameters :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: 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
rrFragment :: URIRef Relative -> Maybe ByteString
rrQuery :: URIRef Relative -> Query
rrPath :: URIRef Relative -> ByteString
rrAuthority :: URIRef Relative -> Maybe Authority
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
hByteString -> [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
hByteString -> [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
unoSortParameters :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: 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
unoSortParameters :: URINormalizationOptions -> Bool
unoDropExtraSlashes :: 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
authorityPort :: Authority -> Maybe Port
authorityHost :: Authority -> Host
authorityUserInfo :: Authority -> Maybe UserInfo
..} = [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
uiPassword :: UserInfo -> ByteString
uiUsername :: 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
  RelativeRef Maybe Authority
authority ByteString
path Query
query Maybe ByteString
fragment <- URIParserOptions -> Parser' URIParseError (URIRef Relative)
relativeRefParser' URIParserOptions
opts
  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
fragment


-------------------------------------------------------------------------------
-- | 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)
hierPartParser 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
<|> URIParser (Maybe Authority, ByteString)
rrPathParser
  Query
query <- URIParserOptions -> URIParser Query
queryParser URIParserOptions
opts
  Maybe ByteString
frag  <- URIParser (Maybe ByteString)
mFragmentParser
  case Maybe ByteString
frag of
    Just ByteString
_  -> 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


-------------------------------------------------------------------------------
-- | Hier part immediately follows the schema and encompasses the
-- authority and path sections.
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
<|>
                 URIParser (Maybe Authority, ByteString)
pathAbsoluteParser 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
<|>
                 URIParser (Maybe Authority, ByteString)
pathRootlessParser 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
<|>
                 URIParser (Maybe Authority, ByteString)
pathEmptyParser


-------------------------------------------------------------------------------
-- | Relative references have awkward corner cases.  See
-- 'firstRelRefSegmentParser'.
rrPathParser :: URIParser (Maybe Authority, ByteString)
rrPathParser :: URIParser (Maybe Authority, ByteString)
rrPathParser = (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
<$>
    (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>) (ByteString -> ByteString -> ByteString)
-> Parser' URIParseError ByteString
-> Parser' URIParseError (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' URIParseError ByteString
firstRelRefSegmentParser Parser' URIParseError (ByteString -> ByteString)
-> Parser' URIParseError ByteString
-> Parser' URIParseError 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' URIParseError ByteString
pathParser)


-------------------------------------------------------------------------------
-- | 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' URIParseError ByteString
pathParser)


-------------------------------------------------------------------------------
-- | See the "path-absolute" grammar in the RFC. Essentially a special
-- case of rootless.
pathAbsoluteParser :: URIParser (Maybe Authority, ByteString)
pathAbsoluteParser :: URIParser (Maybe Authority, ByteString)
pathAbsoluteParser = 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
*> URIParser (Maybe Authority, ByteString)
pathRootlessParser


-------------------------------------------------------------------------------
-- | See the "path-rootless" grammar in the RFC.
pathRootlessParser :: URIParser (Maybe Authority, ByteString)
pathRootlessParser :: URIParser (Maybe Authority, ByteString)
pathRootlessParser = (,) (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
<$> Maybe Authority -> Parser' URIParseError (Maybe Authority)
forall a. a -> Parser' URIParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Authority
forall a. Maybe a
Nothing 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' URIParseError ByteString
pathParser1


-------------------------------------------------------------------------------
-- | See the "path-empty" grammar in the RFC. Must not be followed
-- with a path-valid char.
pathEmptyParser :: URIParser (Maybe Authority, ByteString)
pathEmptyParser :: URIParser (Maybe Authority, ByteString)
pathEmptyParser = do
  Maybe Word8
nextChar <- 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
nextChar of
    Just Word8
c -> Bool -> Parser' URIParseError ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Char] -> Word8 -> Bool
notInClass [Char]
pchar Word8
c) Parser' URIParseError ()
-> URIParser (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
forall a b.
Parser' URIParseError a
-> Parser' URIParseError b -> Parser' URIParseError b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
forall a. a -> Parser' URIParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Authority, ByteString)
forall {a}. (Maybe a, ByteString)
emptyCase
    Maybe Word8
_      -> (Maybe Authority, ByteString)
-> URIParser (Maybe Authority, ByteString)
forall a. a -> Parser' URIParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Authority, ByteString)
forall {a}. (Maybe a, ByteString)
emptyCase
  where
    emptyCase :: (Maybe a, ByteString)
emptyCase = (Maybe a
forall a. Maybe a
Nothing, ByteString
forall a. Monoid a => a
mempty)


-------------------------------------------------------------------------------
-- | 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
ui <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 Word8 -> Bool
validForUserInfo
      let (ByteString
user, ByteString
passWithColon) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
colon) (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
urlDecode' ByteString
ui
      let pass :: ByteString
pass = Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
passWithColon
      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
    validForUserInfo :: Word8 -> Bool
validForUserInfo = [Char] -> Word8 -> Bool
inClass ([Char] -> Word8 -> Bool) -> [Char] -> Word8 -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
pctEncoded [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [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 = ByteString -> ByteString
urlDecode' (ByteString -> ByteString)
-> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 ([Char] -> Word8 -> Bool
inClass [Char]
validForRegName)
  where
    validForRegName :: [Char]
validForRegName = [Char]
pctEncoded [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
subDelims [Char] -> [Char] -> [Char]
forall 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


-------------------------------------------------------------------------------
-- | Path with any number of segments
pathParser :: URIParser ByteString
pathParser :: Parser' URIParseError ByteString
pathParser = (Parser ByteString -> Parser ByteString [ByteString])
-> Parser' URIParseError ByteString
pathParser' Parser ByteString -> Parser ByteString [ByteString]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many'


-------------------------------------------------------------------------------
-- | Path with at least 1 segment
pathParser1 :: URIParser ByteString
pathParser1 :: Parser' URIParseError ByteString
pathParser1 = (Parser ByteString -> Parser ByteString [ByteString])
-> Parser' URIParseError ByteString
pathParser' Parser ByteString -> Parser ByteString [ByteString]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many1'


-------------------------------------------------------------------------------
-- | Parses the path section of a url. Note that while this can take
-- percent-encoded characters, it does not itself decode them while parsing.
pathParser' :: (Parser ByteString -> Parser [ByteString]) -> URIParser ByteString
pathParser' :: (Parser ByteString -> Parser ByteString [ByteString])
-> Parser' URIParseError ByteString
pathParser' Parser ByteString -> Parser ByteString [ByteString]
repeatParser = (ByteString -> ByteString
urlDecodeQuery (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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]
repeatParser Parser ByteString
segmentParser) Parser ByteString
-> URIParseError -> Parser' URIParseError ByteString
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPath
  where
    segmentParser :: Parser ByteString
segmentParser = [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 [ByteString -> Parser ByteString
string ByteString
"/", (Word8 -> Bool) -> Parser ByteString
A.takeWhile ([Char] -> Word8 -> Bool
inClass [Char]
pchar)]


-------------------------------------------------------------------------------
-- | Parses the first segment of a path section of a relative-path
-- reference.  See RFC 3986, Section 4.2.
-- firstRelRefSegmentParser :: URIParser ByteString
firstRelRefSegmentParser :: URIParser ByteString
firstRelRefSegmentParser :: Parser' URIParseError ByteString
firstRelRefSegmentParser = (Word8 -> Bool) -> Parser ByteString
A.takeWhile ([Char] -> Word8 -> Bool
inClass ([Char]
pchar [Char] -> [Char] -> [Char]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Char]
":")) Parser ByteString
-> URIParseError -> Parser' URIParseError ByteString
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedPath


-------------------------------------------------------------------------------
-- | 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 = do
  ByteString
s <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile (URIParserOptions -> Word8 -> Bool
upoValidQueryChar URIParserOptions
opts) Parser ByteString
-> URIParseError -> Parser' URIParseError ByteString
forall e a. Show e => Parser a -> e -> Parser' e a
`orFailWith` URIParseError
MalformedQuery
  if ByteString -> Bool
BS.null ByteString
s
     then (ByteString, ByteString)
-> Parser' URIParseError (ByteString, ByteString)
forall a. a -> Parser' URIParseError 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
       let (ByteString
k, ByteString
vWithEquals) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
equals) ByteString
s
       let v :: ByteString
v = Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
vWithEquals
       (ByteString, ByteString)
-> Parser' URIParseError (ByteString, ByteString)
forall a. a -> Parser' URIParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
urlDecodeQuery ByteString
k, ByteString -> ByteString
urlDecodeQuery ByteString
v)


-------------------------------------------------------------------------------
validForQuery :: Word8 -> Bool
validForQuery :: Word8 -> Bool
validForQuery = [Char] -> Word8 -> Bool
inClass (Char
'?'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]
pchar)


-------------------------------------------------------------------------------
validForQueryLax :: Word8 -> Bool
validForQueryLax :: Word8 -> Bool
validForQueryLax = [Char] -> Word8 -> Bool
notInClass [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
$ (Word8 -> Bool) -> Parser ByteString
A.takeWhile Word8 -> Bool
validFragmentWord
  where
    validFragmentWord :: Word8 -> Bool
validFragmentWord = [Char] -> Word8 -> Bool
inClass (Char
'?'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'/'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
pchar)


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


-------------------------------------------------------------------------------
pchar :: String
pchar :: [Char]
pchar = [Char]
pctEncoded [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
subDelims [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":@" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
unreserved


-------------------------------------------------------------------------------
-- 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]
"%"


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


-------------------------------------------------------------------------------
-- | ByteString Utilities
-------------------------------------------------------------------------------


-------------------------------------------------------------------------------
-- | Decoding specifically for the query string, which decodes + as
-- space. Shorthand for @urlDecode True@
urlDecodeQuery :: ByteString -> ByteString
urlDecodeQuery :: ByteString -> ByteString
urlDecodeQuery = Bool -> ByteString -> ByteString
urlDecode Bool
plusToSpace
  where
    plusToSpace :: Bool
plusToSpace = Bool
True


-------------------------------------------------------------------------------
-- | Decode any part of the URL besides the query, which decodes + as
-- space.
urlDecode' :: ByteString -> ByteString
urlDecode' :: ByteString -> ByteString
urlDecode' = Bool -> ByteString -> ByteString
urlDecode Bool
plusToSpace
  where
    plusToSpace :: Bool
plusToSpace = Bool
False


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


instance F.MonadFail (Parser' e) where
#if MIN_VERSION_attoparsec(0,13,1)
  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
  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)
           => (String -> e) -- ^ Fallback if we can't parse a failure message for the sake of totality.
           -> 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


-------------------------------------------------------------------------------
-- | This function was extracted from the @http-types@ package. The
-- license can be found in licenses/http-types/LICENSE
urlDecode
    :: Bool
    -- ^ Whether to decode '+' to ' '
    -> BS.ByteString
    -> BS.ByteString
urlDecode :: Bool -> ByteString -> ByteString
urlDecode Bool
replacePlus ByteString
z = (ByteString, Maybe ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe ByteString) -> ByteString)
-> (ByteString, Maybe ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> (ByteString, Maybe ByteString)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN (ByteString -> Int
BS.length ByteString
z) ByteString -> Maybe (Word8, ByteString)
go ByteString
z
  where
    go :: ByteString -> Maybe (Word8, ByteString)
go ByteString
bs' =
        case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs' of
            Maybe (Word8, ByteString)
Nothing -> Maybe (Word8, ByteString)
forall a. Maybe a
Nothing
            Just (Word8
43, ByteString
ws) | Bool
replacePlus -> (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just (Word8
32, ByteString
ws) -- plus to space
            Just (Word8
37, ByteString
ws) -> (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just ((Word8, ByteString) -> Maybe (Word8, ByteString))
-> (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$ (Word8, ByteString)
-> Maybe (Word8, ByteString) -> (Word8, ByteString)
forall a. a -> Maybe a -> a
fromMaybe (Word8
37, ByteString
ws) (Maybe (Word8, ByteString) -> (Word8, ByteString))
-> Maybe (Word8, ByteString) -> (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$ do -- percent
                (Word8
x, ByteString
xs) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
ws
                Word8
x' <- Word8 -> Maybe Word8
forall {a}. (Ord a, Num a) => a -> Maybe a
hexVal Word8
x
                (Word8
y, ByteString
ys) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
xs
                Word8
y' <- Word8 -> Maybe Word8
forall {a}. (Ord a, Num a) => a -> Maybe a
hexVal Word8
y
                (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just (Word8 -> Word8 -> Word8
combine Word8
x' Word8
y', ByteString
ys)
            Just (Word8
w, ByteString
ws) -> (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just (Word8
w, ByteString
ws)
    hexVal :: a -> Maybe 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 -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ 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 -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ 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 -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
87 -- a - f
        | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
    combine :: Word8 -> Word8 -> Word8
    combine :: Word8 -> Word8 -> Word8
combine Word8
a Word8
b = Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
a Int
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
b


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