Simple module to decode RFC1342 strings

1 files changed, 65 insertions, 0 deletions

diff --git a/Rfc1342.hs b/Rfc1342.hs
new file mode 100644
index 0000000..2699a26
--- /dev/null
+++ b/Rfc1342.hs
@@ -0,0 +1,65 @@
+-- A simple RFC1342 decoder
+-- Copyright (C) 2013 Raúl Benencia <rul@kalgan.cc>
+--
+-- This program is free software: you can redistribute it and/or modify
+--     it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+module Rfc1342 (decodeField) where
+-- This module is an ugly hack. You've been warned.
+
+import qualified Codec.Binary.Base64 as B64
+import qualified Codec.Binary.QuotedPrintable as QP
+
+import Data.Char (toLower, isSpace, chr)
+import Data.List(isPrefixOf)
+import Data.Word (Word8)
+
+import Data.Encoding(decodeString)
+
+-- Encoding imports. If you want to support more encodings, just add'em here.
+import Data.Encoding.UTF8
+import Data.Encoding.ISO88591
+import Data.Encoding.ISO88598
+import Data.Encoding.ISO88599
+
+decodeField :: String -> String
+decodeField ('=':'?':cs) = decodeWithCharset dec rest
+  where (encoding, rest) = span (\c -> c /= '?') cs
+        dec = case (map toLower encoding) of
+          "utf-8"      -> decodeString UTF8
+          "iso-8859-1" -> decodeString ISO88591
+          "iso-8859-8" -> decodeString ISO88598
+          "iso-8859-9" -> decodeString ISO88599
+          _            -> id
+decodeField []           = []
+decodeField (c:cs)       = c:decodeField cs
+
+decodeWithCharset dec [] = []
+decodeWithCharset dec ('?':c:'?':cs) | toLower c == 'b' = dataDecodeWith B64.decode
+                                     | toLower c == 'q' = dataDecodeWith QP.decode
+                                     | otherwise        = cs
+  where (encoded, rest') = span  (\c -> c /= '?') cs
+        rest = if "?=" `isPrefixOf` rest'
+               then drop 2 rest'
+               else rest'
+        dataDecodeWith datadec = (_2spc . dec . unwrap . datadec $ encoded) ++ (decodeField $ dropWhile isSpace rest)
+
+unwrap :: Maybe [Word8] -> String
+unwrap Nothing    = []
+unwrap (Just str) = bytesToString str
+
+bytesToString :: [Word8] -> String
+bytesToString = map (chr . fromIntegral)
+
+-- Sometimes an underscore represents the SPACE character
+_2spc = map (\x -> if x == '_' then ' ' else x)
\ No newline at end of file