Mahdollista useampi kappale samaa riviä samassa laskussa
This commit is contained in:
parent
ff5137d7d7
commit
d8698834f6
|
@ -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
|
||||
|
|
|
@ -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 = ""
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
Loading…
Reference in New Issue