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