Network/HTTP/Lucu/Parser/Http.hs

   1 -- |This is an auxiliary parser utilities for parsing things related
   2 -- on HTTP protocol.
   3 --
   4 -- In general you don't have to use this module directly.
   5 module Network.HTTP.Lucu.Parser.Http
   6     ( isCtl
   7     , isSeparator
   8     , isChar
   9     , isToken
  10     , listOf
  11     , token
  12     , lws
  13     , text
  14     , separator
  15     , quotedStr
  16     )
  17     where
  18
  19 import qualified Data.ByteString.Lazy.Char8 as B
  20 import           Data.ByteString.Lazy.Char8 (ByteString)
  21 import           Data.List
  22 import           Network.HTTP.Lucu.Parser
  23
  24 -- |@'isCtl' c@ is True iff @0x20 <= @c@ < 0x7F@.
  25 isCtl :: Char -> Bool
  26 isCtl c
  27     | c <  '\x1f' = True
  28     | c >= '\x7f' = True
  29     | otherwise  = False
  30
  31 -- |@'isSeparator' c@ is True iff c is one of HTTP separators.
  32 isSeparator :: Char -> Bool
  33 isSeparator c = elem c "()<>@,;:\\\"/[]?={} \t"
  34
  35 -- |@'isChar' c@ is True iff @c <= 0x7f@.
  36 isChar :: Char -> Bool
  37 isChar c
  38     | c <= '\x7f' = True
  39     | otherwise   = False
  40
  41 -- |@'isToken' c@ is equivalent to @not ('isCtl' c || 'isSeparator'
  42 -- c)@
  43 isToken :: Char -> Bool
  44 isToken c = not (isCtl c || isSeparator c)
  45
  46 -- |@'listOf' p@ is similar to @'Network.HTTP.Lucu.Parser.sepBy' p
  47 -- ('Network.HTTP.Lucu.Parser.char' \',\')@ but it allows any
  48 -- occurrences of LWS before and after each tokens.
  49 listOf :: Parser a -> Parser [a]
  50 listOf p = do many lws
  51               sepBy p (do many lws
  52                           char ','
  53                           many lws)
  54
  55 -- |'token' is equivalent to @'Network.HTTP.Lucu.Parser.many1' $
  56 -- 'Network.HTTP.Lucu.Parser.satisfy' 'isToken'@
  57 token :: Parser String
  58 token = many1 $ satisfy isToken
  59
  60 -- |'lws' is an HTTP LWS: @'Network.HTTP.Lucu.Parser.crlf'?
  61 -- ('Network.HTTP.Lucu.Parser.sp' | 'Network.HTTP.Lucu.Parser.ht')+@
  62 lws :: Parser String
  63 lws = do s  <- option "" crlf
  64          xs <- many1 (sp <|> ht)
  65          return (s ++ xs)
  66
  67 -- |'text' accepts one character which doesn't satisfy 'isCtl'.
  68 text :: Parser Char
  69 text = satisfy (\ c -> not (isCtl c))
  70
  71 -- |'separator' accepts one character which satisfies 'isSeparator'.
  72 separator :: Parser Char
  73 separator = satisfy isSeparator
  74
  75 -- |'quotedStr' accepts a string surrounded by double quotation
  76 -- marks. Quotes can be escaped by backslashes.
  77 quotedStr :: Parser String
  78 quotedStr = do char '"'
  79                xs <- many (qdtext <|> quotedPair)
  80                char '"'
  81                return $ foldr (++) "" xs
  82     where
  83       qdtext = do c <- satisfy (/= '"')
  84                   return [c]
  85
  86       quotedPair = do q <- char '\\'
  87                       c <- satisfy isChar
  88                       return [c]