summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorSigbjorn Finne <sigbjorn.finne@gmail.com>2008-11-09 10:13:22 -0800
committerSigbjorn Finne <sigbjorn.finne@gmail.com>2008-11-09 10:13:22 -0800
commit89c17335e3d35bd96dc4430329a18c36209a9e66 (patch)
tree4f54461bdc903d8169aef3f7294a1063ada9a051
parent48270df4b7c981be0fa41a80916011fade98c0d3 (diff)
MIMEValue: include extra header field + toggle to control inclusion of content-type when emitting its type; added nullMIMEValue for easier construction of MIMEValues; upped version to 0.3.0
-rw-r--r--Codec/MIME/Parse.hs17
-rw-r--r--Codec/MIME/Type.hs31
-rw-r--r--Codec/MIME/Utils.hs2
-rw-r--r--mime.cabal4
4 files changed, 40 insertions, 14 deletions
diff --git a/Codec/MIME/Parse.hs b/Codec/MIME/Parse.hs
index 629a0cf..07bdb46 100644
--- a/Codec/MIME/Parse.hs
+++ b/Codec/MIME/Parse.hs
@@ -26,8 +26,11 @@ parseMIMEBody headers_in body =
case mimeType mty of
Multipart{} -> fst (parseMultipart mty body)
Message{} -> fst (parseMultipart mty body)
- _ -> MIMEValue mty (parseContentDisp headers)
- (Single (processBody headers body))
+ _ -> nullMIMEValue
+ { mime_val_type = mty
+ , mime_val_disp = parseContentDisp headers
+ , mime_val_content = Single (processBody headers body)
+ }
where headers = [ (map toLower k,v) | (k,v) <- headers_in ]
mty = fromMaybe defaultType
@@ -102,8 +105,14 @@ parseMultipart mty body =
case lookupField "boundary" (mimeParams mty) of
Nothing -> trace ("Multipart mime type, " ++ showType mty ++
", has no required boundary parameter. Defaulting to text/plain") $
- (MIMEValue defaultType Nothing (Single body), "")
- Just bnd -> (MIMEValue mty Nothing (Multi vals), rs)
+ (nullMIMEValue{ mime_val_type = defaultType
+ , mime_val_disp = Nothing
+ , mime_val_content = Single body
+ }, "")
+ Just bnd -> (nullMIMEValue { mime_val_type = mty
+ , mime_val_disp = Nothing
+ , mime_val_content = Multi vals
+ }, rs)
where (vals,rs) = splitMulti bnd body
splitMulti :: String -> String -> ([MIMEValue], String)
diff --git a/Codec/MIME/Type.hs b/Codec/MIME/Type.hs
index 8d9830a..ab16ab7 100644
--- a/Codec/MIME/Type.hs
+++ b/Codec/MIME/Type.hs
@@ -1,6 +1,6 @@
{- |
- Module : MIME.Type
+ Module : Codec.MIME.Type
Copyright : (c) 2006-2008, Galois Inc.
- License : BSD3
@@ -21,13 +21,19 @@ data Type
, mimeParams :: [(String,String)]
} deriving ( Show, Ord, Eq )
+nullType :: Type
+nullType = Type
+ { mimeType = Text "plain"
+ , mimeParams = []
+ }
+
showType :: Type -> String
showType t = showMIMEType (mimeType t) ++ showMIMEParams (mimeParams t)
showMIMEParams :: [(String,String)] -> String
showMIMEParams ps = concatMap showP ps
where
- showP (a,b) = ';':a ++ '=':'"':b ++ "\""
+ showP (a,b) = ';':' ':a ++ '=':'"':b ++ "\""
data MIMEType
@@ -133,11 +139,22 @@ showMultipart m =
type Content = String
-data MIMEValue = MIMEValue {
- mime_val_type :: Type,
- mime_val_disp :: Maybe Disposition,
- mime_val_content :: MIMEContent }
- deriving ( Show, Eq )
+data MIMEValue = MIMEValue
+ { mime_val_type :: Type
+ , mime_val_disp :: Maybe Disposition
+ , mime_val_content :: MIMEContent
+ , mime_val_headers :: [(String,String)]
+ , 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
diff --git a/Codec/MIME/Utils.hs b/Codec/MIME/Utils.hs
index 143b770..03f41fb 100644
--- a/Codec/MIME/Utils.hs
+++ b/Codec/MIME/Utils.hs
@@ -1,5 +1,5 @@
{- |
- Module : MIME.Utils
+ Module : Codec.MIME.Utils
Copyright : (c) 2007-2008, Galois, Inc.
License : BSD3
diff --git a/mime.cabal b/mime.cabal
index 5c9f803..7c3380c 100644
--- a/mime.cabal
+++ b/mime.cabal
@@ -1,5 +1,5 @@
name: mime
-version: 0.2.2
+version: 0.3.0
synopsis: Working with MIME types.
description: Working with MIME types.
category: Codec
@@ -23,6 +23,6 @@ library
Codec.MIME.Parse
Codec.MIME.Utils
Codec.MIME.Base64
- other-modules: Codec.MIME.Decode
+ Codec.MIME.Decode
Codec.MIME.QuotedPrintable
ghc-options: -Wall -O2