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.Http
  26 import Network.HTTP.Lucu.RFC2231
  27 import Prelude hiding (min)
  28 import Prelude.Unicode
  29
  30 -- |@'MIMEType' \"major\" \"minor\" [(\"name\", \"value\"), ...]@
  31 -- represents \"major\/minor; name=value; ...\".
  32 data MIMEType = MIMEType {
  33       mtMajor  ∷ !CIAscii
  34     , mtMinor  ∷ !CIAscii
  35     , mtParams ∷ !(Map CIAscii Text)
  36     } deriving (Eq)
  37
  38 instance Show MIMEType where
  39     show = A.toString ∘ A.fromAsciiBuilder ∘ printMIMEType
  40
  41 -- |@'mkMIMEType' major minor@ returns a 'MIMEType' with the given
  42 -- @major@ and @minor@ types but without any parameters.
  43 mkMIMEType ∷ CIAscii → CIAscii → MIMEType
  44 {-# INLINE mkMIMEType #-}
  45 mkMIMEType maj min
  46     = MIMEType maj min (∅)
  47
  48 -- |Convert a 'MIMEType' to an 'AsciiBuilder'.
  49 printMIMEType ∷ MIMEType → AsciiBuilder
  50 {-# INLINEABLE printMIMEType #-}
  51 printMIMEType (MIMEType maj min params)
  52     = A.toAsciiBuilder (A.fromCIAscii maj) ⊕
  53       A.toAsciiBuilder "/" ⊕
  54       A.toAsciiBuilder (A.fromCIAscii min) ⊕
  55       printMIMEParams params
  56
  57 -- |Parse 'MIMEType' from an 'Ascii'. This function throws an
  58 -- exception for parse error.
  59 parseMIMEType ∷ Ascii → MIMEType
  60 {-# INLINEABLE parseMIMEType #-}
  61 parseMIMEType str
  62     = case parseOnly p $ A.toByteString str of
  63         Right  t → t
  64         Left err → error ("unparsable MIME Type: " ⧺ A.toString str ⧺ ": " ⧺ err)
  65     where
  66       p ∷ Parser MIMEType
  67       {-# INLINE p #-}
  68       p = do t ← mimeType
  69              endOfInput
  70              return t
  71
  72 -- |'Parser' for an 'MIMEType'.
  73 mimeType ∷ Parser MIMEType
  74 {-# INLINEABLE mimeType #-}
  75 mimeType = do maj    ← A.toCIAscii <$> token
  76               _      ← char '/'
  77               min    ← A.toCIAscii <$> token
  78               params ← mimeParams
  79               return $ MIMEType maj min params
  80
  81 -- |'Parser' for a list of 'MIMEType's.
  82 mimeTypeList ∷ Parser [MIMEType]
  83 {-# INLINE mimeTypeList #-}
  84 mimeTypeList = listOf mimeType