Network/HTTP/Lucu/Parser/Http.hs

   1 module Network.HTTP.Lucu.Parser.Http
   2     ( isCtl       -- Char -> Bool
   3     , isSeparator -- Char -> Bool
   4     , isChar      -- Char -> Bool
   5     , isToken     -- Char -> Bool
   6     , listOf      -- Parser a -> Parser [a]
   7     , token       -- Parser String
   8     , lws         -- Parser String
   9     , text        -- Parser Char
  10     , separator   -- Parser Char
  11     , quotedStr   -- Parser String
  12     )
  13     where
  14
  15 import qualified Data.ByteString.Lazy.Char8 as B
  16 import           Data.ByteString.Lazy.Char8 (ByteString)
  17 import           Data.List
  18 import           Network.HTTP.Lucu.Parser
  19
  20 isCtl :: Char -> Bool
  21 isCtl c
  22     | c <  '\x1f' = True
  23     | c >= '\x7f' = True
  24     | otherwise  = False
  25
  26
  27 isSeparator :: Char -> Bool
  28 isSeparator c = elem c "()<>@,;:\\\"/[]?={} \t"
  29
  30
  31 isChar :: Char -> Bool
  32 isChar c
  33     | c <= '\x7f' = True
  34     | otherwise   = False
  35
  36
  37 isToken :: Char -> Bool
  38 isToken c = not (isCtl c || isSeparator c)
  39
  40
  41 listOf :: Parser a -> Parser [a]
  42 listOf p = do many lws
  43               sepBy p (do many lws
  44                           char ','
  45                           many lws)
  46
  47
  48 token :: Parser String
  49 token = many1 $ satisfy isToken
  50
  51
  52 lws :: Parser String
  53 lws = do s  <- option "" crlf
  54          xs <- many1 (sp <|> ht)
  55          return (s ++ xs)
  56
  57
  58 text :: Parser Char
  59 text = satisfy (\ c -> not (isCtl c))
  60
  61
  62 separator :: Parser Char
  63 separator = satisfy isSeparator
  64
  65
  66 quotedStr :: Parser String
  67 quotedStr = do char '"'
  68                xs <- many (qdtext <|> quotedPair)
  69                char '"'
  70                return $ foldr (++) "" xs
  71     where
  72       qdtext = do c <- satisfy (/= '"')
  73                   return [c]
  74
  75       quotedPair = do q <- char '\\'
  76                       c <- satisfy isChar
  77                       return [c]