module Codec.MIME.Decode where
import Data.Char
import Codec.MIME.QuotedPrintable as QP
import Codec.MIME.Base64 as Base64
decodeBody :: String -> String -> String
decodeBody :: String -> String -> String
decodeBody enc :: String
enc body :: String
body =
case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
enc of
"base64" -> String -> String
Base64.decodeToString String
body
"quoted-printable" -> String -> String
QP.decode String
body
_ -> String
body
decodeWord :: String -> Maybe (String, String)
decodeWord :: String -> Maybe (String, String)
decodeWord str :: String
str =
case String
str of
'=':'?':xs :: String
xs ->
case (String, String) -> (String, String)
forall a. (a, String) -> (a, String)
dropLang ((String, String) -> (String, String))
-> (String, String) -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\ch :: Char
ch -> Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='?' Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '*') String
xs of
(cs :: String
cs,_:x :: Char
x:'?':bs :: String
bs)
| String -> Bool
isKnownCharset ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
cs) ->
case Char -> Char
toLower Char
x of
'q' -> String -> (String, String) -> Maybe (String, String)
forall p. p -> (String, String) -> Maybe (String, String)
decodeQ String
cs ((Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='?') String
bs)
'b' -> String -> (String, String) -> Maybe (String, String)
forall p. p -> (String, String) -> Maybe (String, String)
decodeB String
cs ((Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='?') String
bs)
_ -> Maybe (String, String)
forall a. Maybe a
Nothing
_ -> Maybe (String, String)
forall a. Maybe a
Nothing
_ -> Maybe (String, String)
forall a. Maybe a
Nothing
where
isKnownCharset :: String -> Bool
isKnownCharset cs :: String
cs = String
cs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["iso-8859-1", "us-ascii"]
dropLang :: (a, String) -> (a, String)
dropLang (as :: a
as,'*':bs :: String
bs) = (a
as,(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/='?') String
bs)
dropLang (as :: a
as,bs :: String
bs) = (a
as,String
bs)
decodeQ :: p -> (String, String) -> Maybe (String, String)
decodeQ cset :: p
cset (fs :: String
fs,'?':'=':rs :: String
rs) = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (p -> String -> String
forall p p. p -> p -> p
fromCharset p
cset (String -> String
QP.decode String
fs),String
rs)
decodeQ _ _ = Maybe (String, String)
forall a. Maybe a
Nothing
decodeB :: p -> (String, String) -> Maybe (String, String)
decodeB cset :: p
cset (fs :: String
fs,'?':'=':rs :: String
rs) =
(String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (p -> String -> String
forall p p. p -> p -> p
fromCharset p
cset (String -> String
Base64.decodeToString String
fs),String
rs)
decodeB _ _ = Maybe (String, String)
forall a. Maybe a
Nothing
fromCharset :: p -> p -> p
fromCharset _cset :: p
_cset cs :: p
cs = p
cs
decodeWords :: String -> String
decodeWords :: String -> String
decodeWords "" = ""
decodeWords (x :: Char
x:xs :: String
xs)
| Char -> Bool
isSpace Char
x = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decodeWords String
xs
| Bool
otherwise =
case String -> Maybe (String, String)
decodeWord (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs) of
Nothing -> Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decodeWords String
xs
Just (as :: String
as,bs :: String
bs) -> String
as String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
decodeWords String
bs