module Control.Parser.HTTP ( module Control.Parser, URI(..),uriId,uri, Request(..),ReqType(..),Response(..),Status(..),Header(..),Host, reqLine,request ) where import Control.Parser hiding (space,spaces) import Data.Char import Data.List (intercalate) data URI = URI { uriScheme :: String, uriUser :: Maybe String, uriHost :: String, uriPort :: Maybe Int, uriPath :: [String], uriRequest :: Maybe String, uriFragment :: Maybe String } deriving Show uriId :: (Monoid w,Stream Char s,Monad m) => ParserT w s m String uriId = many1 (satisfy (\c -> isAlphaNum c || c`elem`['-','_','~','.'])) uri :: (Monoid w,Stream Char s,Monad m) => ParserT w s m URI uri = URI<$>(uriId <* several "://") <*>tryMay (uriId <* single '@') <*>uriId <*>tryMay (single ':' *> number) <*>many ("/"<$single '/' <+> uriId) <*>tryMay (single '?' >> many (noneOf "#")) <*>tryMay (single '#' >> many token) data Request = Request ReqType [Header] Host FilePath data ReqType = GET | HEAD | POST ByteString data Response = Response Status [Header] ByteString data Status = OK | NotFound data Header = Header String String type Host = String space :: (Monoid w, Monad m, Stream Char s) => ParserT w s m Char space = sp <+> (nl >> sp) where sp = oneOf " \t" spaces :: (Monoid w, Monad m, Stream Char s) => ParserT w s m String spaces = many space nl :: (Monoid w, Monad m, Stream Char s) => ParserT w s m () nl = try (single '\n') (several "\r\n") word :: (Monoid w, Monad m, Stream Char s) => ParserT w s m String word = quotedString '"' <+> many (noneOf " \t\n") line :: (Monoid w, Monad m, Stream Char s) => ParserT w s m String line = intercalate " " <$> (spaces >> (word`sepBy`spaces)) <* (spaces >> nl) reqLine :: (Monoid w, Monad m) => ParserT w String m [String] reqLine = pureParser (pure<$>words) request :: (Monoid w, Monad m) => ParserT w String m [String] request = do _ <- line >*> reqLine many (line <*= guard . not . null)