{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------
-- |
-- Module    : Codec.MIME.Type
-- Copyright : (c) 2006-2009, Galois, Inc. 
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sigbjorn.finne@gmail.com>
-- Stability : provisional
-- Portability: portable
--
-- 
-- Representing MIME types and values.
-- 
--------------------------------------------------------------------
module Codec.MIME.Type where

import qualified Data.Text as T
import Data.Monoid ((<>))

data MIMEParam = MIMEParam  { paramName     :: T.Text
                            , paramValue    :: T.Text }
    deriving (Show, Ord, Eq)

data Type = Type
    { mimeType   :: MIMEType
    , mimeParams :: [MIMEParam]
    } deriving ( Show, Ord, Eq )

-- | The @null@ MIME record type value; currently a @text/plain@.
nullType :: Type
nullType = Type
    { mimeType   = Text "plain"
    , mimeParams = []
    }

showType :: Type -> T.Text
showType t = showMIMEType (mimeType t) <> showMIMEParams (mimeParams t)

showMIMEParams :: [MIMEParam] -> T.Text
showMIMEParams ps = T.concat $ map showP ps
  where 
    showP (MIMEParam a b) = "; " <> a <> "=\"" <> b <> "\""


data MIMEType
 = Application SubType
 | Audio       SubType
 | Image       SubType
 | Message     SubType
 | Model       SubType
 | Multipart   Multipart
 | Text        TextType
 | Video       SubType
 | Other       {otherType :: T.Text, otherSubType :: SubType}
   deriving ( Show, Ord, Eq )

showMIMEType :: MIMEType -> T.Text
showMIMEType t = 
 case t of
   Application s -> "application/"<>s
   Audio s       -> "audio/"<>s
   Image s       -> "image/"<>s
   Message s     -> "message/"<>s
   Model s       -> "model/"<>s
   Multipart s   -> "multipart/"<>showMultipart s
   Text s        -> "text/"<>s
   Video s       -> "video/"<>s
   Other a b     -> a <> "/" <> b

-- | a (type, subtype) MIME pair.
data MIMEPair
 = MIMEPair T.Text SubType
   deriving ( Eq )

showMIMEPair :: MIMEPair -> T.Text
showMIMEPair (MIMEPair a b) = a <> "/" <> b

-- | default subtype representation.
type SubType = T.Text

-- | subtype for text content; currently just a string.
type TextType = SubType

subTypeString :: Type -> T.Text
subTypeString t = T.drop 1 $ snd $ T.break (=='/') (showMIMEType (mimeType t))

majTypeString :: Type -> T.Text
majTypeString t = fst $ T.break (=='/') (showMIMEType (mimeType t))

data Multipart
 = Alternative
 | Byteranges
 | Digest
 | Encrypted
 | FormData
 | Mixed
 | Parallel
 | Related
 | Signed
 | Extension  T.Text  -- ^ e.g., 'x-foo' (i.e., includes the 'x-' bit)
 | OtherMulti T.Text  -- unrecognized\/uninterpreted.
                      -- (e.g., appledouble, voice-message, etc.)
   deriving ( Show, Ord, Eq )

isXmlBased :: Type -> Bool
isXmlBased t = 
  case mimeType t of
     Multipart{} -> False
     _ -> "+xml" `T.isSuffixOf` subTypeString t

isXmlType :: Type -> Bool
isXmlType t = isXmlBased t ||
  case mimeType t of
    Application s -> s `elem` xml_media_types
    Text s        -> s `elem` xml_media_types
    _             -> False
 where
    -- Note: xml-dtd isn't considered an XML type here.
  xml_media_types :: [T.Text]
  xml_media_types = 
    [ "xml"
    , "xml-external-parsed-entity"
    ]
  

showMultipart :: Multipart -> T.Text
showMultipart m = 
 case m of
   Alternative -> "alternative"
   Byteranges  -> "byteranges"
   Digest      -> "digest"
   Encrypted   -> "encrypted"
   FormData    -> "form-data"
   Mixed       -> "mixed"
   Parallel    -> "parallel"
   Related     -> "related"
   Signed      -> "signed"
   Extension e -> e
   OtherMulti e -> e
   
type Content = T.Text

data MIMEValue = MIMEValue
      { mime_val_type     :: Type
      , mime_val_disp     :: Maybe Disposition
      , mime_val_content  :: MIMEContent
      , mime_val_headers  :: [MIMEParam]
      , mime_val_inc_type :: Bool
      } deriving ( Show, Eq )

nullMIMEValue :: MIMEValue
nullMIMEValue = MIMEValue
      { mime_val_type     = nullType
      , mime_val_disp     = Nothing
      , mime_val_content  = Multi []
      , mime_val_headers  = []
      , mime_val_inc_type = True
      } 

data MIMEContent 
  = Single Content
  | Multi [MIMEValue]
    deriving (Eq,Show)
   
data Disposition
 = Disposition
     { dispType   :: DispType
     , dispParams :: [DispParam]
     } deriving ( Show, Eq )

data DispType
 = DispInline
 | DispAttachment
 | DispFormData
 | DispOther T.Text
   deriving ( Show, Eq)

data DispParam
 = Name T.Text
 | Filename T.Text
 | CreationDate T.Text
 | ModDate T.Text
 | ReadDate T.Text
 | Size T.Text
 | OtherParam T.Text T.Text
   deriving ( Show, Eq)