OverloadedStrings
, UnicodeSyntax
#-}
-{-# OPTIONS_HADDOCK prune #-}
-- |Manipulation of MIME Types.
module Network.HTTP.Lucu.MIMEType
( MIMEType(..)
+ , mkMIMEType
+
, parseMIMEType
, printMIMEType
)
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)
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
return $ MIMEType maj min params
mimeTypeListP ∷ Parser [MIMEType]
+{-# INLINE mimeTypeListP #-}
mimeTypeListP = listOf mimeTypeP