Lisää mahdollisuus katsoa lähetettäviä viestejä ennen lähettämistä
This commit is contained in:
parent
f11ddb8ca4
commit
c2cda17113
|
@ -33,13 +33,23 @@ main = do
|
||||||
UpdateTable bankCsv -> updateTableMain csv bankCsv
|
UpdateTable bankCsv -> updateTableMain csv bankCsv
|
||||||
|
|
||||||
sendInvoicesMain :: FilePath -> SendOptions -> IO ()
|
sendInvoicesMain :: FilePath -> SendOptions -> IO ()
|
||||||
sendInvoicesMain csvPath options@SendOptions {email, sendmail, reminders} = do
|
sendInvoicesMain csvPath options@SendOptions {email, sendmail, reminders, dryRun} = do
|
||||||
invoices <- mapMaybe (\(address, invoice) -> (address,) <$> renderEmail reminders [email] address invoice) <$> readInvoices csvPath options
|
invoices <- readInvoices csvPath options
|
||||||
forM_ invoices $ \(address, invoiceMail) -> do
|
forM_ invoices $ \(address, invoice) -> do
|
||||||
sendEmail sendmail invoiceMail
|
case renderInvoice reminders invoice of
|
||||||
|
Nothing -> pure ()
|
||||||
|
Just (subject, body) -> do
|
||||||
|
case dryRun of
|
||||||
|
False -> do
|
||||||
|
sendEmail sendmail $ renderEmail [email] address subject body
|
||||||
putStr "Lähetetty osoitteeseen: "
|
putStr "Lähetetty osoitteeseen: "
|
||||||
T.putStrLn $ decodeUtf8 $ renderAddresses address
|
T.putStrLn $ decodeUtf8 $ renderAddresses address
|
||||||
threadDelay (3 * 1000 * 1000)
|
threadDelay (3 * 1000 * 1000)
|
||||||
|
True -> do
|
||||||
|
T.putStrLn $ "To: " <> decodeUtf8 (renderAddresses address)
|
||||||
|
T.putStrLn $ "From: " <> decodeUtf8 (renderAddresses [email])
|
||||||
|
T.putStrLn $ "\n" <> body
|
||||||
|
T.putStrLn "-------\n"
|
||||||
|
|
||||||
updateTableMain :: FilePath -> FilePath -> IO ()
|
updateTableMain :: FilePath -> FilePath -> IO ()
|
||||||
updateTableMain invoiceCsv transactionCsv = do
|
updateTableMain invoiceCsv transactionCsv = do
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
module Laskutin.Email where
|
module Laskutin.Email where
|
||||||
|
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.MIME (MIMEMessage, Address, createTextPlainMessage, defaultCharsets, headerSubject, headerFrom, headerTo, headerBCC, renderMessage)
|
import Data.MIME (Address, createTextPlainMessage, defaultCharsets, headerSubject, headerFrom, headerTo, headerBCC, renderMessage)
|
||||||
import Control.Lens (set)
|
import Control.Lens (set)
|
||||||
import Data.Semigroup (sconcat)
|
import Data.Semigroup (sconcat)
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar
|
||||||
|
@ -19,12 +19,13 @@ import qualified Data.ByteString.Lazy as LBS
|
||||||
|
|
||||||
import Laskutin.Types
|
import Laskutin.Types
|
||||||
|
|
||||||
renderEmail :: Bool -> [Address] -> [Address] -> Invoice -> Maybe ByteString
|
renderEmail :: [Address] -> [Address] -> Text -> Text -> ByteString
|
||||||
renderEmail isReminder senders recipients = fmap (renderMessage
|
renderEmail senders recipients subject = renderMessage
|
||||||
. set (headerBCC defaultCharsets) senders
|
. set (headerBCC defaultCharsets) senders
|
||||||
. set (headerTo defaultCharsets) recipients
|
. set (headerTo defaultCharsets) recipients
|
||||||
. set (headerFrom defaultCharsets) senders)
|
. set (headerFrom defaultCharsets) senders
|
||||||
. invoiceEmail isReminder
|
. set (headerSubject defaultCharsets) (Just subject)
|
||||||
|
. createTextPlainMessage
|
||||||
|
|
||||||
sendEmail :: FilePath -> ByteString -> IO ()
|
sendEmail :: FilePath -> ByteString -> IO ()
|
||||||
sendEmail sendmail email = do
|
sendEmail sendmail email = do
|
||||||
|
@ -36,10 +37,9 @@ sendEmail sendmail email = do
|
||||||
ExitSuccess -> pure ()
|
ExitSuccess -> pure ()
|
||||||
ExitFailure code -> throwIO $ ErrorCall ("sendmail exited with error code " <> show code)
|
ExitFailure code -> throwIO $ ErrorCall ("sendmail exited with error code " <> show code)
|
||||||
|
|
||||||
invoiceEmail :: Bool -> Invoice -> Maybe MIMEMessage
|
renderInvoice :: Bool -> Invoice -> Maybe (Text, Text)
|
||||||
invoiceEmail _ Invoice {isPaid = True} = Nothing
|
renderInvoice _ Invoice {isPaid = True} = Nothing
|
||||||
invoiceEmail isReminder Invoice {rows, reference, account, recipient, due, subject, message, isPaid = False} = Just $
|
renderInvoice isReminder Invoice {rows, reference, account, recipient, due, subject, message, isPaid = False} = Just $ (subjectPrefix <> " – " <> subject,) $
|
||||||
set (headerSubject defaultCharsets) (Just $ subjectPrefix <> " – " <> subject ) $ createTextPlainMessage $
|
|
||||||
(if isReminder then "Muistutus alla olevan laskun maksamisesta. Jos olet juuri maksanut kyseisen laskun, tämä muistutus on aiheeton.\n\n" else mempty)
|
(if isReminder then "Muistutus alla olevan laskun maksamisesta. Jos olet juuri maksanut kyseisen laskun, tämä muistutus on aiheeton.\n\n" else mempty)
|
||||||
<> (if T.null message then mempty else (message <> "\n\n\n"))
|
<> (if T.null message then mempty else (message <> "\n\n\n"))
|
||||||
<> sconcat (NE.map renderInvoiceRow rows) <> "\n"
|
<> sconcat (NE.map renderInvoiceRow rows) <> "\n"
|
||||||
|
|
|
@ -32,6 +32,7 @@ data SendOptions = SendOptions
|
||||||
, email :: Address
|
, email :: Address
|
||||||
, sendmail :: FilePath
|
, sendmail :: FilePath
|
||||||
, reminders :: Bool
|
, reminders :: Bool
|
||||||
|
, dryRun :: Bool
|
||||||
}
|
}
|
||||||
|
|
||||||
parseOptions :: IO Options
|
parseOptions :: IO Options
|
||||||
|
@ -60,3 +61,4 @@ sendOptions = fmap Send $ SendOptions
|
||||||
(long "email" <> help "Invoice sender email address" <> metavar "EMAIL")
|
(long "email" <> help "Invoice sender email address" <> metavar "EMAIL")
|
||||||
<*> strOption (long "sendmail" <> short 'm' <> metavar "FILE" <> help "The sendmail program to use")
|
<*> strOption (long "sendmail" <> short 'm' <> metavar "FILE" <> help "The sendmail program to use")
|
||||||
<*> switch (long "reminders" <> short 'r' <> help "Send reminder emails")
|
<*> switch (long "reminders" <> short 'r' <> help "Send reminder emails")
|
||||||
|
<*> switch (long "dry-run" <> short 'd' <> help "Only print what invoices would be sent. Do not send anything")
|
||||||
|
|
Loading…
Reference in New Issue