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
|
UpdateTable bankCsv -> updateTableMain csv bankCsv
|
||||||
|
|
||||||
sendInvoicesMain :: FilePath -> SendOptions -> IO ()
|
sendInvoicesMain :: FilePath -> SendOptions -> IO ()
|
||||||
sendInvoicesMain csvPath options@SendOptions {email, sendmail} = do
|
sendInvoicesMain csvPath options@SendOptions {email, sendmail, reminders} = do
|
||||||
invoices <- readInvoices csvPath options
|
invoices <- filter (\(_, Invoice {isPaid}) -> not isPaid) <$> readInvoices csvPath options
|
||||||
forM_ invoices $ \invoice@(address, _) -> do
|
forM_ invoices $ \invoice@(address, _) -> do
|
||||||
sendEmail sendmail $ uncurry (renderEmail [email]) invoice
|
sendEmail sendmail $ uncurry (renderEmail reminders [email]) invoice
|
||||||
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)
|
||||||
|
@ -46,9 +46,9 @@ updateTableMain invoiceCsv transactionCsv = do
|
||||||
LBS.writeFile invoiceCsv $ encodeByName headers newInvoices
|
LBS.writeFile invoiceCsv $ encodeByName headers newInvoices
|
||||||
|
|
||||||
updateInvoices :: [CsvTransaction] -> CsvInvoice -> CsvInvoice
|
updateInvoices :: [CsvTransaction] -> CsvInvoice -> CsvInvoice
|
||||||
updateInvoices transactions invoice@CsvInvoice {isPaid, reference}
|
updateInvoices transactions invoice@CsvInvoice {isPaid, reference, ..}
|
||||||
| isPaid = invoice
|
| isPaid = invoice
|
||||||
| otherwise = invoice {isPaid = reference `elem` transactionReferences}
|
| otherwise = CsvInvoice {isPaid = reference `elem` transactionReferences, ..}
|
||||||
where transactionReferences = catMaybes $ transactionReference <$> transactions
|
where transactionReferences = catMaybes $ transactionReference <$> transactions
|
||||||
transactionReference CsvTransaction {referenceOrMessage = Message _} = Nothing
|
transactionReference CsvTransaction {referenceOrMessage = Message _} = Nothing
|
||||||
transactionReference CsvTransaction {referenceOrMessage = Reference ref} = Just ref
|
transactionReference CsvTransaction {referenceOrMessage = Reference ref} = Just ref
|
||||||
|
|
|
@ -19,12 +19,12 @@ import qualified Data.ByteString.Lazy as LBS
|
||||||
|
|
||||||
import Laskutin.Types
|
import Laskutin.Types
|
||||||
|
|
||||||
renderEmail :: [Address] -> [Address] -> Invoice -> ByteString
|
renderEmail :: Bool -> [Address] -> [Address] -> Invoice -> ByteString
|
||||||
renderEmail senders recipients = renderMessage
|
renderEmail isReminder senders recipients = 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
|
. invoiceEmail isReminder
|
||||||
|
|
||||||
sendEmail :: FilePath -> ByteString -> IO ()
|
sendEmail :: FilePath -> ByteString -> IO ()
|
||||||
sendEmail sendmail email = do
|
sendEmail sendmail email = do
|
||||||
|
@ -36,10 +36,11 @@ 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 :: Invoice -> MIMEMessage
|
invoiceEmail :: Bool -> Invoice -> MIMEMessage
|
||||||
invoiceEmail Invoice {rows, reference, account, recipient, due, subject, message} =
|
invoiceEmail isReminder Invoice {rows, reference, account, recipient, due, subject, message} =
|
||||||
set (headerSubject defaultCharsets) (Just $ "Lasku – " <> subject ) $ createTextPlainMessage $
|
set (headerSubject defaultCharsets) (Just $ subjectPrefix <> " – " <> subject ) $ createTextPlainMessage $
|
||||||
(if T.null message then mempty else (message <> "\n\n\n"))
|
(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"
|
<> sconcat (NE.map renderInvoiceRow rows) <> "\n"
|
||||||
<> renderInvoiceRow InvoiceRow {name = "YHTEENSÄ", amount = 1, price = sum $ invoiceRowSum <$> rows} <> "\n"
|
<> renderInvoiceRow InvoiceRow {name = "YHTEENSÄ", amount = 1, price = sum $ invoiceRowSum <$> rows} <> "\n"
|
||||||
<> "Maksu tilisiirrolla\n\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
|
<> maybe mempty (("Eräpäivä: " <>) . renderDay) due
|
||||||
where renderDay (YearMonthDay year month day) =
|
where renderDay (YearMonthDay year month day) =
|
||||||
T.pack $ show day <> "." <> show month <> "." <> show year
|
T.pack $ show day <> "." <> show month <> "." <> show year
|
||||||
|
subjectPrefix = if isReminder then "Maksumuistutus" else "Lasku"
|
||||||
|
|
||||||
invoiceRowSum :: InvoiceRow -> Euro
|
invoiceRowSum :: InvoiceRow -> Euro
|
||||||
invoiceRowSum InvoiceRow {amount, price} = fromIntegral amount * price
|
invoiceRowSum InvoiceRow {amount, price} = fromIntegral amount * price
|
||||||
|
|
|
@ -30,6 +30,7 @@ data SendOptions = SendOptions
|
||||||
, due :: Maybe Day
|
, due :: Maybe Day
|
||||||
, email :: Address
|
, email :: Address
|
||||||
, sendmail :: FilePath
|
, sendmail :: FilePath
|
||||||
|
, reminders :: Bool
|
||||||
}
|
}
|
||||||
|
|
||||||
parseOptions :: IO Options
|
parseOptions :: IO Options
|
||||||
|
@ -56,3 +57,4 @@ sendOptions = fmap Send $ SendOptions
|
||||||
<*> option (eitherReader $ parse (address defaultCharsets) . T.encodeUtf8 . T.pack)
|
<*> option (eitherReader $ parse (address defaultCharsets) . T.encodeUtf8 . T.pack)
|
||||||
(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")
|
||||||
|
|
|
@ -44,6 +44,7 @@ data Invoice = Invoice
|
||||||
, subject :: Text
|
, subject :: Text
|
||||||
, message :: Text
|
, message :: Text
|
||||||
, due :: Maybe Day
|
, due :: Maybe Day
|
||||||
|
, isPaid :: Bool
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
data Reference = Reference {base :: [Digit], checksum :: Digit}
|
data Reference = Reference {base :: [Digit], checksum :: Digit}
|
||||||
|
|
Loading…
Reference in New Issue