{-# LANGUAGE
    DeriveDataTypeable
  , OverloadedStrings
  , RecordWildCards
  , TemplateHaskell
  , UnicodeSyntax
  #-}
-- |Parsing and printing MIME Media Types
-- (<http://tools.ietf.org/html/rfc2046>).
module Network.HTTP.Lucu.MIMEType
    ( MIMEType(..)
    , mkMIMEType

    , parseMIMEType
    , printMIMEType

    , mimeType
    , mimeTypeList
    )
    where
import Control.Applicative
import Data.Ascii (Ascii, AsciiBuilder, CIAscii)
import qualified Data.Ascii as A
import Data.Attoparsec.Char8 as P
import Data.Monoid.Unicode
import Data.Typeable
import Language.Haskell.TH.Syntax
import Network.HTTP.Lucu.MIMEParams
import Network.HTTP.Lucu.Parser
import Network.HTTP.Lucu.Parser.Http
import Network.HTTP.Lucu.Utils
import Prelude.Unicode

-- |A media type, subtype, and parameters.
data MIMEType
    = MIMEType {
        mtMedia  ∷ !CIAscii
      , mtSub    ∷ !CIAscii
      , mtParams ∷ !MIMEParams
      }
    deriving (Eq, Show, Read, Typeable)

instance Lift MIMEType where
    lift (MIMEType {..})
        = [| MIMEType {
               mtMedia  = $(liftCIAscii mtMedia)
             , mtSub    = $(liftCIAscii mtSub)
             , mtParams = $(lift mtParams)
             }
           |]

-- |@'mkMIMEType' media sub@ returns a 'MIMEType' with the given
-- @media@ and @sub@ types but without any parameters.
mkMIMEType ∷ CIAscii → CIAscii → MIMEType
{-# INLINE mkMIMEType #-}
mkMIMEType = flip flip (∅) ∘ MIMEType

-- |Convert a 'MIMEType' to an 'AsciiBuilder'.
printMIMEType ∷ MIMEType → AsciiBuilder
{-# INLINEABLE printMIMEType #-}
printMIMEType (MIMEType {..})
    = A.toAsciiBuilder (A.fromCIAscii mtMedia) ⊕
      A.toAsciiBuilder "/" ⊕
      A.toAsciiBuilder (A.fromCIAscii mtSub) ⊕
      printMIMEParams mtParams

-- |Parse 'MIMEType' from an 'Ascii'. This function throws an
-- exception for parse error. For literals consider using
-- 'Network.HTTP.Lucu.MIMEType.TH.mimeType'.
parseMIMEType ∷ Ascii → MIMEType
{-# INLINEABLE parseMIMEType #-}
parseMIMEType str
    = case parseOnly (finishOff mimeType) $ A.toByteString str of
        Right  t → t
        Left err → error ("unparsable MIME Type: " ⧺ A.toString str ⧺ ": " ⧺ err)

-- |'Parser' for an 'MIMEType'.
mimeType ∷ Parser MIMEType
{-# INLINEABLE mimeType #-}
mimeType = do media  ← A.toCIAscii <$> token
              _      ← char '/'
              sub    ← A.toCIAscii <$> token
              params ← mimeParams
              return $ MIMEType media sub params

-- |'Parser' for a list of 'MIMEType's.
mimeTypeList ∷ Parser [MIMEType]
{-# INLINE mimeTypeList #-}
mimeTypeList = listOf mimeType