diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,9 @@
+# Revision history for mime-string
+
+## 0.5.0.0  -- 2017-10-07
+
+* fix building with GHC 8.2
+
+## 0.4.0.0  -- 2008-12-07
+
+* previous version
diff --git a/Codec/Binary/EncodingQ/String.hs b/Codec/Binary/EncodingQ/String.hs
deleted file mode 100644
--- a/Codec/Binary/EncodingQ/String.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-
--- 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 "" = ""
-
diff --git a/Codec/MIME/String.hs b/Codec/MIME/String.hs
deleted file mode 100644
--- a/Codec/MIME/String.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-
-module Codec.MIME.String (
-    module Codec.MIME.String.ContentDisposition,
-    module Codec.MIME.String.Date,
-    module Codec.MIME.String.EncodedWord,
-    module Codec.MIME.String.Flatten,
-    module Codec.MIME.String.Headers,
-    module Codec.MIME.String.Parse,
-    module Codec.MIME.String.QuotedPrintable,
-    module Codec.MIME.String.Types,
- ) where
-
-import Codec.MIME.String.ContentDisposition
-import Codec.MIME.String.Date
-import Codec.MIME.String.EncodedWord
-import Codec.MIME.String.Flatten
-import Codec.MIME.String.Headers
-import Codec.MIME.String.Parse
-import Codec.MIME.String.QuotedPrintable
-import Codec.MIME.String.Types
-
diff --git a/Codec/MIME/String/ContentDisposition.hs b/Codec/MIME/String/ContentDisposition.hs
deleted file mode 100644
--- a/Codec/MIME/String/ContentDisposition.hs
+++ /dev/null
@@ -1,115 +0,0 @@
-
--- We assume we have US-ASCII characters
-
-module Codec.MIME.String.ContentDisposition
-      (
-       ContentDisposition(ContentDisposition),
-       DispositionType(Inline, Attachment),
-       DispositionParameter(..),
-       get_content_disposition,
-      ) where
-
-import Codec.MIME.String.Internal.Utils
-import Codec.MIME.String.Internal.ABNF
-      (
-       Parser, parse, nested_parse,
-       (<$>), (<$), (<*>), (<*), (<|>),
-       pEOI, pPred, pChar, pMany, pAtLeast,
-      )
-import Codec.MIME.String.Date (FullDate, p_date_time)
-import Codec.MIME.String.Headers
-      (
-       Parameter, p_parameter,
-       cws, p_ci_string, p_extension_token, p_value, p_quoted_string,
-      )
-
-data ContentDisposition = ContentDisposition DispositionType
-                                             [DispositionParameter]
-    deriving (Show, Read)
-
-data DispositionType = Inline | Attachment
-    deriving (Show, Read)
-
-data DispositionParameter = Filename String
-                          | CreationDate FullDate
-                          | ModificationDate FullDate
-                          | ReadDate FullDate
-                          | Size Integer
-                          | DispositionParameter Parameter
-    deriving (Show, Read)
-
-get_content_disposition :: String -> Maybe ContentDisposition
-get_content_disposition xs
- = case parse ph_content_disposition xs of
-       Left cd -> Just cd
-       Right _ -> Nothing
-
-ph_content_disposition :: Parser Char ContentDisposition
-ph_content_disposition = ContentDisposition
-                     <$  cws
-                     <*> p_disposition_type
-                     <*> pMany (    id
-                                <$  cws
-                                <*  pChar ';'
-                                <*  cws
-                                <*> p_disposition_parm)
-                     <*  cws
-                     <*  pEOI
-
-p_disposition_type :: Parser Char DispositionType
-p_disposition_type = Inline <$  p_ci_string "inline"
-                 <|> Attachment <$  p_ci_string "attachment"
-                 <|> Attachment <$  p_extension_token
-
-p_disposition_parm :: Parser Char DispositionParameter
-p_disposition_parm = p_filename_parm
-                 <|> p_creation_date_parm
-                 <|> p_modification_date_parm
-                 <|> p_read_date_parm
-                 <|> p_size_parm
-                 <|> DispositionParameter <$> p_parameter
-
-p_filename_parm :: Parser Char DispositionParameter
-p_filename_parm = Filename
-              <$  p_ci_string "filename"
-              <*  cws
-              <*  pChar '='
-              <*  cws
-              <*> p_value
-
-p_creation_date_parm :: Parser Char DispositionParameter
-p_creation_date_parm = CreationDate
-                   <$  p_ci_string "creation-date"
-                   <*  cws
-                   <*  pChar '='
-                   <*  cws
-                   <*> p_quoted_date_time
-
-p_modification_date_parm :: Parser Char DispositionParameter
-p_modification_date_parm = ModificationDate
-                       <$  p_ci_string "modification-date"
-                       <*  cws
-                       <*  pChar '='
-                       <*  cws
-                       <*> p_quoted_date_time
-
-p_read_date_parm :: Parser Char DispositionParameter
-p_read_date_parm = ReadDate
-               <$  p_ci_string "read-date"
-               <*  cws
-               <*  pChar '='
-               <*  cws
-               <*> p_quoted_date_time
-
-p_size_parm :: Parser Char DispositionParameter
-p_size_parm = (Size . read)
-          <$  p_ci_string "size"
-          <*  cws
-          <*  pChar '='
-          <*  cws
-          <*> pAtLeast 1 (pPred isAsciiDigit)
-
-p_quoted_date_time :: Parser Char FullDate
-p_quoted_date_time = nested_parse p_quoted_string
-                                  (id <$> p_date_time <*  pEOI)
-
diff --git a/Codec/MIME/String/Date.hs b/Codec/MIME/String/Date.hs
deleted file mode 100644
--- a/Codec/MIME/String/Date.hs
+++ /dev/null
@@ -1,241 +0,0 @@
-
-module Codec.MIME.String.Date
-      (FullDate(FullDate), DOW(..), Date(Date), Day, Month(..), Year,
-       Time(Time), Zone, TimeOfDay(TimeOfDay), Hour, Minute, Second,
-       show_full_date, show_mbox_full_date, get_date, p_date_time,
-       get_current_date, epochDate,
-      )
-      where
-
-import Codec.MIME.String.Internal.ABNF
-      (
-       Parser, parse,
-       (<$>), (<$), (<*>), (<*), (<|>),
-       pEOI, pPred, pChar, pAtLeast, pFromTo, pExactly, pMaybe,
-      )
-import Codec.MIME.String.Headers (cws, p_ci_string)
-import Codec.MIME.String.Internal.Utils
-
-import Control.Monad.Trans (MonadIO, liftIO)
-import System.Time hiding (Month(May), Day)
-import qualified System.Time as Time (Month(May))
-
-data FullDate = FullDate (Maybe DOW) Date Time
-    deriving (Show, Read)
-
-data DOW = Mon | Tue | Wed | Thu | Fri | Sat | Sun
-    deriving (Show, Read)
-
-data Date = Date Day Month Year
-    deriving (Show, Read)
-type Day = Int
-data Month = Jan | Feb | Mar | Apr | May | Jun
-           | Jul | Aug | Sep | Oct | Nov | Dec
-    deriving (Show, Read)
-type Year = Int
-
-data Time = Time TimeOfDay Zone
-    deriving (Show, Read)
-type Zone = Int
-data TimeOfDay = TimeOfDay Hour Minute (Maybe Second)
-    deriving (Show, Read)
-type Hour = Int
-type Minute = Int
-type Second = Int
-
-epochDate :: FullDate
-epochDate = FullDate (Just Thu) (Date 01 Jan 1970)
-                     (Time (TimeOfDay 0 0 (Just 0)) 0)
-
------------------------- Showing
-
-show_full_date :: FullDate -> String
-show_full_date (FullDate m_dow date time)
- = shown_dow ++ show_date date ++ " " ++ show_time time
-    where shown_dow = case m_dow of
-                          Nothing -> ""
-                          Just dow -> show dow ++ ", "
-
-show_date :: Date -> String
-show_date (Date day month year)
-  = show_int 2 day ++ " " ++ show month ++ " " ++ show year
-
-show_time :: Time -> String
-show_time (Time tod zone) = show_tod tod ++ " " ++ show_zone zone
-
-show_tod :: TimeOfDay -> String
-show_tod (TimeOfDay h m m_s)
- = show_int 2 h ++ ":" ++ show_int 2 m ++ shown_s
-    where shown_s = case m_s of
-                        Nothing -> ""
-                        Just s -> ":" ++ show_int 2 s
-
-show_zone :: Zone -> String
-show_zone z = (if z < 0 then '-' else '+'):show_int 4 (abs z)
-
-show_int :: Int -> Int -> String
-show_int digits int = let s = show int
-                      in replicate (digits - length s) '0' ++ s
-
--- Showing for the "From " line in mboxes is sadly a slightly different format
-
-show_mbox_full_date :: FullDate -> String
-show_mbox_full_date (FullDate m_dow (Date day month year) (Time tod _))
- = shown_dow ++ show month ++ " " ++ show_int 2 day ++ " " ++
-   show_tod tod ++ " " ++ show year
-    where shown_dow = case m_dow of
-                          Nothing -> ""
-                          Just dow -> show dow ++ " "
-
------------------------- Parsing
-
-get_date :: String -> Maybe FullDate
-get_date xs
- = case parse ph_date xs of
-       Left f -> Just f
-       Right _ -> Nothing
-
-ph_date :: Parser Char FullDate
-ph_date = id
-      <$  cws
-      <*> p_date_time
-      <*  cws
-      <*  pEOI
-
-p_date_time :: Parser Char FullDate
-p_date_time = FullDate
-          <$> pMaybe (    id
-                      <$> p_dow
-                      <*  cws
-                      <*  pChar ','
-                      <*  cws)
-          <*> p_date
-          <*  cws
-          <*> p_time
-
-p_dow :: Parser Char DOW
-p_dow = Mon <$  p_ci_string "Mon"
-    <|> Tue <$  p_ci_string "Tue"
-    <|> Wed <$  p_ci_string "Wed"
-    <|> Thu <$  p_ci_string "Thu"
-    <|> Fri <$  p_ci_string "Fri"
-    <|> Sat <$  p_ci_string "Sat"
-    <|> Sun <$  p_ci_string "Sun"
-
-p_date :: Parser Char Date
-p_date = Date
-     <$> p_day
-     <*  cws
-     <*> p_month
-     <*  cws
-     <*> p_year
-
--- obs-year merged in
-p_year :: Parser Char Year
-p_year = (\ds -> let y = read ds
-                 in case ds of
-                        [_, _, _] -> 2000 + y
-                        [_, _]
-                         | y < 50 -> 1900 + y
-                         | otherwise -> 2000 + y
-                        _ -> y)
-     <$> pAtLeast 2 (pPred isAsciiDigit)
-
-p_month :: Parser Char Month
-p_month = Jan <$  p_ci_string "Jan"
-      <|> Feb <$  p_ci_string "Feb"
-      <|> Mar <$  p_ci_string "Mar"
-      <|> Apr <$  p_ci_string "Apr"
-      <|> May <$  p_ci_string "May"
-      <|> Jun <$  p_ci_string "Jun"
-      <|> Jul <$  p_ci_string "Jul"
-      <|> Aug <$  p_ci_string "Aug"
-      <|> Sep <$  p_ci_string "Sep"
-      <|> Oct <$  p_ci_string "Oct"
-      <|> Nov <$  p_ci_string "Nov"
-      <|> Dec <$  p_ci_string "Dec"
-
-p_day :: Parser Char Day
-p_day = read <$> pFromTo 1 2 (pPred isAsciiDigit)
-
-p_time :: Parser Char Time
-p_time = Time
-     <$> p_time_of_day
-     <*  cws
-     <*> p_zone
-
-p_time_of_day :: Parser Char TimeOfDay
-p_time_of_day = TimeOfDay
-            <$> p_hour
-            <*  cws
-            <*  pChar ':'
-            <*  cws
-            <*> p_minute
-            <*> pMaybe (    id
-                        <$  cws
-                        <*  pChar ':'
-                        <*  cws
-                        <*> p_second)
-
-p_hour :: Parser Char Hour
-p_hour = read <$> pExactly 2 (pPred isAsciiDigit)
-
-p_minute :: Parser Char Minute
-p_minute = read <$> pExactly 2 (pPred isAsciiDigit)
-
-p_second :: Parser Char Second
-p_second = read <$> pExactly 2 (pPred isAsciiDigit)
-
-p_zone :: Parser Char Zone
-p_zone = (\f n -> f $ read n)
-     <$> (id <$  pChar '+' <|> negate <$  pChar '-')
-     <*> pExactly 4 (pPred isAsciiDigit)
- <|> p_obs_zone
-
-p_obs_zone :: Parser Char Zone
-p_obs_zone = 0 <$  p_ci_string "UT"
-         <|> 0 <$  p_ci_string "GMT"
-         <|> -500 <$  p_ci_string "EST"
-         <|> -400 <$  p_ci_string "EDT"
-         <|> -600 <$  p_ci_string "CST"
-         <|> -500 <$  p_ci_string "CDT"
-         <|> -700 <$  p_ci_string "MST"
-         <|> -600 <$  p_ci_string "MDT"
-         <|> -800 <$  p_ci_string "PST"
-         <|> -700 <$  p_ci_string "PDT"
-         -- Military time zones. Strictly we shouldn't accept [jJ]
-         -- but no harm done.
-         -- 'they SHOULD all be considered equivalent to "-0000"' as
-         -- RFC 822 defined them incorrectly.
-         <|> 0 <$  pPred isAsciiAlpha
-
-get_current_date :: MonadIO m => m FullDate
-get_current_date
- = do clt <- liftIO getClockTime
-      cat <- liftIO $ toCalendarTime clt
-      let fd = FullDate (Just dow) date time
-          get_dow Sunday    = Sun
-          get_dow Monday    = Mon
-          get_dow Tuesday   = Tue
-          get_dow Wednesday = Wed
-          get_dow Thursday  = Thu
-          get_dow Friday    = Fri
-          get_dow Saturday  = Sat
-          get_month January   = Jan
-          get_month February  = Feb
-          get_month March     = Mar
-          get_month April     = Apr
-          get_month Time.May  = May
-          get_month June      = Jun
-          get_month July      = Jul
-          get_month August    = Aug
-          get_month September = Sep
-          get_month October   = Oct
-          get_month November  = Nov
-          get_month December  = Dec
-          dow = get_dow (ctWDay cat)
-          date = Date (ctDay cat) (get_month (ctMonth cat)) (ctYear cat)
-          time = Time tod (ctTZ cat `div` 36)
-          tod = TimeOfDay (ctHour cat) (ctMin cat) (Just (ctSec cat))
-      return fd
-
diff --git a/Codec/MIME/String/EncodedWord.hs b/Codec/MIME/String/EncodedWord.hs
deleted file mode 100644
--- a/Codec/MIME/String/EncodedWord.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-
-module Codec.MIME.String.EncodedWord (base64_encode) where
-
-import Codec.Binary.Base64.String (encode)
-
-base64_encode :: String -> String -> String
-base64_encode charset xs = "=?" ++ charset ++ "?B?" ++ encode xs ++ "?="
-
diff --git a/Codec/MIME/String/Flatten.hs b/Codec/MIME/String/Flatten.hs
deleted file mode 100644
--- a/Codec/MIME/String/Flatten.hs
+++ /dev/null
@@ -1,144 +0,0 @@
-
-module Codec.MIME.String.Flatten
-    (flatten, Attachments, Attachment)
-    where
-
-import qualified Codec.Binary.Base64.String as Base64 (encode)
-import qualified Codec.MIME.String.QuotedPrintable as QP (encode)
-import Codec.MIME.String.Headers
-import Codec.MIME.String.Internal.Utils
-import Codec.MIME.String.Types
-
-{-
-XXX For message IDs:
-import Network.BSD (getHostName)
-import System.Locale (defaultTimeLocale)
-import System.Random (randomIO)
-import System.Time (getClockTime, toCalendarTime, formatCalendarTime)
--}
-
-type Attachments = [Attachment]
-type Attachment = (String, FilePath, Maybe ContentType)
-
--- XXX This should be rewritten in a more compositional way!
-flatten :: Headers -> String -> Maybe String -> Attachments -> IO String
-flatten headers body maybeHtmlBody attachments
- = do -- XXX Could add one of one isn't already found? msgid <- mk_msgid
-      let -- XXX This (\n) could be prettier - check llengths of bits
-          alternativeBoundary = "=:A"
-          alternativePartStart = "\n--" ++ alternativeBoundary ++ "\n"
-          alternativePartsEnd  = "\n--" ++ alternativeBoundary ++ "--\n"
-          mixedBoundary = "=:M"
-          mixedPartStart = "\n--" ++ mixedBoundary ++ "\n"
-          mixedPartsEnd  = "\n--" ++ mixedBoundary ++ "--\n"
-          common_headers = unlines (concatMap h_raw_header headers)
-                        ++ "MIME-Version: 1.0\n"
-          text_content_headers = unlines [
-              "Content-type: text/plain; charset=utf-8",
-              "Content-transfer-encoding: quoted-printable",
-              "Content-Disposition: inline"]
-          html_content_headers = unlines [
-              "Content-type: text/html; charset=utf-8",
-              "Content-transfer-encoding: quoted-printable",
-              "Content-Disposition: inline"]
-          -- This is overly paranoid
-          safe_char c = isAsciiAlphaNum c || (c `elem` " .-_")
-          mime_attachment (a, fn, mct)
-              = let -- XXX showParam and ct should do some sanity checking
-                    -- of the values they are passed
-                    showParam (Parameter k v) = "; " ++ k ++ "=\"" ++ v ++ "\""
-                    ct = case mct of
-                         Just (ContentType x y ps) ->
-                             "Content-type: " ++ x ++ "/" ++ y
-                          ++ concatMap showParam ps ++ "\n"
-                         Nothing -> "Content-type: application/octet-stream\n"
-                in mixedPartStart
-                ++ ct
-                ++ "Content-transfer-encoding: base64\n"
-                ++ "Content-Disposition: attachment; filename=\""
-                       ++ (case reverse $ filter safe_char
-                                        $ takeWhile ('/' /=)
-                                        $ reverse fn of
-                               [] -> "unknown"
-                               fn' -> fn')
-                       ++ "\"\n"
-                ++ "\n"
-                ++ Base64.encode a
-          msg = if single_part
-                then case maybeHtmlBody of
-                     Nothing ->
-                         common_headers
-                      ++ text_content_headers
-                      ++ "\n"
-                      ++ QP.encode (my_lines body)
-                     Just htmlBody ->
-                         common_headers
-                      ++ "Content-type: multipart/alternative; boundary=\""
-                                             ++ alternativeBoundary ++ "\"\n"
-                      ++ "\n"
-                      ++ "This is a multi-part message in MIME format.\n"
-                      ++ alternativePartStart
-                      ++ text_content_headers
-                      ++ "\n"
-                      ++ QP.encode (my_lines body)
-                      ++ alternativePartStart
-                      ++ html_content_headers
-                      ++ "\n"
-                      ++ QP.encode (my_lines htmlBody)
-                      ++ alternativePartsEnd
-                else case maybeHtmlBody of
-                     Nothing ->
-                         common_headers
-                      ++ "Content-type: multipart/mixed; boundary=\""
-                                             ++ mixedBoundary ++ "\"\n"
-                      ++ "\n"
-                      ++ "This is a multi-part message in MIME format.\n"
-                      ++ mixedPartStart
-                      ++ text_content_headers
-                      ++ "\n"
-                      ++ QP.encode (my_lines body)
-                      ++ concatMap mime_attachment attachments
-                      ++ mixedPartsEnd
-                     Just htmlBody ->
-                         common_headers
-                      ++ "Content-type: multipart/mixed; boundary=\""
-                                                    ++ mixedBoundary ++ "\"\n"
-                      ++ "\n"
-                      ++ "This is a multi-part message in MIME format.\n"
-                      ++ mixedPartStart
-                      -- Start of the body
-                      ++ "Content-type: multipart/alternative; boundary=\""
-                                             ++ alternativeBoundary ++ "\"\n"
-                      ++ "\n"
-                      ++ alternativePartStart
-                      ++ text_content_headers
-                      ++ "\n"
-                      ++ QP.encode (my_lines body)
-                      ++ alternativePartStart
-                      ++ html_content_headers
-                      ++ "\n"
-                      ++ QP.encode (my_lines htmlBody)
-                      ++ alternativePartsEnd
-                      -- End of the body
-                      ++ concatMap mime_attachment attachments
-                      ++ mixedPartsEnd
-      return msg
-    where single_part = null attachments
-
--- XXX The IO calls used to use liftIOErr. We could use something similar
--- but require we are called in a MonadError m?
--- XXX We should possibly be including a program name
-{-
-mk_msgid :: IO String
-mk_msgid
- = do hostname <- getHostName
-      clock_time <- getClockTime
-      calendar_time <- toCalendarTime clock_time
-      r <- randomIO
-      let timestamp = formatCalendarTime defaultTimeLocale
-                                         "%Y%m%d%H%M%S" calendar_time
-          lhs = concat $ intersperse "."
-                [timestamp, show (r :: Int)]
-      return (lhs ++ "@" ++ hostname)
--}
-
diff --git a/Codec/MIME/String/Headers.hs b/Codec/MIME/String/Headers.hs
deleted file mode 100644
--- a/Codec/MIME/String/Headers.hs
+++ /dev/null
@@ -1,634 +0,0 @@
-
--- We assume we have US-ASCII characters
-
-module Codec.MIME.String.Headers
-      (
-       Domain(Domain, LiteralDomain),
-       Mailbox(Mailbox),
-       RoutedEmailAddress(RoutedEmailAddress, NormalEmailAddress),
-       EmailAddress(EmailAddress), get_addr_spec,
-       Address(Address, Group),
-       ContentType(ContentType), get_content_type,
-       ContentDescription(ContentDescription),
-       get_content_description,
-       ContentTransferEncoding(ContentTransferEncoding),
-       get_content_transfer_encoding,
-       ContentID(ContentID), get_content_id,
-       MessageID(MessageID),
-       MIMEVersion(MIMEVersion), get_mime_version,
-       Parameter(Parameter), p_parameter,
-       From(From), To(To), Subject(Subject),
-       get_from,   get_to, get_subject,
-       get_boundary, p_extension_token, p_value, p_quoted_string,
-       cws, p_ci_string,
-      )
-      where
-
-import Codec.MIME.String.Internal.ABNF
-      (
-       Parser, parse, pSucceed, pFail,
-       (<$>), (<$), (<*>), (<*), (<|>), (<|), (<!>),
-       pEOI, pPred, pChar, pMany, pAtLeast, pMaybe, pOptDef, pString,
-      )
-import qualified Codec.Binary.Base64.String as Base64 (decode)
-import qualified Codec.Binary.EncodingQ.String as EncodingQ (decode)
-import Codec.MIME.String.Internal.Utils
-
-import Codec.Text.IConv
-import qualified Data.ByteString.Lazy.Char8 as BS
-import Data.Char
-import Data.List
-
------------------------
--- Utils
-
-ignore :: Parser inp a -> Parser inp ()
-ignore p = () <$  p
-
-boxp :: Parser inp a -> Parser inp [a]
-boxp p = box <$> p
-
------------------------
--- RFC 2234
-
-p_CTL :: Parser Char Char
-p_CTL = pPred (\c -> ord c < 32 || ord c == 127)
-
-p_SP :: Parser Char Char
-p_SP = pChar ' '
-
-p_HTAB :: Parser Char Char
-p_HTAB = pChar '\t'
-
-p_WSP :: Parser Char Char
-p_WSP = p_SP <|> p_HTAB
-
------------------------
--- RFC 2822
-
--- Case insensitive strings, written "Foo"
-p_ci_string :: String -> Parser Char String
-p_ci_string s = s <$  f s
-    where f "" = pSucceed ()
-          f (c:cs) = let p = if isAsciiAlpha c
-                             then pChar (toLower c) <|  pChar (toUpper c)
-                             else pChar c
-                     in () <$  p <*  f cs
-
-p_NO_WS_CTL :: Parser Char Char
-p_NO_WS_CTL = pPred (\c -> let o = ord c in 1 <= o && o <= 8
-                                         || o == 11
-                                         || o == 12
-                                         || 14 <= o && o <= 31
-                                         || o == 127)
-
--- If we follow the spec precisely then we get pMany (pMany), and hence
--- non-termination, so we merge the definition of p_obs_text in.
-p_text :: Parser Char String
-p_text = concat
-     <$> pMany (
-                    p_encoded_words
-                <|  boxp (pPred (\c -> let o = ord c in 0 <= o && o <= 9
-                                                     || o == 11
-                                                     || o == 12
-                                                     || 14 <= o && o <= 127))
-               )
-
--- We are lax about checking they have any necessary surrounding
--- whitespace
-p_encoded_words :: Parser Char String
-p_encoded_words = (\x xs -> x ++ concat xs)
-              <$> p_encoded_word
-              <*> pMany (id <$  cws <*> p_encoded_word)
-
--- XXX What happens if iconv doesn't understand the charset "cs"?
-p_encoded_word :: Parser Char String
-p_encoded_word = (\cs dec text -> BS.unpack $ convertFuzzy Transliterate cs "utf8" $ BS.pack $ dec text)
-             <$  pString "=?"
-             <*> p_charset
-             <*  pChar '?'
-             <*> p_encoding
-             <*  pChar '?'
-             <*> p_encoded_text
-             <*  pString "?="
-
--- token definition inlined as they use a different one to p_token.
-p_charset :: Parser Char String
-p_charset = pAtLeast 1 (pPred isAscii <!> (p_SP <|> p_CTL <|> p_especials))
-
-p_especials :: Parser Char Char
-p_especials = pPred (`elem` "()<>@,;:\\\"/[]?.=")
-
--- This is much stricter than specified, but if it's not [qQbB] then
--- we'd want to fall back to showing it as a string anyway.
-p_encoding :: Parser Char (String -> String)
-p_encoding = EncodingQ.decode <$  (pChar 'Q' <|> pChar 'q')
-         <|> Base64.decode <$  (pChar 'B' <|> pChar 'b')
-
-p_encoded_text :: Parser Char String
-p_encoded_text = pMany (pPred (\c -> isAsciiPrint c && c /= '?' && c /= ' '))
-
-p_quoted_pair :: Parser Char String
-p_quoted_pair = id <$  pChar '\\' <*> p_text <|> (boxp p_obs_qp)
-
-p_obs_qp :: Parser Char Char
-p_obs_qp = id <$  pChar '\\' <*> pPred isAscii
-
--- Done differently as the newlines are already gone
-p_FWS :: Parser Char String
-p_FWS = pMany p_WSP
-
-p_ctext :: Parser Char Char
-p_ctext = p_NO_WS_CTL
-      <|> pPred (\c -> let o = ord c in 33 <= o && o <= 39
-                                     || 42 <= o && o <= 91
-                                     || 93 <= o && o <= 126)
-
-p_ccontent :: Parser Char ()
-p_ccontent = ignore p_ctext <|> ignore p_quoted_pair <|> p_comment
-
-p_comment :: Parser Char ()
-p_comment = ()
-        <$  pChar '('
-        <*  pMany (() <$  pMany p_NO_WS_CTL <*  p_ccontent)
-        <*  pMany p_NO_WS_CTL
-        <*  pChar ')'
-
--- We might want to keep the result. If we do then we also need to
--- handle encoded words properly.
--- This isn't quite CFWS as we need to be able to accept "1.0"
--- as a MIME version with cws between all the characters.
--- Also, we've already removed all the newlines in the headers.
-cws :: Parser Char ()
-cws = ignore $ pMany (ignore (pAtLeast 1 p_WSP) <|> p_comment)
-
-p_qtext :: Parser Char Char
-p_qtext = p_NO_WS_CTL
-      <|> pPred (\c -> let o = ord c in o == 33
-                                     || 35 <= o && o <= 91
-                                     || 93 <= o && o <= 126)
-
-p_qcontent :: Parser Char String
-p_qcontent = boxp p_qtext
-         <|> p_quoted_pair
-
-p_quoted_string :: Parser Char String
-p_quoted_string = (++)
-              <$  cws
-              <*  pChar '"'
-              <*> (concat <$> pMany ((++) <$> pOptDef "" p_FWS <*> p_qcontent))
-              <*> pOptDef "" p_FWS
-              <*  pChar '"'
-
-p_dcontent :: Parser Char String
-p_dcontent = boxp p_dtext <|> p_quoted_pair
-
-p_dtext :: Parser Char Char
-p_dtext = p_NO_WS_CTL
-      <|> pPred (\c -> let o = ord c in 33 <= o && o <= 90
-                                     || 94 <= o && o <= 126)
-
-data MessageID = MessageID String Domain
-    deriving (Show, Read)
-
-p_msg_id :: Parser Char MessageID
-p_msg_id = MessageID
-       <$  cws
-       <*  pChar '<'
-       <*> p_id_left
-       <*  pChar '@'
-       <*> p_id_right
-       <*  pChar '>'
-       <*  cws
-
-p_atom :: Parser Char String
-p_atom = id
-     <$  cws
-     <*> pAtLeast 1 p_atext
-     <*  cws
-
-p_atext :: Parser Char Char
-p_atext = pPred (\c -> isAsciiAlphaNum c || c `elem` "!#$%&'+-/=?^_`{|}~")
-
-p_dot_atom :: Parser Char String
-p_dot_atom = id 
-         <$  cws
-         <*> p_dot_atom_text
-         <*  cws
-
-p_word :: Parser Char String
-p_word = p_atom <|> p_quoted_string
-
--- This incorporates obs-phrase
-p_phrase :: Parser Char [String]
-p_phrase = (:)
-       <$> (p_encoded_words <|  p_word)
-       <*> pMany (id <$  cws <*> (p_encoded_words <|  p_word <|  pString "."))
-   <|> boxp p_quoted_string
-
-p_dot_atom_text :: Parser Char String
-p_dot_atom_text = (\x xs -> x ++ concat xs)
-              <$> pAtLeast 1 p_atext
-              <*> pMany ((:) <$> pChar '.' <*> pAtLeast 1 p_atext)
-
-p_id_left :: Parser Char String
-p_id_left = p_dot_atom_text <|> p_no_fold_quote <|> p_obs_id_left
-
-p_id_right :: Parser Char Domain
-p_id_right = Domain <$> p_dot_atom_text
-         <|> p_no_fold_literal
-         <|> p_obs_id_right
-
-p_obs_id_left :: Parser Char String
-p_obs_id_left = p_local_part
-
-p_local_part :: Parser Char String
-p_local_part = p_dot_atom <|> p_quoted_string <|> p_obs_local_part
-
-p_obs_local_part :: Parser Char String
-p_obs_local_part = (\x xs -> x ++ concat xs)
-               <$> p_word
-               <*> pMany ((:) <$> pChar '.' <*> p_word)
-
-p_domain :: Parser Char Domain
-p_domain = Domain <$> p_dot_atom <|> p_domain_literal <|> p_obs_domain
-
-p_domain_literal :: Parser Char Domain
-p_domain_literal = (LiteralDomain . concat)
-               <$  cws
-               <*  pChar '['
-               <*> pMany (    id
-                          <$  p_FWS
-                          <*> p_dcontent)
-               <*  p_FWS
-               <*  pChar ']'
-               <*  cws
-
-p_obs_domain :: Parser Char Domain
-p_obs_domain = (\x xs -> Domain (x ++ concat xs))
-           <$> p_atom
-           <*> pMany ((:) <$> pChar '.' <*> p_atom)
-
-p_obs_id_right :: Parser Char Domain
-p_obs_id_right = p_domain
-
-p_no_fold_quote :: Parser Char String
-p_no_fold_quote = concat
-              <$  pChar '"'
-              <*> pMany (boxp p_qtext <|> p_quoted_pair)
-              <*  pChar '"'
-
-data Domain = Domain String | LiteralDomain String
-    deriving (Show, Read, Eq)
-
-p_no_fold_literal :: Parser Char Domain
-p_no_fold_literal = LiteralDomain . concat
-                <$  pChar '['
-                <*> pMany (boxp p_dtext <|> p_quoted_pair)
-                <*  pChar ']'
-
-data Subject = Subject String
-    deriving (Show, Read)
-
-get_subject :: String -> Maybe Subject
-get_subject xs
- = case parse ph_subject xs of
-       Left cd -> Just cd
-       Right _ -> Nothing
-
--- This is actually the RFC822 definition, as otherwise things get very
--- confusing.
--- Would be pMany, but p_text already does that for us
-ph_subject :: Parser Char Subject
-ph_subject = Subject <$> p_text <*  pEOI
-
-data From = From [Mailbox]
-    deriving (Show, Read, Eq)
-
-get_from :: String -> Maybe From
-get_from xs
- = case parse ph_from xs of
-       Left f -> Just f
-       Right _ -> Nothing
-
-ph_from :: Parser Char From
-ph_from = From <$  cws <*> p_mailbox_list <*  cws <*  pEOI
-
-data To = To [Address]
-    deriving (Show, Read)
-
-data Address = Address Mailbox
-             | Group String [Mailbox]
-    deriving (Show, Read)
-
-get_to :: String -> Maybe To
-get_to xs
- = case parse ph_to xs of
-       Left t -> Just t
-       Right _ -> Nothing
-
-ph_to :: Parser Char To
-ph_to = To <$  cws <*> p_address_list <*  cws <*  pEOI
-
--- obs-addr-list merged in
-p_address_list :: Parser Char [Address]
-p_address_list = (:)
-             <$  pMany (() <$  pChar ',' <*  cws)
-             <*> p_address
-             <*> pMany (    id
-                        <$  pAtLeast 1 (() <$  cws <*  pChar ',')
-                        <*  cws
-                        <*> p_address)
-             <*  pMany (() <$  cws <*  pChar ',')
-
-p_address :: Parser Char Address
-p_address = Address <$> p_mailbox
-        <|> p_group
-
-p_group :: Parser Char Address
-p_group = Group
-      <$> p_display_name 
-      <*  cws
-      <*  pChar ':'
-      <*  cws
-      <*> pOptDef [] p_mailbox_list
-      <*  cws
-      <*  pChar ';'
-
--- obs-mbox-list merged in
-p_mailbox_list :: Parser Char [Mailbox]
-p_mailbox_list = (:)
-             <$  pMany (() <$  pChar ',' <*  cws)
-             <*> p_mailbox
-             <*> pMany (    id
-                        <$  pAtLeast 1 (() <$  cws <*  pChar ',')
-                        <*  cws
-                        <*> p_mailbox)
-             <*  pMany (() <$  cws <*  pChar ',')
-
-data Mailbox = Mailbox (Maybe String) RoutedEmailAddress
-    deriving (Show, Read, Eq)
-
-p_mailbox :: Parser Char Mailbox
-p_mailbox = p_name_addr
-        <|> (Mailbox Nothing . NormalEmailAddress) <$> p_addr_spec
-
-p_name_addr :: Parser Char Mailbox
-p_name_addr = Mailbox
-          <$> pMaybe p_display_name
-          <*  cws
-          <*> p_angle_addr
-
-data EmailAddress = EmailAddress String Domain
-    deriving (Show, Read, Eq)
-
-data RoutedEmailAddress = NormalEmailAddress          EmailAddress
-                        | RoutedEmailAddress [Domain] EmailAddress
-    deriving (Show, Read, Eq)
-
-p_angle_addr :: Parser Char RoutedEmailAddress
-p_angle_addr = ($)
-           <$  pChar '<'
-           <*  cws
-           -- This next makes us also satisfy obs-angle-addr
-           <*> pOptDef NormalEmailAddress
-                       (RoutedEmailAddress <$> p_obs_route <*  cws)
-           <*> p_addr_spec
-           <*  cws
-           <*  pChar '>'
-
-get_addr_spec :: String -> Maybe EmailAddress
-get_addr_spec xs
- = case parse p_addr_spec xs of
-       Left e -> Just e
-       Right _ -> Nothing
-
-p_addr_spec :: Parser Char EmailAddress
-p_addr_spec  = EmailAddress
-           <$> p_local_part
-           <*  cws
-           <*  pChar '@'
-           <*  cws
-           <*> p_domain
-
-p_display_name :: Parser Char String
-p_display_name = (concat . intersperse " ") <$> p_phrase
-
-p_obs_route :: Parser Char [Domain]
-p_obs_route = id <$> p_obs_domain_list <*  pChar ':'
-
-p_obs_domain_list :: Parser Char [Domain]
-p_obs_domain_list = (:)
-                <$  pChar '@'
-                <*  cws
-                <*> p_domain
-                <*> pMany (    id
-                           <$  pMaybe (() <$  cws <*  pChar ',')
-                           <*  cws
-                           <*  pChar '@'
-                           <*  cws
-                           <*> p_domain)
-
------------------------
--- RFC 2045
-
-data MIMEVersion = MIMEVersion Integer Integer
-    deriving (Show, Read)
-
-get_mime_version :: String -> Maybe MIMEVersion
-get_mime_version xs = case parse ph_mime_version xs of
-                          Left ct -> Just ct
-                          Right _ -> Nothing
-
-ph_mime_version :: Parser Char MIMEVersion
-ph_mime_version = MIMEVersion
-              <$  cws
-              <*> (read <$> pMany (pPred isAsciiDigit))
-              <*  cws
-              <*  pChar '.'
-              <*  cws
-              <*> (read <$> pMany (pPred isAsciiDigit))
-              <*  cws
-              <*  pEOI
-
-data ContentType = ContentType String -- Case insensitive: lower-cased
-                               String -- Case insensitive: lower-cased
-                               [Parameter]
-    deriving (Show, Read)
-data Parameter = Parameter String -- Case insensitive: lower-cased
-                           String
-    deriving (Show, Read)
-
-get_content_type :: String -> Maybe ContentType
-get_content_type xs = case parse ph_content_type xs of
-                          Left ct -> Just ct
-                          Right _ -> Nothing
-
-ph_content_type :: Parser Char ContentType
-ph_content_type = ContentType
-              <$  cws
-              <*> p_type
-              <*  cws
-              <*  pChar '/'
-              <*  cws
-              <*> p_subtype
-              <*> pMany (id
-                     <$  cws
-                     <*  pChar ';'
-                     <*  cws
-                     <*> p_parameter)
-              <*  cws
-              <*  pEOI
-
-
--- For type and subtypes, allow anything that matches a regexp that
--- subsumes the currently allowed values
-p_type :: Parser Char String
-p_type = pAtLeast 1 (pPred (\c -> isAsciiAlphaNum c || c `elem` "-.+"))
-
-p_subtype :: Parser Char String
-p_subtype = pAtLeast 1 (pPred (\c -> isAsciiAlphaNum c || c `elem` "-.+"))
-
-{-
-p_type :: Parser Char String
-p_type = p_discrete_type <|> p_composite_type
-
-p_subtype :: Parser Char String
-p_subtype = map asciiToLower <$> (p_extension_token <|> p_iana_token)
-
-p_discrete_type :: Parser Char String
-p_discrete_type = p_ci_string "text"
-              <|> p_ci_string "image"
-              <|> p_ci_string "audio"
-              <|> p_ci_string "video"
-              <|> p_ci_string "application"
-              <|> map asciiToLower <$> p_extension_token
-
-p_composite_type :: Parser Char String
-p_composite_type = p_ci_string "message"
-               <|> p_ci_string "multipart"
-               <|> map asciiToLower <$> p_extension_token
-
-p_iana_token :: Parser Char String
-p_iana_token = pFail
--}
-
-p_extension_token :: Parser Char String
-p_extension_token = p_ietf_token <|> p_x_token
-
-p_ietf_token :: Parser Char String
-p_ietf_token = pFail
-
-p_x_token :: Parser Char String
-p_x_token = (\x t -> x:'-':t)
-        <$> (pChar 'X' <|> pChar 'x')
-        <*  pChar '-'
-        <*> p_token
-
-p_parameter :: Parser Char Parameter
-p_parameter = Parameter
-          <$> p_attribute
-          <*  cws
-          <*  pChar '='
-          <*  cws
-          <*> p_value
-
-p_attribute :: Parser Char String
-p_attribute = map asciiToLower <$> p_token
-
-p_value :: Parser Char String
-p_value = p_token <|> p_quoted_string
-
-p_token :: Parser Char String
-p_token = pAtLeast 1 (pPred isAscii <!> (p_SP <|> p_CTL <|> p_tspecials))
-
-p_tspecials :: Parser Char Char
-p_tspecials = pPred (`elem` "()<>@,;:\\\"/[]?=")
-
------
-
-data ContentTransferEncoding
-        = ContentTransferEncoding String -- Case insensitive: lower-cased
-    deriving (Show, Read)
-
-get_content_transfer_encoding :: String -> Maybe ContentTransferEncoding
-get_content_transfer_encoding xs
- = case parse ph_content_transfer_encoding xs of
-       Left cte -> Just cte
-       Right _ -> Nothing
-
-ph_content_transfer_encoding :: Parser Char ContentTransferEncoding
-ph_content_transfer_encoding
-    = ContentTransferEncoding
-  <$  cws
-  <*> p_mechanism
-  <*  cws
-  <*  pEOI
-
-p_mechanism :: Parser Char String
-p_mechanism = p_ci_string "7bit"
-          <|> p_ci_string "8bit"
-          <|> p_ci_string "binary"
-          <|> p_ci_string "quoted-printable"
-          <|> p_ci_string "base64"
-          <|> map asciiToLower <$> p_ietf_token
-          <|> map asciiToLower <$> p_x_token
-
-data ContentID = ContentID MessageID
-    deriving (Show, Read)
-
-get_content_id :: String -> Maybe ContentID
-get_content_id xs
- = case parse ph_content_id xs of
-       Left ci -> Just ci
-       Right _ -> Nothing
-
-ph_content_id :: Parser Char ContentID
-ph_content_id
-    = ContentID
-  <$  cws
-  <*> p_msg_id
-  <*  cws
-  <*  pEOI
-
-data ContentDescription = ContentDescription String
-    deriving (Show, Read)
-
-get_content_description :: String -> Maybe ContentDescription
-get_content_description xs
- = case parse ph_content_description xs of
-       Left cd -> Just cd
-       Right _ -> Nothing
-
-ph_content_description :: Parser Char ContentDescription
-ph_content_description
-    = ContentDescription
-  <$  cws
-  <*> p_text -- would be pMany, but p_text already does that for us
-  <*  cws
-  <*  pEOI
-
------------------------
--- RFC 2046
-
--- Not really a header as such
-
-get_boundary :: String -> Maybe String
-get_boundary xs
- = case parse p_boundary xs of
-       Left b -> Just b
-       Right _ -> Nothing
-
--- We are very flexible here
-p_boundary :: Parser Char String
-p_boundary = (\ss b bs -> dropFromEndWhile (' ' ==) (ss ++ [b] ++ bs))
-         <$> pMany (pChar ' ')
-         <*> p_bchars
-         <*> pMany p_bchars
-
-p_bchars :: Parser Char Char
-p_bchars = p_bcharsnospace <|> pChar ' '
-
-p_bcharsnospace :: Parser Char Char
-p_bcharsnospace = pPred (\c -> isAsciiAlphaNum c || c `elem` "'()+_,-./:=?")
-
diff --git a/Codec/MIME/String/Internal/ABNF.hs b/Codec/MIME/String/Internal/ABNF.hs
deleted file mode 100644
--- a/Codec/MIME/String/Internal/ABNF.hs
+++ /dev/null
@@ -1,173 +0,0 @@
-
-module Codec.MIME.String.Internal.ABNF
-      (Parser, apply, parse,
-       pPred, pSucceed, pFail, pEOI, (<*>), (<|>), (<| ), (<!>), nested_parse,
-       pChar, pString, (<$>), (<$ ), (<* ), ( |>),
-       pMany, pAtLeast, pAtMost, pExactly, pFromTo, pOptDef, pMaybe
-      ) where
-
-import Data.Word
-
-newtype Parser inp res = Parser ([(inp, Pos)] -> ParseResult inp res)
-
-data ParseResult inp res = Success res [(inp, Pos)] !Pos
-                         | Fail !Pos
-
-type Line = Integer
-type Column = Integer
-data Pos = Pos !Line !Column
-         | EOI
-    deriving (Eq, Ord)
-
-get_pos :: [(a, Pos)] -> Pos
-get_pos [] = EOI
-get_pos ((_, p):_) = p
-
-show_pos :: Pos -> String
-show_pos EOI = "End of input"
-show_pos (Pos l c) = "Line " ++ show l ++ ", column " ++ show c
-
-infixl 6 <$>, <$, <*>, <*
-infixr 3 <|>, <|, |>
-
-posify :: String -> [(Char, Pos)]
-posify = f 1 1
-    where f _ _ []        = []
-          f l c ('\n':xs) = ('\n', Pos l c):f (l+1) 1     xs
-          f l c (x   :xs) = (x,    Pos l c):f l     (c+1) xs
-
-apply :: Parser Char a -> String -> Either (a, String) String
-apply (Parser p) xs
- = case p $ posify xs of
-       Success res ys _ -> Left (res, map fst ys)
-       Fail pos -> Right ("Error: Failed at " ++ show_pos pos)
-
-parse :: Parser Char a -> String -> Either a String
-parse (Parser p) xs
- = case p $ posify xs of
-       Success res [] _ -> Left res
-       Success _ ((_, pos):_) _ ->
-           Right ("Error: Only consumed up to " ++ show_pos pos)
-       Fail pos ->
-           Right ("Error: Failed at " ++ show_pos pos)
-
--- Primitive combinators
-
-pPred :: (inp -> Bool) -> Parser inp inp
-pPred p = Parser
-        $ \inp -> case inp of
-                      ((x, pos):inp')
-                       | p x -> Success x inp' pos
-                      _ -> Fail (get_pos inp)
-
-pSucceed :: res -> Parser a res
-pSucceed x = Parser $ \inp -> Success x inp (get_pos inp)
-
-pFail :: Parser a res
-pFail = Parser $ \inp -> Fail (get_pos inp)
-
-pEOI :: Parser a ()
-pEOI = Parser $ \inp -> case inp of
-                            [] -> Success () [] EOI
-                            _ -> Fail (get_pos inp)
-
-(<*>) :: Parser inp (a -> b) -> Parser inp a -> Parser inp b
-Parser p <*> Parser q = Parser $ \inp ->
-                        case p inp of
-                            Fail pos -> Fail pos
-                            Success f inp' pos ->
-                                case q inp' of
-                                    Fail pos' -> Fail (pos `max` pos')
-                                    Success x inp'' pos' ->
-                                        Success (f x) inp'' (pos `max` pos')
-
-(<|>) :: Parser inp a -> Parser inp a -> Parser inp a
-Parser p <|> Parser q = Parser $ \inp ->
-                        case (p inp, q inp) of
-                            (Fail posp, Fail posq) -> Fail (posp `max` posq)
-                            (Fail posp, Success x inp' posq) ->
-                                Success x inp' (posp `max` posq)
-                            (Success x inp' posp, Fail posq) ->
-                                Success x inp' (posp `max` posq)
-                            (rp@(Success _ _ posp), rq@(Success _ _ posq))
-                                -> if posp >= posq then rp else rq
-
-(<| ) :: Parser inp a -> Parser inp a -> Parser inp a
-Parser p <|  Parser q = Parser $ \inp ->
-                        case p inp of
-                            Fail posp ->
-                                case q inp of
-                                    Fail posq -> Fail (posp `max` posq)
-                                    Success x inp' posq ->
-                                        Success x inp' (posp `max` posq)
-                            s -> s
-
-(<!>) :: Parser inp a -> Parser inp b -> Parser inp a
-Parser p <!> Parser q = Parser $ \inp -> case q inp of
-                                             Fail _ ->
-                                                 p inp
-                                             Success _ _ pos -> Fail pos
-
-check_fails_empty :: Parser inp a -> ()
-check_fails_empty (Parser p) = case p [] of
-                                   Fail _ -> ()
-                                   _ -> error "check_fails_empty failed"
-
-nested_parse :: Parser Char String -> Parser Char a -> Parser Char a
-nested_parse (Parser p1) (Parser p2)
- = Parser
- $ \inp -> case p1 inp of
-               Fail pos -> Fail pos
-               Success inp' rem_inp pos ->
-                   case p2 $ posify inp' of
-                       Fail pos' -> Fail (pos `max` pos')
-                       Success x [] pos' -> Success x rem_inp (pos `max` pos')
-                       Success _ _ pos' -> Fail (pos `max` pos')
-
--- Derived combinators
-
-pChar :: Char -> Parser Char Char
-pChar c = pPred (c ==)
-
-pString :: String -> Parser Char String
-pString "" = pSucceed ""
-pString (c:cs) = (:) <$> pChar c <*> pString cs
-
-(<$>) :: (a -> b) -> Parser inp a -> Parser inp b
-x <$> q = pSucceed x <*> q
-
-(<$ ) :: a -> Parser inp b -> Parser inp a
-x <$  q = pSucceed x <*  q
-
-(<* ) :: Parser inp a -> Parser inp b -> Parser inp a
-p <*  q = (\x _ -> x) <$> p <*> q
-
-( |>) :: Parser inp a -> Parser inp a -> Parser inp a
-p  |> q = q <|  p
-
-pMany :: Parser inp a -> Parser inp [a]
-pMany p = check_fails_empty p `seq` ((:) <$> p <*> pMany p) <|  pSucceed []
-
-pAtLeast :: Word -> Parser inp a -> Parser inp [a]
-pAtLeast 0 p = pMany p
-pAtLeast n p = ((:) <$> p <*> pAtLeast (n-1) p)
-
-pAtMost :: Word -> Parser inp a -> Parser inp [a]
-pAtMost 0 _ = pSucceed []
-pAtMost n p = ((:) <$> p <*> pAtMost (n-1) p) <|  pSucceed []
-
-pExactly :: Word -> Parser inp a -> Parser inp [a]
-pExactly 0 _ = pSucceed []
-pExactly n p = ((:) <$> p <*> pExactly (n-1) p)
-
-pFromTo :: Word -> Word -> Parser inp a -> Parser inp [a]
-pFromTo 0 t p = pAtMost t p
-pFromTo _ 0 _ = error "Codec.MIME.String.Internal.ABNF.pFromTo: Bad arguments"
-pFromTo f t p = ((:) <$> p <*> pFromTo (f-1) (t-1) p)
-
-pOptDef :: a -> Parser inp a -> Parser inp a
-pOptDef x p = p <|  pSucceed x
-
-pMaybe :: Parser inp a -> Parser inp (Maybe a)
-pMaybe p = Just <$> p <|  pSucceed Nothing
-
diff --git a/Codec/MIME/String/Internal/Utils.hs b/Codec/MIME/String/Internal/Utils.hs
deleted file mode 100644
--- a/Codec/MIME/String/Internal/Utils.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-
-module Codec.MIME.String.Internal.Utils where
-
-import Data.Char
-
-isAsciiDigit :: Char -> Bool
-isAsciiDigit c = isAscii c && isDigit c
-
-isAsciiHexDigit :: Char -> Bool
-isAsciiHexDigit c = isAscii c && isHexDigit c
-
-isAsciiPrint :: Char -> Bool
-isAsciiPrint c = isAscii c && isPrint c
-
-isAsciiAlpha :: Char -> Bool
-isAsciiAlpha c = isAscii c && isAlpha c
-
-isAsciiAlphaNum :: Char -> Bool
-isAsciiAlphaNum c = isAscii c && isAlphaNum c
-
-asciiToLower :: Char -> Char
-asciiToLower c | isAscii c = toLower c
-               | otherwise = c
-
-asciiToUpper :: Char -> Char
-asciiToUpper c | isAscii c = toUpper c
-               | otherwise = c
-
-splits :: Int -> [a] -> [[a]]
-splits _ [] = []
-splits n xs = case splitAt n xs of
-                  (ys, zs) -> ys:splits n zs
-
-box :: a -> [a]
-box x = [x]
-
-dropFromEndWhile :: (a -> Bool) -> [a] -> [a]
-dropFromEndWhile p = foldr (\x xs -> if null xs && p x then [] else x:xs) []
-
--- We are generous about what we allow as line terminators. Any of
--- \r \n \r\n \n\r will satisfy us.
-my_lines :: String -> [String]
-my_lines xs = case get_line xs of
-                  (ys, Nothing) -> [ys]
-                  (ys, Just zs) -> ys:my_lines zs
-
-get_line :: String -> (String, Maybe String)
-get_line xs = case break is_cr_or_lf xs of
-                  (ys, z1:z2:zs)
-                   | is_cr_or_lf z2 && z1 /= z2 -> (ys, Just zs)
-                  (ys, _:zs) -> (ys, Just zs)
-                  (ys, "") -> (ys, Nothing)
-
-is_cr_or_lf :: Char -> Bool
-is_cr_or_lf '\r' = True
-is_cr_or_lf '\n' = True
-is_cr_or_lf _ = False
-
diff --git a/Codec/MIME/String/Parse.hs b/Codec/MIME/String/Parse.hs
deleted file mode 100644
--- a/Codec/MIME/String/Parse.hs
+++ /dev/null
@@ -1,318 +0,0 @@
-
-module Codec.MIME.String.Parse where
-
-import qualified Codec.Binary.Base64.String as Base64 (decode)
-import Codec.MIME.String.ContentDisposition
-      (
-       ContentDisposition(ContentDisposition), get_content_disposition,
-       DispositionType(Inline, Attachment),
-       DispositionParameter(..),
-      )
-import Codec.MIME.String.Date (get_date)
-import Codec.MIME.String.Headers
-      (
-       ContentTransferEncoding(ContentTransferEncoding),
-       get_content_transfer_encoding,
-       ContentType(ContentType), get_content_type,
-       get_content_description, get_boundary,
-       Parameter(Parameter),
-       MIMEVersion(MIMEVersion), get_mime_version,
-       Subject(Subject),
-       get_subject, get_from, get_to,
-      )
-import qualified Codec.MIME.String.QuotedPrintable as QuotedPrintable (decode)
-import Codec.MIME.String.Types
-      (
-       ParseM,
-       Header(Header, h_raw_header, h_raw_name, h_name, h_body),
-       Headers,
-       Message(Message),
-       MessageInfo(..),
-       Multipart(Multipart),
-       MessageContent(NoContent, Mixed, Alternative,
-                      Parallel, Digest, RFC822),
-       mkData, mkBody,
-       digest_content_type, ascii_text_content_type,
-      )
-import Codec.MIME.String.Internal.Utils
-
-import Codec.Text.IConv
-import Control.Monad (liftM)
-import Control.Monad.State (evalState, get, put)
-import qualified Data.ByteString.Lazy.Char8 as BS
-import Data.ByteString.Lazy.Char8 (ByteString)
-import Data.Maybe (fromMaybe)
-
-mkMessage :: MessageInfo -> ParseM MessageContent -> ParseM Message
-mkMessage mi f_mc
- = do pn <- get
-      put (pn + 1)
-      -- This is done slightly oddly so we get numbering in the natural
-      -- order, which in turn is important when looking for a part number
-      mc <- f_mc
-      return $ Message pn mi mc
-
-parse :: String -> Message
-parse msg = evalState (parse_message msg) 1
-
-parse_message :: String -> ParseM Message
-parse_message msg
- = let (headers, m_body) = parse_headers msg
-   in case get_header headers "mime-version:" get_mime_version of
-          -- We only try and be clever if the MIME version is 1.0
-          Just (MIMEVersion 1 0) ->
-              parse_mime_message ascii_text_content_type msg
-          _ ->
-              do let m_from = get_header headers "from:" get_from
-                     m_subject = get_header headers "subject:" (Just . Subject)
-                     m_to = get_header headers "to:" get_to
-                     m_date = get_header headers "date:" get_date
-                     mi = MessageInfo {
-                              mi_headers = headers,
-                              mi_from = m_from,
-                              mi_subject = m_subject,
-                              mi_to = m_to,
-                              mi_date = m_date,
-                              mi_content_description = Nothing
-                          }
-                     mc = case m_body of
-                              Just body ->
-                                  mkBody ascii_text_content_type "unknown"
-                                         (convertAsciiToUtf8 body)
-                              Nothing ->
-                                  return $ NoContent ascii_text_content_type
-                 mkMessage mi mc
-
-convertAsciiToUtf8 :: String -> String
-convertAsciiToUtf8 xs
-    = BS.unpack $ convertFuzzy Transliterate "US-ASCII" "utf8" $ BS.pack xs
-
-parse_mime_message :: ContentType -> String -> ParseM Message
-parse_mime_message def_content_type msg
- = let (headers, m_body) = parse_headers msg
-       mi = make_mime_message_info headers
-       mc = case m_body of
-                Nothing ->
-                    do let m_ct = get_header headers "content-type:"
-                                                  get_content_type
-                           content_type = fromMaybe def_content_type m_ct
-                       return $ NoContent content_type
-                Just body ->
-                    make_mime_message_content def_content_type headers body
-   in mkMessage mi mc
-
-make_mime_message_info :: Headers -> MessageInfo
-make_mime_message_info headers
- = let m_content_description = get_header headers "content-description:"
-                                               get_content_description
-       m_from = get_header headers "from:" get_from
-       m_subject = get_header headers "subject:" get_subject
-       m_to = get_header headers "to:" get_to
-       m_date = get_header headers "date:" get_date
-   in MessageInfo {
-          mi_headers = headers,
-          mi_from = m_from,
-          mi_subject = m_subject,
-          mi_to = m_to,
-          mi_date = m_date,
-          mi_content_description = m_content_description
-      }
-
-make_mime_message_content :: ContentType -> Headers -> String
-                          -> ParseM MessageContent
-make_mime_message_content def_content_type headers body
- = -- We accept illegal combinations of content type and
-   -- encoding, so just decode whatever it says
-   case m_decoded_body of
-       Nothing ->
-           mkData (Just cte) content_type filename body
-       Just decoded_body ->
-           case content_disposition of
-               ContentDisposition Attachment _ ->
-                   mkData Nothing content_type filename decoded_body
-               ContentDisposition Inline _ ->
-                   case content_type of
-                   ContentType "text" _ ps ->
-                       let charset = fromMaybe "US-ASCII"
-                                   $ lookup_param "charset" ps
-                           decoded_body' = BS.pack decoded_body
-                       in case tryConvertFuzzy Transliterate charset "utf8" decoded_body' of
-                          Just xs ->
-                              mkBody content_type filename $ BS.unpack xs
-                          Nothing ->
-                              mkData Nothing content_type filename decoded_body
-                   ContentType "multipart" st ps
-                    | Just raw_b <- lookup_param "boundary" ps,
-                      Just b <- get_boundary raw_b
-                       -> do let (preamble, parts, epilogue)
-                                     = get_parts b decoded_body
-                                 ct = case st of
-                                          "digest" -> digest_content_type
-                                          _ -> ascii_text_content_type
-                                 constr = case st of
-                                              "alternative" -> Alternative
-                                              "parallel" -> Parallel
-                                              "digest" -> Digest
-                                              _ -> Mixed
-                             ms <- mapM (parse_mime_message ct) parts
-                             return $ constr (Multipart preamble ms epilogue)
-                   ContentType "message" "rfc822" _ ->
-                       liftM (RFC822 decoded_body filename)
-                             (parse_message decoded_body)
-                   -- Anything else is treated like an
-                   -- application/octet-stream
-                   _ -> mkData Nothing content_type filename decoded_body
- where m_cd = get_header headers "content-disposition:"
-                              get_content_disposition
-       content_disposition = fromMaybe (ContentDisposition Inline []) m_cd
-       m_ct = get_header headers "content-type:"
-                              get_content_type
-       content_type = fromMaybe def_content_type m_ct
-       filename = get_filename content_disposition content_type
-       m_ce = get_header headers "content-transfer-encoding:"
-                              get_content_transfer_encoding
-       cte@(ContentTransferEncoding content_transfer_encoding)
-           = fromMaybe (ContentTransferEncoding "7bit") m_ce
-       m_decoded_body
-        = if content_transfer_encoding == "base64" then
-              Just (Base64.decode body)
-          else if content_transfer_encoding == "quoted-printable" then
-              Just (QuotedPrintable.decode $ my_lines body)
-          else if content_transfer_encoding `elem`
-                                    ["7bit", "8bit", "binary"] then
-              -- Don't worry if 8-bit data is in 7-bit transfer-encoded data
-              Just body
-          else Nothing
-
--- XXX This is rather hacky. We really want convertFuzzy to tell us if
--- the conversion is supported itself
-tryConvertFuzzy :: Fuzzy -> EncodingName -> EncodingName -> ByteString
-                -> Maybe ByteString
-tryConvertFuzzy fuzzy from_charset to_charset decoded_body =
-    case convertStrictly from_charset to_charset decoded_body of
-    Right (UnsuportedConversion {}) -> Nothing
-    _ -> Just $ convertFuzzy fuzzy from_charset to_charset decoded_body
-
-get_filename :: ContentDisposition -> ContentType -> FilePath
-get_filename (ContentDisposition _ params) (ContentType _ _ params')
- = loop params
-    where loop [] = -- Look up legacy name parameter in content type
-                    case lookup_param "name" params' of
-                        Nothing -> default_filename
-                        Just f -> sanitise f
-          loop (Filename f:_) = sanitise f
-          loop (_:ps) = loop ps
-          sanitise f = case reverse $ takeWhile ('/' /=) $ reverse f of
-                           "" -> default_filename
-                           f' -> f'
-          default_filename = "unknown"
-
-get_parts :: String -> String -> (String, [String], String)
-get_parts boundary body
- = case gps [] body of
-       (pre:parts, epi) -> (pre, parts, epi)
-       _ -> error "Parse.get_parts: Can't happen XXX"
-    where gps acc "" = ([from_acc acc], "")
-          gps acc xs
-           = case fmap (dropWhile isWSP) $ after dd_boundary
-                                         $ snd $ read_line_ending xs of
-                 Just "--" -> ([from_acc acc], "")
-                 Just ('-':'-':cs@(c:_))
-                  | is_cr_or_lf c -> ([from_acc acc], cs)
-                 Just "" -> ([from_acc acc], "")
-                 Just (c1:cs)
-                       | is_cr_or_lf c1
-                          -> let cs' = case cs of
-                                           c2:cs''
-                                            | is_cr_or_lf c2 && c1 /= c2
-                                               -> cs''
-                                           _ -> cs
-                             in case gps [] cs' of
-                                    (ps, ep) -> (from_acc acc:ps, ep)
-                 _ -> case read_line_ending xs of
-                          (le, xs') ->
-                              case break is_cr_or_lf xs' of
-                                  (ys, zs) -> gps (ys:le:acc) zs
-          from_acc acc = concat $ reverse acc
-          read_line_ending cs = case cs of
-                                    (c1:cs1)
-                                     | is_cr_or_lf c1 ->
-                                        case cs1 of
-                                            (c2:cs2)
-                                             | is_cr_or_lf c2 && c1 /= c2 ->
-                                                ([c1, c2], cs2)
-                                            _ -> ([c1], cs1)
-                                    _ -> ("", cs)
-          after "" ys = Just ys
-          after (x:xs) (y:ys)
-           | x == y = after xs ys
-           | otherwise = Nothing
-          after (_:_) "" = Nothing
-          dd_boundary = "--" ++ boundary
-          isWSP ' ' = True
-          isWSP '\t' = True
-          isWSP _ = False
-
--- Returns the value of the first parameter of the name (must be lower cased)
-lookup_param :: String -> [Parameter] -> Maybe String
-lookup_param _ [] = Nothing
-lookup_param name (Parameter n v:ps)
- | name == n = Just v
- | otherwise = lookup_param name ps
-
-get_header :: Headers -> String -> (String -> Maybe a) -> Maybe a
-get_header hs name getter
- = case filter ((name ==) . h_name) hs of
-       [h] -> getter (h_body h)
-       _ -> Nothing
-
--- We skip over leading white space lines, both for resilience and
--- because this is allowed for MIME part headers.
-parse_headers :: String -> (Headers, Maybe String)
-parse_headers msg = skip_whitespace (Just msg)
-    where skip_whitespace :: Maybe String -> ([Header], Maybe String)
-          skip_whitespace Nothing = ([], Nothing)
-          skip_whitespace (Just xs) = case get_line xs of
-                                          ([], m_zs) -> ([], m_zs)
-                                          (ys, m_zs) ->
-                                              case dropWhile isWhite ys of
-                                                  [] -> skip_whitespace m_zs
-                                                  ys' -> gather [ys'] m_zs
-          gather :: [String] -> Maybe String -> ([Header], Maybe String)
-          gather acc Nothing = ([mk_rev_header acc], Nothing)
-          gather acc (Just xs)
-              = case get_line xs of
-                    ([], m_zs) -> ([mk_rev_header acc], m_zs)
-                    (ys, m_zs)
-                     | starts_with_white ys -> gather (ys:acc) m_zs
-                     | otherwise -> let (hs, m_rest) = gather [ys] m_zs
-                                    in (mk_rev_header acc:hs, m_rest)
-          starts_with_white (c:_) = isWhite c
-          starts_with_white [] = False
-          isWhite ' ' = True
-          isWhite '\t' = True
-          isWhite _ = False
-
--- Takes the lines comprising a header (in reverse order) and constructs
--- the corresponding Header
-mk_rev_header :: [String] -> Header
-mk_rev_header = mk_header . reverse
-
--- Takes the lines comprising a header and constructs
--- the corresponding Header
-mk_header :: [String] -> Header
-mk_header xs = let unfolded = concat xs
-                   (raw_name, body) = case break ends_header unfolded of
-                                          (name, ':':val) -> (name ++ ":", val)
-                                          (name, val) -> (name, val)
-               in Header {
-                      h_raw_header = xs,
-                      h_raw_name = raw_name,
-                      h_name = map asciiToLower raw_name,
-                      h_body = body
-                  }
-    where ends_header ':' = True
-          ends_header ' ' = True
-          ends_header '\t' = True
-          ends_header _ = False
-
diff --git a/Codec/MIME/String/QuotedPrintable.hs b/Codec/MIME/String/QuotedPrintable.hs
deleted file mode 100644
--- a/Codec/MIME/String/QuotedPrintable.hs
+++ /dev/null
@@ -1,60 +0,0 @@
-
--- 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 . concat . intersperse "\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 "" = ""
-
diff --git a/Codec/MIME/String/Types.hs b/Codec/MIME/String/Types.hs
deleted file mode 100644
--- a/Codec/MIME/String/Types.hs
+++ /dev/null
@@ -1,82 +0,0 @@
-
-module Codec.MIME.String.Types
-      (
-       ParseM, PartNumber, Headers,
-       Header(Header, h_raw_header, h_raw_name, h_name, h_body),
-       Message(..), MessageInfo(..), Multipart(Multipart),
-       MessageContent(NoContent, Body, Data, Mixed, Alternative,
-                      Parallel, Digest, RFC822),
-       mkData, mkBody,
-       digest_content_type, ascii_text_content_type,
-      )
-      where
-
-import Codec.MIME.String.Date (FullDate)
-import Codec.MIME.String.Headers
-      (
-       ContentType(ContentType), ContentDescription, ContentTransferEncoding,
-       Parameter(Parameter), From, To, Subject,
-      )
-import Codec.MIME.String.Internal.Utils (my_lines)
-
-import Control.Monad.State (State)
-
-type Headers = [Header]
-data Header = Header {
-                  h_raw_header :: [String],
-                  h_raw_name :: String,
-                  h_name :: String,
-                  h_body :: String
-              }
-    deriving (Show, Read)
-
-data MessageInfo = MessageInfo {
-                       mi_headers :: Headers,
-                       mi_from :: Maybe From,
-                       mi_to :: Maybe To,
-                       mi_subject :: Maybe Subject,
-                       mi_date :: Maybe FullDate,
-                       mi_content_description :: Maybe ContentDescription
-                   }
-    deriving (Show, Read)
-data MessageContent = NoContent ContentType
-                    | Body ContentType FilePath String -- UTF-8 text
-                    | Data (Maybe ContentTransferEncoding)
-                           ContentType FilePath String -- 8-bit data
-                    | Mixed       Multipart
-                    | Alternative Multipart
-                    | Parallel    Multipart
-                    | Digest      Multipart
-                    | RFC822 String{- unparsed message-} FilePath Message
-    deriving (Show, Read)
-
-type ParseM a = State PartNumber a
-
-mkBody :: ContentType -> FilePath -> String -> ParseM MessageContent
-mkBody ct fp s = return $ Body ct fp $ unlines $ my_lines s
-
-mkData :: Maybe ContentTransferEncoding -> ContentType -> FilePath
-       -> String -> ParseM MessageContent
-mkData m_cte ct fp s = return $ Data m_cte ct fp s
-
-data Multipart = Multipart String    -- Preamble
-                           [Message] -- The messages themselves
-                           String    -- Epilogue
-    deriving (Show, Read)
-
-type PartNumber = Integer
-
-data Message = Message {
-                   m_part_number :: PartNumber,
-                   m_message_info :: MessageInfo,
-                   m_message_content :: MessageContent
-               }
-    deriving (Show, Read)
-
-ascii_text_content_type :: ContentType
-ascii_text_content_type
- = ContentType "text" "plain" [Parameter "charset" "US-ASCII"]
-
-digest_content_type :: ContentType
-digest_content_type = ContentType "message" "rfc822" []
-
diff --git a/Setup.hs b/Setup.hs
--- a/Setup.hs
+++ b/Setup.hs
@@ -1,8 +1,2 @@
-
-module Main (main) where
-
 import Distribution.Simple
-
-main :: IO ()
 main = defaultMain
-
diff --git a/mime-string.cabal b/mime-string.cabal
--- a/mime-string.cabal
+++ b/mime-string.cabal
@@ -1,21 +1,29 @@
-Name:               mime-string
-Version:            0.4
-License:            OtherLicense
-License-File:       COPYING
-Copyright:          Ian Lynagh, 2005, 2007
-Author:             Ian Lynagh
-Maintainer:         igloo@earth.li
-Stability:          experimental
-Synopsis:           MIME implementation for String's.
-Build-Type:         Simple
-Description:
+name:               mime-string
+version:            0.5
+license:            OtherLicense
+license-File:       COPYING
+author:             Ian Lynagh
+maintainer:         guillaumh@gmail.com
+synopsis:           MIME implementation for String's.
+build-type:         Simple
+description:
     Implementation of the MIME RFCs 2045-2049.
     Rather rough around the edges at the moment.
-Category:           Codec
-Build-Depends:      base, mtl, network, iconv, base64-string, old-time, bytestring
-Extensions:         PatternGuards
-Extra-source-files: "BSD3", "GPL-2"
-Exposed-modules:
+category:           Codec
+cabal-version:      >=1.10
+extra-source-files:
+    BSD3
+    GPL-2
+    ChangeLog.md
+source-repository head
+  type: darcs
+  location: http://hub.darcs.net/gh/mime-string
+
+library
+  hs-source-dirs:      src
+  build-depends:      base < 5, mtl, network, iconv, base64-string, old-time, bytestring, random, old-locale
+  default-extensions:         PatternGuards
+  exposed-modules:
     Codec.Binary.EncodingQ.String
     Codec.MIME.String
     Codec.MIME.String.ContentDisposition
@@ -26,8 +34,8 @@
     Codec.MIME.String.Parse
     Codec.MIME.String.Types
     Codec.MIME.String.QuotedPrintable
-Other-Modules:
+  Other-Modules:
     Codec.MIME.String.Internal.ABNF
     Codec.MIME.String.Internal.Utils
-GHC-Options: -Wall
-
+  GHC-Options: -Wall
+  default-language:    Haskell2010
diff --git a/src/Codec/Binary/EncodingQ/String.hs b/src/Codec/Binary/EncodingQ/String.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/Binary/EncodingQ/String.hs
@@ -0,0 +1,49 @@
+
+-- 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 "" = ""
+
diff --git a/src/Codec/MIME/String.hs b/src/Codec/MIME/String.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/MIME/String.hs
@@ -0,0 +1,21 @@
+
+module Codec.MIME.String (
+    module Codec.MIME.String.ContentDisposition,
+    module Codec.MIME.String.Date,
+    module Codec.MIME.String.EncodedWord,
+    module Codec.MIME.String.Flatten,
+    module Codec.MIME.String.Headers,
+    module Codec.MIME.String.Parse,
+    module Codec.MIME.String.QuotedPrintable,
+    module Codec.MIME.String.Types,
+ ) where
+
+import Codec.MIME.String.ContentDisposition
+import Codec.MIME.String.Date
+import Codec.MIME.String.EncodedWord
+import Codec.MIME.String.Flatten
+import Codec.MIME.String.Headers
+import Codec.MIME.String.Parse
+import Codec.MIME.String.QuotedPrintable
+import Codec.MIME.String.Types
+
diff --git a/src/Codec/MIME/String/ContentDisposition.hs b/src/Codec/MIME/String/ContentDisposition.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/MIME/String/ContentDisposition.hs
@@ -0,0 +1,116 @@
+
+-- We assume we have US-ASCII characters
+
+module Codec.MIME.String.ContentDisposition
+      (
+       ContentDisposition(ContentDisposition),
+       DispositionType(Inline, Attachment),
+       DispositionParameter(..),
+       get_content_disposition,
+      ) where
+
+import Prelude hiding ( (<*>), (<$>), (<*), (<$) )
+import Codec.MIME.String.Internal.Utils
+import Codec.MIME.String.Internal.ABNF
+      (
+       Parser, parse, nested_parse,
+       (<$>), (<$), (<*>), (<*), (<|>),
+       pEOI, pPred, pChar, pMany, pAtLeast,
+      )
+import Codec.MIME.String.Date (FullDate, p_date_time)
+import Codec.MIME.String.Headers
+      (
+       Parameter, p_parameter,
+       cws, p_ci_string, p_extension_token, p_value, p_quoted_string,
+      )
+
+data ContentDisposition = ContentDisposition DispositionType
+                                             [DispositionParameter]
+    deriving (Show, Read)
+
+data DispositionType = Inline | Attachment
+    deriving (Show, Read)
+
+data DispositionParameter = Filename String
+                          | CreationDate FullDate
+                          | ModificationDate FullDate
+                          | ReadDate FullDate
+                          | Size Integer
+                          | DispositionParameter Parameter
+    deriving (Show, Read)
+
+get_content_disposition :: String -> Maybe ContentDisposition
+get_content_disposition xs
+ = case parse ph_content_disposition xs of
+       Left cd -> Just cd
+       Right _ -> Nothing
+
+ph_content_disposition :: Parser Char ContentDisposition
+ph_content_disposition = ContentDisposition
+                     <$  cws
+                     <*> p_disposition_type
+                     <*> pMany (    id
+                                <$  cws
+                                <*  pChar ';'
+                                <*  cws
+                                <*> p_disposition_parm)
+                     <*  cws
+                     <*  pEOI
+
+p_disposition_type :: Parser Char DispositionType
+p_disposition_type = Inline <$  p_ci_string "inline"
+                 <|> Attachment <$  p_ci_string "attachment"
+                 <|> Attachment <$  p_extension_token
+
+p_disposition_parm :: Parser Char DispositionParameter
+p_disposition_parm = p_filename_parm
+                 <|> p_creation_date_parm
+                 <|> p_modification_date_parm
+                 <|> p_read_date_parm
+                 <|> p_size_parm
+                 <|> DispositionParameter <$> p_parameter
+
+p_filename_parm :: Parser Char DispositionParameter
+p_filename_parm = Filename
+              <$  p_ci_string "filename"
+              <*  cws
+              <*  pChar '='
+              <*  cws
+              <*> p_value
+
+p_creation_date_parm :: Parser Char DispositionParameter
+p_creation_date_parm = CreationDate
+                   <$  p_ci_string "creation-date"
+                   <*  cws
+                   <*  pChar '='
+                   <*  cws
+                   <*> p_quoted_date_time
+
+p_modification_date_parm :: Parser Char DispositionParameter
+p_modification_date_parm = ModificationDate
+                       <$  p_ci_string "modification-date"
+                       <*  cws
+                       <*  pChar '='
+                       <*  cws
+                       <*> p_quoted_date_time
+
+p_read_date_parm :: Parser Char DispositionParameter
+p_read_date_parm = ReadDate
+               <$  p_ci_string "read-date"
+               <*  cws
+               <*  pChar '='
+               <*  cws
+               <*> p_quoted_date_time
+
+p_size_parm :: Parser Char DispositionParameter
+p_size_parm = (Size . read)
+          <$  p_ci_string "size"
+          <*  cws
+          <*  pChar '='
+          <*  cws
+          <*> pAtLeast 1 (pPred isAsciiDigit)
+
+p_quoted_date_time :: Parser Char FullDate
+p_quoted_date_time = nested_parse p_quoted_string
+                                  (id <$> p_date_time <*  pEOI)
+
diff --git a/src/Codec/MIME/String/Date.hs b/src/Codec/MIME/String/Date.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/MIME/String/Date.hs
@@ -0,0 +1,242 @@
+
+module Codec.MIME.String.Date
+      (FullDate(FullDate), DOW(..), Date(Date), Day, Month(..), Year,
+       Time(Time), Zone, TimeOfDay(TimeOfDay), Hour, Minute, Second,
+       show_full_date, show_mbox_full_date, get_date, p_date_time,
+       get_current_date, epochDate,
+      )
+      where
+
+import Prelude hiding ( (<*>), (<$>), (<*), (<$) )
+import Codec.MIME.String.Internal.ABNF
+      (
+       Parser, parse,
+       (<$>), (<$), (<*>), (<*), (<|>),
+       pEOI, pPred, pChar, pAtLeast, pFromTo, pExactly, pMaybe,
+      )
+import Codec.MIME.String.Headers (cws, p_ci_string)
+import Codec.MIME.String.Internal.Utils
+
+import Control.Monad.Trans (MonadIO, liftIO)
+import System.Time hiding (Month(May), Day)
+import qualified System.Time as Time (Month(May))
+
+data FullDate = FullDate (Maybe DOW) Date Time
+    deriving (Show, Read)
+
+data DOW = Mon | Tue | Wed | Thu | Fri | Sat | Sun
+    deriving (Show, Read)
+
+data Date = Date Day Month Year
+    deriving (Show, Read)
+type Day = Int
+data Month = Jan | Feb | Mar | Apr | May | Jun
+           | Jul | Aug | Sep | Oct | Nov | Dec
+    deriving (Show, Read)
+type Year = Int
+
+data Time = Time TimeOfDay Zone
+    deriving (Show, Read)
+type Zone = Int
+data TimeOfDay = TimeOfDay Hour Minute (Maybe Second)
+    deriving (Show, Read)
+type Hour = Int
+type Minute = Int
+type Second = Int
+
+epochDate :: FullDate
+epochDate = FullDate (Just Thu) (Date 01 Jan 1970)
+                     (Time (TimeOfDay 0 0 (Just 0)) 0)
+
+------------------------ Showing
+
+show_full_date :: FullDate -> String
+show_full_date (FullDate m_dow date time)
+ = shown_dow ++ show_date date ++ " " ++ show_time time
+    where shown_dow = case m_dow of
+                          Nothing -> ""
+                          Just dow -> show dow ++ ", "
+
+show_date :: Date -> String
+show_date (Date day month year)
+  = show_int 2 day ++ " " ++ show month ++ " " ++ show year
+
+show_time :: Time -> String
+show_time (Time tod zone) = show_tod tod ++ " " ++ show_zone zone
+
+show_tod :: TimeOfDay -> String
+show_tod (TimeOfDay h m m_s)
+ = show_int 2 h ++ ":" ++ show_int 2 m ++ shown_s
+    where shown_s = case m_s of
+                        Nothing -> ""
+                        Just s -> ":" ++ show_int 2 s
+
+show_zone :: Zone -> String
+show_zone z = (if z < 0 then '-' else '+'):show_int 4 (abs z)
+
+show_int :: Int -> Int -> String
+show_int digits int = let s = show int
+                      in replicate (digits - length s) '0' ++ s
+
+-- Showing for the "From " line in mboxes is sadly a slightly different format
+
+show_mbox_full_date :: FullDate -> String
+show_mbox_full_date (FullDate m_dow (Date day month year) (Time tod _))
+ = shown_dow ++ show month ++ " " ++ show_int 2 day ++ " " ++
+   show_tod tod ++ " " ++ show year
+    where shown_dow = case m_dow of
+                          Nothing -> ""
+                          Just dow -> show dow ++ " "
+
+------------------------ Parsing
+
+get_date :: String -> Maybe FullDate
+get_date xs
+ = case parse ph_date xs of
+       Left f -> Just f
+       Right _ -> Nothing
+
+ph_date :: Parser Char FullDate
+ph_date = id
+      <$  cws
+      <*> p_date_time
+      <*  cws
+      <*  pEOI
+
+p_date_time :: Parser Char FullDate
+p_date_time = FullDate
+          <$> pMaybe (    id
+                      <$> p_dow
+                      <*  cws
+                      <*  pChar ','
+                      <*  cws)
+          <*> p_date
+          <*  cws
+          <*> p_time
+
+p_dow :: Parser Char DOW
+p_dow = Mon <$  p_ci_string "Mon"
+    <|> Tue <$  p_ci_string "Tue"
+    <|> Wed <$  p_ci_string "Wed"
+    <|> Thu <$  p_ci_string "Thu"
+    <|> Fri <$  p_ci_string "Fri"
+    <|> Sat <$  p_ci_string "Sat"
+    <|> Sun <$  p_ci_string "Sun"
+
+p_date :: Parser Char Date
+p_date = Date
+     <$> p_day
+     <*  cws
+     <*> p_month
+     <*  cws
+     <*> p_year
+
+-- obs-year merged in
+p_year :: Parser Char Year
+p_year = (\ds -> let y = read ds
+                 in case ds of
+                        [_, _, _] -> 2000 + y
+                        [_, _]
+                         | y < 50 -> 1900 + y
+                         | otherwise -> 2000 + y
+                        _ -> y)
+     <$> pAtLeast 2 (pPred isAsciiDigit)
+
+p_month :: Parser Char Month
+p_month = Jan <$  p_ci_string "Jan"
+      <|> Feb <$  p_ci_string "Feb"
+      <|> Mar <$  p_ci_string "Mar"
+      <|> Apr <$  p_ci_string "Apr"
+      <|> May <$  p_ci_string "May"
+      <|> Jun <$  p_ci_string "Jun"
+      <|> Jul <$  p_ci_string "Jul"
+      <|> Aug <$  p_ci_string "Aug"
+      <|> Sep <$  p_ci_string "Sep"
+      <|> Oct <$  p_ci_string "Oct"
+      <|> Nov <$  p_ci_string "Nov"
+      <|> Dec <$  p_ci_string "Dec"
+
+p_day :: Parser Char Day
+p_day = read <$> pFromTo 1 2 (pPred isAsciiDigit)
+
+p_time :: Parser Char Time
+p_time = Time
+     <$> p_time_of_day
+     <*  cws
+     <*> p_zone
+
+p_time_of_day :: Parser Char TimeOfDay
+p_time_of_day = TimeOfDay
+            <$> p_hour
+            <*  cws
+            <*  pChar ':'
+            <*  cws
+            <*> p_minute
+            <*> pMaybe (    id
+                        <$  cws
+                        <*  pChar ':'
+                        <*  cws
+                        <*> p_second)
+
+p_hour :: Parser Char Hour
+p_hour = read <$> pExactly 2 (pPred isAsciiDigit)
+
+p_minute :: Parser Char Minute
+p_minute = read <$> pExactly 2 (pPred isAsciiDigit)
+
+p_second :: Parser Char Second
+p_second = read <$> pExactly 2 (pPred isAsciiDigit)
+
+p_zone :: Parser Char Zone
+p_zone = (\f n -> f $ read n)
+     <$> (id <$  pChar '+' <|> negate <$  pChar '-')
+     <*> pExactly 4 (pPred isAsciiDigit)
+ <|> p_obs_zone
+
+p_obs_zone :: Parser Char Zone
+p_obs_zone = 0 <$  p_ci_string "UT"
+         <|> 0 <$  p_ci_string "GMT"
+         <|> -500 <$  p_ci_string "EST"
+         <|> -400 <$  p_ci_string "EDT"
+         <|> -600 <$  p_ci_string "CST"
+         <|> -500 <$  p_ci_string "CDT"
+         <|> -700 <$  p_ci_string "MST"
+         <|> -600 <$  p_ci_string "MDT"
+         <|> -800 <$  p_ci_string "PST"
+         <|> -700 <$  p_ci_string "PDT"
+         -- Military time zones. Strictly we shouldn't accept [jJ]
+         -- but no harm done.
+         -- 'they SHOULD all be considered equivalent to "-0000"' as
+         -- RFC 822 defined them incorrectly.
+         <|> 0 <$  pPred isAsciiAlpha
+
+get_current_date :: MonadIO m => m FullDate
+get_current_date
+ = do clt <- liftIO getClockTime
+      cat <- liftIO $ toCalendarTime clt
+      let fd = FullDate (Just dow) date time
+          get_dow Sunday    = Sun
+          get_dow Monday    = Mon
+          get_dow Tuesday   = Tue
+          get_dow Wednesday = Wed
+          get_dow Thursday  = Thu
+          get_dow Friday    = Fri
+          get_dow Saturday  = Sat
+          get_month January   = Jan
+          get_month February  = Feb
+          get_month March     = Mar
+          get_month April     = Apr
+          get_month Time.May  = May
+          get_month June      = Jun
+          get_month July      = Jul
+          get_month August    = Aug
+          get_month September = Sep
+          get_month October   = Oct
+          get_month November  = Nov
+          get_month December  = Dec
+          dow = get_dow (ctWDay cat)
+          date = Date (ctDay cat) (get_month (ctMonth cat)) (ctYear cat)
+          time = Time tod (ctTZ cat `div` 36)
+          tod = TimeOfDay (ctHour cat) (ctMin cat) (Just (ctSec cat))
+      return fd
+
diff --git a/src/Codec/MIME/String/EncodedWord.hs b/src/Codec/MIME/String/EncodedWord.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/MIME/String/EncodedWord.hs
@@ -0,0 +1,8 @@
+
+module Codec.MIME.String.EncodedWord (base64_encode) where
+
+import Codec.Binary.Base64.String (encode)
+
+base64_encode :: String -> String -> String
+base64_encode charset xs = "=?" ++ charset ++ "?B?" ++ encode xs ++ "?="
+
diff --git a/src/Codec/MIME/String/Flatten.hs b/src/Codec/MIME/String/Flatten.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/MIME/String/Flatten.hs
@@ -0,0 +1,144 @@
+
+module Codec.MIME.String.Flatten
+    (flatten, Attachments, Attachment)
+    where
+
+import qualified Codec.Binary.Base64.String as Base64 (encode)
+import qualified Codec.MIME.String.QuotedPrintable as QP (encode)
+import Codec.MIME.String.Headers
+import Codec.MIME.String.Internal.Utils
+import Codec.MIME.String.Types
+
+{-
+XXX For message IDs:
+import Network.BSD (getHostName)
+import System.Locale (defaultTimeLocale)
+import System.Random (randomIO)
+import System.Time (getClockTime, toCalendarTime, formatCalendarTime)
+-}
+
+type Attachments = [Attachment]
+type Attachment = (String, FilePath, Maybe ContentType)
+
+-- XXX This should be rewritten in a more compositional way!
+flatten :: Headers -> String -> Maybe String -> Attachments -> IO String
+flatten headers body maybeHtmlBody attachments
+ = do -- XXX Could add one of one isn't already found? msgid <- mk_msgid
+      let -- XXX This (\n) could be prettier - check llengths of bits
+          alternativeBoundary = "=:A"
+          alternativePartStart = "\n--" ++ alternativeBoundary ++ "\n"
+          alternativePartsEnd  = "\n--" ++ alternativeBoundary ++ "--\n"
+          mixedBoundary = "=:M"
+          mixedPartStart = "\n--" ++ mixedBoundary ++ "\n"
+          mixedPartsEnd  = "\n--" ++ mixedBoundary ++ "--\n"
+          common_headers = unlines (concatMap h_raw_header headers)
+                        ++ "MIME-Version: 1.0\n"
+          text_content_headers = unlines [
+              "Content-type: text/plain; charset=utf-8",
+              "Content-transfer-encoding: quoted-printable",
+              "Content-Disposition: inline"]
+          html_content_headers = unlines [
+              "Content-type: text/html; charset=utf-8",
+              "Content-transfer-encoding: quoted-printable",
+              "Content-Disposition: inline"]
+          -- This is overly paranoid
+          safe_char c = isAsciiAlphaNum c || (c `elem` " .-_")
+          mime_attachment (a, fn, mct)
+              = let -- XXX showParam and ct should do some sanity checking
+                    -- of the values they are passed
+                    showParam (Parameter k v) = "; " ++ k ++ "=\"" ++ v ++ "\""
+                    ct = case mct of
+                         Just (ContentType x y ps) ->
+                             "Content-type: " ++ x ++ "/" ++ y
+                          ++ concatMap showParam ps ++ "\n"
+                         Nothing -> "Content-type: application/octet-stream\n"
+                in mixedPartStart
+                ++ ct
+                ++ "Content-transfer-encoding: base64\n"
+                ++ "Content-Disposition: attachment; filename=\""
+                       ++ (case reverse $ filter safe_char
+                                        $ takeWhile ('/' /=)
+                                        $ reverse fn of
+                               [] -> "unknown"
+                               fn' -> fn')
+                       ++ "\"\n"
+                ++ "\n"
+                ++ Base64.encode a
+          msg = if single_part
+                then case maybeHtmlBody of
+                     Nothing ->
+                         common_headers
+                      ++ text_content_headers
+                      ++ "\n"
+                      ++ QP.encode (my_lines body)
+                     Just htmlBody ->
+                         common_headers
+                      ++ "Content-type: multipart/alternative; boundary=\""
+                                             ++ alternativeBoundary ++ "\"\n"
+                      ++ "\n"
+                      ++ "This is a multi-part message in MIME format.\n"
+                      ++ alternativePartStart
+                      ++ text_content_headers
+                      ++ "\n"
+                      ++ QP.encode (my_lines body)
+                      ++ alternativePartStart
+                      ++ html_content_headers
+                      ++ "\n"
+                      ++ QP.encode (my_lines htmlBody)
+                      ++ alternativePartsEnd
+                else case maybeHtmlBody of
+                     Nothing ->
+                         common_headers
+                      ++ "Content-type: multipart/mixed; boundary=\""
+                                             ++ mixedBoundary ++ "\"\n"
+                      ++ "\n"
+                      ++ "This is a multi-part message in MIME format.\n"
+                      ++ mixedPartStart
+                      ++ text_content_headers
+                      ++ "\n"
+                      ++ QP.encode (my_lines body)
+                      ++ concatMap mime_attachment attachments
+                      ++ mixedPartsEnd
+                     Just htmlBody ->
+                         common_headers
+                      ++ "Content-type: multipart/mixed; boundary=\""
+                                                    ++ mixedBoundary ++ "\"\n"
+                      ++ "\n"
+                      ++ "This is a multi-part message in MIME format.\n"
+                      ++ mixedPartStart
+                      -- Start of the body
+                      ++ "Content-type: multipart/alternative; boundary=\""
+                                             ++ alternativeBoundary ++ "\"\n"
+                      ++ "\n"
+                      ++ alternativePartStart
+                      ++ text_content_headers
+                      ++ "\n"
+                      ++ QP.encode (my_lines body)
+                      ++ alternativePartStart
+                      ++ html_content_headers
+                      ++ "\n"
+                      ++ QP.encode (my_lines htmlBody)
+                      ++ alternativePartsEnd
+                      -- End of the body
+                      ++ concatMap mime_attachment attachments
+                      ++ mixedPartsEnd
+      return msg
+    where single_part = null attachments
+
+-- XXX The IO calls used to use liftIOErr. We could use something similar
+-- but require we are called in a MonadError m?
+-- XXX We should possibly be including a program name
+{-
+mk_msgid :: IO String
+mk_msgid
+ = do hostname <- getHostName
+      clock_time <- getClockTime
+      calendar_time <- toCalendarTime clock_time
+      r <- randomIO
+      let timestamp = formatCalendarTime defaultTimeLocale
+                                         "%Y%m%d%H%M%S" calendar_time
+          lhs = concat $ intersperse "."
+                [timestamp, show (r :: Int)]
+      return (lhs ++ "@" ++ hostname)
+-}
+
diff --git a/src/Codec/MIME/String/Headers.hs b/src/Codec/MIME/String/Headers.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/MIME/String/Headers.hs
@@ -0,0 +1,635 @@
+
+-- We assume we have US-ASCII characters
+
+module Codec.MIME.String.Headers
+      (
+       Domain(Domain, LiteralDomain),
+       Mailbox(Mailbox),
+       RoutedEmailAddress(RoutedEmailAddress, NormalEmailAddress),
+       EmailAddress(EmailAddress), get_addr_spec,
+       Address(Address, Group),
+       ContentType(ContentType), get_content_type,
+       ContentDescription(ContentDescription),
+       get_content_description,
+       ContentTransferEncoding(ContentTransferEncoding),
+       get_content_transfer_encoding,
+       ContentID(ContentID), get_content_id,
+       MessageID(MessageID),
+       MIMEVersion(MIMEVersion), get_mime_version,
+       Parameter(Parameter), p_parameter,
+       From(From), To(To), Subject(Subject),
+       get_from,   get_to, get_subject,
+       get_boundary, p_extension_token, p_value, p_quoted_string,
+       cws, p_ci_string,
+      )
+      where
+
+import Prelude hiding ( (<*>), (<$>), (<*), (<$) )
+import Codec.MIME.String.Internal.ABNF
+      (
+       Parser, parse, pSucceed, pFail,
+       (<$>), (<$), (<*>), (<*), (<|>), (<|), (<!>),
+       pEOI, pPred, pChar, pMany, pAtLeast, pMaybe, pOptDef, pString,
+      )
+import qualified Codec.Binary.Base64.String as Base64 (decode)
+import qualified Codec.Binary.EncodingQ.String as EncodingQ (decode)
+import Codec.MIME.String.Internal.Utils
+
+import Codec.Text.IConv
+import qualified Data.ByteString.Lazy.Char8 as BS
+import Data.Char
+import Data.List
+
+-----------------------
+-- Utils
+
+ignore :: Parser inp a -> Parser inp ()
+ignore p = () <$  p
+
+boxp :: Parser inp a -> Parser inp [a]
+boxp p = box <$> p
+
+-----------------------
+-- RFC 2234
+
+p_CTL :: Parser Char Char
+p_CTL = pPred (\c -> ord c < 32 || ord c == 127)
+
+p_SP :: Parser Char Char
+p_SP = pChar ' '
+
+p_HTAB :: Parser Char Char
+p_HTAB = pChar '\t'
+
+p_WSP :: Parser Char Char
+p_WSP = p_SP <|> p_HTAB
+
+-----------------------
+-- RFC 2822
+
+-- Case insensitive strings, written "Foo"
+p_ci_string :: String -> Parser Char String
+p_ci_string s = s <$  f s
+    where f "" = pSucceed ()
+          f (c:cs) = let p = if isAsciiAlpha c
+                             then pChar (toLower c) <|  pChar (toUpper c)
+                             else pChar c
+                     in () <$  p <*  f cs
+
+p_NO_WS_CTL :: Parser Char Char
+p_NO_WS_CTL = pPred (\c -> let o = ord c in 1 <= o && o <= 8
+                                         || o == 11
+                                         || o == 12
+                                         || 14 <= o && o <= 31
+                                         || o == 127)
+
+-- If we follow the spec precisely then we get pMany (pMany), and hence
+-- non-termination, so we merge the definition of p_obs_text in.
+p_text :: Parser Char String
+p_text = concat
+     <$> pMany (
+                    p_encoded_words
+                <|  boxp (pPred (\c -> let o = ord c in 0 <= o && o <= 9
+                                                     || o == 11
+                                                     || o == 12
+                                                     || 14 <= o && o <= 127))
+               )
+
+-- We are lax about checking they have any necessary surrounding
+-- whitespace
+p_encoded_words :: Parser Char String
+p_encoded_words = (\x xs -> x ++ concat xs)
+              <$> p_encoded_word
+              <*> pMany (id <$  cws <*> p_encoded_word)
+
+-- XXX What happens if iconv doesn't understand the charset "cs"?
+p_encoded_word :: Parser Char String
+p_encoded_word = (\cs dec text -> BS.unpack $ convertFuzzy Transliterate cs "utf8" $ BS.pack $ dec text)
+             <$  pString "=?"
+             <*> p_charset
+             <*  pChar '?'
+             <*> p_encoding
+             <*  pChar '?'
+             <*> p_encoded_text
+             <*  pString "?="
+
+-- token definition inlined as they use a different one to p_token.
+p_charset :: Parser Char String
+p_charset = pAtLeast 1 (pPred isAscii <!> (p_SP <|> p_CTL <|> p_especials))
+
+p_especials :: Parser Char Char
+p_especials = pPred (`elem` "()<>@,;:\\\"/[]?.=")
+
+-- This is much stricter than specified, but if it's not [qQbB] then
+-- we'd want to fall back to showing it as a string anyway.
+p_encoding :: Parser Char (String -> String)
+p_encoding = EncodingQ.decode <$  (pChar 'Q' <|> pChar 'q')
+         <|> Base64.decode <$  (pChar 'B' <|> pChar 'b')
+
+p_encoded_text :: Parser Char String
+p_encoded_text = pMany (pPred (\c -> isAsciiPrint c && c /= '?' && c /= ' '))
+
+p_quoted_pair :: Parser Char String
+p_quoted_pair = id <$  pChar '\\' <*> p_text <|> boxp p_obs_qp
+
+p_obs_qp :: Parser Char Char
+p_obs_qp = id <$  pChar '\\' <*> pPred isAscii
+
+-- Done differently as the newlines are already gone
+p_FWS :: Parser Char String
+p_FWS = pMany p_WSP
+
+p_ctext :: Parser Char Char
+p_ctext = p_NO_WS_CTL
+      <|> pPred (\c -> let o = ord c in 33 <= o && o <= 39
+                                     || 42 <= o && o <= 91
+                                     || 93 <= o && o <= 126)
+
+p_ccontent :: Parser Char ()
+p_ccontent = ignore p_ctext <|> ignore p_quoted_pair <|> p_comment
+
+p_comment :: Parser Char ()
+p_comment = ()
+        <$  pChar '('
+        <*  pMany (() <$  pMany p_NO_WS_CTL <*  p_ccontent)
+        <*  pMany p_NO_WS_CTL
+        <*  pChar ')'
+
+-- We might want to keep the result. If we do then we also need to
+-- handle encoded words properly.
+-- This isn't quite CFWS as we need to be able to accept "1.0"
+-- as a MIME version with cws between all the characters.
+-- Also, we've already removed all the newlines in the headers.
+cws :: Parser Char ()
+cws = ignore $ pMany (ignore (pAtLeast 1 p_WSP) <|> p_comment)
+
+p_qtext :: Parser Char Char
+p_qtext = p_NO_WS_CTL
+      <|> pPred (\c -> let o = ord c in o == 33
+                                     || 35 <= o && o <= 91
+                                     || 93 <= o && o <= 126)
+
+p_qcontent :: Parser Char String
+p_qcontent = boxp p_qtext
+         <|> p_quoted_pair
+
+p_quoted_string :: Parser Char String
+p_quoted_string = (++)
+              <$  cws
+              <*  pChar '"'
+              <*> (concat <$> pMany ((++) <$> pOptDef "" p_FWS <*> p_qcontent))
+              <*> pOptDef "" p_FWS
+              <*  pChar '"'
+
+p_dcontent :: Parser Char String
+p_dcontent = boxp p_dtext <|> p_quoted_pair
+
+p_dtext :: Parser Char Char
+p_dtext = p_NO_WS_CTL
+      <|> pPred (\c -> let o = ord c in 33 <= o && o <= 90
+                                     || 94 <= o && o <= 126)
+
+data MessageID = MessageID String Domain
+    deriving (Show, Read)
+
+p_msg_id :: Parser Char MessageID
+p_msg_id = MessageID
+       <$  cws
+       <*  pChar '<'
+       <*> p_id_left
+       <*  pChar '@'
+       <*> p_id_right
+       <*  pChar '>'
+       <*  cws
+
+p_atom :: Parser Char String
+p_atom = id
+     <$  cws
+     <*> pAtLeast 1 p_atext
+     <*  cws
+
+p_atext :: Parser Char Char
+p_atext = pPred (\c -> isAsciiAlphaNum c || c `elem` "!#$%&'+-/=?^_`{|}~")
+
+p_dot_atom :: Parser Char String
+p_dot_atom = id 
+         <$  cws
+         <*> p_dot_atom_text
+         <*  cws
+
+p_word :: Parser Char String
+p_word = p_atom <|> p_quoted_string
+
+-- This incorporates obs-phrase
+p_phrase :: Parser Char [String]
+p_phrase = (:)
+       <$> (p_encoded_words <|  p_word)
+       <*> pMany (id <$  cws <*> (p_encoded_words <|  p_word <|  pString "."))
+   <|> boxp p_quoted_string
+
+p_dot_atom_text :: Parser Char String
+p_dot_atom_text = (\x xs -> x ++ concat xs)
+              <$> pAtLeast 1 p_atext
+              <*> pMany ((:) <$> pChar '.' <*> pAtLeast 1 p_atext)
+
+p_id_left :: Parser Char String
+p_id_left = p_dot_atom_text <|> p_no_fold_quote <|> p_obs_id_left
+
+p_id_right :: Parser Char Domain
+p_id_right = Domain <$> p_dot_atom_text
+         <|> p_no_fold_literal
+         <|> p_obs_id_right
+
+p_obs_id_left :: Parser Char String
+p_obs_id_left = p_local_part
+
+p_local_part :: Parser Char String
+p_local_part = p_dot_atom <|> p_quoted_string <|> p_obs_local_part
+
+p_obs_local_part :: Parser Char String
+p_obs_local_part = (\x xs -> x ++ concat xs)
+               <$> p_word
+               <*> pMany ((:) <$> pChar '.' <*> p_word)
+
+p_domain :: Parser Char Domain
+p_domain = Domain <$> p_dot_atom <|> p_domain_literal <|> p_obs_domain
+
+p_domain_literal :: Parser Char Domain
+p_domain_literal = (LiteralDomain . concat)
+               <$  cws
+               <*  pChar '['
+               <*> pMany (    id
+                          <$  p_FWS
+                          <*> p_dcontent)
+               <*  p_FWS
+               <*  pChar ']'
+               <*  cws
+
+p_obs_domain :: Parser Char Domain
+p_obs_domain = (\x xs -> Domain (x ++ concat xs))
+           <$> p_atom
+           <*> pMany ((:) <$> pChar '.' <*> p_atom)
+
+p_obs_id_right :: Parser Char Domain
+p_obs_id_right = p_domain
+
+p_no_fold_quote :: Parser Char String
+p_no_fold_quote = concat
+              <$  pChar '"'
+              <*> pMany (boxp p_qtext <|> p_quoted_pair)
+              <*  pChar '"'
+
+data Domain = Domain String | LiteralDomain String
+    deriving (Show, Read, Eq)
+
+p_no_fold_literal :: Parser Char Domain
+p_no_fold_literal = LiteralDomain . concat
+                <$  pChar '['
+                <*> pMany (boxp p_dtext <|> p_quoted_pair)
+                <*  pChar ']'
+
+newtype Subject = Subject String
+    deriving (Show, Read)
+
+get_subject :: String -> Maybe Subject
+get_subject xs
+ = case parse ph_subject xs of
+       Left cd -> Just cd
+       Right _ -> Nothing
+
+-- This is actually the RFC822 definition, as otherwise things get very
+-- confusing.
+-- Would be pMany, but p_text already does that for us
+ph_subject :: Parser Char Subject
+ph_subject = Subject <$> p_text <*  pEOI
+
+newtype From = From [Mailbox]
+    deriving (Show, Read, Eq)
+
+get_from :: String -> Maybe From
+get_from xs
+ = case parse ph_from xs of
+       Left f -> Just f
+       Right _ -> Nothing
+
+ph_from :: Parser Char From
+ph_from = From <$  cws <*> p_mailbox_list <*  cws <*  pEOI
+
+newtype To = To [Address]
+    deriving (Show, Read)
+
+data Address = Address Mailbox
+             | Group String [Mailbox]
+    deriving (Show, Read)
+
+get_to :: String -> Maybe To
+get_to xs
+ = case parse ph_to xs of
+       Left t -> Just t
+       Right _ -> Nothing
+
+ph_to :: Parser Char To
+ph_to = To <$  cws <*> p_address_list <*  cws <*  pEOI
+
+-- obs-addr-list merged in
+p_address_list :: Parser Char [Address]
+p_address_list = (:)
+             <$  pMany (() <$  pChar ',' <*  cws)
+             <*> p_address
+             <*> pMany (    id
+                        <$  pAtLeast 1 (() <$  cws <*  pChar ',')
+                        <*  cws
+                        <*> p_address)
+             <*  pMany (() <$  cws <*  pChar ',')
+
+p_address :: Parser Char Address
+p_address = Address <$> p_mailbox
+        <|> p_group
+
+p_group :: Parser Char Address
+p_group = Group
+      <$> p_display_name 
+      <*  cws
+      <*  pChar ':'
+      <*  cws
+      <*> pOptDef [] p_mailbox_list
+      <*  cws
+      <*  pChar ';'
+
+-- obs-mbox-list merged in
+p_mailbox_list :: Parser Char [Mailbox]
+p_mailbox_list = (:)
+             <$  pMany (() <$  pChar ',' <*  cws)
+             <*> p_mailbox
+             <*> pMany (    id
+                        <$  pAtLeast 1 (() <$  cws <*  pChar ',')
+                        <*  cws
+                        <*> p_mailbox)
+             <*  pMany (() <$  cws <*  pChar ',')
+
+data Mailbox = Mailbox (Maybe String) RoutedEmailAddress
+    deriving (Show, Read, Eq)
+
+p_mailbox :: Parser Char Mailbox
+p_mailbox = p_name_addr
+        <|> (Mailbox Nothing . NormalEmailAddress) <$> p_addr_spec
+
+p_name_addr :: Parser Char Mailbox
+p_name_addr = Mailbox
+          <$> pMaybe p_display_name
+          <*  cws
+          <*> p_angle_addr
+
+data EmailAddress = EmailAddress String Domain
+    deriving (Show, Read, Eq)
+
+data RoutedEmailAddress = NormalEmailAddress          EmailAddress
+                        | RoutedEmailAddress [Domain] EmailAddress
+    deriving (Show, Read, Eq)
+
+p_angle_addr :: Parser Char RoutedEmailAddress
+p_angle_addr = ($)
+           <$  pChar '<'
+           <*  cws
+           -- This next makes us also satisfy obs-angle-addr
+           <*> pOptDef NormalEmailAddress
+                       (RoutedEmailAddress <$> p_obs_route <*  cws)
+           <*> p_addr_spec
+           <*  cws
+           <*  pChar '>'
+
+get_addr_spec :: String -> Maybe EmailAddress
+get_addr_spec xs
+ = case parse p_addr_spec xs of
+       Left e -> Just e
+       Right _ -> Nothing
+
+p_addr_spec :: Parser Char EmailAddress
+p_addr_spec  = EmailAddress
+           <$> p_local_part
+           <*  cws
+           <*  pChar '@'
+           <*  cws
+           <*> p_domain
+
+p_display_name :: Parser Char String
+p_display_name = (concat . intersperse " ") <$> p_phrase
+
+p_obs_route :: Parser Char [Domain]
+p_obs_route = id <$> p_obs_domain_list <*  pChar ':'
+
+p_obs_domain_list :: Parser Char [Domain]
+p_obs_domain_list = (:)
+                <$  pChar '@'
+                <*  cws
+                <*> p_domain
+                <*> pMany (    id
+                           <$  pMaybe (() <$  cws <*  pChar ',')
+                           <*  cws
+                           <*  pChar '@'
+                           <*  cws
+                           <*> p_domain)
+
+-----------------------
+-- RFC 2045
+
+data MIMEVersion = MIMEVersion Integer Integer
+    deriving (Show, Read)
+
+get_mime_version :: String -> Maybe MIMEVersion
+get_mime_version xs = case parse ph_mime_version xs of
+                          Left ct -> Just ct
+                          Right _ -> Nothing
+
+ph_mime_version :: Parser Char MIMEVersion
+ph_mime_version = MIMEVersion
+              <$  cws
+              <*> (read <$> pMany (pPred isAsciiDigit))
+              <*  cws
+              <*  pChar '.'
+              <*  cws
+              <*> (read <$> pMany (pPred isAsciiDigit))
+              <*  cws
+              <*  pEOI
+
+data ContentType = ContentType String -- Case insensitive: lower-cased
+                               String -- Case insensitive: lower-cased
+                               [Parameter]
+    deriving (Show, Read)
+data Parameter = Parameter String -- Case insensitive: lower-cased
+                           String
+    deriving (Show, Read)
+
+get_content_type :: String -> Maybe ContentType
+get_content_type xs = case parse ph_content_type xs of
+                          Left ct -> Just ct
+                          Right _ -> Nothing
+
+ph_content_type :: Parser Char ContentType
+ph_content_type = ContentType
+              <$  cws
+              <*> p_type
+              <*  cws
+              <*  pChar '/'
+              <*  cws
+              <*> p_subtype
+              <*> pMany (id
+                     <$  cws
+                     <*  pChar ';'
+                     <*  cws
+                     <*> p_parameter)
+              <*  cws
+              <*  pEOI
+
+
+-- For type and subtypes, allow anything that matches a regexp that
+-- subsumes the currently allowed values
+p_type :: Parser Char String
+p_type = pAtLeast 1 (pPred (\c -> isAsciiAlphaNum c || c `elem` "-.+"))
+
+p_subtype :: Parser Char String
+p_subtype = pAtLeast 1 (pPred (\c -> isAsciiAlphaNum c || c `elem` "-.+"))
+
+{-
+p_type :: Parser Char String
+p_type = p_discrete_type <|> p_composite_type
+
+p_subtype :: Parser Char String
+p_subtype = map asciiToLower <$> (p_extension_token <|> p_iana_token)
+
+p_discrete_type :: Parser Char String
+p_discrete_type = p_ci_string "text"
+              <|> p_ci_string "image"
+              <|> p_ci_string "audio"
+              <|> p_ci_string "video"
+              <|> p_ci_string "application"
+              <|> map asciiToLower <$> p_extension_token
+
+p_composite_type :: Parser Char String
+p_composite_type = p_ci_string "message"
+               <|> p_ci_string "multipart"
+               <|> map asciiToLower <$> p_extension_token
+
+p_iana_token :: Parser Char String
+p_iana_token = pFail
+-}
+
+p_extension_token :: Parser Char String
+p_extension_token = p_ietf_token <|> p_x_token
+
+p_ietf_token :: Parser Char String
+p_ietf_token = pFail
+
+p_x_token :: Parser Char String
+p_x_token = (\x t -> x:'-':t)
+        <$> (pChar 'X' <|> pChar 'x')
+        <*  pChar '-'
+        <*> p_token
+
+p_parameter :: Parser Char Parameter
+p_parameter = Parameter
+          <$> p_attribute
+          <*  cws
+          <*  pChar '='
+          <*  cws
+          <*> p_value
+
+p_attribute :: Parser Char String
+p_attribute = map asciiToLower <$> p_token
+
+p_value :: Parser Char String
+p_value = p_token <|> p_quoted_string
+
+p_token :: Parser Char String
+p_token = pAtLeast 1 (pPred isAscii <!> (p_SP <|> p_CTL <|> p_tspecials))
+
+p_tspecials :: Parser Char Char
+p_tspecials = pPred (`elem` "()<>@,;:\\\"/[]?=")
+
+-----
+
+newtype ContentTransferEncoding
+        = ContentTransferEncoding String -- Case insensitive: lower-cased
+    deriving (Show, Read)
+
+get_content_transfer_encoding :: String -> Maybe ContentTransferEncoding
+get_content_transfer_encoding xs
+ = case parse ph_content_transfer_encoding xs of
+       Left cte -> Just cte
+       Right _ -> Nothing
+
+ph_content_transfer_encoding :: Parser Char ContentTransferEncoding
+ph_content_transfer_encoding
+    = ContentTransferEncoding
+  <$  cws
+  <*> p_mechanism
+  <*  cws
+  <*  pEOI
+
+p_mechanism :: Parser Char String
+p_mechanism = p_ci_string "7bit"
+          <|> p_ci_string "8bit"
+          <|> p_ci_string "binary"
+          <|> p_ci_string "quoted-printable"
+          <|> p_ci_string "base64"
+          <|> map asciiToLower <$> p_ietf_token
+          <|> map asciiToLower <$> p_x_token
+
+newtype ContentID = ContentID MessageID
+    deriving (Show, Read)
+
+get_content_id :: String -> Maybe ContentID
+get_content_id xs
+ = case parse ph_content_id xs of
+       Left ci -> Just ci
+       Right _ -> Nothing
+
+ph_content_id :: Parser Char ContentID
+ph_content_id
+    = ContentID
+  <$  cws
+  <*> p_msg_id
+  <*  cws
+  <*  pEOI
+
+newtype ContentDescription = ContentDescription String
+    deriving (Show, Read)
+
+get_content_description :: String -> Maybe ContentDescription
+get_content_description xs
+ = case parse ph_content_description xs of
+       Left cd -> Just cd
+       Right _ -> Nothing
+
+ph_content_description :: Parser Char ContentDescription
+ph_content_description
+    = ContentDescription
+  <$  cws
+  <*> p_text -- would be pMany, but p_text already does that for us
+  <*  cws
+  <*  pEOI
+
+-----------------------
+-- RFC 2046
+
+-- Not really a header as such
+
+get_boundary :: String -> Maybe String
+get_boundary xs
+ = case parse p_boundary xs of
+       Left b -> Just b
+       Right _ -> Nothing
+
+-- We are very flexible here
+p_boundary :: Parser Char String
+p_boundary = (\ss b bs -> dropFromEndWhile (' ' ==) (ss ++ [b] ++ bs))
+         <$> pMany (pChar ' ')
+         <*> p_bchars
+         <*> pMany p_bchars
+
+p_bchars :: Parser Char Char
+p_bchars = p_bcharsnospace <|> pChar ' '
+
+p_bcharsnospace :: Parser Char Char
+p_bcharsnospace = pPred (\c -> isAsciiAlphaNum c || c `elem` "'()+_,-./:=?")
+
diff --git a/src/Codec/MIME/String/Internal/ABNF.hs b/src/Codec/MIME/String/Internal/ABNF.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/MIME/String/Internal/ABNF.hs
@@ -0,0 +1,173 @@
+
+module Codec.MIME.String.Internal.ABNF
+      (Parser, apply, parse,
+       pPred, pSucceed, pFail, pEOI, (<*>), (<|>), (<| ), (<!>), nested_parse,
+       pChar, pString, (<$>), (<$ ), (<* ), ( |>),
+       pMany, pAtLeast, pAtMost, pExactly, pFromTo, pOptDef, pMaybe
+      ) where
+
+import Prelude hiding ( (<*>), (<$>), (<*), (<$) )
+
+newtype Parser inp res = Parser ([(inp, Pos)] -> ParseResult inp res)
+
+data ParseResult inp res = Success res [(inp, Pos)] !Pos
+                         | Fail !Pos
+
+type Line = Integer
+type Column = Integer
+data Pos = Pos !Line !Column
+         | EOI
+    deriving (Eq, Ord)
+
+get_pos :: [(a, Pos)] -> Pos
+get_pos [] = EOI
+get_pos ((_, p):_) = p
+
+show_pos :: Pos -> String
+show_pos EOI = "End of input"
+show_pos (Pos l c) = "Line " ++ show l ++ ", column " ++ show c
+
+infixl 6 <$>, <$, <*>, <*
+infixr 3 <|>, <|, |>
+
+posify :: String -> [(Char, Pos)]
+posify = f 1 1
+    where f _ _ []        = []
+          f l c ('\n':xs) = ('\n', Pos l c):f (l+1) 1     xs
+          f l c (x   :xs) = (x,    Pos l c):f l     (c+1) xs
+
+apply :: Parser Char a -> String -> Either (a, String) String
+apply (Parser p) xs
+ = case p $ posify xs of
+       Success res ys _ -> Left (res, map fst ys)
+       Fail pos -> Right ("Error: Failed at " ++ show_pos pos)
+
+parse :: Parser Char a -> String -> Either a String
+parse (Parser p) xs
+ = case p $ posify xs of
+       Success res [] _ -> Left res
+       Success _ ((_, pos):_) _ ->
+           Right ("Error: Only consumed up to " ++ show_pos pos)
+       Fail pos ->
+           Right ("Error: Failed at " ++ show_pos pos)
+
+-- Primitive combinators
+
+pPred :: (inp -> Bool) -> Parser inp inp
+pPred p = Parser
+        $ \inp -> case inp of
+                      ((x, pos):inp')
+                       | p x -> Success x inp' pos
+                      _ -> Fail (get_pos inp)
+
+pSucceed :: res -> Parser a res
+pSucceed x = Parser $ \inp -> Success x inp (get_pos inp)
+
+pFail :: Parser a res
+pFail = Parser $ \inp -> Fail (get_pos inp)
+
+pEOI :: Parser a ()
+pEOI = Parser $ \inp -> case inp of
+                            [] -> Success () [] EOI
+                            _ -> Fail (get_pos inp)
+
+(<*>) :: Parser inp (a -> b) -> Parser inp a -> Parser inp b
+Parser p <*> Parser q = Parser $ \inp ->
+                        case p inp of
+                            Fail pos -> Fail pos
+                            Success f inp' pos ->
+                                case q inp' of
+                                    Fail pos' -> Fail (pos `max` pos')
+                                    Success x inp'' pos' ->
+                                        Success (f x) inp'' (pos `max` pos')
+
+(<|>) :: Parser inp a -> Parser inp a -> Parser inp a
+Parser p <|> Parser q = Parser $ \inp ->
+                        case (p inp, q inp) of
+                            (Fail posp, Fail posq) -> Fail (posp `max` posq)
+                            (Fail posp, Success x inp' posq) ->
+                                Success x inp' (posp `max` posq)
+                            (Success x inp' posp, Fail posq) ->
+                                Success x inp' (posp `max` posq)
+                            (rp@(Success _ _ posp), rq@(Success _ _ posq))
+                                -> if posp >= posq then rp else rq
+
+(<| ) :: Parser inp a -> Parser inp a -> Parser inp a
+Parser p <|  Parser q = Parser $ \inp ->
+                        case p inp of
+                            Fail posp ->
+                                case q inp of
+                                    Fail posq -> Fail (posp `max` posq)
+                                    Success x inp' posq ->
+                                        Success x inp' (posp `max` posq)
+                            s -> s
+
+(<!>) :: Parser inp a -> Parser inp b -> Parser inp a
+Parser p <!> Parser q = Parser $ \inp -> case q inp of
+                                             Fail _ ->
+                                                 p inp
+                                             Success _ _ pos -> Fail pos
+
+check_fails_empty :: Parser inp a -> ()
+check_fails_empty (Parser p) = case p [] of
+                                   Fail _ -> ()
+                                   _ -> error "check_fails_empty failed"
+
+nested_parse :: Parser Char String -> Parser Char a -> Parser Char a
+nested_parse (Parser p1) (Parser p2)
+ = Parser
+ $ \inp -> case p1 inp of
+               Fail pos -> Fail pos
+               Success inp' rem_inp pos ->
+                   case p2 $ posify inp' of
+                       Fail pos' -> Fail (pos `max` pos')
+                       Success x [] pos' -> Success x rem_inp (pos `max` pos')
+                       Success _ _ pos' -> Fail (pos `max` pos')
+
+-- Derived combinators
+
+pChar :: Char -> Parser Char Char
+pChar c = pPred (c ==)
+
+pString :: String -> Parser Char String
+pString "" = pSucceed ""
+pString (c:cs) = (:) <$> pChar c <*> pString cs
+
+(<$>) :: (a -> b) -> Parser inp a -> Parser inp b
+x <$> q = pSucceed x <*> q
+
+(<$ ) :: a -> Parser inp b -> Parser inp a
+x <$  q = pSucceed x <*  q
+
+(<* ) :: Parser inp a -> Parser inp b -> Parser inp a
+p <*  q = (\x _ -> x) <$> p <*> q
+
+( |>) :: Parser inp a -> Parser inp a -> Parser inp a
+p  |> q = q <|  p
+
+pMany :: Parser inp a -> Parser inp [a]
+pMany p = check_fails_empty p `seq` ((:) <$> p <*> pMany p) <|  pSucceed []
+
+pAtLeast :: Word -> Parser inp a -> Parser inp [a]
+pAtLeast 0 p = pMany p
+pAtLeast n p = (:) <$> p <*> pAtLeast (n-1) p
+
+pAtMost :: Word -> Parser inp a -> Parser inp [a]
+pAtMost 0 _ = pSucceed []
+pAtMost n p = ((:) <$> p <*> pAtMost (n-1) p) <|  pSucceed []
+
+pExactly :: Word -> Parser inp a -> Parser inp [a]
+pExactly 0 _ = pSucceed []
+pExactly n p = (:) <$> p <*> pExactly (n-1) p
+
+pFromTo :: Word -> Word -> Parser inp a -> Parser inp [a]
+pFromTo 0 t p = pAtMost t p
+pFromTo _ 0 _ = error "Codec.MIME.String.Internal.ABNF.pFromTo: Bad arguments"
+pFromTo f t p = (:) <$> p <*> pFromTo (f-1) (t-1) p
+
+pOptDef :: a -> Parser inp a -> Parser inp a
+pOptDef x p = p <|  pSucceed x
+
+pMaybe :: Parser inp a -> Parser inp (Maybe a)
+pMaybe p = Just <$> p <|  pSucceed Nothing
+
diff --git a/src/Codec/MIME/String/Internal/Utils.hs b/src/Codec/MIME/String/Internal/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/MIME/String/Internal/Utils.hs
@@ -0,0 +1,58 @@
+
+module Codec.MIME.String.Internal.Utils where
+
+import Data.Char
+
+isAsciiDigit :: Char -> Bool
+isAsciiDigit c = isAscii c && isDigit c
+
+isAsciiHexDigit :: Char -> Bool
+isAsciiHexDigit c = isAscii c && isHexDigit c
+
+isAsciiPrint :: Char -> Bool
+isAsciiPrint c = isAscii c && isPrint c
+
+isAsciiAlpha :: Char -> Bool
+isAsciiAlpha c = isAscii c && isAlpha c
+
+isAsciiAlphaNum :: Char -> Bool
+isAsciiAlphaNum c = isAscii c && isAlphaNum c
+
+asciiToLower :: Char -> Char
+asciiToLower c | isAscii c = toLower c
+               | otherwise = c
+
+asciiToUpper :: Char -> Char
+asciiToUpper c | isAscii c = toUpper c
+               | otherwise = c
+
+splits :: Int -> [a] -> [[a]]
+splits _ [] = []
+splits n xs = case splitAt n xs of
+                  (ys, zs) -> ys:splits n zs
+
+box :: a -> [a]
+box x = [x]
+
+dropFromEndWhile :: (a -> Bool) -> [a] -> [a]
+dropFromEndWhile p = foldr (\x xs -> if null xs && p x then [] else x:xs) []
+
+-- We are generous about what we allow as line terminators. Any of
+-- \r \n \r\n \n\r will satisfy us.
+my_lines :: String -> [String]
+my_lines xs = case get_line xs of
+                  (ys, Nothing) -> [ys]
+                  (ys, Just zs) -> ys:my_lines zs
+
+get_line :: String -> (String, Maybe String)
+get_line xs = case break is_cr_or_lf xs of
+                  (ys, z1:z2:zs)
+                   | is_cr_or_lf z2 && z1 /= z2 -> (ys, Just zs)
+                  (ys, _:zs) -> (ys, Just zs)
+                  (ys, "") -> (ys, Nothing)
+
+is_cr_or_lf :: Char -> Bool
+is_cr_or_lf '\r' = True
+is_cr_or_lf '\n' = True
+is_cr_or_lf _ = False
+
diff --git a/src/Codec/MIME/String/Parse.hs b/src/Codec/MIME/String/Parse.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/MIME/String/Parse.hs
@@ -0,0 +1,314 @@
+
+module Codec.MIME.String.Parse where
+
+import qualified Codec.Binary.Base64.String as Base64 (decode)
+import Codec.MIME.String.ContentDisposition
+      (
+       ContentDisposition(ContentDisposition), get_content_disposition,
+       DispositionType(Inline, Attachment),
+       DispositionParameter(..),
+      )
+import Codec.MIME.String.Date (get_date)
+import Codec.MIME.String.Headers
+      (
+       ContentTransferEncoding(ContentTransferEncoding),
+       get_content_transfer_encoding,
+       ContentType(ContentType), get_content_type,
+       get_content_description, get_boundary,
+       Parameter(Parameter),
+       MIMEVersion(MIMEVersion), get_mime_version,
+       Subject(Subject),
+       get_subject, get_from, get_to,
+      )
+import qualified Codec.MIME.String.QuotedPrintable as QuotedPrintable (decode)
+import Codec.MIME.String.Types
+      (
+       ParseM,
+       Header(Header, h_raw_header, h_raw_name, h_name, h_body),
+       Headers,
+       Message(Message),
+       MessageInfo(..),
+       Multipart(Multipart),
+       MessageContent(NoContent, Mixed, Alternative,
+                      Parallel, Digest, RFC822),
+       mkData, mkBody,
+       digest_content_type, ascii_text_content_type,
+      )
+import Codec.MIME.String.Internal.Utils
+
+import Codec.Text.IConv
+import Control.Monad (liftM)
+import Control.Monad.State (evalState, get, put)
+import qualified Data.ByteString.Lazy.Char8 as BS
+import Data.ByteString.Lazy.Char8 (ByteString)
+import Data.Maybe (fromMaybe)
+
+mkMessage :: MessageInfo -> ParseM MessageContent -> ParseM Message
+mkMessage mi f_mc
+ = do pn <- get
+      put (pn + 1)
+      -- This is done slightly oddly so we get numbering in the natural
+      -- order, which in turn is important when looking for a part number
+      mc <- f_mc
+      return $ Message pn mi mc
+
+parse :: String -> Message
+parse msg = evalState (parse_message msg) 1
+
+parse_message :: String -> ParseM Message
+parse_message msg
+ = let (headers, m_body) = parse_headers msg
+   in case get_header headers "mime-version:" get_mime_version of
+          -- We only try and be clever if the MIME version is 1.0
+          Just (MIMEVersion 1 0) ->
+              parse_mime_message ascii_text_content_type msg
+          _ ->
+              do let m_from = get_header headers "from:" get_from
+                     m_subject = get_header headers "subject:" (Just . Subject)
+                     m_to = get_header headers "to:" get_to
+                     m_date = get_header headers "date:" get_date
+                     mi = MessageInfo {
+                              mi_headers = headers,
+                              mi_from = m_from,
+                              mi_subject = m_subject,
+                              mi_to = m_to,
+                              mi_date = m_date,
+                              mi_content_description = Nothing
+                          }
+                     mc = case m_body of
+                              Just body ->
+                                  mkBody ascii_text_content_type "unknown"
+                                         (convertAsciiToUtf8 body)
+                              Nothing ->
+                                  return $ NoContent ascii_text_content_type
+                 mkMessage mi mc
+
+convertAsciiToUtf8 :: String -> String
+convertAsciiToUtf8 xs
+    = BS.unpack $ convertFuzzy Transliterate "US-ASCII" "utf8" $ BS.pack xs
+
+parse_mime_message :: ContentType -> String -> ParseM Message
+parse_mime_message def_content_type msg
+ = let (headers, m_body) = parse_headers msg
+       mi = make_mime_message_info headers
+       mc = case m_body of
+                Nothing ->
+                    do let m_ct = get_header headers "content-type:"
+                                                  get_content_type
+                           content_type = fromMaybe def_content_type m_ct
+                       return $ NoContent content_type
+                Just body ->
+                    make_mime_message_content def_content_type headers body
+   in mkMessage mi mc
+
+make_mime_message_info :: Headers -> MessageInfo
+make_mime_message_info headers
+ = let m_content_description = get_header headers "content-description:"
+                                               get_content_description
+       m_from = get_header headers "from:" get_from
+       m_subject = get_header headers "subject:" get_subject
+       m_to = get_header headers "to:" get_to
+       m_date = get_header headers "date:" get_date
+   in MessageInfo {
+          mi_headers = headers,
+          mi_from = m_from,
+          mi_subject = m_subject,
+          mi_to = m_to,
+          mi_date = m_date,
+          mi_content_description = m_content_description
+      }
+
+make_mime_message_content :: ContentType -> Headers -> String
+                          -> ParseM MessageContent
+make_mime_message_content def_content_type headers body
+ = -- We accept illegal combinations of content type and
+   -- encoding, so just decode whatever it says
+   case m_decoded_body of
+       Nothing ->
+           mkData (Just cte) content_type filename body
+       Just decoded_body ->
+           case content_disposition of
+               ContentDisposition Attachment _ ->
+                   mkData Nothing content_type filename decoded_body
+               ContentDisposition Inline _ ->
+                   case content_type of
+                   ContentType "text" _ ps ->
+                       let charset = fromMaybe "US-ASCII"
+                                   $ lookup_param "charset" ps
+                           decoded_body' = BS.pack decoded_body
+                       in case tryConvertFuzzy Transliterate charset "utf8" decoded_body' of
+                          Just xs ->
+                              mkBody content_type filename $ BS.unpack xs
+                          Nothing ->
+                              mkData Nothing content_type filename decoded_body
+                   ContentType "multipart" st ps
+                    | Just raw_b <- lookup_param "boundary" ps,
+                      Just b <- get_boundary raw_b
+                       -> do let (preamble, parts, epilogue)
+                                     = get_parts b decoded_body
+                                 ct = case st of
+                                          "digest" -> digest_content_type
+                                          _ -> ascii_text_content_type
+                                 constr = case st of
+                                              "alternative" -> Alternative
+                                              "parallel" -> Parallel
+                                              "digest" -> Digest
+                                              _ -> Mixed
+                             ms <- mapM (parse_mime_message ct) parts
+                             return $ constr (Multipart preamble ms epilogue)
+                   ContentType "message" "rfc822" _ ->
+                       liftM (RFC822 decoded_body filename)
+                             (parse_message decoded_body)
+                   -- Anything else is treated like an
+                   -- application/octet-stream
+                   _ -> mkData Nothing content_type filename decoded_body
+ where m_cd = get_header headers "content-disposition:"
+                              get_content_disposition
+       content_disposition = fromMaybe (ContentDisposition Inline []) m_cd
+       m_ct = get_header headers "content-type:"
+                              get_content_type
+       content_type = fromMaybe def_content_type m_ct
+       filename = get_filename content_disposition content_type
+       m_ce = get_header headers "content-transfer-encoding:"
+                              get_content_transfer_encoding
+       cte@(ContentTransferEncoding content_transfer_encoding)
+           = fromMaybe (ContentTransferEncoding "7bit") m_ce
+       m_decoded_body
+        | content_transfer_encoding == "base64" = Just (Base64.decode body)
+        | content_transfer_encoding == "quoted-printable" = Just (QuotedPrintable.decode $ my_lines body)
+        | content_transfer_encoding `elem` ["7bit", "8bit", "binary"] = Just body
+              -- Don't worry if 8-bit data is in 7-bit transfer-encoded data
+        | otherwise = Nothing
+
+-- XXX This is rather hacky. We really want convertFuzzy to tell us if
+-- the conversion is supported itself
+tryConvertFuzzy :: Fuzzy -> EncodingName -> EncodingName -> ByteString
+                -> Maybe ByteString
+tryConvertFuzzy fuzzy from_charset to_charset decoded_body =
+    case convertStrictly from_charset to_charset decoded_body of
+    Right (UnsuportedConversion {}) -> Nothing
+    _ -> Just $ convertFuzzy fuzzy from_charset to_charset decoded_body
+
+get_filename :: ContentDisposition -> ContentType -> FilePath
+get_filename (ContentDisposition _ params) (ContentType _ _ params')
+ = loop params
+    where loop [] = -- Look up legacy name parameter in content type
+                    case lookup_param "name" params' of
+                        Nothing -> default_filename
+                        Just f -> sanitise f
+          loop (Filename f:_) = sanitise f
+          loop (_:ps) = loop ps
+          sanitise f = case reverse $ takeWhile ('/' /=) $ reverse f of
+                           "" -> default_filename
+                           f' -> f'
+          default_filename = "unknown"
+
+get_parts :: String -> String -> (String, [String], String)
+get_parts boundary body
+ = case gps [] body of
+       (pre:parts, epi) -> (pre, parts, epi)
+       _ -> error "Parse.get_parts: Can't happen XXX"
+    where gps acc "" = ([from_acc acc], "")
+          gps acc xs
+           = case fmap (dropWhile isWSP) $ after dd_boundary
+                                         $ snd $ read_line_ending xs of
+                 Just "--" -> ([from_acc acc], "")
+                 Just ('-':'-':cs@(c:_))
+                  | is_cr_or_lf c -> ([from_acc acc], cs)
+                 Just "" -> ([from_acc acc], "")
+                 Just (c1:cs)
+                       | is_cr_or_lf c1
+                          -> let cs' = case cs of
+                                           c2:cs''
+                                            | is_cr_or_lf c2 && c1 /= c2
+                                               -> cs''
+                                           _ -> cs
+                             in case gps [] cs' of
+                                    (ps, ep) -> (from_acc acc:ps, ep)
+                 _ -> case read_line_ending xs of
+                          (le, xs') ->
+                              case break is_cr_or_lf xs' of
+                                  (ys, zs) -> gps (ys:le:acc) zs
+          from_acc acc = concat $ reverse acc
+          read_line_ending cs = case cs of
+                                    (c1:cs1)
+                                     | is_cr_or_lf c1 ->
+                                        case cs1 of
+                                            (c2:cs2)
+                                             | is_cr_or_lf c2 && c1 /= c2 ->
+                                                ([c1, c2], cs2)
+                                            _ -> ([c1], cs1)
+                                    _ -> ("", cs)
+          after "" ys = Just ys
+          after (x:xs) (y:ys)
+           | x == y = after xs ys
+           | otherwise = Nothing
+          after (_:_) "" = Nothing
+          dd_boundary = "--" ++ boundary
+          isWSP ' ' = True
+          isWSP '\t' = True
+          isWSP _ = False
+
+-- Returns the value of the first parameter of the name (must be lower cased)
+lookup_param :: String -> [Parameter] -> Maybe String
+lookup_param _ [] = Nothing
+lookup_param name (Parameter n v:ps)
+ | name == n = Just v
+ | otherwise = lookup_param name ps
+
+get_header :: Headers -> String -> (String -> Maybe a) -> Maybe a
+get_header hs name getter
+ = case filter ((name ==) . h_name) hs of
+       [h] -> getter (h_body h)
+       _ -> Nothing
+
+-- We skip over leading white space lines, both for resilience and
+-- because this is allowed for MIME part headers.
+parse_headers :: String -> (Headers, Maybe String)
+parse_headers msg = skip_whitespace (Just msg)
+    where skip_whitespace :: Maybe String -> ([Header], Maybe String)
+          skip_whitespace Nothing = ([], Nothing)
+          skip_whitespace (Just xs) = case get_line xs of
+                                          ([], m_zs) -> ([], m_zs)
+                                          (ys, m_zs) ->
+                                              case dropWhile isWhite ys of
+                                                  [] -> skip_whitespace m_zs
+                                                  ys' -> gather [ys'] m_zs
+          gather :: [String] -> Maybe String -> ([Header], Maybe String)
+          gather acc Nothing = ([mk_rev_header acc], Nothing)
+          gather acc (Just xs)
+              = case get_line xs of
+                    ([], m_zs) -> ([mk_rev_header acc], m_zs)
+                    (ys, m_zs)
+                     | starts_with_white ys -> gather (ys:acc) m_zs
+                     | otherwise -> let (hs, m_rest) = gather [ys] m_zs
+                                    in (mk_rev_header acc:hs, m_rest)
+          starts_with_white (c:_) = isWhite c
+          starts_with_white [] = False
+          isWhite ' ' = True
+          isWhite '\t' = True
+          isWhite _ = False
+
+-- Takes the lines comprising a header (in reverse order) and constructs
+-- the corresponding Header
+mk_rev_header :: [String] -> Header
+mk_rev_header = mk_header . reverse
+
+-- Takes the lines comprising a header and constructs
+-- the corresponding Header
+mk_header :: [String] -> Header
+mk_header xs = let unfolded = concat xs
+                   (raw_name, body) = case break ends_header unfolded of
+                                          (name, ':':val) -> (name ++ ":", val)
+                                          (name, val) -> (name, val)
+               in Header {
+                      h_raw_header = xs,
+                      h_raw_name = raw_name,
+                      h_name = map asciiToLower raw_name,
+                      h_body = body
+                  }
+    where ends_header ':' = True
+          ends_header ' ' = True
+          ends_header '\t' = True
+          ends_header _ = False
+
diff --git a/src/Codec/MIME/String/QuotedPrintable.hs b/src/Codec/MIME/String/QuotedPrintable.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/MIME/String/QuotedPrintable.hs
@@ -0,0 +1,60 @@
+
+-- 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 "" = ""
+
diff --git a/src/Codec/MIME/String/Types.hs b/src/Codec/MIME/String/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/MIME/String/Types.hs
@@ -0,0 +1,82 @@
+
+module Codec.MIME.String.Types
+      (
+       ParseM, PartNumber, Headers,
+       Header(Header, h_raw_header, h_raw_name, h_name, h_body),
+       Message(..), MessageInfo(..), Multipart(Multipart),
+       MessageContent(NoContent, Body, Data, Mixed, Alternative,
+                      Parallel, Digest, RFC822),
+       mkData, mkBody,
+       digest_content_type, ascii_text_content_type,
+      )
+      where
+
+import Codec.MIME.String.Date (FullDate)
+import Codec.MIME.String.Headers
+      (
+       ContentType(ContentType), ContentDescription, ContentTransferEncoding,
+       Parameter(Parameter), From, To, Subject,
+      )
+import Codec.MIME.String.Internal.Utils (my_lines)
+
+import Control.Monad.State (State)
+
+type Headers = [Header]
+data Header = Header {
+                  h_raw_header :: [String],
+                  h_raw_name :: String,
+                  h_name :: String,
+                  h_body :: String
+              }
+    deriving (Show, Read)
+
+data MessageInfo = MessageInfo {
+                       mi_headers :: Headers,
+                       mi_from :: Maybe From,
+                       mi_to :: Maybe To,
+                       mi_subject :: Maybe Subject,
+                       mi_date :: Maybe FullDate,
+                       mi_content_description :: Maybe ContentDescription
+                   }
+    deriving (Show, Read)
+data MessageContent = NoContent ContentType
+                    | Body ContentType FilePath String -- UTF-8 text
+                    | Data (Maybe ContentTransferEncoding)
+                           ContentType FilePath String -- 8-bit data
+                    | Mixed       Multipart
+                    | Alternative Multipart
+                    | Parallel    Multipart
+                    | Digest      Multipart
+                    | RFC822 String{- unparsed message-} FilePath Message
+    deriving (Show, Read)
+
+type ParseM a = State PartNumber a
+
+mkBody :: ContentType -> FilePath -> String -> ParseM MessageContent
+mkBody ct fp s = return $ Body ct fp $ unlines $ my_lines s
+
+mkData :: Maybe ContentTransferEncoding -> ContentType -> FilePath
+       -> String -> ParseM MessageContent
+mkData m_cte ct fp s = return $ Data m_cte ct fp s
+
+data Multipart = Multipart String    -- Preamble
+                           [Message] -- The messages themselves
+                           String    -- Epilogue
+    deriving (Show, Read)
+
+type PartNumber = Integer
+
+data Message = Message {
+                   m_part_number :: PartNumber,
+                   m_message_info :: MessageInfo,
+                   m_message_content :: MessageContent
+               }
+    deriving (Show, Read)
+
+ascii_text_content_type :: ContentType
+ascii_text_content_type
+ = ContentType "text" "plain" [Parameter "charset" "US-ASCII"]
+
+digest_content_type :: ContentType
+digest_content_type = ContentType "message" "rfc822" []
+