---------------------------------------------------------
-- |
-- Module        : Data.Mime.Header
-- Copyright     : Michael Snoyman
-- License       : BSD3
--
-- Maintainer    : Michael Snoyman <michael@snoyman.com>
-- Stability     : Unstable
-- Portability   : portable
--
-- Functions for parsing MIME headers (Key: value; k1=v1; k2=v2)
--
---------------------------------------------------------

module Data.Mime.Header
    ( Header
    , parseHeader
    , lookupHeader
    , lookupHeaderAttr
    ) where

import Data.String.Util
import Data.ByteString.Class
import qualified Data.ByteString.Lazy as BS

type SMap = [(String, String)]

-- | A single MIME header.
type Header = (String, String, SMap)

-- | Parse a header line in the format
-- Name: value; attkey=attval; attkey2=attval2.
parseHeader :: BS.ByteString -> Header
parseHeader bs =
    let s = fromLazyByteString bs
        (k, rest) = span (/= ':') s
        (v, attrs) = parseRest rest
     in (k, v, attrs) where
    parseRest :: String -> (String, SMap)
    parseRest s =
        let (v, rest) = span (/= ';') s
            attrs = parseAttrs rest
         in (dropPrefix ": " v, attrs)
    parseAttrs :: String -> SMap
    parseAttrs [] = []
    parseAttrs s =
        let s' = dropPrefix "; " s
            (next, rest) = span (/= ';') s'
            (k, v) = span (/= '=') next
            v' = dropPrefix "=" v
            v'' = dropQuotes v'
         in (k, v'') : parseAttrs rest

lookupHeaderAttr :: Monad m => String -> String -> [Header] -> m String
lookupHeaderAttr k1 k2 [] =
    fail $ "Could not find header when looking for attr: " ++ 
           k1 ++ ":" ++ k2
lookupHeaderAttr k1 k2 ((key, _, vals):rest)
    | k1 == key = case lookup k2 vals of
                    Nothing -> fail $ "Could not find header attr "
                                      ++ k1 ++ ":" ++ k2
                    Just v -> return v
    | otherwise = lookupHeaderAttr k1 k2 rest

lookupHeader :: Monad m => String -> [Header] -> m String
lookupHeader k [] = fail $ "Header " ++ k ++ " not found"
lookupHeader k ((key, val, _):rest)
    | k == key = return val
    | otherwise = lookupHeader k rest