--------------------------------------------------------------------
-- |
-- Module    : Codec.MIME.QuotedPrintable
-- Copyright : (c) 2006-2009, Galois, Inc. 
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sigbjorn.finne@gmail.com>
-- Stability : provisional
-- Portability:
--
-- To and from QP content encoding.
--
--------------------------------------------------------------------
module Codec.MIME.QuotedPrintable 
       ( decode -- :: String -> String
       , encode -- :: String -> String
       ) where

import Data.Char

-- | 'decode' incoming quoted-printable content, stripping
-- out soft line breaks and translating @=XY@ sequences
-- into their decoded byte\/octet. The output encoding\/representation 
-- is still a String, not a sequence of bytes.
decode :: String -> String
decode :: String -> String
decode "" = ""
decode ('=':'\r':'\n':xs :: String
xs) = String -> String
decode String
xs -- soft line break.
decode ('=':x1 :: Char
x1:x2 :: Char
x2:xs :: String
xs)
 | Char -> Bool
isHexDigit Char
x1 Bool -> Bool -> Bool
&& Char -> Bool
isHexDigit Char
x2 =
    Int -> Char
chr (Char -> Int
digitToInt Char
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
x2) Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decode String
xs
decode ('=':xs :: String
xs) = '='Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
decode String
xs
              -- make it explicit that we propagate other '=' occurrences.
decode (x1 :: Char
x1:xs :: String
xs) = Char
x1Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
decode String
xs

-- | 'encode' converts a sequence of characeter _octets_ into
-- quoted-printable form; suitable for transmission in MIME
-- payloads. Note the stress on _octets_; it is assumed that
-- you have already converted Unicode into a <=8-bit encoding
-- (UTF-8, most likely.)
encode :: String -> String
encode :: String -> String
encode xs :: String
xs = Int -> String -> String
encodeLength 0 String
xs

-- | @encodeLength llen str@ is the worker function during encoding.
-- The extra argument @llen@ tracks the current column for the line
-- being processed. Soft line breaks are inserted if a line exceeds
-- a max length.
encodeLength :: Int -> String -> String
encodeLength :: Int -> String -> String
encodeLength _ "" = ""
encodeLength n :: Int
n (x :: Char
x:xs :: String
xs)
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 72  = '='Char -> String -> String
forall a. a -> [a] -> [a]
:'\r'Char -> String -> String
forall a. a -> [a] -> [a]
:'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String -> String
encodeLength 0 (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
encodeLength _ ('=':xs :: String
xs) 
 = '='Char -> String -> String
forall a. a -> [a] -> [a]
:'3'Char -> String -> String
forall a. a -> [a] -> [a]
:'D'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String -> String
encodeLength 0 String
xs
encodeLength n :: Int
n (x :: Char
x:xs :: String
xs)
 | Int
ox Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0x100 = String -> String
forall a. HasCallStack => String -> a
error ("QuotedPrintable.encode: encountered > 8 bit character: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char, Int) -> String
forall a. Show a => a -> String
show (Char
x,Int
ox))
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 72     = '='Char -> String -> String
forall a. a -> [a] -> [a]
:'\r'Char -> String -> String
forall a. a -> [a] -> [a]
:'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String -> String
encodeLength 0 (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
 | Int
ox Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0x21 Bool -> Bool -> Bool
&& Int
ox Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x7e = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
encodeLength (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) String
xs
 | Int
ox Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0x09 Bool -> Bool -> Bool
|| Int
ox Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0x20 = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
encodeLength (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) String
xs
 | Bool
otherwise = '='Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> Char
showH (Int
ox Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 0x10)Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> Char
showH (Int
ox Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 0x10)Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String -> String
encodeLength (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+3) String
xs
 where
  ox :: Int
ox = Char -> Int
ord Char
x
  showH :: Int -> Char
showH v :: Int
v
   | Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 10    = Int -> Char
chr (Int
ord_0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
v)
   | Bool
otherwise = Int -> Char
chr (Int
ord_A Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
vInt -> Int -> Int
forall a. Num a => a -> a -> a
-10))
   
  ord_0 :: Int
ord_0 = Char -> Int
ord '0'
  ord_A :: Int
ord_A = Char -> Int
ord 'A'