88 lines
3.5 KiB
Haskell
88 lines
3.5 KiB
Haskell
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
module Laskutin where
|
|
|
|
import Control.Concurrent (threadDelay)
|
|
import Control.Monad (forM_, forM)
|
|
import Data.Csv (encodeByName)
|
|
import Data.List.NonEmpty (nonEmpty, singleton)
|
|
import Data.MIME (Address, renderAddresses)
|
|
import Data.Maybe (fromMaybe, mapMaybe)
|
|
import Data.Text.Encoding (decodeUtf8)
|
|
import System.Exit (exitFailure)
|
|
import System.IO (stderr, hPutStrLn)
|
|
|
|
import qualified Data.ByteString.Lazy as LBS
|
|
import qualified Data.Text.IO as T
|
|
|
|
import Laskutin.CSV
|
|
import Laskutin.Email
|
|
import Laskutin.Options
|
|
import Laskutin.Types
|
|
import Laskutin.Status
|
|
import Laskutin.InvoiceList
|
|
|
|
main :: IO ()
|
|
main = do
|
|
Options {csv, command} <- parseOptions
|
|
case command of
|
|
Status -> statusMain csv
|
|
List listOptions -> listMain csv listOptions
|
|
Send sendOptions -> sendInvoicesMain csv sendOptions
|
|
UpdateTable bankCsv -> updateTableMain csv bankCsv
|
|
|
|
sendInvoicesMain :: FilePath -> SendOptions -> IO ()
|
|
sendInvoicesMain csvPath options@SendOptions {email, sendmail, reminders, dryRun} = do
|
|
invoices <- readInvoices csvPath options
|
|
forM_ invoices $ \(address, invoice) -> do
|
|
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: "
|
|
T.putStrLn $ decodeUtf8 $ renderAddresses address
|
|
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 invoiceCsv transactionCsv = do
|
|
(headers, csvInvoices) <- parseCsvFile invoiceCsv
|
|
(_, csvTransactions) <- parseCsvFile transactionCsv
|
|
let newInvoices = fmap (updateInvoices csvTransactions) csvInvoices
|
|
LBS.writeFile invoiceCsv $ encodeByName headers newInvoices
|
|
|
|
statusMain :: FilePath -> IO ()
|
|
statusMain invoiceCsv = do
|
|
(_, invoices) <- parseCsvFile invoiceCsv
|
|
T.putStr $ showStatus $ invoiceStatus invoices
|
|
|
|
listMain :: FilePath -> ListOptions -> IO ()
|
|
listMain invoiceCsv options = do
|
|
(_, invoices) <- parseCsvFile invoiceCsv
|
|
T.putStr $ showInvoiceList options invoices
|
|
|
|
updateInvoices :: [CsvTransaction] -> CsvInvoice -> CsvInvoice
|
|
updateInvoices transactions invoice@CsvInvoice {reference, ..}
|
|
| csvIsPaid invoice = invoice
|
|
| otherwise = CsvInvoice {paid = Just transactionsSum, ..}
|
|
where transactionsSum = sum $ map amount $ filter hasReference transactions
|
|
hasReference CsvTransaction {referenceOrMessage = Reference ref} = reference == ref
|
|
hasReference CsvTransaction {referenceOrMessage = Message _} = False
|
|
|
|
readInvoices :: FilePath -> SendOptions -> IO [([Address], Invoice)]
|
|
readInvoices csv SendOptions {account, recipient, subject, message, due} = do
|
|
(_, csvInvoices) <- parseCsvFile csv
|
|
forM csvInvoices $ \CsvInvoice {..} -> do
|
|
invoiceRows <- maybe (hPutStrLn stderr "No invoice rows in invoice" >> exitFailure) pure $
|
|
nonEmpty $ mapMaybe invoiceRowFromCsv rows
|
|
pure ([invoiceRecipient], Invoice { rows = invoiceRows, paid = fromMaybe 0 paid, ..})
|