X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMIMEType.hs;h=36cdf0f82797b491783e9fd8ad1cac48fc2848ff;hb=72a3e24;hp=ce637d53f8331b75bdcaddae468f8c8122a72800;hpb=3fe5ca3bca04e0124a5f2440e893dc5375e0bb51;p=Lucu.git diff --git a/Network/HTTP/Lucu/MIMEType.hs b/Network/HTTP/Lucu/MIMEType.hs index ce637d5..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 @@ -18,7 +19,6 @@ import Control.Applicative 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,10 +33,20 @@ 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 + +-- |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.toAsciiBuilder (A.fromCIAscii maj) ⊕ A.toAsciiBuilder "/" ⊕ @@ -46,17 +56,20 @@ printMIMEType (MIMEType maj min 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 @@ -64,4 +77,5 @@ mimeTypeP = do maj ← A.toCIAscii <$> token return $ MIMEType maj min params mimeTypeListP ∷ Parser [MIMEType] +{-# INLINE mimeTypeListP #-} mimeTypeListP = listOf mimeTypeP