-- | Message and message header manipulation functions
{-# LANGUAGE DeriveFunctor #-}
module MimeMessage(-- * Messages
                   MimeMessage(..),parseMessage,parseMessage',showMessage,
                   module MessageHeaders,
                   -- * Analysing messages
                   contentType, mimeContentType,
                   headerWithParams,parseParams,
                   -- * Parsing helpers
                   rmcrHdr,rejoin,disasmHeader,
                   -- * Rendering helpers
                   hdrlines,
                   -- * Obsolete functions
                   splitmsg
                  ) where
import Data.List(intersperse)
import Data.Char(isSpace)
import Utils2(mapPair,strToLower,addcr,aboth,trim,unquote,breakAt,chopList,apFst,apSnd)
import MessageHeaders
import qualified HeaderNames as HN(contentType)

data MimeMessage body = MimeMsg { mimeHdrs :: Headers, mimeBody :: body }
                      deriving (Show,Functor)

parseMessage :: String -> MimeMessage String
parseMessage = parseMessage' . rmcrHdr
parseMessage' = uncurry MimeMsg . apFst (map disasmHeader . rejoin . lines)
-- ^ Parse a message where the headers have already been separated from the body

showMessage (MimeMsg hdrs body) = asmMsg (hdrs,body)

splitmsg = apFst (map disasmHeader) . breakAt "" 

disasmHeader = mapPair (hn,rmspace) . breakAt ':'

--getmsgheader msg h = getheader (fst (splitmsg msg)) h

-- | Content-Type without parameters
mimeContentType = fst . contentType

-- | Content-Type with parameters
contentType = headerWithParams HN.contentType
headerWithParams h = apFst strToLower . breakAt ';' . flip getheader h

parseParams = map (apFst strToLower . apSnd unquote . aboth trim . breakAt '=')
              . chopList (breakAt ';')

asmHeader (h@('F':'r':'o':'m':' ':_),r) = h ++ ":" ++ r
asmHeader (h,r) = h ++ ": " ++ r

hdrlines :: Headers -> [String]
hdrlines = map (asmHeader.apFst orig)

asmMsg (hdrs,body) = addcr (unlines (hdrlines hdrs)) ++ "\r\n" ++ body

--parseMsg = splitmsg . lines -- old
msglines (hdr,body) = hdrlines hdr ++ [""] ++ body
printMsg = unlines . msglines

rmspace (' ':s) = s
rmspace s = s


-- | Separate the message headers from the message body,
-- while converting CRLF to LF in the headers
rmcrHdr ('\r':s) = rmcrHdr s
rmcrHdr ('\n':'\r':'\n':s) = ("",s)
rmcrHdr ('\n':'\n':s) = ("",s)
rmcrHdr (c:s) = apFst (c:) (rmcrHdr s)
rmcrHdr "" = ("","")

-- | Rejoin headers that were split over several lines
rejoin (l1:ls) =
  case break (null . takeWhile isSpace) ls of
    (ls1,ls2) -> concat (intersperse "\n" (l1:ls1)):rejoin ls2
rejoin [] = []