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

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 Lazy.BS.getContents
    delay <- scan $ Lazy.Char8.BS.unpack mailStr
    let
      (headers, body) = break (== "") $ Lazy.Char8.BS.lines mailStr
      headers' = filter (not . (Lazy.Char8.BS.isPrefixOf `on` CI.foldCase) "X-Delay:") headers 
      mailStr' = Lazy.Char8.BS.unlines $ headers' ++ body

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