mime 0.2 → 0.2.1

raw patch · 2 files changed

+26/−10 lines, 2 filesnew-uploader

Files

• Codec/MIME/Parse.hs +25/−9
• mime.cabal +1/−1

@@ -31,7 +31,7 @@   where headers = [ (map toLower k,v) | (k,v) <- headers_in ]        mty = fromMaybe defaultType-                       (parseContentType =<< lookup "content-type" headers)+                       (parseContentType =<< lookupField "content-type" headers) defaultType :: Type defaultType = Type { mimeType   = Text "plain"                    , mimeParams = [("charset", "us-ascii")]@@ -39,7 +39,7 @@  parseContentDisp :: [(String,String)] -> Maybe Disposition parseContentDisp headers =-  (processDisp . dropFoldingWSP) =<< lookup "content-disposition" headers+  (processDisp . dropFoldingWSP) =<< lookupField "content-disposition" headers   where   processDisp "" = Nothing   processDisp xs = Just $@@ -72,7 +72,7 @@  processBody :: [(String,String)] -> String -> String processBody headers body =-  case lookup "content-transfer-encoding" headers of+  case lookupField "content-transfer-encoding" headers of     Nothing -> body     Just v  -> decodeBody v body @@ -99,7 +99,7 @@  parseMultipart :: Type -> String -> (MIMEValue, String) parseMultipart mty body =-  case lookup "boundary" (mimeParams mty) of+  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), "")@@ -148,7 +148,7 @@                          }        _ -> trace ("unable to parse content-type: " ++ show str) $ Nothing  where-  toType a b = case lookup (map toLower a) mediaTypes of+  toType a b = case lookupField (map toLower a) mediaTypes of                  Just ctor -> ctor b                  _ -> Other a b @@ -157,7 +157,8 @@ parseParams "" = [] parseParams (';':xs) =     case break (=='=') (dropFoldingWSP xs) of-      (nm,_:vs) ->+      (_,[]) -> []+      (nm_raw,_:vs) ->         case vs of           '"':vs1 ->              case break (=='"') vs1 of@@ -165,9 +166,10 @@                (val,_:zs) -> (nm,val):parseParams (dropWhile isHSpace zs)           _ -> case break (\ ch -> isHSpace ch || isTSpecial ch) vs of                  (val,zs) -> (nm,val):parseParams (dropWhile isHSpace zs)-      _ -> []+       where+        nm = map toLower nm_raw -parseParams cs = trace ("curious: " ++ show cs) []+parseParams cs = trace ("Codec.MIME.Parse.parseParams: curious param value -- " ++ show cs) []  mediaTypes :: [(String, String -> MIMEType)] mediaTypes =@@ -180,7 +182,7 @@   , ("text",        Text)   , ("video",       Video)   ]- where toMultipart b = fromMaybe other (lookup (map toLower b) multipartTypes)+ where toMultipart b = fromMaybe other (lookupField (map toLower b) multipartTypes)           where other = case b of                           'x':'-':_ -> Extension b                           _ -> OtherMulti b@@ -239,3 +241,17 @@    | otherwise  = (reverse (dropWhile isHSpace acc), x:xs)   go acc (x:xs) = go (x:acc) xs +-- case in-sensitive lookup of field names or attributes\/parameters.+lookupField :: String -> [(String,a)] -> Maybe a+lookupField n ns = +   -- assume that inputs have been mostly normalized already +   -- (i.e., lower-cased), but should the lookup fail fall back+   -- to a second try where we do normalize before giving up.+  case lookup n ns of+    x@Just{} -> x+    Nothing  -> +      let nl = map toLower n in+      case find (\ (y,_) -> nl == map toLower y) ns of+        Nothing -> Nothing+	Just (_,x)  -> Just x+      

@@ -1,5 +1,5 @@ name:               mime-version:            0.2+version:            0.2.1 synopsis:           Working with MIME types. description:        Working with MIME types. category:           Codec