-- #prune

-- |Manipulation of MIME Types.
module Network.HTTP.Lucu.MIMEType
    ( MIMEType(..)
    , (</>)
    , (<:>)
    , (<=>)
    , mimeTypeP
    , mimeTypeListP
    )
    where

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

-- |@'MIMEType' \"major\" \"minor\" [(\"name\", \"value\")]@
-- represents \"major\/minor; name=value\".
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 <:>

-- |@\"major\" \<\/\> \"minor\"@ constructs a MIME Type
-- \"major\/minor\".
(</>) :: String -> String -> MIMEType
maj </> min
    = MIMEType maj min []

-- |This operator appends a @(name, value)@ pair to a MIME Type.
(<:>) :: MIMEType -> (String, String) -> MIMEType
mt@(MIMEType _ _ params) <:> pair
    = pair `seq`
      mt {
        mtParams = mtParams mt ++ [pair]
      }

-- |This operator takes two strings and makes a tuple of them. So you
-- can say
--
-- > "text" </> "xml" <:> "charset" <=> "UTF-8" <:> "q" <=> "0.9"
--
-- to represent \"text\/xml; charset=UTF-8; q=0.9\".
(<=>) :: 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