split into library + executables

6 files changed, 0 insertions, 806 deletions

diff --git a/Codec/MIME/Base64.hs b/Codec/MIME/Base64.hs
deleted file mode 100644
index f60419b..0000000
--- a/Codec/MIME/Base64.hs
+++ /dev/null
@@ -1,147 +0,0 @@
---------------------------------------------------------------------
--- |
--- Module    : Codec.MIME.Base64
--- Copyright : (c) 2006-2009, Galois, Inc. 
--- License   : BSD3
---
--- Maintainer: Sigbjorn Finne <sigbjorn.finne@gmail.com>
--- Stability : provisional
--- Portability: portable
---
--- 
--- Base64 decoding and encoding routines, multiple entry
--- points for either depending on use and level of control
--- wanted over the encoded output (and its input form on the
--- decoding side.)
--- 
---------------------------------------------------------------------
-module Codec.MIME.Base64 
-        ( encodeRaw         -- :: Bool -> String -> [Word8]
-        , encodeRawString   -- :: Bool -> String -> String
-        , encodeRawPrim     -- :: Bool -> Char -> Char -> [Word8] -> String
-
-        , formatOutput      -- :: Int    -> Maybe String -> String -> String
-
-        , decode            -- :: String -> [Word8]
-        , decodeToString    -- :: String -> String
-        , decodePrim        -- :: Char -> Char -> String -> [Word8]
-        ) where
-
-import Data.Bits
-import Data.Char
-import Data.Word
-import Data.Maybe
-
-encodeRawString :: Bool -> String -> String
-encodeRawString trail xs = encodeRaw trail (map (fromIntegral.ord) xs)
-
--- | @formatOutput n mbLT str@ formats @str@, splitting it
--- into lines of length @n@. The optional value lets you control what
--- line terminator sequence to use; the default is CRLF (as per MIME.)
-formatOutput :: Int -> Maybe String -> String -> String
-formatOutput n mbTerm str
- | n <= 0    = error ("Codec.MIME.Base64.formatOutput: negative line length " ++ show n)
- | otherwise = chop n str
-   where
-     crlf :: String
-     crlf = fromMaybe "\r\n" mbTerm
-
-     chop _ "" = ""
-     chop i xs =
-       case splitAt i xs of
-         (as,"") -> as
-         (as,bs) -> as ++ crlf ++ chop i bs
-
-encodeRaw :: Bool -> [Word8] -> String
-encodeRaw trail bs = encodeRawPrim trail '+' '/' bs
-
--- | @encodeRawPrim@ lets you control what non-alphanum characters to use
--- (The base64url variation uses @*@ and @-@, for instance.)
--- No support for mapping these to multiple characters in the output though.
-encodeRawPrim :: Bool -> Char -> Char -> [Word8] -> String
-encodeRawPrim trail ch62 ch63 ls = encoder ls
- where
-  trailer xs ys
-   | not trail = xs
-   | otherwise = xs ++ ys
-  f = fromB64 ch62 ch63 
-  encoder []    = []
-  encoder [x]   = trailer (take 2 (encode3 f x 0 0 "")) "=="
-  encoder [x,y] = trailer (take 3 (encode3 f x y 0 "")) "="
-  encoder (x:y:z:ws) = encode3 f x y z (encoder ws)
-
-encode3 :: (Word8 -> Char) -> Word8 -> Word8 -> Word8 -> String -> String
-encode3 f a b c rs = 
-     f (low6 (w24 `shiftR` 18)) :
-     f (low6 (w24 `shiftR` 12)) :
-     f (low6 (w24 `shiftR` 6))  :
-     f (low6 w24) : rs
-   where
-    w24 :: Word32
-    w24 = (fromIntegral a `shiftL` 16) +
-          (fromIntegral b `shiftL` 8)  + 
-           fromIntegral c
-
-decodeToString :: String -> String
-decodeToString str = map (chr.fromIntegral) $ decode str
-
-decode :: String -> [Word8]
-decode str = decodePrim '+' '/' str
-
-decodePrim :: Char -> Char -> String -> [Word8]
-decodePrim ch62 ch63 str =  decoder $ takeUntilEnd str
- where
-  takeUntilEnd "" = []
-  takeUntilEnd ('=':_) = []
-  takeUntilEnd (x:xs) = 
-    case toB64 ch62 ch63 x of
-      Nothing -> takeUntilEnd xs
-      Just b  -> b : takeUntilEnd xs
-
-decoder :: [Word8] -> [Word8]
-decoder [] = []
-decoder [x] = take 1 (decode4 x 0 0 0 [])
-decoder [x,y] = take 1 (decode4 x y 0 0 []) -- upper 4 bits of second val are known to be 0.
-decoder [x,y,z] = take 2 (decode4 x y z 0 [])
-decoder (x:y:z:w:xs) = decode4 x y z w (decoder xs)
-
-decode4 :: Word8 -> Word8 -> Word8 -> Word8 -> [Word8] -> [Word8]
-decode4 a b c d rs =
-  (lowByte (w24 `shiftR` 16)) :
-  (lowByte (w24 `shiftR` 8))  :
-  (lowByte w24) : rs
- where
-  w24 :: Word32
-  w24 =
-   (fromIntegral a) `shiftL` 18 .|.
-   (fromIntegral b) `shiftL` 12 .|.
-   (fromIntegral c) `shiftL` 6  .|.
-   (fromIntegral d)
-
-toB64 :: Char -> Char -> Char -> Maybe Word8
-toB64 a b ch
-  | ch >= 'A' && ch <= 'Z' = Just (fromIntegral (ord ch - ord 'A'))
-  | ch >= 'a' && ch <= 'z' = Just (26 + fromIntegral (ord ch - ord 'a'))
-  | ch >= '0' && ch <= '9' = Just (52 + fromIntegral (ord ch - ord '0'))
-  | ch == a = Just 62
-  | ch == b = Just 63
-  | otherwise = Nothing
-
-fromB64 :: Char -> Char -> Word8 -> Char
-fromB64 ch62 ch63 x 
-  | x < 26    = chr (ord 'A' + xi)
-  | x < 52    = chr (ord 'a' + (xi-26))
-  | x < 62    = chr (ord '0' + (xi-52))
-  | x == 62   = ch62
-  | x == 63   = ch63
-  | otherwise = error ("fromB64: index out of range " ++ show x)
- where
-  xi :: Int
-  xi = fromIntegral x
-
-low6 :: Word32 -> Word8
-low6 x = fromIntegral (x .&. 0x3f)
-
-lowByte :: Word32 -> Word8
-lowByte x = (fromIntegral x) .&. 0xff
-
diff --git a/Codec/MIME/Decode.hs b/Codec/MIME/Decode.hs
deleted file mode 100644
index 278d6f6..0000000
--- a/Codec/MIME/Decode.hs
+++ /dev/null
@@ -1,76 +0,0 @@
---------------------------------------------------------------------
--- |
--- Module    : Codec.MIME.Decode
--- Copyright : (c) 2006-2009, Galois, Inc. 
--- License   : BSD3
---
--- Maintainer: Sigbjorn Finne <sigbjorn.finne@gmail.com>
--- Stability : provisional
--- Portability: portable
---
--- 
--- 
---------------------------------------------------------------------
-
-module Codec.MIME.Decode where
-
-import Data.Char
-
-import Codec.MIME.QuotedPrintable as QP
-import Codec.MIME.Base64 as Base64
-
--- | @decodeBody enc str@ decodes @str@ according to the scheme
--- specified by @enc@. Currently, @base64@ and @quoted-printable@ are
--- the only two encodings supported. If you supply anything else
--- for @enc@, @decodeBody@ returns @str@.
--- 
-decodeBody :: String -> String -> String
-decodeBody enc body =
- case map toLower enc of
-   "base64"           -> Base64.decodeToString body
-   "quoted-printable" -> QP.decode body
-   _ -> body
-
--- Decoding of RFC 2047's "encoded-words" production
--- (as used in email-headers and some HTTP header cases
--- (AtomPub's Slug: header))
-decodeWord :: String -> Maybe (String, String)
-decodeWord str =
-  case str of
-   '=':'?':xs ->
-     case dropLang $ break (\ch -> ch =='?' || ch == '*') xs of
-       (cs,_:x:'?':bs)
-         | isKnownCharset (map toLower cs) ->
-           case toLower x of
-             'q' -> decodeQ cs (break (=='?') bs)
-             'b' -> decodeB cs (break (=='?') bs)
-             _   -> Nothing
-       _ -> Nothing
-   _ -> Nothing
- where
-  isKnownCharset cs = cs `elem` ["iso-8859-1", "us-ascii"]
-
-   -- ignore RFC 2231 extension of permitting a language tag to be supplied
-   -- after the charset.
-  dropLang (as,'*':bs) = (as,dropWhile (/='?') bs)
-  dropLang (as,bs) = (as,bs)
-
-  decodeQ cset (fs,'?':'=':rs) = Just (fromCharset cset (QP.decode fs),rs)
-  decodeQ _ _ = Nothing
-
-  decodeB cset (fs,'?':'=':rs) =
-    Just (fromCharset cset (Base64.decodeToString fs),rs)
-  decodeB _ _ = Nothing
-
-  fromCharset _cset cs = cs
-
-decodeWords :: String -> String
-decodeWords "" = ""
-decodeWords (x:xs)
- | isSpace x = x : decodeWords xs
- | otherwise =
-  case decodeWord (x:xs) of
-    Nothing -> x : decodeWords xs
-    Just (as,bs) -> as ++ decodeWords bs
-
-
diff --git a/Codec/MIME/Parse.hs b/Codec/MIME/Parse.hs
deleted file mode 100644
index c5392fe..0000000
--- a/Codec/MIME/Parse.hs
+++ /dev/null
@@ -1,295 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
---------------------------------------------------------------------
--- |
--- Module    : Codec.MIME.Pare
--- Copyright : (c) 2006-2009, Galois, Inc. 
--- License   : BSD3
---
--- Maintainer: Sigbjorn Finne <sigbjorn.finne@gmail.com>
--- Stability : provisional
--- Portability: portable
---
--- Parsing MIME content.
--- 
---------------------------------------------------------------------
-module Codec.MIME.Parse
-  ( parseMIMEBody    -- :: [(T.Text,T.Text)] -> T.Text -> MIMEValue
-  , parseMIMEType    -- :: T.Text -> Maybe Type
-  , parseMIMEMessage -- :: T.Text -> MIMEValue
-
-  , parseHeaders     -- :: T.Text -> ([(T.Text,T.Text)], T.Text)
-  , parseMultipart   -- :: Type -> T.Text -> (MIMEValue, T.Text)
-  , parseContentType -- :: T.Text -> Maybe Type
-  , splitMulti       -- :: T.Text -> T.Text -> ([MIMEValue], T.Text)
-  , normalizeCRLF
-  ) where
-
-import Codec.MIME.Type
-import Codec.MIME.Decode
-import Control.Arrow(second)
-
-import           Data.CaseInsensitive   (CI)
-import qualified Data.CaseInsensitive as CI
-import Data.Char
-import Data.Maybe
-import qualified Data.List as L
-import Debug.Trace ( trace )
-import qualified Data.Text as T
-import Data.Monoid(Monoid(..), (<>))
-
-enableTrace :: Bool
-enableTrace = False
-
-doTrace :: String -> b -> b
-doTrace | enableTrace = trace
-        | otherwise   = \_ x -> x
-
-
-parseMIMEBody :: [MIMEParam] -> T.Text -> MIMEValue
-parseMIMEBody headers body = result { mime_val_headers = headers }
-  where
-  result = case mimeType mty of
-    Multipart{} -> fst (parseMultipart mty body)
-    Message{}   -> fst (parseMultipart mty body)
-    _           -> nullMIMEValue { mime_val_type    = mty
-                                 , mime_val_disp    = parseContentDisp headers
-                                 , mime_val_content = Single (processBody headers body)
-                                 }
-  mty = fromMaybe defaultType
-                       (parseContentType =<< lookupField "content-type" (paramPairs headers))
-defaultType :: Type
-defaultType = Type { mimeType   = Text "plain"
-                   , mimeParams = [MIMEParam "charset" "us-ascii"]
-                   }
-
-parseContentDisp :: [MIMEParam] -> Maybe Disposition
-parseContentDisp headers =
-    (processDisp . dropFoldingWSP) =<< lookupField "content-disposition" (paramPairs headers)
-  where
-    processDisp t | T.null t  = Nothing
-                  | T.null bs = Just $ Disposition { dispType = toDispType as
-                                                   , dispParams = []
-                                                   }
-                  | otherwise = Just $ Disposition { dispType = toDispType as
-                                                   , dispParams = processParams (parseParams bs)
-                                                   } 
-      where (as,bs) = T.break (\ch -> isSpace ch || ch == ';') t
-
-    processParams = map procP
-      where
-        procP (MIMEParam k val)
-            | "name" == k              = Name val
-            | "filename" == k          = Filename val
-            | "creation-date" == k     = CreationDate val
-            | "modification-date" == k = ModDate val
-            | "read-date" == k         = ReadDate val
-            | "size" == k              = Size val
-            | otherwise                = OtherParam k val
-
-    toDispType t = if t == "inline" then DispInline
-                   else if t == "attachment" then DispAttachment
-                   else if t == "form-data"  then DispFormData
-                   else  DispOther t
-
-paramPairs :: [MIMEParam] -> [(CI T.Text, T.Text)]
-paramPairs = map paramPair
-  where
-    paramPair (MIMEParam a b) = (a,b)
-
-processBody :: [MIMEParam] -> T.Text -> T.Text
-processBody headers body =
-  case lookupField "content-transfer-encoding" $ paramPairs headers of
-    Nothing -> body
-    Just v  -> T.pack $ decodeBody (T.unpack v) $ T.unpack body
-
-normalizeCRLF :: T.Text -> T.Text
-normalizeCRLF t
-    | T.null t = ""
-    | "\r\n" `T.isPrefixOf` t = "\r\n" <> normalizeCRLF (T.drop 2 t)
-    | any (`T.isPrefixOf` t) ["\r", "\n"] = "\r\n" <> normalizeCRLF (T.drop 1 t)
-    | otherwise = let (a,b) = T.break (`elem` ("\r\n" :: String)) t in a <> normalizeCRLF b
-  
-parseMIMEMessage :: T.Text -> MIMEValue
-parseMIMEMessage entity =
-  case parseHeaders (normalizeCRLF entity) of
-   (as,bs) -> parseMIMEBody as bs
-
-parseHeaders :: T.Text -> ([MIMEParam], T.Text)
-parseHeaders str =
-  case findFieldName "" str of
-    Left (nm, rs) -> parseFieldValue (CI.mk nm) (dropFoldingWSP rs)
-    Right body    -> ([],body)
- where
-  findFieldName acc t 
-    | T.null t = Right ""
-    | "\r\n" `T.isPrefixOf` t = Right $ T.drop 2 t
-    | ":" `T.isPrefixOf` t = Left (T.reverse $ T.dropWhile isHSpace acc, T.drop 1 t)
-    | otherwise = findFieldName (T.take 1 t <> acc) $ T.drop 1 t
-
-  parseFieldValue nm xs 
-      | T.null bs = ([MIMEParam nm as], "")
-      | otherwise = let (zs,ys) = parseHeaders bs in (MIMEParam nm as :zs, ys)
-    where 
-      (as,bs) = takeUntilCRLF xs
-
-parseMultipart :: Type -> T.Text -> (MIMEValue, T.Text)
-parseMultipart mty body =
-  case lookupField "boundary" (paramPairs $ mimeParams mty) of
-    Nothing -> doTrace ("Multipart mime type, " ++ T.unpack (showType mty) ++
-      ", has no required boundary parameter. Defaulting to text/plain") $
-      (nullMIMEValue{ mime_val_type = defaultType
-                    , mime_val_disp = Nothing
-                    , mime_val_content = Single body
-                    }, "")
-    Just bnd -> (nullMIMEValue { mime_val_type = mty
-                               , mime_val_disp = Nothing
-                               , mime_val_content = Multi vals
-                               }, rs)
-      where (vals,rs) = splitMulti bnd body
-
-splitMulti :: T.Text -> T.Text -> ([MIMEValue], T.Text)
-splitMulti bnd body_in =
-  -- Note: we insert a CRLF if it looks as if the boundary string starts
-  -- right off the bat.  No harm done if this turns out to be incorrect.
-  let body | "--" `T.isPrefixOf` body_in = "\r\n" <> body_in
-           | otherwise  = body_in
-  in case untilMatch dashBoundary body of
-       Nothing           -> mempty
-       Just xs  | "--" `T.isPrefixOf` xs    -> ([], T.drop 2 xs)
-                | otherwise                 -> splitMulti1 (dropTrailer xs)
-
- where
-  dashBoundary = ("\r\n--" <> bnd)
-
-  splitMulti1 xs 
-      | T.null as && T.null bs = ([], "")
-      | T.null bs = ([parseMIMEMessage as],"")
-      | T.isPrefixOf "--" bs    =  ([parseMIMEMessage as], dropTrailer bs)
-      | otherwise   = let (zs,ys) = splitMulti1 (dropTrailer bs)
-                            in ((parseMIMEMessage as) : zs,ys)
-
-    where
-      (as,bs) = matchUntil dashBoundary xs
-
-  dropTrailer xs 
-      | "\r\n" `T.isPrefixOf` xs1 = T.drop 2 xs1
-      | otherwise   = xs1 -- hmm, flag an error?
-    where
-       xs1 = T.dropWhile isHSpace xs 
-
-parseMIMEType :: T.Text -> Maybe Type
-parseMIMEType = parseContentType
-
-parseContentType :: T.Text -> Maybe Type
-parseContentType str
-    | T.null minor0 = doTrace ("unable to parse content-type: " ++ show str) $ Nothing
-    | otherwise     = Just Type  { mimeType = toType (CI.mk maj) as
-                                 , mimeParams = parseParams (T.dropWhile isHSpace bs)
-                                 }
-  where
-    (maj, minor0) = T.break (=='/') (dropFoldingWSP str)
-    minor = T.drop 1 minor0
-    (as, bs) = T.break (\ ch -> isHSpace ch || isTSpecial ch) minor 
-    toType a b = case lookupField a mediaTypes of
-         Just ctor -> ctor b
-         _ -> Other a b
-
-parseParams :: T.Text -> [MIMEParam]
-parseParams t   | T.null t          = []
-                | ';' == T.head t   = let (nm_raw, vs0) = T.break (=='=') (dropFoldingWSP $ T.tail t) 
-                                          nm = CI.mk nm_raw in
-                    if T.null vs0 
-                        then []
-                        else let vs = T.tail vs0 in
-                            if not (T.null vs) && T.head vs == '"' 
-                                then let vs1 = T.tail vs 
-                                         (val, zs0) = T.break (=='"') vs1 in
-                                    if T.null zs0 
-                                        then [MIMEParam nm val]
-                                        else MIMEParam nm val : parseParams (T.dropWhile isHSpace $ T.tail zs0)
-                                else let (val, zs) = T.break (\ch -> isHSpace ch || isTSpecial ch) vs in
-                                    MIMEParam nm val : parseParams (T.dropWhile isHSpace zs)
-                | otherwise = doTrace ("Codec.MIME.Parse.parseParams: curious param value -- " ++ show t) []
-
-mediaTypes :: [(CI T.Text, T.Text -> MIMEType)]
-mediaTypes =
-  [ ("multipart",   (Multipart . toMultipart))
-  , ("application", Application)
-  , ("audio",       Audio)
-  , ("image",       Image)
-  , ("message",     Message)
-  , ("model",       Model)
-  , ("text",        Text)
-  , ("video",       Video)
-  ]
- where toMultipart b = fromMaybe other (lookupField (CI.mk b) multipartTypes)
-          where other | T.isPrefixOf "x-" b = Extension b
-                      | otherwise           = OtherMulti b
-
-multipartTypes :: [(CI T.Text, Multipart)]
-multipartTypes =
-  [ ("alternative", Alternative)
-  , ("byteranges",  Byteranges)
-  , ("digest",      Digest)
-  , ("encrypted",   Encrypted)
-  , ("form-data",   FormData)
-  , ("mixed",       Mixed)
-  , ("parallel",    Parallel)
-  , ("related",     Related)
-  , ("signed",      Signed)
-  ]
-
-untilMatch :: T.Text -> T.Text -> Maybe T.Text
-untilMatch a b  | T.null a  = Just b
-                | T.null b  = Nothing
-                | a `T.isPrefixOf` b = Just $ T.drop (T.length a) b
-                | otherwise = untilMatch a $ T.tail b
-
-matchUntil :: T.Text -> T.Text -> (T.Text, T.Text)
--- searching str; returning parts before str and after str
-matchUntil str = second (T.drop $ T.length str) . T.breakOn str
-
-{-
-matchUntil' :: T.Text -> T.Text -> (T.Text, T.Text)
-matchUntil' _   "" = ("", "")
-matchUntil' str xs
-    | T.null xs = mempty
-    -- slow, but it'll do for now.
-    | str `T.isPrefixOf` xs = ("", T.drop (T.length str) xs)
-    | otherwise = let (as,bs) = matchUntil' str $ T.tail xs in (T.take 1 xs <> as, bs)
--}
-
-isHSpace :: Char -> Bool
-isHSpace c = c == ' ' || c == '\t'
-
-isTSpecial :: Char -> Bool
-isTSpecial x = x `elem` ("()<>@,;:\\\"/[]?=" :: String) -- "
-
-dropFoldingWSP :: T.Text -> T.Text
-dropFoldingWSP t | T.null t   = ""
-                 | isHSpace (T.head t) = dropFoldingWSP $ T.tail t
-                 | "\r\n" `T.isPrefixOf` t && not (T.null $ T.drop 2 t) && isHSpace (T.head $ T.drop 2 t) 
-                    = dropFoldingWSP $ T.drop 3 t
-                 | otherwise    = t 
-
-takeUntilCRLF :: T.Text -> (T.Text, T.Text)
-takeUntilCRLF str = go "" str
- where
-  go acc t  | T.null t  = (T.reverse (T.dropWhile isHSpace acc), "")
-            | "\r\n" `T.isPrefixOf` t && not (T.null $ T.drop 2 t) && isHSpace (T.head $ T.drop 2 t)  
-                        = go (" " <> acc) (T.drop 3 t)
-            | "\r\n" `T.isPrefixOf` t && not (T.null $ T.drop 2 t)  
-                        = (T.reverse (T.dropWhile isHSpace acc), T.drop 2 t)
-            | otherwise = go (T.take 1 t <> acc) $ T.tail t
-
--- case in-sensitive lookup of field names or attributes\/parameters.
-lookupField :: CI T.Text -> [(CI T.Text,a)] -> Maybe a
-lookupField n ns = 
-   -- assume that inputs have been mostly normalized already 
-   -- (i.e., lower-cased), but should the lookup fail fall back
-   -- to a second try where we do normalize before giving up.
-  case lookup n ns of
-    x@Just{} -> x
-    Nothing  -> 
-      fmap snd $ L.find ((n==) . fst) ns
-      
diff --git a/Codec/MIME/QuotedPrintable.hs b/Codec/MIME/QuotedPrintable.hs
deleted file mode 100644
index cdc2266..0000000
--- a/Codec/MIME/QuotedPrintable.hs
+++ /dev/null
@@ -1,66 +0,0 @@
---------------------------------------------------------------------
--- |
--- Module    : Codec.MIME.QuotedPrintable
--- Copyright : (c) 2006-2009, Galois, Inc. 
--- License   : BSD3
---
--- Maintainer: Sigbjorn Finne <sigbjorn.finne@gmail.com>
--- Stability : provisional
--- Portability:
---
--- To and from QP content encoding.
---
---------------------------------------------------------------------
-module Codec.MIME.QuotedPrintable 
-       ( decode -- :: String -> String
-       , encode -- :: String -> String
-       ) where
-
-import Data.Char
-
--- | 'decode' incoming quoted-printable content, stripping
--- out soft line breaks and translating @=XY@ sequences
--- into their decoded byte\/octet. The output encoding\/representation 
--- is still a String, not a sequence of bytes.
-decode :: String -> String
-decode "" = ""
-decode ('=':'\r':'\n':xs) = decode xs -- soft line break.
-decode ('=':x1:x2:xs)
- | isHexDigit x1 && isHexDigit x2 =
-    chr (digitToInt x1 * 16 + digitToInt x2) : decode xs
-decode ('=':xs) = '=':decode xs
-              -- make it explicit that we propagate other '=' occurrences.
-decode (x1:xs) = x1:decode xs
-
--- | 'encode' converts a sequence of characeter _octets_ into
--- quoted-printable form; suitable for transmission in MIME
--- payloads. Note the stress on _octets_; it is assumed that
--- you have already converted Unicode into a <=8-bit encoding
--- (UTF-8, most likely.)
-encode :: String -> String
-encode xs = encodeLength 0 xs
-
--- | @encodeLength llen str@ is the worker function during encoding.
--- The extra argument @llen@ tracks the current column for the line
--- being processed. Soft line breaks are inserted if a line exceeds
--- a max length.
-encodeLength :: Int -> String -> String
-encodeLength _ "" = ""
-encodeLength n (x:xs)
- | n >= 72  = '=':'\r':'\n':encodeLength 0 (x:xs)
-encodeLength _ ('=':xs) 
- = '=':'3':'D':encodeLength 0 xs
-encodeLength n (x:xs)
- | ox >= 0x100 = error ("QuotedPrintable.encode: encountered > 8 bit character: " ++ show (x,ox))
- | n >= 72     = '=':'\r':'\n':encodeLength 0 (x:xs)
- | ox >= 0x21 && ox <= 0x7e = x : encodeLength (n+1) xs
- | ox == 0x09 || ox == 0x20 = x : encodeLength (n+1) xs
- | otherwise = '=':showH (ox `div` 0x10): showH (ox `mod` 0x10):encodeLength (n+3) xs
- where
-  ox = ord x
-  showH v
-   | v < 10    = chr (ord_0 + v)
-   | otherwise = chr (ord_A + (v-10))
-   
-  ord_0 = ord '0'
-  ord_A = ord 'A'
diff --git a/Codec/MIME/Type.hs b/Codec/MIME/Type.hs
deleted file mode 100644
index 72ec94f..0000000
--- a/Codec/MIME/Type.hs
+++ /dev/null
@@ -1,189 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
---------------------------------------------------------------------
--- |
--- Module    : Codec.MIME.Type
--- Copyright : (c) 2006-2009, Galois, Inc. 
--- License   : BSD3
---
--- Maintainer: Sigbjorn Finne <sigbjorn.finne@gmail.com>
--- Stability : provisional
--- Portability: portable
---
--- 
--- Representing MIME types and values.
--- 
---------------------------------------------------------------------
-module Codec.MIME.Type where
-
-import           Data.CaseInsensitive   (CI)
-import qualified Data.CaseInsensitive as CI
-import qualified Data.Text as T
-import Data.Monoid ((<>))
-
-data MIMEParam = MIMEParam  { paramName     :: CI T.Text
-                            , paramValue    :: T.Text }
-    deriving (Show, Ord, Eq)
-
-data Type = Type
-    { mimeType   :: MIMEType
-    , mimeParams :: [MIMEParam]
-    } deriving ( Show, Ord, Eq )
-
--- | The @null@ MIME record type value; currently a @text/plain@.
-nullType :: Type
-nullType = Type
-    { mimeType   = Text "plain"
-    , mimeParams = []
-    }
-
-showType :: Type -> T.Text
-showType t = showMIMEType (mimeType t) <> showMIMEParams (mimeParams t)
-
-showMIMEParams :: [MIMEParam] -> T.Text
-showMIMEParams ps = T.concat $ map showP ps
-  where 
-    showP (MIMEParam k v) = "; " <> CI.original k <> "=\"" <> v <> "\""
-
-
-data MIMEType
- = Application SubType
- | Audio       SubType
- | Image       SubType
- | Message     SubType
- | Model       SubType
- | Multipart   Multipart
- | Text        TextType
- | Video       SubType
- | Other       {otherType :: CI T.Text, otherSubType :: SubType}
-   deriving ( Show, Ord, Eq )
-
-showMIMEType :: MIMEType -> T.Text
-showMIMEType t = 
- case t of
-   Application s -> "application/"<>s
-   Audio s       -> "audio/"<>s
-   Image s       -> "image/"<>s
-   Message s     -> "message/"<>s
-   Model s       -> "model/"<>s
-   Multipart s   -> "multipart/"<>showMultipart s
-   Text s        -> "text/"<>s
-   Video s       -> "video/"<>s
-   Other a b     -> CI.original a <> "/" <> b
-
--- | a (type, subtype) MIME pair.
-data MIMEPair
- = MIMEPair T.Text SubType
-   deriving ( Eq )
-
-showMIMEPair :: MIMEPair -> T.Text
-showMIMEPair (MIMEPair a b) = a <> "/" <> b
-
--- | default subtype representation.
-type SubType = T.Text
-
--- | subtype for text content; currently just a string.
-type TextType = SubType
-
-subTypeString :: Type -> T.Text
-subTypeString t = T.drop 1 $ snd $ T.break (=='/') (showMIMEType (mimeType t))
-
-majTypeString :: Type -> T.Text
-majTypeString t = fst $ T.break (=='/') (showMIMEType (mimeType t))
-
-data Multipart
- = Alternative
- | Byteranges
- | Digest
- | Encrypted
- | FormData
- | Mixed
- | Parallel
- | Related
- | Signed
- | Extension  T.Text  -- ^ e.g., 'x-foo' (i.e., includes the 'x-' bit)
- | OtherMulti T.Text  -- unrecognized\/uninterpreted.
-                      -- (e.g., appledouble, voice-message, etc.)
-   deriving ( Show, Ord, Eq )
-
-isXmlBased :: Type -> Bool
-isXmlBased t = 
-  case mimeType t of
-     Multipart{} -> False
-     _ -> "+xml" `T.isSuffixOf` subTypeString t
-
-isXmlType :: Type -> Bool
-isXmlType t = isXmlBased t ||
-  case mimeType t of
-    Application s -> s `elem` xml_media_types
-    Text s        -> s `elem` xml_media_types
-    _             -> False
- where
-    -- Note: xml-dtd isn't considered an XML type here.
-  xml_media_types :: [T.Text]
-  xml_media_types = 
-    [ "xml"
-    , "xml-external-parsed-entity"
-    ]
-  
-
-showMultipart :: Multipart -> T.Text
-showMultipart m = 
- case m of
-   Alternative -> "alternative"
-   Byteranges  -> "byteranges"
-   Digest      -> "digest"
-   Encrypted   -> "encrypted"
-   FormData    -> "form-data"
-   Mixed       -> "mixed"
-   Parallel    -> "parallel"
-   Related     -> "related"
-   Signed      -> "signed"
-   Extension e -> e
-   OtherMulti e -> e
-   
-type Content = T.Text
-
-data MIMEValue = MIMEValue
-      { mime_val_type     :: Type
-      , mime_val_disp     :: Maybe Disposition
-      , mime_val_content  :: MIMEContent
-      , mime_val_headers  :: [MIMEParam]
-      , mime_val_inc_type :: Bool
-      } deriving ( Show, Eq )
-
-nullMIMEValue :: MIMEValue
-nullMIMEValue = MIMEValue
-      { mime_val_type     = nullType
-      , mime_val_disp     = Nothing
-      , mime_val_content  = Multi []
-      , mime_val_headers  = []
-      , mime_val_inc_type = True
-      } 
-
-data MIMEContent 
-  = Single Content
-  | Multi [MIMEValue]
-    deriving (Eq,Show)
-   
-data Disposition
- = Disposition
-     { dispType   :: DispType
-     , dispParams :: [DispParam]
-     } deriving ( Show, Eq )
-
-data DispType
- = DispInline
- | DispAttachment
- | DispFormData
- | DispOther T.Text
-   deriving ( Show, Eq)
-
-data DispParam
- = Name T.Text
- | Filename T.Text
- | CreationDate T.Text
- | ModDate T.Text
- | ReadDate T.Text
- | Size T.Text
- | OtherParam (CI T.Text) T.Text
-   deriving ( Show, Eq)
diff --git a/Codec/MIME/Utils.hs b/Codec/MIME/Utils.hs
deleted file mode 100644
index dd54860..0000000
--- a/Codec/MIME/Utils.hs
+++ /dev/null
@@ -1,33 +0,0 @@
---------------------------------------------------------------------
--- |
--- Module    : Codec.MIME.Utils
--- Copyright : (c) 2006-2009, Galois, Inc. 
--- License   : BSD3
---
--- Maintainer: Sigbjorn Finne <sigbjorn.finne@gmail.com>
--- Stability : provisional
--- Portability: portable
---
--- Extracting content from MIME values and types.
--- 
---------------------------------------------------------------------
-module Codec.MIME.Utils
-  ( findMultipartNamed -- :: String -> MIMEValue -> Maybe MIMEValue
-  )  where
-
-import Codec.MIME.Type
-import Data.List ( find )
-import Control.Monad ( msum )
-import Data.Text(Text)
-
--- | Given a parameter name, locate it within a MIME value,
--- returning the corresponding (sub) MIME value.
-findMultipartNamed :: Text -> MIMEValue -> Maybe MIMEValue
-findMultipartNamed nm mv =
- case mime_val_content mv of
-   Multi ms  -> msum (map (findMultipartNamed nm) ms)
-   Single {} -> do cd <- mime_val_disp mv
-                   _ <- find (withDispName nm) (dispParams cd)
-                   return mv
- where withDispName a (Name b) = a == b
-       withDispName _ _ = False