{-# LANGUAGE
    OverloadedStrings
  , UnicodeSyntax
  #-}

-- |MIME Types
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.Map (Map)
import Data.Monoid.Unicode
import Data.Text (Text)
import Network.HTTP.Lucu.Parser
import Network.HTTP.Lucu.Parser.Http
import Network.HTTP.Lucu.RFC2231
import Prelude hiding (min)
import Prelude.Unicode

-- |@'MIMEType' \"major\" \"minor\" [(\"name\", \"value\"), ...]@
-- represents \"major\/minor; name=value; ...\".
data MIMEType = MIMEType {
      mtMajor  ∷ !CIAscii
    , mtMinor  ∷ !CIAscii
    , mtParams ∷ !(Map CIAscii Text)
    } deriving (Eq)

instance Show MIMEType where
    show = A.toString ∘ A.fromAsciiBuilder ∘ printMIMEType

-- |@'mkMIMEType' major minor@ returns a 'MIMEType' with the given
-- @major@ and @minor@ types but without any parameters.
mkMIMEType ∷ CIAscii → CIAscii → MIMEType
{-# INLINE mkMIMEType #-}
mkMIMEType maj min
    = MIMEType maj min (∅)

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

-- |Parse 'MIMEType' from an 'Ascii'. This function throws an
-- exception for parse error.
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 maj    ← A.toCIAscii <$> token
              _      ← char '/'
              min    ← A.toCIAscii <$> token
              params ← mimeParams
              return $ MIMEType maj min params

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