-- |This is an auxiliary parser utilities for parsing things related
-- on HTTP protocol.
--
-- In general you don't have to use this module directly.
module Network.HTTP.Lucu.Parser.Http
    ( isCtl
    , isSeparator
    , isChar
    , isToken
    , listOf
    , token
    , lws
    , text
    , separator
    , quotedStr
    )
    where

import qualified Data.ByteString.Lazy.Char8 as B
import           Data.ByteString.Lazy.Char8 (ByteString)
import           Data.List
import           Network.HTTP.Lucu.Parser

-- |@'isCtl' c@ is True iff @0x20 <= @c@ < 0x7F@.
isCtl :: Char -> Bool
isCtl c
    | c <  '\x1f' = True
    | c >= '\x7f' = True
    | otherwise  = False

-- |@'isSeparator' c@ is True iff c is one of HTTP separators.
isSeparator :: Char -> Bool
isSeparator c = elem c "()<>@,;:\\\"/[]?={} \t"

-- |@'isChar' c@ is True iff @c <= 0x7f@.
isChar :: Char -> Bool
isChar c
    | c <= '\x7f' = True
    | otherwise   = False

-- |@'isToken' c@ is equivalent to @not ('isCtl' c || 'isSeparator'
-- c)@
isToken :: Char -> Bool
isToken c = not (isCtl c || isSeparator c)

-- |@'listOf' p@ is similar to @'Network.HTTP.Lucu.Parser.sepBy' p
-- ('Network.HTTP.Lucu.Parser.char' \',\')@ but it allows any
-- occurrences of LWS before and after each tokens.
listOf :: Parser a -> Parser [a]
listOf p = do many lws
              sepBy p (do many lws
                          char ','
                          many lws)

-- |'token' is equivalent to @'Network.HTTP.Lucu.Parser.many1' $
-- 'Network.HTTP.Lucu.Parser.satisfy' 'isToken'@
token :: Parser String
token = many1 $ satisfy isToken

-- |'lws' is an HTTP LWS: @'Network.HTTP.Lucu.Parser.crlf'?
-- ('Network.HTTP.Lucu.Parser.sp' | 'Network.HTTP.Lucu.Parser.ht')+@
lws :: Parser String
lws = do s  <- option "" crlf
         xs <- many1 (sp <|> ht)
         return (s ++ xs)

-- |'text' accepts one character which doesn't satisfy 'isCtl'.
text :: Parser Char
text = satisfy (\ c -> not (isCtl c))

-- |'separator' accepts one character which satisfies 'isSeparator'.
separator :: Parser Char
separator = satisfy isSeparator

-- |'quotedStr' accepts a string surrounded by double quotation
-- marks. Quotes can be escaped by backslashes.
quotedStr :: Parser String
quotedStr = do char '"'
               xs <- many (qdtext <|> quotedPair)
               char '"'
               return $ foldr (++) "" xs
    where
      qdtext = do c <- satisfy (/= '"')
                  return [c]

      quotedPair = do q <- char '\\'
                      c <- satisfy isChar
                      return [c]