A small URL parser, including URL-encoded arguments

Url.hs

module Url where

import Data.List

import Text.Parsec
import Text.Parsec.String

data Proto = HTTP | FTP

data URL = URL {
                protocol :: Proto,
                secure :: Bool,
                host :: String,
                port :: Int,
                path :: [String],
                args :: [(String,Maybe String)]
} deriving Show


instance Show Proto where
    show HTTP = "http"
    show FTP = "ftp"

makeURL :: URL -> String
makeURL u = (show $ protocol u) ++ (if secure u then "s" else "") ++ "://" ++ host u ++ "/" ++ intercalate "/" (path u) ++ (if null (args u) then "" else "?" ++ intercalate "&" (map makeArg (args u)))
    where makeArg (k,Just v) = k ++ "=" ++ v
          makeArg (k,Nothing) = k

parseURL :: String -> Either ParseError URL
parseURL s = parse urlp (take 10 s) s

urlp :: Parser URL
urlp = do
        (prot,sec) <- protop
        hname <- hostp
        prt <- try portp <|> return 0
        pth <- pathp
        urlargs <- (char '?' >> many argsp) <|> return []
        let prt' = if prt == 0
                    then (if sec then 443 else 80)
                    else prt
        return $ URL { protocol = prot, secure = sec, host = hname, port = prt', path = pth, args = urlargs }

protop :: Parser (Proto, Bool)
protop = do
        try (string "http://" >> return (HTTP,False))
        <|> try (string "ftp://" >> return (FTP,False))
        <|> try (string "https://" >> return (HTTP,True))
        <|> (string "ftps://" >> return (FTP,True))

hostp :: Parser String
hostp = many (noneOf ":/?")

portp :: Parser Int
portp = do
        char ':'
        p <- (many1 (oneOf ['0'..'9']) <?> "port number")
        return . read $ p

pathp :: Parser [String]
pathp = (eof >> return [])
        <|> do char '/'
               sepBy (many $ noneOf "/?") (char '/')


argsp :: Parser (String, Maybe String)
argsp = do
        arg <- many1 (noneOf "=&")
        val <- (try valp <|> return Nothing)
        (char '&' >> return ()) <|> eof
        return $ (arg,val)

valp :: Parser (Maybe String)
valp = do
    char '='
    v <- many (noneOf "&")
    return (Just v)