{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}

module System.URI.File.Internal where

import Control.Applicative
import Control.Monad
import Data.Attoparsec.ByteString (Parser)
import Data.Bits
import Data.ByteString (ByteString)
import Data.Maybe
import Data.Ix (range)
import Data.Word
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.ByteString.Char8 as A (decimal)

import qualified Data.ByteString as BS


-- $setup
-- >>> :set -XOverloadedStrings



    -----------------------
    --[ Main data types ]--
    -----------------------


-- | A parsed file URI. It can have an auth/host part.
data FileURI = FileURI {
    FileURI -> Maybe ByteString
fileAuth :: Maybe ByteString   -- ^ optional host part ("localhost" is parsed as 'Nothing'); <https://learn.microsoft.com/en-us/dotnet/standard/io/file-path-formats#unc-paths UNC> paths on windows go into 'filePath' and are not split
  , FileURI -> ByteString
filePath :: ByteString         -- ^ the proper absolute filepath
  } deriving (Int -> FileURI -> ShowS
[FileURI] -> ShowS
FileURI -> [Char]
(Int -> FileURI -> ShowS)
-> (FileURI -> [Char]) -> ([FileURI] -> ShowS) -> Show FileURI
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileURI -> ShowS
showsPrec :: Int -> FileURI -> ShowS
$cshow :: FileURI -> [Char]
show :: FileURI -> [Char]
$cshowList :: [FileURI] -> ShowS
showList :: [FileURI] -> ShowS
Show, FileURI -> FileURI -> Bool
(FileURI -> FileURI -> Bool)
-> (FileURI -> FileURI -> Bool) -> Eq FileURI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileURI -> FileURI -> Bool
== :: FileURI -> FileURI -> Bool
$c/= :: FileURI -> FileURI -> Bool
/= :: FileURI -> FileURI -> Bool
Eq)


-- | RFC syntax configuration.
data ParseSyntax = StrictPosix   -- ^ Only parses the strict syntax according to <https://www.rfc-editor.org/rfc/rfc8089.html#section-2 section 2 of RFC 8089>, which is technically posix paths.
                 | ExtendedPosix -- ^ Also parses extended user information described in <https://www.rfc-editor.org/rfc/rfc8089.html#appendix-E.1 E.1>
                 | ExtendedWindows -- ^ Parses windows paths according to <https://www.rfc-editor.org/rfc/rfc8089.html#appendix-E.1 E.1>, <https://www.rfc-editor.org/rfc/rfc8089.html#appendix-E.2 E.2> and <https://www.rfc-editor.org/rfc/rfc8089.html#appendix-E.3 E.3>. Unlike the spec, posix paths are rejected.
  deriving (Int -> ParseSyntax -> ShowS
[ParseSyntax] -> ShowS
ParseSyntax -> [Char]
(Int -> ParseSyntax -> ShowS)
-> (ParseSyntax -> [Char])
-> ([ParseSyntax] -> ShowS)
-> Show ParseSyntax
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseSyntax -> ShowS
showsPrec :: Int -> ParseSyntax -> ShowS
$cshow :: ParseSyntax -> [Char]
show :: ParseSyntax -> [Char]
$cshowList :: [ParseSyntax] -> ShowS
showList :: [ParseSyntax] -> ShowS
Show, ParseSyntax -> ParseSyntax -> Bool
(ParseSyntax -> ParseSyntax -> Bool)
-> (ParseSyntax -> ParseSyntax -> Bool) -> Eq ParseSyntax
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseSyntax -> ParseSyntax -> Bool
== :: ParseSyntax -> ParseSyntax -> Bool
$c/= :: ParseSyntax -> ParseSyntax -> Bool
/= :: ParseSyntax -> ParseSyntax -> Bool
Eq)




    ---------------
    --[ Parsing ]--
    ---------------


