{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.MIME.Extended
    ( module Data.MIME
    ) where

import Control.Lens hiding ((.=))
import Data.Aeson
import Data.ByteString.Extended ()
import Data.MIME
import Data.MIME.EncodedWord
import qualified Data.Vector



instance ToJSON (Message s MIME) where
    toJSON (Message h b) =
      object
          [ "headers" .= toJSON h
          , "body" .=
            case b of
              Part b' -> toJSON b'
              Encapsulated b' -> toJSON b'
              Multipart b' -> toJSON b'
              FailedParse _ msg -> toJSON msg
          ]

instance FromJSON (Message s MIME) where
    parseJSON =
        withObject "MIMEMessage" $ \v -> do
          h <- v .: "headers"
          b <-
            case h ^. contentType of
              ContentType "message" "rfc822" _ ->
                Encapsulated <$> v .: "body"

              ContentType "multipart" _ _ ->
                Multipart <$> v .: "body"

              _ ->
                Part <$> v .: "body"
          pure $ Message h b


instance ToJSON Headers where
    toJSON (Headers h) =
        Array . Data.Vector.fromList . map toJSON' $ h
      where
        toJSON' (k, v) =
          object
            [ "key" .= toJSON k
            , "value" .= toJSON (decodeEncodedWords defaultCharsets v)
            ]

instance FromJSON Headers where
    parseJSON =
        withArray "Headers" $ \v -> do
          x <- mapM parseJSON' $ Data.Vector.toList v
          pure $ Headers x
      where
        parseJSON' =
            withObject "Header" $ \v ->
              (,) <$> v .: "key"
                  <*> encodeEncodedWords `fmap` (v .: "value")