Network/HTTP/Lucu/MIMEType.hs

   1 {-# LANGUAGE
   2     OverloadedStrings
   3   , UnicodeSyntax
   4   #-}
   5
   6 -- |MIME Types
   7 module Network.HTTP.Lucu.MIMEType
   8     ( MIMEType(..)
   9     , mkMIMEType
  10
  11     , parseMIMEType
  12     , printMIMEType
  13
  14     , mimeType
  15     , mimeTypeList
  16     )
  17     where
  18 import Control.Applicative
  19 import Data.Ascii (Ascii, AsciiBuilder, CIAscii)
  20 import qualified Data.Ascii as A
  21 import Data.Attoparsec.Char8 as P
  22 import Data.Map (Map)
  23 import Data.Monoid.Unicode
  24 import Data.Text (Text)
  25 import Network.HTTP.Lucu.Parser
  26 import Network.HTTP.Lucu.Parser.Http
  27 import Network.HTTP.Lucu.RFC2231
  28 import Prelude hiding (min)
  29 import Prelude.Unicode
  30
  31 -- |@'MIMEType' \"major\" \"minor\" [(\"name\", \"value\"), ...]@
  32 -- represents \"major\/minor; name=value; ...\".
  33 data MIMEType = MIMEType {
  34       mtMajor  ∷ !CIAscii
  35     , mtMinor  ∷ !CIAscii
  36     , mtParams ∷ !(Map CIAscii Text)
  37     } deriving (Eq)
  38
  39 instance Show MIMEType where
  40     show = A.toString ∘ A.fromAsciiBuilder ∘ printMIMEType
  41
  42 -- |@'mkMIMEType' major minor@ returns a 'MIMEType' with the given
  43 -- @major@ and @minor@ types but without any parameters.
  44 mkMIMEType ∷ CIAscii → CIAscii → MIMEType
  45 {-# INLINE mkMIMEType #-}
  46 mkMIMEType maj min
  47     = MIMEType maj min (∅)
  48
  49 -- |Convert a 'MIMEType' to an 'AsciiBuilder'.
  50 printMIMEType ∷ MIMEType → AsciiBuilder
  51 {-# INLINEABLE printMIMEType #-}
  52 printMIMEType (MIMEType maj min params)
  53     = A.toAsciiBuilder (A.fromCIAscii maj) ⊕
  54       A.toAsciiBuilder "/" ⊕
  55       A.toAsciiBuilder (A.fromCIAscii min) ⊕
  56       printMIMEParams params
  57
  58 -- |Parse 'MIMEType' from an 'Ascii'. This function throws an
  59 -- exception for parse error.
  60 parseMIMEType ∷ Ascii → MIMEType
  61 {-# INLINEABLE parseMIMEType #-}
  62 parseMIMEType str
  63     = case parseOnly (finishOff mimeType) $ A.toByteString str of
  64         Right  t → t
  65         Left err → error ("unparsable MIME Type: " ⧺ A.toString str ⧺ ": " ⧺ err)
  66
  67 -- |'Parser' for an 'MIMEType'.
  68 mimeType ∷ Parser MIMEType
  69 {-# INLINEABLE mimeType #-}
  70 mimeType = do maj    ← A.toCIAscii <$> token
  71               _      ← char '/'
  72               min    ← A.toCIAscii <$> token
  73               params ← mimeParams
  74               return $ MIMEType maj min params
  75
  76 -- |'Parser' for a list of 'MIMEType's.
  77 mimeTypeList ∷ Parser [MIMEType]
  78 {-# INLINE mimeTypeList #-}
  79 mimeTypeList = listOf mimeType