------------------------------------------------------------------------------
-- | Defines the 'MediaType' accept header with an 'Accept' instance for use
-- in content-type negotiation.
module Network.HTTP.Media.MediaType
    (
    -- * Type and creation
      MediaType
    , Parameters
    , (//)
    , (/:)

    -- * Querying
    , mainType
    , subType
    , parameters
    , (/?)
    , (/.)
    ) where

import qualified Data.ByteString.Char8                 as BS
import qualified Data.CaseInsensitive                  as CI
import qualified Data.Map                              as Map

import           Data.ByteString                       (ByteString)
import           Data.CaseInsensitive                  (CI)
import           Data.Map                              (empty, insert)

import qualified Network.HTTP.Media.MediaType.Internal as Internal

import           Network.HTTP.Media.MediaType.Internal (MediaType (MediaType))
import           Network.HTTP.Media.MediaType.Internal hiding (MediaType (..))
import           Network.HTTP.Media.Utils


------------------------------------------------------------------------------
-- | Retrieves the main type of a 'MediaType'.
mainType :: MediaType -> CI ByteString
mainType = Internal.mainType


------------------------------------------------------------------------------
-- | Retrieves the sub type of a 'MediaType'.
subType :: MediaType -> CI ByteString
subType = Internal.subType


------------------------------------------------------------------------------
-- | Retrieves the parameters of a 'MediaType'.
parameters :: MediaType -> Parameters
parameters = Internal.parameters


------------------------------------------------------------------------------
-- | Builds a 'MediaType' without parameters. Can produce an error if
-- either type is invalid.
(//) :: ByteString -> ByteString -> MediaType
a // b
    | a == "*" && b == "*" = MediaType (CI.mk a) (CI.mk b) empty
    | b == "*"             = MediaType (ensureR a) (CI.mk b) empty
    | otherwise            = MediaType (ensureR a) (ensureR b) empty


------------------------------------------------------------------------------
-- | Adds a parameter to a 'MediaType'. Can produce an error if either
-- string is invalid.
(/:) :: MediaType -> (ByteString, ByteString) -> MediaType
(MediaType a b p) /: (k, v) = MediaType a b $ insert (ensureR k) (ensureV v) p


------------------------------------------------------------------------------
-- | Evaluates if a 'MediaType' has a parameter of the given name.
(/?) :: MediaType -> ByteString -> Bool
(MediaType _ _ p) /? k = Map.member (CI.mk k) p


------------------------------------------------------------------------------
-- | Retrieves a parameter from a 'MediaType'.
(/.) :: MediaType -> ByteString -> Maybe (CI ByteString)
(MediaType _ _ p) /. k = Map.lookup (CI.mk k) p


------------------------------------------------------------------------------
-- | Ensures that the 'ByteString' matches the ABNF for `reg-name` in RFC
-- 4288.
ensureR :: ByteString -> CI ByteString
ensureR bs = CI.mk $ if l == 0 || l > 127
    then error $ "Invalid length for " ++ show bs else ensure isMediaChar bs
  where l = BS.length bs


------------------------------------------------------------------------------
-- | Ensures that the 'ByteString' does not contain invalid characters for
-- a parameter value. RFC 4288 does not specify what characters are valid, so
-- here we just disallow parameter and media type breakers, ',' and ';'.
ensureV :: ByteString -> CI ByteString
ensureV = CI.mk . ensure (`notElem` [',', ';'])


------------------------------------------------------------------------------
-- | Ensures the predicate matches for every character in the given string.
ensure :: (Char -> Bool) -> ByteString -> ByteString
ensure f bs = maybe
    (error $ "Invalid character in " ++ show bs) (const bs) (BS.find f bs)