-- | Parse a file URI such as @file:\/\/\/foo\/bar@ into 'FileURI'.
--
-- >>> parseFileURI StrictPosix "file:/path/to/file"
-- Right (FileURI {fileAuth = Nothing, filePath = "/path/to/file"})
-- >>> parseFileURI StrictPosix "file:///path/to/file"
-- Right (FileURI {fileAuth = Nothing, filePath = "/path/to/file"})
-- >>> parseFileURI StrictPosix "file://hostname/path/to/file"
-- Right (FileURI {fileAuth = Just "hostname", filePath = "/path/to/file"})
-- >>> parseFileURI StrictPosix "file://localhost/path/to/file"
-- Right (FileURI {fileAuth = Nothing, filePath = "/path/to/file"})
-- >>> parseFileURI StrictPosix "http://localhost/path/to/file"
-- Left "string"
-- >>> parseFileURI StrictPosix "/path/to/file"
-- Left "string"
-- >>> parseFileURI ExtendedWindows "file://///host.example.com/path/to/file"
-- Right (FileURI {fileAuth = Nothing, filePath = "//host.example.com/path/to/file"})
-- >>> parseFileURI ExtendedWindows "file:///c:/path/to/file"
-- Right (FileURI {fileAuth = Nothing, filePath = "c:/path/to/file"})
-- >>> parseFileURI ExtendedWindows "file:/c:/path/to/file"
-- Right (FileURI {fileAuth = Nothing, filePath = "c:/path/to/file"})
-- >>> parseFileURI ExtendedWindows "file:c:/path/to/file"
-- Right (FileURI {fileAuth = Nothing, filePath = "c:/path/to/file"})
parseFileURI :: ParseSyntax  -- ^ RFC syntax configuration
             -> ByteString   -- ^ input file URI
             -> Either String FileURI
parseFileURI :: ParseSyntax -> ByteString -> Either [Char] FileURI
parseFileURI ParseSyntax
StrictPosix     = Parser FileURI -> ByteString -> Either [Char] FileURI
forall a. Parser a -> ByteString -> Either [Char] a
A.parseOnly (Parser FileURI
fileURIStrictP          Parser FileURI -> Parser ByteString () -> Parser FileURI
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput)
parseFileURI ParseSyntax
ExtendedPosix   = Parser FileURI -> ByteString -> Either [Char] FileURI
forall a. Parser a -> ByteString -> Either [Char] a
A.parseOnly (Parser FileURI
fileURIExtendedPosixP   Parser FileURI -> Parser ByteString () -> Parser FileURI
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput)
parseFileURI ParseSyntax
ExtendedWindows = Parser FileURI -> ByteString -> Either [Char] FileURI
forall a. Parser a -> ByteString -> Either [Char] a
A.parseOnly (Parser FileURI
fileURIExtendedWindowsP Parser FileURI -> Parser ByteString () -> Parser FileURI
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput)



    --------------------------
    --[ Attoparsec parsers ]--
    --------------------------


-- | Parse a file URI according to the <https://www.rfc-editor.org/rfc/rfc8089.html#section-2 main ABNF in RFC 8089>, without
-- any extended rules, which is as follows:
--
-- @
--    file-URI       = file-scheme ":" file-hier-part
--
--    file-scheme    = "file"
--
--    file-hier-part = ( "//" auth-path )
--                   / local-path
--
--    auth-path      = [ file-auth ] path-absolute
--
--    local-path     = path-absolute
--
--    file-auth      = "localhost"
--                   / host
-- @
fileURIStrictP :: Parser FileURI
fileURIStrictP :: Parser FileURI
fileURIStrictP = ByteString -> Parser ByteString
A.string ByteString
"file:" Parser ByteString -> Parser FileURI -> Parser FileURI
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 FileURI
fileHierPart
 where
  fileHierPart :: Parser FileURI
fileHierPart = (ByteString -> Parser ByteString
A.string ByteString
"//" Parser ByteString -> Parser FileURI -> Parser FileURI
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 FileURI
authPath) Parser FileURI -> Parser FileURI -> Parser FileURI
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser FileURI
localPath
  authPath :: Parser FileURI
authPath = (\Maybe ByteString
mfA -> Maybe ByteString -> ByteString -> FileURI
FileURI (if Maybe ByteString
mfA Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"localhost" then Maybe ByteString
forall a. Maybe a
Nothing else Maybe ByteString
mfA))
          (Maybe ByteString -> ByteString -> FileURI)
