{-# LANGUAGE RecordWildCards, ApplicativeDo, FlexibleContexts #-}

module Main (main) where

import Postdelay.Scan
import Postdelay.Queue

import Data.Function (on)
import Data.List
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI

import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Catch (MonadCatch)
import Control.Monad.Reader

import Data.ByteString.Lazy as Lazy (ByteString)
import qualified Data.ByteString.Lazy as Lazy.BS

import Data.ByteString.Lazy.Char8 as Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as Lazy.Char8.BS

import Data.Conduit

import System.Environment (getProgName)

import qualified Options.Applicative as Opt (Parser)
import Options.Applicative hiding (Parser)


opts :: Opt.Parser (String, [String], StoreConfig)
opts = do
  sConfig <- storeConfig
  sender <- strOption $ mconcat
    [ long "sender"
    , short 'f'
    , metavar "SENDER"
    ]
  recipients <- some . strArgument $ mconcat
    [ metavar "RECIPIENTS"
    ]
  pure (sender, recipients, sConfig)

main :: (MonadIO m, MonadCatch m) => m ()
main = do
  pName <- liftIO getProgName
  (sender, recipients, sConfig) <- liftIO . execParser . info (helper <*> opts) $ mconcat
    [ fullDesc
    , progDesc "Queue an email for later delivery"
    , header pName
    ]
  
  flip runReaderT sConfig $ do
    mailStr <- liftIO getContents
    delay <- scan mailStr
    let
      (headers, body) = break (== "") $ lines mailStr
      mailStr' = unlines $ filter (not . (isPrefixOf `on` CI.foldCase) "X-Delay:") headers ++ body

      sendNow = sendmail sender recipients $ Lazy.Char8.BS.pack mailStr'
      sendLater sendDelay = pushStore . yield $ StoredMail
        { message = Lazy.Char8.BS.pack mailStr'
        , ..
        }
    maybe sendNow sendLater delay