QuotedPrintable.hs

-- Defined in RFC 2045.
-- We assume we have US-ASCII characters.
-- We return a string with native '\n' line endings.

module Codec.MIME.String.QuotedPrintable (encode, decode) where

import Codec.MIME.String.Internal.Utils
import Data.Bits
import Data.Char
import Data.List

encode :: [String] -> String
encode = enc 0

-- The Int is the number of characters on this line so far
-- 76 is the maximum we can have no one line, and 3 is the most
-- generated for 1 input char (but we also need space for a trailing
-- '=' for a soft line break).
enc :: Int -> [String] -> String
enc _ [] = ""
enc _ [[]] = ""
enc _ ([]:ls) = '\n':enc 0 ls
enc n ls | n > 72 = '=':'\n':enc 0 ls
enc n ((c:cs):ls)
 | (33 <= o && o <= 126 && o /= 61) ||
   (not (null cs) && (o == 9 || o == 32))  = c:enc (n+1) (cs:ls)
 | otherwise                               = '=':x1:x2:enc (n+3) (cs:ls)
    where o = ord c
          x1 = toUpper $ intToDigit (o `shiftR` 4)
          x2 = toUpper $ intToDigit (o .&. 0xF)

-- decode is very forgiving, and makes some best guesses
decode :: [String] -> String
decode = dec . intercalate "\n"
       . removeSoftLinebreaks
       . map (dropFromEndWhile is_tab_space)
    where is_tab_space ' ' = True
          is_tab_space '\t' = True
          is_tab_space _ = False
          breakLast "" = ("", "")
          breakLast [x] = ("", [x])
          breakLast (x:xs) = case breakLast xs of
                                 (ys, zs) -> (x:ys, zs)
          removeSoftLinebreaks [] = []
          removeSoftLinebreaks (x:xs)
              = case breakLast x of
                    (x', "=") ->
                        case removeSoftLinebreaks xs of
                            [] -> [x']
                            (y:ys) -> (x' ++ y):ys
                    _ -> x:removeSoftLinebreaks xs

dec :: String -> String
dec ('=':c1:c2:cs)
 | isAsciiHexDigit c1 && isAsciiHexDigit c2
    = chr ((digitToInt c1 `shiftL` 4)  + digitToInt c2):dec cs
dec (c:cs) = c:dec cs
dec "" = ""