{-# LANGUAGE
    UnboxedTuples
  , UnicodeSyntax
  #-}
{-# OPTIONS_HADDOCK prune #-}

-- |Manipulation of MIME Types.
module Network.HTTP.Lucu.MIMEType
    ( MIMEType(..)
    , parseMIMEType
    , printMIMEType

    , mimeTypeP
    , mimeTypeListP
    )
    where
import Data.Ascii (Ascii, CIAscii)
import qualified Data.Ascii as A
import qualified Data.ByteString.Lazy as B
import Network.HTTP.Lucu.Parser.Http
import Network.HTTP.Lucu.Utils
import Prelude hiding (min)

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

-- |Convert a 'MIMEType' to 'Ascii'.
printMIMEType ∷ MIMEType → Ascii
printMIMEType (MIMEType maj min params)
    = A.fromAsciiBuilder $
      ( A.toAsciiBuilder maj ⊕
        A.toAsciiBuilder "/" ⊕
        A.toAsciiBuilder min ⊕
        if null params then
            (∅)
        else
            A.toAsciiBuilder "; " ⊕
            joinWith "; " (map printPair params)
      )
    where
      printPair ∷ (CIAscii, Ascii) → A.AsciiBuilder
      printPair (name, value)
          = A.toAsciiBuilder (A.fromCIAscii name) ⊕
            A.toAsciiBuilder "=" ⊕
            if any ((¬) ∘ isToken) value then
                quoteStr value
            else
                A.toAsciiBuilder value

-- |Parse 'MIMEType' from a 'Prelude.String'. This function throws an
-- exception for parse error.
parseMIMEType :: String -> MIMEType
parseMIMEType str = case parseStr mimeTypeP str of
                      (# Success t, r #) -> if B.null r
                                            then t
                                            else error ("unparsable MIME Type: " ++ str)
                      (# _        , _ #) -> error ("unparsable MIME Type: " ++ str)


mimeTypeP :: Parser MIMEType
mimeTypeP = allowEOF $!
            do maj    <- token
               _      <- char '/'
               min    <- token
               params <- many paramP
               return $ MIMEType maj min params
    where
      paramP :: Parser (String, String)
      paramP = do _     <- many lws
                  _     <- char ';'
                  _     <- many lws
                  name  <- token
                  _     <- char '='
                  value <- token <|> quotedStr
                  return (name, value)

mimeTypeListP :: Parser [MIMEType]
mimeTypeListP = allowEOF $! listOf mimeTypeP