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

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

param :: Parser (ByteString, ByteString)
param :: Parser ByteString (ByteString, ByteString)
param = do
  ByteString
name <- Parser ByteString ByteString
paramName
  Parser ()
skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
"=" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
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 ()
skipSpace
  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
'"' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> ByteString
fixup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
body) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'"'
  where body :: Parser ByteString ByteString
body = forall s.
s -> (s -> Char -> Maybe s) -> Parser ByteString ByteString
A8.scan Quot
Literal 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
'"')  -> forall a. Maybe a
Nothing
            (Quot, Char)
_                -> Maybe Quot
literal
        literal :: Maybe Quot
literal   = forall a. a -> Maybe a
Just Quot
Literal
        backslash :: Maybe Quot
backslash = forall a. a -> Maybe a
Just Quot
Backslash
        fixup :: ByteString -> ByteString
fixup = String -> ByteString
B8.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
go 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 forall a. a -> [a] -> [a]
: String -> String
go String
xs
                go (Char
'\\' : x :: Char
x@Char
'"' : String
xs)  = Char
x forall a. a -> [a] -> [a]
: String -> String
go String
xs
                go (Char
x : String
xs)             = Char
x 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 forall a b. (a -> b) -> a -> b
$ String -> Word8 -> Bool
A.inClass String
"a-zA-Z0-9!#$&+-.^_`|~"
  Maybe Char
c <- Parser (Maybe Char)
peekChar
  forall (m :: * -> *) a. Monad m => a -> m a
return 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