X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMIMEType.hs;h=36cdf0f82797b491783e9fd8ad1cac48fc2848ff;hb=72a3e24;hp=dfaef11172d472666545301c7255043b34aae5b7;hpb=dfc778742934b8f2ac6a6709741c79ecd40c5ff1;p=Lucu.git diff --git a/Network/HTTP/Lucu/MIMEType.hs b/Network/HTTP/Lucu/MIMEType.hs index dfaef11..36cdf0f 100644 --- a/Network/HTTP/Lucu/MIMEType.hs +++ b/Network/HTTP/Lucu/MIMEType.hs @@ -2,11 +2,12 @@ OverloadedStrings , UnicodeSyntax #-} -{-# OPTIONS_HADDOCK prune #-} -- |Manipulation of MIME Types. module Network.HTTP.Lucu.MIMEType ( MIMEType(..) + , mkMIMEType + , parseMIMEType , printMIMEType @@ -15,10 +16,9 @@ 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 import Data.Map (Map) import Data.Monoid.Unicode import Data.Text (Text) @@ -33,32 +33,43 @@ data MIMEType = MIMEType { mtMajor ∷ !CIAscii , mtMinor ∷ !CIAscii , mtParams ∷ !(Map CIAscii Text) - } deriving (Eq, Show) + } deriving (Eq) + +instance Show MIMEType where + show = A.toString ∘ A.fromAsciiBuilder ∘ printMIMEType --- |Convert a 'MIMEType' to 'Ascii'. -printMIMEType ∷ MIMEType → Ascii +-- |Construct a 'MIMEType' without any parameters. +mkMIMEType ∷ CIAscii → CIAscii → MIMEType +{-# INLINE mkMIMEType #-} +mkMIMEType maj min + = MIMEType maj min (∅) + +-- |Convert a 'MIMEType' to 'AsciiBuilder'. +printMIMEType ∷ MIMEType → AsciiBuilder +{-# INLINEABLE printMIMEType #-} printMIMEType (MIMEType maj min params) - = A.fromAsciiBuilder $ - ( A.toAsciiBuilder (A.fromCIAscii maj) ⊕ - A.toAsciiBuilder "/" ⊕ - A.toAsciiBuilder (A.fromCIAscii min) ⊕ - printParams params - ) + = 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. parseMIMEType ∷ Ascii → MIMEType +{-# INLINEABLE parseMIMEType #-} parseMIMEType str - = let p = do t ← mimeTypeP - endOfInput - return t - bs = A.toByteString str - in - case parseOnly p bs of - Right t → t - Left err → error ("unparsable MIME Type: " ⧺ C8.unpack bs ⧺ ": " ⧺ err) + = case parseOnly p $ A.toByteString str of + Right t → t + Left err → error ("unparsable MIME Type: " ⧺ A.toString str ⧺ ": " ⧺ err) + where + p ∷ Parser MIMEType + {-# INLINE p #-} + p = do t ← mimeTypeP + endOfInput + return t mimeTypeP ∷ Parser MIMEType +{-# INLINEABLE mimeTypeP #-} mimeTypeP = do maj ← A.toCIAscii <$> token _ ← char '/' min ← A.toCIAscii <$> token @@ -66,4 +77,5 @@ mimeTypeP = do maj ← A.toCIAscii <$> token return $ MIMEType maj min params mimeTypeListP ∷ Parser [MIMEType] +{-# INLINE mimeTypeListP #-} mimeTypeListP = listOf mimeTypeP