Mahdollista useampi kappale samaa riviä samassa laskussa

This commit is contained in:
Saku Laesvuori 2023-11-15 17:17:10 +02:00
parent ff5137d7d7
commit d8698834f6
Signed by: slaesvuo
GPG Key ID: 257D284A2A1D3A32
3 changed files with 31 additions and 14 deletions

View File

@ -4,9 +4,10 @@
module Laskutin.CSV (CsvInvoice(..), CsvTransaction(..), TransactionMessage(..), parseCsvFile, invoiceRowFromCsv) where module Laskutin.CSV (CsvInvoice(..), CsvTransaction(..), TransactionMessage(..), parseCsvFile, invoiceRowFromCsv) where
import Data.Bifunctor (first) import Data.Bifunctor (first, bimap)
import Data.Bifunctor (second) import Data.Bifunctor (second)
import Control.Monad ((>=>)) import Control.Monad ((>=>), guard)
import Data.Char (isDigit)
import Data.HashMap.Strict (delete) import Data.HashMap.Strict (delete)
import Data.List.NonEmpty (NonEmpty, nonEmpty) import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.MIME (Address, address, renderAddress, defaultCharsets, parse) import Data.MIME (Address, address, renderAddress, defaultCharsets, parse)
@ -36,7 +37,8 @@ data CsvInvoice = CsvInvoice
} deriving Show } deriving Show
data CsvInvoiceRow = CsvInvoiceRow data CsvInvoiceRow = CsvInvoiceRow
{ amount :: Maybe Euro { amount :: Maybe Int
, price :: Euro
, name :: Text , name :: Text
} deriving Show } deriving Show
@ -102,10 +104,19 @@ instance FromNamedRecord CsvTransaction where
<*> row .: encodeUtf8 "Määrä EUR" <*> row .: encodeUtf8 "Määrä EUR"
namedRecordToRows :: NamedRecord -> Parser [CsvInvoiceRow] namedRecordToRows :: NamedRecord -> Parser [CsvInvoiceRow]
namedRecordToRows row = pure namedRecordToRows = mapM (parseInvoiceRow . bimap decodeUtf8 decodeUtf8) . HM.toList
$ fmap (uncurry (flip CsvInvoiceRow) . first decodeUtf8) where parseInvoiceRow (header', amount') = do
$ HM.toList let amount = readInt amount'
$ fmap (readEuro . decodeUtf8) row Just (name, price) <- pure $ readHeader header'
pure CsvInvoiceRow {amount, name, price}
readInt x = do
guard $ not $ T.null x
guard $ T.all isDigit x
pure $ read $ T.unpack x
readHeader x = do
[name, price'] <- pure $ T.strip <$> T.splitOn ":" x
price <- readEuro price'
pure (name, price)
emailField, referenceField, paidField :: BS.ByteString emailField, referenceField, paidField :: BS.ByteString
emailField = "sposti" emailField = "sposti"
@ -119,5 +130,5 @@ parseCsvFile :: FromNamedRecord a => FilePath -> IO (Header, [a])
parseCsvFile = LBS.readFile >=> handleParseErrors . decodeByName parseCsvFile = LBS.readFile >=> handleParseErrors . decodeByName
invoiceRowFromCsv :: CsvInvoiceRow -> Maybe InvoiceRow invoiceRowFromCsv :: CsvInvoiceRow -> Maybe InvoiceRow
invoiceRowFromCsv CsvInvoiceRow {amount, name} = invoiceRowFromCsv CsvInvoiceRow {amount, name, price} =
maybe Nothing (\amount -> Just InvoiceRow {name, amount}) amount maybe Nothing (\amount -> Just InvoiceRow {name, price, amount}) amount

View File

@ -41,15 +41,20 @@ invoiceEmail Invoice {rows, reference, account, recipient, due, subject, message
set (headerSubject defaultCharsets) (Just $ "Lasku " <> subject ) $ createTextPlainMessage $ set (headerSubject defaultCharsets) (Just $ "Lasku " <> subject ) $ createTextPlainMessage $
(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"
<> renderInvoiceRow InvoiceRow {name = "YHTEENSÄ", amount = sum $ invoiceRowAmount <$> rows} <> "\n" <> renderInvoiceRow InvoiceRow {name = "YHTEENSÄ", amount = 1, price = sum $ invoiceRowSum <$> rows} <> "\n"
<> "Maksu tilisiirrolla\n\n" <> "Maksu tilisiirrolla\n\n"
<> "Viitenumero: " <> renderReference reference <> "\n" <> "Viitenumero: " <> renderReference reference <> "\n"
<> "Tilinumero: " <> renderIBAN account <> "\n" <> "Tilinumero: " <> renderIBAN account <> "\n"
<> "Vastaanottaja: " <> recipient <> "\n" <> "Vastaanottaja: " <> recipient <> "\n"
<> maybe mempty (("Eräpäivä: " <>) . renderDay) due <> maybe mempty (("Eräpäivä: " <>) . renderDay) due
where invoiceRowAmount InvoiceRow {amount} = amount where renderDay (YearMonthDay year month day) =
renderDay (YearMonthDay year month day) =
T.pack $ show day <> "." <> show month <> "." <> show year T.pack $ show day <> "." <> show month <> "." <> show year
invoiceRowSum :: InvoiceRow -> Euro
invoiceRowSum InvoiceRow {amount, price} = fromIntegral amount * price
renderInvoiceRow :: InvoiceRow -> Text renderInvoiceRow :: InvoiceRow -> Text
renderInvoiceRow InvoiceRow {name, amount} = name <> ": " <> renderEuro amount <> "\n" renderInvoiceRow row@InvoiceRow {name, price, amount}
| amount > 1 = name <> ", " <> renderEuro price <> "/kpl * " <> T.pack (show amount) <> "kpl: " <> renderEuro (invoiceRowSum row) <> "\n"
| amount == 1 = name <> ": " <> renderEuro price <> "\n"
| otherwise = ""

View File

@ -31,7 +31,8 @@ import Data.Maybe (fromMaybe)
import qualified Data.Text as T import qualified Data.Text as T
data InvoiceRow = InvoiceRow data InvoiceRow = InvoiceRow
{ amount :: Euro { price :: Euro
, amount :: Int
, name :: Text , name :: Text
} deriving (Show, Eq) } deriving (Show, Eq)