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
import Data.Bifunctor (first)
import Data.Bifunctor (first, bimap)
import Data.Bifunctor (second)
import Control.Monad ((>=>))
import Control.Monad ((>=>), guard)
import Data.Char (isDigit)
import Data.HashMap.Strict (delete)
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.MIME (Address, address, renderAddress, defaultCharsets, parse)
@ -36,7 +37,8 @@ data CsvInvoice = CsvInvoice
} deriving Show
data CsvInvoiceRow = CsvInvoiceRow
{ amount :: Maybe Euro
{ amount :: Maybe Int
, price :: Euro
, name :: Text
} deriving Show
@ -102,10 +104,19 @@ instance FromNamedRecord CsvTransaction where
<*> row .: encodeUtf8 "Määrä EUR"
namedRecordToRows :: NamedRecord -> Parser [CsvInvoiceRow]
namedRecordToRows row = pure
$ fmap (uncurry (flip CsvInvoiceRow) . first decodeUtf8)
$ HM.toList
$ fmap (readEuro . decodeUtf8) row
namedRecordToRows = mapM (parseInvoiceRow . bimap decodeUtf8 decodeUtf8) . HM.toList
where parseInvoiceRow (header', amount') = do
let amount = readInt amount'
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 = "sposti"
@ -119,5 +130,5 @@ parseCsvFile :: FromNamedRecord a => FilePath -> IO (Header, [a])
parseCsvFile = LBS.readFile >=> handleParseErrors . decodeByName
invoiceRowFromCsv :: CsvInvoiceRow -> Maybe InvoiceRow
invoiceRowFromCsv CsvInvoiceRow {amount, name} =
maybe Nothing (\amount -> Just InvoiceRow {name, amount}) amount
invoiceRowFromCsv CsvInvoiceRow {amount, name, price} =
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 $
(if T.null message then mempty else (message <> "\n\n\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"
<> "Viitenumero: " <> renderReference reference <> "\n"
<> "Tilinumero: " <> renderIBAN account <> "\n"
<> "Vastaanottaja: " <> recipient <> "\n"
<> maybe mempty (("Eräpäivä: " <>) . renderDay) due
where invoiceRowAmount InvoiceRow {amount} = amount
renderDay (YearMonthDay year month day) =
where renderDay (YearMonthDay year month day) =
T.pack $ show day <> "." <> show month <> "." <> show year
invoiceRowSum :: InvoiceRow -> Euro
invoiceRowSum InvoiceRow {amount, price} = fromIntegral amount * price
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
data InvoiceRow = InvoiceRow
{ amount :: Euro
{ price :: Euro
, amount :: Int
, name :: Text
} deriving (Show, Eq)