Lisää mahdollisuus lähettää maksumuistutuksia
This commit is contained in:
parent
ad7d057201
commit
72e432cc82
|
@ -30,10 +30,10 @@ main = do
|
|||
UpdateTable bankCsv -> updateTableMain csv bankCsv
|
||||
|
||||
sendInvoicesMain :: FilePath -> SendOptions -> IO ()
|
||||
sendInvoicesMain csvPath options@SendOptions {email, sendmail} = do
|
||||
invoices <- readInvoices csvPath options
|
||||
sendInvoicesMain csvPath options@SendOptions {email, sendmail, reminders} = do
|
||||
invoices <- filter (\(_, Invoice {isPaid}) -> not isPaid) <$> readInvoices csvPath options
|
||||
forM_ invoices $ \invoice@(address, _) -> do
|
||||
sendEmail sendmail $ uncurry (renderEmail [email]) invoice
|
||||
sendEmail sendmail $ uncurry (renderEmail reminders [email]) invoice
|
||||
putStr "Lähetetty osoitteeseen: "
|
||||
T.putStrLn $ decodeUtf8 $ renderAddresses address
|
||||
threadDelay (3 * 1000 * 1000)
|
||||
|
@ -46,9 +46,9 @@ updateTableMain invoiceCsv transactionCsv = do
|
|||
LBS.writeFile invoiceCsv $ encodeByName headers newInvoices
|
||||
|
||||
updateInvoices :: [CsvTransaction] -> CsvInvoice -> CsvInvoice
|
||||
updateInvoices transactions invoice@CsvInvoice {isPaid, reference}
|
||||
updateInvoices transactions invoice@CsvInvoice {isPaid, reference, ..}
|
||||
| isPaid = invoice
|
||||
| otherwise = invoice {isPaid = reference `elem` transactionReferences}
|
||||
| otherwise = CsvInvoice {isPaid = reference `elem` transactionReferences, ..}
|
||||
where transactionReferences = catMaybes $ transactionReference <$> transactions
|
||||
transactionReference CsvTransaction {referenceOrMessage = Message _} = Nothing
|
||||
transactionReference CsvTransaction {referenceOrMessage = Reference ref} = Just ref
|
||||
|
|
|
@ -19,12 +19,12 @@ import qualified Data.ByteString.Lazy as LBS
|
|||
|
||||
import Laskutin.Types
|
||||
|
||||
renderEmail :: [Address] -> [Address] -> Invoice -> ByteString
|
||||
renderEmail senders recipients = renderMessage
|
||||
renderEmail :: Bool -> [Address] -> [Address] -> Invoice -> ByteString
|
||||
renderEmail isReminder senders recipients = renderMessage
|
||||
. set (headerBCC defaultCharsets) senders
|
||||
. set (headerTo defaultCharsets) recipients
|
||||
. set (headerFrom defaultCharsets) senders
|
||||
. invoiceEmail
|
||||
. invoiceEmail isReminder
|
||||
|
||||
sendEmail :: FilePath -> ByteString -> IO ()
|
||||
sendEmail sendmail email = do
|
||||
|
@ -36,10 +36,11 @@ sendEmail sendmail email = do
|
|||
ExitSuccess -> pure ()
|
||||
ExitFailure code -> throwIO $ ErrorCall ("sendmail exited with error code " <> show code)
|
||||
|
||||
invoiceEmail :: Invoice -> MIMEMessage
|
||||
invoiceEmail Invoice {rows, reference, account, recipient, due, subject, message} =
|
||||
set (headerSubject defaultCharsets) (Just $ "Lasku – " <> subject ) $ createTextPlainMessage $
|
||||
(if T.null message then mempty else (message <> "\n\n\n"))
|
||||
invoiceEmail :: Bool -> Invoice -> MIMEMessage
|
||||
invoiceEmail isReminder Invoice {rows, reference, account, recipient, due, subject, message} =
|
||||
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 T.null message then mempty else (message <> "\n\n\n"))
|
||||
<> sconcat (NE.map renderInvoiceRow rows) <> "\n"
|
||||
<> renderInvoiceRow InvoiceRow {name = "YHTEENSÄ", amount = 1, price = sum $ invoiceRowSum <$> rows} <> "\n"
|
||||
<> "Maksu tilisiirrolla\n\n"
|
||||
|
@ -49,6 +50,7 @@ invoiceEmail Invoice {rows, reference, account, recipient, due, subject, message
|
|||
<> maybe mempty (("Eräpäivä: " <>) . renderDay) due
|
||||
where renderDay (YearMonthDay year month day) =
|
||||
T.pack $ show day <> "." <> show month <> "." <> show year
|
||||
subjectPrefix = if isReminder then "Maksumuistutus" else "Lasku"
|
||||
|
||||
invoiceRowSum :: InvoiceRow -> Euro
|
||||
invoiceRowSum InvoiceRow {amount, price} = fromIntegral amount * price
|
||||
|
|
|
@ -30,6 +30,7 @@ data SendOptions = SendOptions
|
|||
, due :: Maybe Day
|
||||
, email :: Address
|
||||
, sendmail :: FilePath
|
||||
, reminders :: Bool
|
||||
}
|
||||
|
||||
parseOptions :: IO Options
|
||||
|
@ -56,3 +57,4 @@ sendOptions = fmap Send $ SendOptions
|
|||
<*> option (eitherReader $ parse (address defaultCharsets) . T.encodeUtf8 . T.pack)
|
||||
(long "email" <> help "Invoice sender email address" <> metavar "EMAIL")
|
||||
<*> strOption (long "sendmail" <> short 'm' <> metavar "FILE" <> help "The sendmail program to use")
|
||||
<*> switch (long "reminders" <> short 'r' <> help "Send reminder emails")
|
||||
|
|
|
@ -44,6 +44,7 @@ data Invoice = Invoice
|
|||
, subject :: Text
|
||||
, message :: Text
|
||||
, due :: Maybe Day
|
||||
, isPaid :: Bool
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data Reference = Reference {base :: [Digit], checksum :: Digit}
|
||||
|
|
Loading…
Reference in New Issue