--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- |
--Module       : Deliverable
--Author       : Joe Fredette
--License      : BSD3
--Copyright    : Joe Fredette
--
--Maintainer   : Joe Fredette <jfredett.at.gmail.dot.com>
--Stability    : Unstable
--Portability  : Portable 
--
--------------------------------------------------------------------------------
--Description  : Provides a class + instances which abstract over mailbox format
-- types. Currently provides a flat-file and (Slightly broken) Maildir format. 
-- also contains some combinators for dealing with new instances of Deliverable. 
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
{-# LANGUAGE DeriveDataTypeable, GADTs #-}
module HackMail.Data.Deliverable where

import HackMail.Data.Email 
import HackMail.Data.Path

import Control.Monad.Reader
import System.Directory
import System.IO
import Data.Typeable

-- | The main class which abstracts over delivery of datatype to somewhere in the file system.
-- It also abstracts over construction. Due to some weirdity w.r.t. Hint, this, and all instancing
-- datatypes, must derive Typeable. A bit of boilerplate, but deriving generally handles it easily.
class Typeable a => Deliverable a where
        deliverIO :: a -> IO ()
        construct :: Email -> Path -> a 


data DEMail = DE { email :: Email
                 , path :: Path
                 }
        deriving (Eq, Show, Typeable)   

newtype FlatEmail = Flat DEMail
        deriving (Show, Eq, Typeable)

instance Deliverable FlatEmail where
        construct e p = Flat $ DE e p
        deliverIO (Flat (DE e p)) = do
                let msgPath = getDeliveryPath (DE e p)
                writeEmail e (toFilePath p) msgPath

newtype MaildirEmail = MD DEMail
        deriving (Show, Eq, Typeable)

-- TODO: Make this _actually_ create the cur and tmp dirs too.
instance Deliverable MaildirEmail where
        construct e p = MD $ DE e p
        deliverIO (MD (DE e p)) = do
                let newDirPath = p +/+ (parse "new")
                let msgPath = (getDeliveryPath (DE e newDirPath))
                writeEmail e (toFilePath newDirPath) msgPath

getDeliveryPath :: DEMail -> FilePath
getDeliveryPath (DE e p) = mkDeliverablePath p ("msg-" ++ (emailChecksum e) ++ ".eml")

data ToDelivery where Wrap :: Deliverable a => a -> ToDelivery
        deriving (Typeable)

delivery :: ToDelivery -> IO ()
delivery (Wrap x) = deliverIO x