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
|
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
|
||||||
|
|
|
@ -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 = ""
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue