module Network.HTTP.Lucu.MIMEType
    ( MIMEType(..)
    , (+/+)         -- String -> String -> MIMEType
    , (+:+)         -- MIMEType -> (String, String) -> MIMEType
    , (+=+)         -- String -> String -> (String, String)
    , mimeTypeP     -- Parser MIMEType
    , mimeTypeListP -- Parser [MIMEType]
    )
    where

import           Network.HTTP.Lucu.Parser
import           Network.HTTP.Lucu.Parser.Http
import           Network.HTTP.Lucu.Utils


data MIMEType = MIMEType {
      mtMajor  :: String
    , mtMinor  :: String
    , mtParams :: [ (String, String) ]
    } deriving (Eq)


instance Show MIMEType where
    show (MIMEType maj min params)
        = maj ++ "/" ++ min ++
          if null params then
              ""
          else
              "; " ++ joinWith "; " (map showPair params)
        where
          showPair :: (String, String) -> String
          showPair (name, value)
              = name ++ "=" ++ if any (not . isToken) value then
                                   quoteStr value
                               else
                                   value


infix  9 +/+, +=+
infixl 8 +:+


(+/+) :: String -> String -> MIMEType
maj +/+ min
    = MIMEType maj min []


(+:+) :: MIMEType -> (String, String) -> MIMEType
mt@(MIMEType _ _ params) +:+ pair
    = mt {
        mtParams = mtParams mt ++ [pair]
      }


(+=+) :: String -> String -> (String, String)
name +=+ value = (name, value)



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