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 String
enc String
body =
case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
enc of
String
"base64" -> String -> String
Base64.decodeToString String
body
String
"quoted-printable" -> String -> String
QP.decode String
body
String
_ -> String
body
decodeWord :: String -> Maybe (String, String)
decodeWord :: String -> Maybe (String, String)
decodeWord String
str =
case String
str of
Char
'=':Char
'?':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 (\Char
ch -> Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'?' Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*') String
xs of
(String
cs,Char
_:Char
x:Char
'?':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
Char
'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
==Char
'?') String
bs)
Char
'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
==Char
'?') String
bs)
Char
_ -> Maybe (String, String)
forall a. Maybe a
Nothing
(String, String)
_ -> Maybe (String, String)
forall a. Maybe a
Nothing
String
_ -> Maybe (String, String)
forall a. Maybe a
Nothing
where
isKnownCharset :: String -> Bool
isKnownCharset String
cs = String
cs String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"iso-8859-1", String
"us-ascii"]
dropLang :: (a, String) -> (a, String)
dropLang (a
as,Char
'*':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
/=Char
'?') String
bs)
dropLang (a
as,String
bs) = (a
as,String
bs)
decodeQ :: p -> (String, String) -> Maybe (String, String)
decodeQ p
cset (String
fs,Char
'?':Char
'=':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 p
_ (String, String)
_ = Maybe (String, String)
forall a. Maybe a
Nothing
decodeB :: p -> (String, String) -> Maybe (String, String)
decodeB p
cset (String
fs,Char
'?':Char
'=':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 p
_ (String, String)
_ = Maybe (String, String)
forall a. Maybe a
Nothing
fromCharset :: p -> p -> p
fromCharset p
_cset p
cs = p
cs
decodeWords :: String -> String
decodeWords :: String -> String
decodeWords String
"" = String
""
decodeWords (Char
x: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
Maybe (String, String)
Nothing -> Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decodeWords String
xs
Just (String
as,String
bs) -> String
as String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
decodeWords String
bs