-> Parser ByteString (Maybe ByteString)
-> Parser ByteString (ByteString -> FileURI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
-> Parser ByteString (Maybe ByteString)
-> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Maybe ByteString
forall a. Maybe a
Nothing (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Parser ByteString -> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
fileAuth')
          Parser ByteString (ByteString -> FileURI)
-> Parser ByteString -> Parser FileURI
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
pathAbsoluteP
  fileAuth' :: Parser ByteString
fileAuth' = ByteString -> Parser ByteString
A.string ByteString
"localhost" 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
hostP
  localPath :: Parser FileURI
localPath = Maybe ByteString -> ByteString -> FileURI
FileURI Maybe ByteString
forall a. Maybe a
Nothing (ByteString -> FileURI) -> Parser ByteString -> Parser FileURI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
pathAbsoluteP

-- | Parse a file URI according to the <https://www.rfc-editor.org/rfc/rfc8089.html#section-2 main ABNF in RFC 8089>, with
-- extended rule <https://www.rfc-editor.org/rfc/rfc8089.html#appendix-E.1 E.1>.
--
-- @
--    file-URI       = file-scheme ":" file-hier-part
--
--    file-scheme    = "file"
--
--    file-hier-part = ( "//" auth-path )
--                   / local-path
--
--    auth-path      = [ file-auth ] path-absolute
--
--    local-path     = path-absolute
--
--    file-auth      = "localhost"
--                   / [ userinfo "@" ] host
-- @
fileURIExtendedPosixP :: Parser FileURI
fileURIExtendedPosixP :: Parser FileURI
fileURIExtendedPosixP = ByteString -> Parser ByteString
A.string ByteString
"file:" Parser ByteString -> Parser FileURI -> Parser FileURI
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 FileURI
fileHierPart
 where
  fileHierPart :: Parser FileURI
fileHierPart = (ByteString -> Parser ByteString
A.string ByteString
"//" Parser ByteString -> Parser FileURI -> Parser FileURI
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 FileURI
authPath) Parser FileURI -> Parser FileURI -> Parser FileURI
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser FileURI
localPath
  authPath :: Parser FileURI
authPath = (\Maybe ByteString
mfA -> Maybe ByteString -> ByteString -> FileURI
FileURI (if Maybe ByteString
mfA Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"localhost" then Maybe ByteString
forall a. Maybe a
Nothing else Maybe ByteString
mfA))
          (Maybe ByteString -> ByteString -> FileURI)
-> Parser ByteString (Maybe ByteString)
-> Parser ByteString (ByteString -> FileURI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
-> Parser ByteString (Maybe ByteString)
-> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Maybe ByteString
forall a. Maybe a
Nothing (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Parser ByteString -> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
fileAuth')
          Parser ByteString (ByteString -> FileURI)
-> Parser ByteString -> Parser FileURI
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
pathAbsoluteP
  fileAuth' :: Parser ByteString
fileAuth' = ByteString -> Parser ByteString
A.string ByteString
"localhost" 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] -> Parser ByteString
forall (m :: * -> *). Monad m => [m ByteString] -> m ByteString
sequenceM [ByteString -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option ByteString
BS.empty ([Parser ByteString] -> Parser ByteString
forall (m :: * -> *). Monad m => [m ByteString] -> m ByteString
sequenceM [Parser ByteString
userInfoP, Parser ByteString
"@"]), Parser ByteString
hostP]
  localPath :: Parser FileURI
localPath = Maybe ByteString -> ByteString -> FileURI
FileURI Maybe ByteString
forall a. Maybe a
Nothing (ByteString -> FileURI) -> Parser ByteString -> Parser FileURI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
pathAbsoluteP


-- | Parse a file URI according for windows according to <https://www.rfc-editor.org/rfc/rfc8089.html#appendix-E.1 E.1>,
-- <https://www.rfc-editor.org/rfc/rfc8089.html#appendix-E.2 E.2> and
-- <https://www.rfc-editor.org/rfc/rfc8089.html#appendix-E.3 E.3>. Unlike the spec, posix paths are rejected. The ABNF
-- is a slight modification of <https://www.rfc-editor.org/rfc/rfc8089.html#appendix-F Appendix F>.
--
-- @
--    file-URI       = file-scheme ":" file-hier-part
--
--    file-scheme    = "file"
--
--    file-hier-part = ( "//" auth-path )
--                   / local-path
--
--    auth-path      = [ file-auth ] file-absolute
--                   / unc-authority path-absolute
--
--    local-path     =  drive-letter path-absolute
--                   / file-absolute
--
--    file-auth      = "localhost"
--                   / [ userinfo "@" ] host
--
--    unc-authority  = 2*3"/" file-host
--
--    file-host      = inline-IP / IPv4address / reg-name
--
--    inline-IP      = "%5B" ( IPv6address / IPvFuture ) "%5D"
--
--    file-absolute  = "/" drive-letter path-absolute
--
--    drive-letter   = ALPHA ":"
--                   / ALPHA "|"
-- @
fileURIExtendedWindowsP :: Parser FileURI
fileURIExtendedWindowsP :: Parser FileURI
fileURIExtendedWindowsP = ByteString -> Parser ByteString
A.string ByteString
"file:" Parser ByteString -> Parser FileURI -> Parser FileURI
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 FileURI
fileHierPart
 where
  fileHierPart :: Parser FileURI
fileHierPart = (ByteString -> Parser ByteString
A.string ByteString
"//" Parser ByteString -> Parser FileURI -> Parser FileURI
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 FileURI
authPath) Parser FileURI -> Parser FileURI -> Parser FileURI
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser FileURI
localPath
  authPath :: Parser FileURI
authPath = (\(Maybe ByteString
mfA, ByteString
p) -> Maybe ByteString -> ByteString -> FileURI
FileURI (if Maybe ByteString
mfA Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"localhost" then Maybe ByteString
forall a. Maybe a
Nothing else Maybe ByteString
mfA) ByteString
p) ((Maybe ByteString, ByteString) -> FileURI)
-> Parser ByteString (Maybe ByteString, ByteString)
-> Parser FileURI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (
          ((,) (Maybe ByteString -> ByteString -> (Maybe ByteString, ByteString))
-> Parser ByteString (Maybe ByteString)
-> Parser ByteString (ByteString -> (Maybe ByteString, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
-> Parser ByteString (Maybe ByteString)
-> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Maybe ByteString
forall a. Maybe a
Nothing (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Parser ByteString -> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
fileAuth') Parser ByteString (ByteString -> (Maybe ByteString, ByteString))
-> Parser ByteString
-> Parser ByteString (Maybe ByteString, ByteString)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
fileAbsoluteP Parser ByteString (Maybe ByteString, ByteString)
-> Parser ByteString ()
-> Parser ByteString (Maybe ByteString, 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
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput)
      Parser ByteString (Maybe ByteString, ByteString)
-> Parser ByteString (Maybe ByteString, ByteString)
-> Parser ByteString (Maybe ByteString, ByteString)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((,) (Maybe ByteString -> ByteString -> (Maybe ByteString, ByteString))
-> Parser ByteString (Maybe ByteString)
-> Parser ByteString (ByteString -> (Maybe ByteString, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString -> Parser ByteString (Maybe ByteString)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing Parser ByteString (ByteString -> (Maybe ByteString, ByteString))
-> Parser ByteString
-> Parser ByteString (Maybe ByteString, ByteString)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Parser ByteString] -> Parser ByteString
forall (m :: * -> *). Monad m => [m ByteString] -> m ByteString
sequenceM [Parser ByteString
uncAuthorityP, Parser ByteString
pathAbsoluteP] Parser ByteString (Maybe ByteString, ByteString)
-> Parser ByteString ()
-> Parser ByteString (Maybe ByteString, 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
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput)
    )
  fileAuth' :: Parser ByteString
fileAuth' = ByteString -> Parser ByteString
A.string ByteString
"localhost" 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] -> Parser ByteString
forall (m :: * -> *). Monad m => [m ByteString] -> m ByteString
sequenceM [ByteString -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option ByteString
BS.empty ([Parser ByteString] -> Parser ByteString
forall (m :: * -> *). Monad m => [m ByteString] -> m ByteString
sequenceM [Parser ByteString
userInfoP, Parser ByteString
"@"]), Parser ByteString
hostP]
  localPath :: Parser FileURI
localPath = (ByteString -> FileURI) -> Parser ByteString -> Parser FileURI
forall a b. (a -> b) -> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe ByteString -> ByteString -> FileURI
FileURI Maybe ByteString
forall a. Maybe a
Nothing) (Parser ByteString -> Parser FileURI)
-> Parser ByteString -> Parser FileURI
forall a b. (a -> b) -> a -> b
$ (Parser ByteString
fileAbsoluteP Parser ByteString -> Parser ByteString () -> 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
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput) 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] -> Parser ByteString
forall (m :: * -> *). Monad m => [m ByteString] -> m ByteString
sequenceM [Parser ByteString
driveLetterP', Parser ByteString
pathAbsoluteP] Parser ByteString -> Parser ByteString () -> 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
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput)

pathAbsoluteP :: Parser ByteString
pathAbsoluteP :: Parser ByteString
pathAbsoluteP = [Parser ByteString] -> Parser ByteString
forall (m :: * -> *). Monad m => [m ByteString] -> m ByteString
sequenceM [ByteString -> Parser ByteString
A.string ByteString
"/", ByteString -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option ByteString
BS.empty (Parser ByteString -> Parser ByteString)
-> Parser ByteString -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ [Parser ByteString] -> Parser ByteString
forall (m :: * -> *). Monad m => [m ByteString] -> m ByteString
sequenceM [Parser ByteString
segmentNZP, Parser ByteString
pathAbEmpty]]

uncAuthorityP :: Parser ByteString
uncAuthorityP :: Parser ByteString
uncAuthorityP = (\ByteString
a ByteString
b -> [ByteString] -> ByteString
BS.concat [ByteString
a, ByteString
b]) (ByteString -> ByteString -> ByteString)
-> Parser ByteString
-> Parser ByteString (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Parser ByteString
A.string ByteString
"//" Parser ByteString -> Parser ByteString -> 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
<* (ByteString -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option ByteString
BS.empty (ByteString -> Parser ByteString
A.string ByteString
"/"))) Parser ByteString (ByteString -> ByteString)
-> Parser ByteString -> Parser ByteString
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString
fileHostP

fileHostP :: Parser ByteString
fileHostP :: Parser ByteString
fileHostP = Parser ByteString
hostP

fileAbsoluteP :: Parser ByteString
fileAbsoluteP :: Parser ByteString
fileAbsoluteP = ByteString -> Parser ByteString
A.string ByteString
"/" Parser ByteString -> Parser ByteString -> Parser ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Parser ByteString] -> Parser ByteString
forall (m :: * -> *). Monad m => [m ByteString] -> m ByteString
sequenceM [Parser ByteString
driveLetterP', Parser ByteString
pathAbsoluteP]

driveLetterP :: Parser Word8
driveLetterP :: Parser Word8
driveLetterP = (Word8 -> Bool) -> Parser Word8
A.satisfy ([Char] -> Word8 -> Bool
A.inClass [Char]
alpha) Parser Word8 -> Parser ByteString -> Parser Word8
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (ByteString -> Parser ByteString
A.string ByteString
":" Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
A.string ByteString
"|")

-- | Like 'driveLetterP', but appends ':'.
driveLetterP' :: Parser ByteString
driveLetterP' :: Parser ByteString
driveLetterP' = ((ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":") (ByteString -> ByteString)
-> (Word8 -> ByteString) -> Word8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString
BS.singleton) (Word8 -> ByteString) -> Parser Word8 -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
driveLetterP

userInfoP :: Parser ByteString
userInfoP :: Parser ByteString
userInfoP = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> Parser ByteString [Word8] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8 -> Parser ByteString [Word8]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Word8
pctEncodedP Parser Word8 -> Parser Word8 -> Parser Word8
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Word8
satisfyClass ([Char]
":" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
subDelims [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
unreserved))

hostP :: Parser ByteString
hostP :: Parser ByteString
hostP = Parser ByteString
ipLiteralP 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
ipV4P 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
regNameP

regNameP :: Parser ByteString
regNameP :: Parser ByteString
regNameP = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> Parser ByteString [Word8] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8 -> Parser ByteString [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 (Parser Word8
pctEncodedP Parser Word8 -> Parser Word8 -> Parser Word8
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Word8
satisfyClass ([Char]
subDelims [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
unreserved))

ipLiteralP :: Parser ByteString
ipLiteralP :: Parser ByteString
ipLiteralP = Word8 -> Parser Word8
A.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
ipVFutureP 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
ipV6P) 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
A.word8 Word8
cBracket

-- | Parses IPVFuture addresses. See relevant section in RFC.
ipVFutureP :: Parser ByteString
ipVFutureP :: Parser ByteString
ipVFutureP = do
  Word8
_ <- Word8 -> Parser Word8
A.word8 Word8
lowercaseV
  ByteString
ds <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 Word8 -> Bool
hexDigit
  Word8
_ <- Word8 -> Parser Word8
A.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
A.inClass ([Char] -> Word8 -> Bool) -> [Char] -> Word8 -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
subDelims [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> ShowS
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 IPV6 addresses. See relevant section in RFC.
ipV6P :: Parser ByteString
ipV6P :: Parser ByteString
ipV6P = 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
A.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
A.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
ipV4P
    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]
`A.sepBy` Word8 -> Parser Word8
A.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 a valid IPV4 address
ipV4P :: Parser ByteString
ipV4P :: Parser ByteString
ipV4P =
  [Parser ByteString] -> Parser ByteString
forall (m :: * -> *). Monad m => [m ByteString] -> m ByteString
sequenceM
      [ 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
A.string ByteString
"."




pathAbEmpty :: Parser ByteString
pathAbEmpty :: Parser ByteString
pathAbEmpty = ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString
forall a b. (a -> b) -> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ByteString] -> ByteString
BS.concat (Parser ByteString [ByteString] -> Parser ByteString)
-> ([Parser ByteString] -> Parser ByteString [ByteString])
-> [Parser ByteString]
-> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ByteString -> Parser ByteString [ByteString]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString -> Parser ByteString [ByteString])
-> ([Parser ByteString] -> Parser ByteString)
-> [Parser ByteString]
-> Parser ByteString [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parser ByteString] -> Parser ByteString
forall (m :: * -> *). Monad m => [m ByteString] -> m ByteString
sequenceM ([Parser ByteString] -> Parser ByteString)
-> [Parser ByteString] -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString -> Parser ByteString
A.string ByteString
"/", Parser ByteString
segmentP]

segmentP :: Parser ByteString
segmentP :: Parser ByteString
segmentP = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> Parser ByteString [Word8] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8 -> Parser ByteString [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many' Parser Word8
pcharP

segmentNZP :: Parser ByteString
segmentNZP :: Parser ByteString
segmentNZP = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> Parser ByteString [Word8] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8 -> Parser ByteString [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser Word8
pcharP

segmentNZNCP :: Parser ByteString
segmentNZNCP :: Parser ByteString
segmentNZNCP = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> Parser ByteString [Word8] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8 -> Parser ByteString [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 (Parser Word8
pctEncodedP Parser Word8 -> Parser Word8 -> Parser Word8
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser Word8
satisfyClass ([Char]
subDelims [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"@" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
unreserved))

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

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




    ---------------------------
    --[ Word/String classes ]--
    ---------------------------


hexDigit :: Word8 -> Bool
hexDigit :: Word8 -> Bool
hexDigit = [Char] -> Word8 -> Bool
A.inClass [Char]
"0-9a-fA-F"

unreserved :: String
unreserved :: [Char]
unreserved = [Char]
alphaNum [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"~._-"

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

alphaNum :: String
alphaNum :: [Char]
alphaNum = [Char]
alpha [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
digit

alpha :: String
alpha :: [Char]
alpha = [Char]
"a-zA-Z"

digit :: String
digit :: [Char]
digit = [Char]
"0-9"

oBracket :: Word8
oBracket :: Word8
oBracket = Word8
91

cBracket :: Word8
cBracket :: Word8
cBracket = Word8
93

colon :: Word8
colon :: Word8
colon = Word8
58

period :: Word8
period :: Word8
period = Word8
46



    -------------------------------------
    --[ Custom attoparsec combinators ]--
    -------------------------------------


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

sequenceM :: Monad m => [(m ByteString)] -> m ByteString
sequenceM :: forall (m :: * -> *). Monad m => [m ByteString] -> m ByteString
sequenceM = ([ByteString] -> ByteString) -> m [ByteString] -> m ByteString
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ByteString] -> ByteString
BS.concat (m [ByteString] -> m ByteString)
-> ([m ByteString] -> m [ByteString])
-> [m ByteString]
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [m ByteString] -> m [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

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