packages feed

mime 0.3.4 → 0.4.0

raw patch · 4 files changed

+205/−196 lines, 4 filesdep +textdep ~base

Dependencies added: text

Dependency ranges changed: base

Files

Codec/MIME/Parse.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------- -- | -- Module    : Codec.MIME.Pare@@ -12,14 +13,15 @@ --  -------------------------------------------------------------------- module Codec.MIME.Parse-  ( parseMIMEBody    -- :: [(String,String)] -> String -> MIMEValue-  , parseMIMEType    -- :: String -> Maybe Type-  , parseMIMEMessage -- :: String -> MIMEValue+  ( parseMIMEBody    -- :: [(T.Text,T.Text)] -> T.Text -> MIMEValue+  , parseMIMEType    -- :: T.Text -> Maybe Type+  , parseMIMEMessage -- :: T.Text -> MIMEValue -  , parseHeaders     -- :: String -> ([(String,String)], String)-  , parseMultipart   -- :: Type -> String -> (MIMEValue, String)-  , parseContentType -- :: String -> Maybe Type-  , splitMulti       -- :: String -> String -> ([MIMEValue], String)+  , parseHeaders     -- :: T.Text -> ([(T.Text,T.Text)], T.Text)+  , parseMultipart   -- :: Type -> T.Text -> (MIMEValue, T.Text)+  , parseContentType -- :: T.Text -> Maybe Type+  , splitMulti       -- :: T.Text -> T.Text -> ([MIMEValue], T.Text)+  , normalizeCRLF   ) where  import Codec.MIME.Type@@ -27,8 +29,10 @@  import Data.Char import Data.Maybe-import Data.List+import qualified Data.List as L import Debug.Trace ( trace )+import qualified Data.Text as T+import Data.Monoid(Monoid(..), (<>))  enableTrace :: Bool enableTrace = False@@ -38,7 +42,7 @@         | otherwise   = \_ x -> x  -parseMIMEBody :: [(String,String)] -> String -> MIMEValue+parseMIMEBody :: [MIMEParam] -> T.Text -> MIMEValue parseMIMEBody headers_in body = result { mime_val_headers = headers }   where   result = case mimeType mty of@@ -48,84 +52,89 @@                                  , mime_val_disp    = parseContentDisp headers                                  , mime_val_content = Single (processBody headers body)                                  }-  headers = [ (map toLower k,v) | (k,v) <- headers_in ]+  headers = [ MIMEParam (T.toLower k) v | (MIMEParam k v) <- headers_in ]   mty = fromMaybe defaultType-                       (parseContentType =<< lookupField "content-type" headers)+                       (parseContentType =<< lookupField "content-type" (paramPairs headers)) defaultType :: Type defaultType = Type { mimeType   = Text "plain"-                   , mimeParams = [("charset", "us-ascii")]+                   , mimeParams = [MIMEParam "charset" "us-ascii"]                    } -parseContentDisp :: [(String,String)] -> Maybe Disposition+parseContentDisp :: [MIMEParam] -> Maybe Disposition parseContentDisp headers =-  (processDisp . dropFoldingWSP) =<< lookupField "content-disposition" headers+    (processDisp . dropFoldingWSP) =<< lookupField "content-disposition" (paramPairs headers)   where-  processDisp "" = Nothing-  processDisp xs = Just $-    case break (\ch -> isSpace ch || ch == ';') xs of-      (as,"") -> Disposition { dispType = toDispType (map toLower as)-                             , dispParams = []-                             }-      (as,bs) -> Disposition { dispType = toDispType (map toLower as)-                             , dispParams = processParams (parseParams bs)-                             }+    processDisp t | T.null t  = Nothing+                  | T.null bs = Just $ Disposition { dispType = toDispType (T.toLower as)+                                                   , dispParams = []+                                                   }+                  | otherwise = Just $ Disposition { dispType = toDispType (T.toLower as)+                                                   , dispParams = processParams (parseParams bs)+                                                   } +      where (as,bs) = T.break (\ch -> isSpace ch || ch == ';') t -  processParams = map procP-    where-    procP (as,val)-      | "name" == asl              = Name val-      | "filename" == asl          = Filename val-      | "creation-date" == asl     = CreationDate val-      | "modification-date" == asl = ModDate val-      | "read-date" == asl         = ReadDate val-      | "size" == asl              = Size val-      | otherwise                  = OtherParam (map toLower as) val-      where asl = map toLower as+    processParams = map procP+      where+        procP (MIMEParam as val)+            | "name" == asl              = Name val+            | "filename" == asl          = Filename val+            | "creation-date" == asl     = CreationDate val+            | "modification-date" == asl = ModDate val+            | "read-date" == asl         = ReadDate val+            | "size" == asl              = Size val+            | otherwise                  = OtherParam asl val+          where asl = T.toLower as -  toDispType t = case t of-                   "inline"     -> DispInline-                   "attachment" -> DispAttachment-                   "form-data"  -> DispFormData-                   _            -> DispOther t+    toDispType t = if t == "inline" then DispInline+                   else if t == "attachment" then DispAttachment+                   else if t == "form-data"  then DispFormData+                   else  DispOther t -processBody :: [(String,String)] -> String -> String+paramPairs :: [MIMEParam] -> [(T.Text, T.Text)]+paramPairs = map paramPair+  where+    paramPair (MIMEParam a b) = (a,b)++processBody :: [MIMEParam] -> T.Text -> T.Text processBody headers body =-  case lookupField "content-transfer-encoding" headers of+  case lookupField "content-transfer-encoding" $ paramPairs headers of     Nothing -> body-    Just v  -> decodeBody v body+    Just v  -> T.pack $ decodeBody (T.unpack v) $ T.unpack body -normalizeCRLF :: String -> String-normalizeCRLF ('\r':'\n':xs) = '\r':'\n':normalizeCRLF xs-normalizeCRLF ('\r':xs) = '\r':'\n':normalizeCRLF xs-normalizeCRLF ('\n':xs) = '\r':'\n':normalizeCRLF xs-normalizeCRLF (x:xs) = x:normalizeCRLF xs-normalizeCRLF [] = []+normalizeCRLF :: T.Text -> T.Text+normalizeCRLF t+    | T.null t = ""+    | "\r\n" `T.isPrefixOf` t = "\r\n" <> normalizeCRLF (T.drop 2 t)+    | any (`T.isPrefixOf` t) ["\r", "\n"] = "\r\n" <> normalizeCRLF (T.drop 1 t)+    | otherwise = let (a,b) = T.break (`elem` "\r\n") t in a <> normalizeCRLF b   -parseMIMEMessage :: String -> MIMEValue+parseMIMEMessage :: T.Text -> MIMEValue parseMIMEMessage entity =   case parseHeaders (normalizeCRLF entity) of    (as,bs) -> parseMIMEBody as bs -parseHeaders :: String -> ([(String,String)], String)+parseHeaders :: T.Text -> ([MIMEParam], T.Text) parseHeaders str =   case findFieldName "" str of     Left (nm, rs) -> parseFieldValue nm (dropFoldingWSP rs)     Right body    -> ([],body)  where-  findFieldName _acc "" = Right ""-  findFieldName _acc ('\r':'\n':xs) = Right xs-  findFieldName acc (':':xs) = Left (reverse (dropWhile isHSpace acc), xs)-  findFieldName acc (x:xs) = findFieldName (x:acc) xs+  findFieldName acc t +    | T.null t = Right ""+    | "\r\n" `T.isPrefixOf` t = Right $ T.drop 2 t+    | ":" `T.isPrefixOf` t = Left (T.reverse $ T.dropWhile isHSpace acc, T.drop 1 t)+    | otherwise = findFieldName (T.take 1 t <> acc) $ T.drop 1 t -  parseFieldValue nm xs =-    case takeUntilCRLF xs of-      (as,"") -> ([(nm,as)],"")-      (as,bs) -> let (zs,ys) = parseHeaders bs in ((nm,as):zs,ys)+  parseFieldValue nm xs +      | T.null bs = ([MIMEParam nm as], "")+      | otherwise = let (zs,ys) = parseHeaders bs in (MIMEParam nm as :zs, ys)+    where +      (as,bs) = takeUntilCRLF xs -parseMultipart :: Type -> String -> (MIMEValue, String)+parseMultipart :: Type -> T.Text -> (MIMEValue, T.Text) parseMultipart mty body =-  case lookupField "boundary" (mimeParams mty) of-    Nothing -> doTrace ("Multipart mime type, " ++ showType mty +++  case lookupField "boundary" (paramPairs $ mimeParams mty) of+    Nothing -> doTrace ("Multipart mime type, " ++ T.unpack (showType mty) ++       ", has no required boundary parameter. Defaulting to text/plain") $       (nullMIMEValue{ mime_val_type = defaultType                     , mime_val_disp = Nothing@@ -137,71 +146,71 @@ 			       }, rs)       where (vals,rs) = splitMulti bnd body -splitMulti :: String -> String -> ([MIMEValue], String)+splitMulti :: T.Text -> T.Text -> ([MIMEValue], T.Text) splitMulti bnd body_in =   -- Note: we insert a CRLF if it looks as if the boundary string starts   -- right off the bat.  No harm done if this turns out to be incorrect.-  let body = case body_in of-                '-':'-':_ -> ('\r':'\n':body_in)-                _ -> body_in+  let body | "--" `T.isPrefixOf` body_in = "\r\n" <> body_in+           | otherwise  = body_in   in case untilMatch dashBoundary body of-       Nothing           -> ([],"")-       Just ('-':'-':xs) -> ([],xs)-       Just xs           -> splitMulti1 (dropTrailer xs)+       Nothing           -> mempty+       Just xs  | "--" `T.isPrefixOf` xs    -> ([], T.drop 2 xs)+                | otherwise                 -> splitMulti1 (dropTrailer xs)   where-  dashBoundary = ("\r\n--" ++ bnd)+  dashBoundary = ("\r\n--" <> bnd) -  splitMulti1 xs =-    case matchUntil dashBoundary xs of-      ("","") -> ([],"")-      (as,"") -> ([parseMIMEMessage as],"")-      (as,'-':'-':bs) -> ([parseMIMEMessage as], dropTrailer bs)-      (as,bs) -> let (zs,ys) = splitMulti1 (dropTrailer bs)-                 in ((parseMIMEMessage as) : zs,ys)+  splitMulti1 xs +      | T.null as && T.null bs = ([], "")+      | T.null bs = ([parseMIMEMessage as],"")+      | T.isPrefixOf "--" bs    =  ([parseMIMEMessage as], dropTrailer bs)+      | otherwise   = let (zs,ys) = splitMulti1 (dropTrailer bs)+                            in ((parseMIMEMessage as) : zs,ys) -  dropTrailer xs =-    case dropWhile isHSpace xs of-      '\r':'\n':xs1 -> xs1-      xs1 -> xs1 -- hmm, flag an error?+    where+      (as,bs) = matchUntil dashBoundary xs -parseMIMEType :: String -> Maybe Type-parseMIMEType = parseContentType+  dropTrailer xs +      | "\r\n" `T.isPrefixOf` xs1 = T.drop 2 xs1+      | otherwise   = xs1 -- hmm, flag an error?+    where+       xs1 = T.dropWhile isHSpace xs  -parseContentType :: String -> Maybe Type-parseContentType str =-   case break (=='/') (dropFoldingWSP str) of-       (maj,_:minor) ->-          case break (\ ch -> isHSpace ch || isTSpecial ch) minor of-            (as,bs)  -> -               Just Type { mimeType = toType maj as-                         , mimeParams = parseParams (dropWhile isHSpace bs)-                         }-       _ -> doTrace ("unable to parse content-type: " ++ show str) $ Nothing- where-  toType a b = case lookupField (map toLower a) mediaTypes of-                 Just ctor -> ctor b-                 _ -> Other a b+parseMIMEType :: T.Text -> Maybe Type+parseMIMEType = parseContentType -parseParams :: String -> [(String,String)]-parseParams "" = []-parseParams (';':xs) =-    case break (=='=') (dropFoldingWSP xs) of-      (_,[]) -> []-      (nm_raw,_:vs) ->-        case vs of-          '"':vs1 ->-             case break (=='"') vs1 of-               (val,"") -> [(nm,val)]-               (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+parseContentType :: T.Text -> Maybe Type+parseContentType str+    | T.null minor0 = doTrace ("unable to parse content-type: " ++ show str) $ Nothing+    | otherwise     = Just Type  { mimeType = toType maj as+                                 , mimeParams = parseParams (T.dropWhile isHSpace bs)+                                 }+  where+    (maj, minor0) = T.break (=='/') (dropFoldingWSP str)+    minor = T.drop 1 minor0+    (as, bs) = T.break (\ ch -> isHSpace ch || isTSpecial ch) minor +    toType a b = case lookupField (T.toLower a) mediaTypes of+         Just ctor -> ctor b+         _ -> Other a b -parseParams cs = doTrace ("Codec.MIME.Parse.parseParams: curious param value -- " ++ show cs) []+parseParams :: T.Text -> [MIMEParam]+parseParams t   | T.null t          = []+                | ';' == T.head t   = let (nm_raw, vs0) = T.break (=='=') (dropFoldingWSP $ T.tail t) +                                          nm = T.toLower nm_raw in+                    if T.null vs0 +                        then []+                        else let vs = T.tail vs0 in+                            if not (T.null vs) && T.head vs == '"' +                                then let vs1 = T.tail vs +                                         (val, zs0) = T.break (=='"') vs1 in+                                    if T.null zs0 +                                        then [MIMEParam nm val]+                                        else MIMEParam nm val : parseParams (T.dropWhile isHSpace $ T.tail zs0)+                                else let (val, zs) = T.break (\ch -> isHSpace ch || isTSpecial ch) vs in+                                    MIMEParam nm val : parseParams (T.dropWhile isHSpace zs)+                | otherwise = doTrace ("Codec.MIME.Parse.parseParams: curious param value -- " ++ show t) [] -mediaTypes :: [(String, String -> MIMEType)]+mediaTypes :: [(T.Text, T.Text -> MIMEType)] mediaTypes =   [ ("multipart",   (Multipart . toMultipart))   , ("application", Application)@@ -212,12 +221,11 @@   , ("text",        Text)   , ("video",       Video)   ]- where toMultipart b = fromMaybe other (lookupField (map toLower b) multipartTypes)-          where other = case b of-                          'x':'-':_ -> Extension b-                          _ -> OtherMulti b+ where toMultipart b = fromMaybe other (lookupField (T.toLower b) multipartTypes)+          where other | T.isPrefixOf "x-" b = Extension b+                      | otherwise           = OtherMulti b -multipartTypes :: [(String, Multipart)]+multipartTypes :: [(T.Text, Multipart)] multipartTypes =   [ ("alternative", Alternative)   , ("byteranges",  Byteranges)@@ -230,18 +238,19 @@   , ("signed",      Signed)   ] -untilMatch :: String -> String -> Maybe String-untilMatch "" a  = Just a-untilMatch _  "" = Nothing-untilMatch a b | a `isPrefixOf` b = Just $ drop (length a) b-untilMatch a (_:bs) = untilMatch a bs+untilMatch :: T.Text -> T.Text -> Maybe T.Text+untilMatch a b  | T.null a  = Just b+                | T.null b  = Nothing+                | a `T.isPrefixOf` b = Just $ T.drop (T.length a) b+                | otherwise = untilMatch a $ T.tail b -matchUntil :: String -> String -> (String, String)+matchUntil :: T.Text -> T.Text -> (T.Text, T.Text) matchUntil _   "" = ("", "") matchUntil str xs+    | T.null xs = mempty     -- slow, but it'll do for now.-  | str `isPrefixOf` xs = ("", drop (length str) xs)-matchUntil str (x:xs) = let (as,bs) = matchUntil str xs in (x:as,bs)+    | str `T.isPrefixOf` xs = ("", T.drop (T.length str) xs)+    | otherwise = let (as,bs) = matchUntil str $ T.tail xs in (T.take 1 xs <> as, bs)  isHSpace :: Char -> Bool isHSpace c = c == ' ' || c == '\t'@@ -249,25 +258,25 @@ isTSpecial :: Char -> Bool isTSpecial x = x `elem` "()<>@,;:\\\"/[]?=" -- " -dropFoldingWSP :: String -> String-dropFoldingWSP "" = ""-dropFoldingWSP (x:xs)- | isHSpace x = dropFoldingWSP xs-dropFoldingWSP ('\r':'\n':x:xs)- | isHSpace x = dropFoldingWSP xs-dropFoldingWSP (x:xs) = x:xs+dropFoldingWSP :: T.Text -> T.Text+dropFoldingWSP t | T.null t   = ""+                 | isHSpace (T.head t) = dropFoldingWSP $ T.tail t+                 | "\r\n" `T.isPrefixOf` t && not (T.null $ T.drop 2 t) && isHSpace (T.head $ T.drop 2 t) +                    = dropFoldingWSP $ T.drop 3 t+                 | otherwise    = t  -takeUntilCRLF :: String -> (String, String)+takeUntilCRLF :: T.Text -> (T.Text, T.Text) takeUntilCRLF str = go "" str  where-  go acc "" = (reverse (dropWhile isHSpace acc), "")-  go acc ('\r':'\n':x:xs)-   | isHSpace x = go (' ':acc) xs-   | otherwise  = (reverse (dropWhile isHSpace acc), x:xs)-  go acc (x:xs) = go (x:acc) xs+  go acc t  | T.null t  = (T.reverse (T.dropWhile isHSpace acc), "")+            | "\r\n" `T.isPrefixOf` t && not (T.null $ T.drop 2 t) && isHSpace (T.head $ T.drop 2 t)  +                        = go (" " <> acc) (T.drop 3 t)+            | "\r\n" `T.isPrefixOf` t && not (T.null $ T.drop 2 t)  +                        = (T.reverse (T.dropWhile isHSpace acc), T.drop 2 t)+            | otherwise = go (T.take 1 t <> acc) $ T.tail t  -- case in-sensitive lookup of field names or attributes\/parameters.-lookupField :: String -> [(String,a)] -> Maybe a+lookupField :: T.Text -> [(T.Text,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@@ -275,8 +284,6 @@   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+      let nl = T.toLower n in+      fmap snd $ L.find ((nl==) . T.toLower . fst) ns
Codec/MIME/Type.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------- -- | -- Module    : Codec.MIME.Type@@ -14,12 +15,16 @@ -------------------------------------------------------------------- module Codec.MIME.Type where -import Data.List ( isSuffixOf )+import qualified Data.Text as T+import Data.Monoid ((<>)) -data Type- = Type+data MIMEParam = MIMEParam  { paramName     :: T.Text+                            , paramValue    :: T.Text }+    deriving (Show, Ord, Eq)++data Type = Type     { mimeType   :: MIMEType-    , mimeParams :: [(String,String)]+    , mimeParams :: [MIMEParam]     } deriving ( Show, Ord, Eq )  -- | The @null@ MIME record type value; currently a @text/plain@.@@ -29,13 +34,13 @@     , mimeParams = []     } -showType :: Type -> String-showType t = showMIMEType (mimeType t) ++ showMIMEParams (mimeParams t)+showType :: Type -> T.Text+showType t = showMIMEType (mimeType t) <> showMIMEParams (mimeParams t) -showMIMEParams :: [(String,String)] -> String-showMIMEParams ps = concatMap showP ps- where -  showP (a,b) = ';':' ':a ++ '=':'"':b ++ "\""+showMIMEParams :: [MIMEParam] -> T.Text+showMIMEParams ps = T.concat $ map showP ps+  where +    showP (MIMEParam a b) = "; " <> a <> "=\"" <> b <> "\""   data MIMEType@@ -47,46 +52,41 @@  | Multipart   Multipart  | Text        TextType  | Video       SubType- | Other       String SubType+ | Other       {otherType :: T.Text, otherSubType :: SubType}    deriving ( Show, Ord, Eq ) -showMIMEType :: MIMEType -> String+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+   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 String SubType+ = MIMEPair T.Text SubType    deriving ( Eq ) -showMIMEPair :: MIMEPair -> String-showMIMEPair (MIMEPair a b) = a ++ '/':b+showMIMEPair :: MIMEPair -> T.Text+showMIMEPair (MIMEPair a b) = a <> "/" <> b  -- | default subtype representation.-type SubType = String+type SubType = T.Text  -- | subtype for text content; currently just a string. type TextType = SubType -subTypeString :: Type -> String-subTypeString t = -  case break (=='/') (showMIMEType (mimeType t)) of-   (_,"") -> ""-   (_,_:bs) -> bs+subTypeString :: Type -> T.Text+subTypeString t = T.drop 1 $ snd $ T.break (=='/') (showMIMEType (mimeType t)) -majTypeString :: Type -> String-majTypeString t = -  case break (=='/') (showMIMEType (mimeType t)) of-   (as,_) -> as+majTypeString :: Type -> T.Text+majTypeString t = fst $ T.break (=='/') (showMIMEType (mimeType t))  data Multipart  = Alternative@@ -98,8 +98,8 @@  | Parallel  | Related  | Signed- | Extension  String  -- ^ e.g., 'x-foo' (i.e., includes the 'x-' bit)- | OtherMulti String  -- unrecognized\/uninterpreted.+ | 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 ) @@ -107,7 +107,7 @@ isXmlBased t =    case mimeType t of      Multipart{} -> False-     _ -> "+xml" `isSuffixOf` subTypeString t+     _ -> "+xml" `T.isSuffixOf` subTypeString t  isXmlType :: Type -> Bool isXmlType t = isXmlBased t ||@@ -117,14 +117,14 @@     _             -> False  where     -- Note: xml-dtd isn't considered an XML type here.-  xml_media_types :: [String]+  xml_media_types :: [T.Text]   xml_media_types =      [ "xml"     , "xml-external-parsed-entity"     ]    -showMultipart :: Multipart -> String+showMultipart :: Multipart -> T.Text showMultipart m =   case m of    Alternative -> "alternative"@@ -139,13 +139,13 @@    Extension e -> e    OtherMulti e -> e    -type Content = String+type Content = T.Text  data MIMEValue = MIMEValue       { mime_val_type     :: Type       , mime_val_disp     :: Maybe Disposition       , mime_val_content  :: MIMEContent-      , mime_val_headers  :: [(String,String)]+      , mime_val_headers  :: [MIMEParam]       , mime_val_inc_type :: Bool       } deriving ( Show, Eq ) @@ -173,15 +173,15 @@  = DispInline  | DispAttachment  | DispFormData- | DispOther String+ | DispOther T.Text    deriving ( Show, Eq)  data DispParam- = Name String- | Filename String- | CreationDate String- | ModDate String- | ReadDate String- | Size String- | OtherParam String String+ = 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)
Codec/MIME/Utils.hs view
@@ -18,10 +18,11 @@ import Codec.MIME.Type import Data.List ( find ) import Control.Monad ( msum )+import Data.Text(Text)  -- | Given a parameter name, locate it within a MIME value, -- returning the corresponding (sub) MIME value.-findMultipartNamed :: String -> MIMEValue -> Maybe MIMEValue+findMultipartNamed :: Text -> MIMEValue -> Maybe MIMEValue findMultipartNamed nm mv =  case mime_val_content mv of    Multi ms  -> msum (map (findMultipartNamed nm) ms)
mime.cabal view
@@ -1,5 +1,5 @@ name:               mime-version:            0.3.4+version:            0.4.0 synopsis:           Working with MIME types. description:        Working with MIME types. category:           Codec@@ -14,7 +14,8 @@ Extra-Source-Files: CHANGES  library-  build-depends:   base >= 3 && < 5+  build-depends:    base >= 4 && < 5+                    , text >= 0.9    exposed-modules: Codec.MIME.Type                    Codec.MIME.Parse