String.hs

-- XXX Write tests

-- Defined in RFC 2047
-- We assume we have US-ASCII characters.

module Codec.Binary.EncodingQ.String ( encode, decode) where

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

-- len is the maximum length the encoded text in a single block is
-- allowed to be
encode :: Int -> String -> [String]
encode _   "" = []
encode len xs = enc len 0 id id xs

-- 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 -> Int -- Length stuff
    -> ([String] -> [String]) -> (String -> String) -- accumulators
    -> String -- input
    -> [String]
enc _   _      acc_list acc_string ""     = acc_list [acc_string ""]
enc len so_far acc_list acc_string (c:cs)
 = if so_far' > len
   then enc len new_len (acc_list . (acc_string "" :)) id cs
   else enc len new_len acc_list (acc_string . (encoded ++)) cs
    where encoded = if isAsciiPrint c && (c /= ' ') && (c /= '?')
                    then [c]
                    else ['=', x1, x2]
          new_len = length encoded
          so_far' = so_far + new_len
          o = ord c
          x1 = toUpper $ intToDigit (o `shiftR` 4)
          x2 = toUpper $ intToDigit (o .&. 0xF)

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