X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMIMEType.hs;h=ce637d53f8331b75bdcaddae468f8c8122a72800;hb=3fe5ca3;hp=9f2cb87739364af2d434d7b36aea40ddc87d4e1f;hpb=4498b6a9091bebb38a92a730b7abff40833e3ed2;p=Lucu.git diff --git a/Network/HTTP/Lucu/MIMEType.hs b/Network/HTTP/Lucu/MIMEType.hs index 9f2cb87..ce637d5 100644 --- a/Network/HTTP/Lucu/MIMEType.hs +++ b/Network/HTTP/Lucu/MIMEType.hs @@ -15,7 +15,7 @@ module Network.HTTP.Lucu.MIMEType ) where import Control.Applicative -import Data.Ascii (Ascii, CIAscii) +import Data.Ascii (Ascii, AsciiBuilder, CIAscii) import qualified Data.Ascii as A import Data.Attoparsec.Char8 as P import qualified Data.ByteString.Char8 as C8 @@ -23,7 +23,7 @@ import Data.Map (Map) import Data.Monoid.Unicode import Data.Text (Text) import Network.HTTP.Lucu.Parser.Http -import Network.HTTP.Lucu.Utils +import Network.HTTP.Lucu.RFC2231 import Prelude hiding (min) import Prelude.Unicode @@ -35,28 +35,13 @@ data MIMEType = MIMEType { , mtParams ∷ !(Map CIAscii Text) } deriving (Eq, Show) --- |Convert a 'MIMEType' to 'Ascii'. -printMIMEType ∷ MIMEType → Ascii +-- |Convert a 'MIMEType' to 'AsciiBuilder'. +printMIMEType ∷ MIMEType → AsciiBuilder printMIMEType (MIMEType maj min params) - = A.fromAsciiBuilder $ - ( A.toAsciiBuilder (A.fromCIAscii maj) ⊕ - A.toAsciiBuilder "/" ⊕ - A.toAsciiBuilder (A.fromCIAscii min) ⊕ - if null params then - (∅) - else - A.toAsciiBuilder "; " ⊕ - joinWith "; " (map printPair params) - ) - where - printPair ∷ (CIAscii, Ascii) → A.AsciiBuilder - printPair (name, value) - = A.toAsciiBuilder (A.fromCIAscii name) ⊕ - A.toAsciiBuilder "=" ⊕ - if C8.any ((¬) ∘ isToken) (A.toByteString value) then - quoteStr value - else - A.toAsciiBuilder value + = A.toAsciiBuilder (A.fromCIAscii maj) ⊕ + A.toAsciiBuilder "/" ⊕ + A.toAsciiBuilder (A.fromCIAscii min) ⊕ + printParams params -- |Parse 'MIMEType' from an 'Ascii'. This function throws an -- exception for parse error. @@ -75,18 +60,8 @@ mimeTypeP ∷ Parser MIMEType mimeTypeP = do maj ← A.toCIAscii <$> token _ ← char '/' min ← A.toCIAscii <$> token - params ← P.many paramP + params ← paramsP return $ MIMEType maj min params - where - paramP ∷ Parser (CIAscii, Ascii) - paramP = try $ - do skipMany lws - _ ← char ';' - skipMany lws - name ← A.toCIAscii <$> token - _ ← char '=' - value ← token <|> quotedStr - return (name, value) mimeTypeListP ∷ Parser [MIMEType] mimeTypeListP = listOf mimeTypeP