{-# 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 hdr = case parseOnly f hdr of
              Left _   -> []
              Right xs -> xs
  where f = sepBy1 (link <* skipSpace) (char8 ',' *> skipSpace) <* endOfInput

link :: Parser Link
link = Link <$> url <*> many (char8 ';' *> skipSpace *> param)
  where url = char8 '<' *> A8.takeTill (=='>') <* char8 '>' <* skipSpace

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

data Quot = Literal | Backslash

quotedString :: Parser ByteString
quotedString = char '"' *> (fixup <$> body) <* char '"'
  where body = A8.scan Literal $ \s c ->
          case (s,c) of
            (Literal,  '\\') -> backslash
            (Literal,  '"')  -> Nothing
            _                -> literal
        literal   = Just Literal
        backslash = Just Backslash
        fixup = B8.pack . go . B8.unpack
          where go ('\\' : x@'\\' : xs) = x : go xs
                go ('\\' : x@'"' : xs)  = x : go xs
                go (x : xs)             = x : go xs
                go xs                   = xs

paramName :: Parser ByteString
paramName = do
  name <- A.takeWhile1 $ A.inClass "a-zA-Z0-9!#$&+-.^_`|~"
  c <- peekChar
  return $ case c of
             Just '*' -> B8.snoc name '*'
             _        -> name