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           Data.List
  20 import           Network.HTTP.Lucu.Parser
  21
  22 -- |@'isCtl' c@ is True iff @0x20 <= @c@ < 0x7F@.
  23 isCtl :: Char -> Bool
  24 isCtl c
  25     | c <  '\x1f' = True
  26     | c >= '\x7f' = True
  27     | otherwise   = False
  28
  29 -- |@'isSeparator' c@ is True iff c is one of HTTP separators.
  30 isSeparator :: Char -> Bool
  31 isSeparator '('  = True
  32 isSeparator ')'  = True
  33 isSeparator '<'  = True
  34 isSeparator '>'  = True
  35 isSeparator '@'  = True
  36 isSeparator ','  = True
  37 isSeparator ';'  = True
  38 isSeparator ':'  = True
  39 isSeparator '\\' = True
  40 isSeparator '"'  = True
  41 isSeparator '/'  = True
  42 isSeparator '['  = True
  43 isSeparator ']'  = True
  44 isSeparator '?'  = True
  45 isSeparator '='  = True
  46 isSeparator '{'  = True
  47 isSeparator '}'  = True
  48 isSeparator ' '  = True
  49 isSeparator '\t' = True
  50 isSeparator _    = False
  51
  52 -- |@'isChar' c@ is True iff @c <= 0x7f@.
  53 isChar :: Char -> Bool
  54 isChar c
  55     | c <= '\x7f' = True
  56     | otherwise   = False
  57
  58 -- |@'isToken' c@ is equivalent to @not ('isCtl' c || 'isSeparator'
  59 -- c)@
  60 isToken :: Char -> Bool
  61 isToken c = c `seq`
  62             not (isCtl c || isSeparator c)
  63
  64 -- |@'listOf' p@ is similar to @'Network.HTTP.Lucu.Parser.sepBy' p
  65 -- ('Network.HTTP.Lucu.Parser.char' \',\')@ but it allows any
  66 -- occurrences of LWS before and after each tokens.
  67 listOf :: Parser a -> Parser [a]
  68 listOf p = p `seq`
  69            do many lws
  70               sepBy p $! do many lws
  71                             char ','
  72                             many lws
  73
  74 -- |'token' is equivalent to @'Network.HTTP.Lucu.Parser.many1' $
  75 -- 'Network.HTTP.Lucu.Parser.satisfy' 'isToken'@
  76 token :: Parser String
  77 token = many1 $! satisfy isToken
  78
  79 -- |'lws' is an HTTP LWS: @'Network.HTTP.Lucu.Parser.crlf'?
  80 -- ('Network.HTTP.Lucu.Parser.sp' | 'Network.HTTP.Lucu.Parser.ht')+@
  81 lws :: Parser String
  82 lws = do s  <- option "" crlf
  83          xs <- many1 (sp <|> ht)
  84          return (s ++ xs)
  85
  86 -- |'text' accepts one character which doesn't satisfy 'isCtl'.
  87 text :: Parser Char
  88 text = satisfy (\ c -> not (isCtl c))
  89
  90 -- |'separator' accepts one character which satisfies 'isSeparator'.
  91 separator :: Parser Char
  92 separator = satisfy isSeparator
  93
  94 -- |'quotedStr' accepts a string surrounded by double quotation
  95 -- marks. Quotes can be escaped by backslashes.
  96 quotedStr :: Parser String
  97 quotedStr = do char '"'
  98                xs <- many (qdtext <|> quotedPair)
  99                char '"'
 100                return $ foldr (++) "" xs
 101     where
 102       qdtext = do c <- satisfy (/= '"')
 103                   return [c]
 104
 105       quotedPair = do q <- char '\\'
 106                       c <- satisfy isChar
 107                       return [c]