{-# LANGUAGE OverloadedStrings #-}

module Network.Wreq.Internal.Link
       (
         links
       ) where

import Control.Applicative ((<$>), (<*>), (*>), (<*), many)
import Data.Attoparsec.ByteString.Char8 as A8
import Data.ByteString (ByteString)
import Network.Wreq.Types (Link(..))
import qualified Data.Attoparsec.ByteString as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8

links :: B.ByteString -> [Link]
links :: ByteString -> [Link]
links ByteString
hdr = case Parser [Link] -> ByteString -> Either String [Link]
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser [Link]
f ByteString
hdr of
              Left String
_   -> []
              Right [Link]
xs -> [Link]
xs
  where f :: Parser [Link]
f = Parser ByteString Link -> Parser ByteString () -> Parser [Link]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy1 (Parser ByteString Link
link Parser ByteString Link
-> Parser ByteString () -> Parser ByteString Link
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
skipSpace) (Char -> Parser Word8
char8 Char
',' Parser Word8 -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
skipSpace) Parser [Link] -> Parser ByteString () -> Parser [Link]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput

link :: Parser Link
link :: Parser ByteString Link
link = ByteString -> [(ByteString, ByteString)] -> Link
Link (ByteString -> [(ByteString, ByteString)] -> Link)
-> Parser ByteString ByteString
-> Parser ByteString ([(ByteString, ByteString)] -> Link)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
url Parser ByteString ([(ByteString, ByteString)] -> Link)
-> Parser ByteString [(ByteString, ByteString)]
-> Parser ByteString Link
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (ByteString, ByteString)
-> Parser ByteString [(ByteString, ByteString)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> Parser Word8
char8 Char
';' Parser Word8 -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
skipSpace Parser ByteString ()
-> Parser ByteString (ByteString, ByteString)
-> Parser ByteString (ByteString, ByteString)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (ByteString, ByteString)
param)
  where url :: Parser ByteString ByteString
url = Char -> Parser Word8
char8 Char
'<' Parser Word8
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
A8.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'>') Parser ByteString ByteString
-> Parser Word8 -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Word8
char8 Char
'>' Parser ByteString ByteString
-> Parser ByteString () -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
skipSpace

param :: Parser (ByteString, ByteString)
param :: Parser ByteString (ByteString, ByteString)
param = do
  ByteString
name <- Parser ByteString ByteString
paramName
  Parser ByteString ()
skipSpace Parser ByteString ()
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
"=" Parser ByteString ByteString
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
skipSpace
  Char
c <- Parser Char
peekChar'
  let isTokenChar :: Word8 -> Bool
isTokenChar = String -> Word8 -> Bool
A.inClass String
"!#$%&'()*+./0-9:<=>?@a-zA-Z[]^_`{|}~-"
  ByteString
val <- case Char
c of
           Char
'"' -> Parser ByteString ByteString
quotedString
           Char
_   -> (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile Word8 -> Bool
isTokenChar
  Parser ByteString ()
skipSpace
  (ByteString, ByteString)
-> Parser ByteString (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
name, ByteString
val)

data Quot = Literal | Backslash

quotedString :: Parser ByteString
quotedString :: Parser ByteString ByteString
quotedString = Char -> Parser Char
char Char
'"' Parser Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> ByteString
fixup (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
body) Parser ByteString ByteString
-> Parser Char -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'"'
  where body :: Parser ByteString ByteString
body = Quot
-> (Quot -> Char -> Maybe Quot) -> Parser ByteString ByteString
forall s.
s -> (s -> Char -> Maybe s) -> Parser ByteString ByteString
A8.scan Quot
Literal ((Quot -> Char -> Maybe Quot) -> Parser ByteString ByteString)
-> (Quot -> Char -> Maybe Quot) -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ \Quot
s Char
c ->
          case (Quot
s,Char
c) of
            (Quot
Literal,  Char
'\\') -> Maybe Quot
backslash
            (Quot
Literal,  Char
'"')  -> Maybe Quot
forall a. Maybe a
Nothing
            (Quot, Char)
_                -> Maybe Quot
literal
        literal :: Maybe Quot
literal   = Quot -> Maybe Quot
forall a. a -> Maybe a
Just Quot
Literal
        backslash :: Maybe Quot
backslash = Quot -> Maybe Quot
forall a. a -> Maybe a
Just Quot
Backslash
        fixup :: ByteString -> ByteString
fixup = String -> ByteString
B8.pack (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
go (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B8.unpack
          where go :: String -> String
go (Char
'\\' : x :: Char
x@Char
'\\' : String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
xs
                go (Char
'\\' : x :: Char
x@Char
'"' : String
xs)  = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
xs
                go (Char
x : String
xs)             = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
xs
                go String
xs                   = String
xs

paramName :: Parser ByteString
paramName :: Parser ByteString ByteString
paramName = do
  ByteString
name <- (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 ((Word8 -> Bool) -> Parser ByteString ByteString)
-> (Word8 -> Bool) -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ String -> Word8 -> Bool
A.inClass String
"a-zA-Z0-9!#$&+-.^_`|~"
  Maybe Char
c <- Parser (Maybe Char)
peekChar
  ByteString -> Parser ByteString ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Parser ByteString ByteString)
-> ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ case Maybe Char
c of
             Just Char
'*' -> ByteString -> Char -> ByteString
B8.snoc ByteString
name Char
'*'
             Maybe Char
_        -> ByteString
name