Tarkista että maksut ovat tarpeeksi suuria

src/Laskutin.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module Laskutin where
@@ -7,9 +8,9 @@ module Laskutin where
 import Control.Concurrent (threadDelay)
 import Control.Monad (forM_, forM)
 import Data.Csv (encodeByName)
-import Data.List.NonEmpty (nonEmpty)
+import Data.List.NonEmpty (nonEmpty, singleton)
 import Data.MIME (Address, renderAddresses)
-import Data.Maybe (catMaybes, mapMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Text.Encoding (decodeUtf8)
 import System.Exit (exitFailure)
 import System.IO (stderr, hPutStrLn)
@@ -31,9 +32,9 @@ main = do
 
 sendInvoicesMain :: FilePath -> SendOptions -> IO ()
 sendInvoicesMain csvPath options@SendOptions {email, sendmail, reminders} = do
-    invoices <- filter (\(_, Invoice {isPaid}) -> not isPaid) <$> readInvoices csvPath options
-    forM_ invoices $ \invoice@(address, _) -> do
-        sendEmail sendmail $ uncurry (renderEmail reminders [email]) invoice
+    invoices <- mapMaybe (\(address, invoice) -> (address,) <$> renderEmail reminders [email] address invoice) <$> readInvoices csvPath options
+    forM_ invoices $ \(address, invoiceMail) -> do
+        sendEmail sendmail invoiceMail
         putStr "Lähetetty osoitteeseen: "
         T.putStrLn $ decodeUtf8 $ renderAddresses address
         threadDelay (3 * 1000 * 1000)
@@ -46,17 +47,21 @@ updateTableMain invoiceCsv transactionCsv = do
     LBS.writeFile invoiceCsv $ encodeByName headers newInvoices
 
 updateInvoices :: [CsvTransaction] -> CsvInvoice -> CsvInvoice
-updateInvoices transactions invoice@CsvInvoice {isPaid, reference, ..}
-  | isPaid = invoice 
-  | otherwise = CsvInvoice {isPaid = reference `elem` transactionReferences, ..}
-      where transactionReferences = catMaybes $ transactionReference <$> transactions
-            transactionReference CsvTransaction {referenceOrMessage = Message _} = Nothing
-            transactionReference CsvTransaction {referenceOrMessage = Reference ref} = Just ref
+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 $
+    forM csvInvoices $ \csvInvoice@CsvInvoice {..} -> do
+        invoiceRows' <- maybe (hPutStrLn stderr ("No invoice rows in invoice") >> exitFailure) pure $
             nonEmpty $ mapMaybe invoiceRowFromCsv rows
+        let isPaid = fromMaybe 0 paid >= csvInvoiceSum csvInvoice
+            invoiceRows = case paid of
+                            Nothing -> invoiceRows'
+                            Just euro -> invoiceRows' <> singleton InvoiceRow {name = "Aiemmin maksettu", amount = 1, price = negate euro}
         pure ([invoiceRecipient], Invoice { rows = invoiceRows, ..})

src/Laskutin/CSV.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 
-module Laskutin.CSV (CsvInvoice(..), CsvTransaction(..), TransactionMessage(..), parseCsvFile, invoiceRowFromCsv) where
+module Laskutin.CSV (CsvInvoice(..), CsvTransaction(..), TransactionMessage(..), csvInvoiceSum, csvInvoiceRowSum, csvIsPaid, parseCsvFile, invoiceRowFromCsv) where
 
 import Data.Bifunctor (bimap, second)
 import Control.Monad ((>=>), guard)
@@ -29,7 +29,7 @@ import Laskutin.Types
 data CsvInvoice = CsvInvoice
     { invoiceRecipient :: Address
     , reference :: Reference
-    , isPaid :: Bool
+    , paid :: Maybe Euro
     , rows :: [CsvInvoiceRow]
     } deriving Show
 
@@ -47,6 +47,16 @@ data CsvTransaction = CsvTransaction
     , amount :: Euro
     } deriving Show
 
+csvIsPaid :: CsvInvoice -> Bool
+csvIsPaid CsvInvoice {paid = Nothing} = False
+csvIsPaid invoice@CsvInvoice {paid = Just paid} = paid >= csvInvoiceSum invoice
+
+csvInvoiceSum :: CsvInvoice -> Euro
+csvInvoiceSum CsvInvoice {rows} = sum $ csvInvoiceRowSum <$> rows
+
+csvInvoiceRowSum :: CsvInvoiceRow -> Euro
+csvInvoiceRowSum CsvInvoiceRow {amount, price} = maybe 0 ((* price) . fromIntegral) amount
+
 data TransactionMessage = Message Text
                         | Reference Reference
                         deriving Show
@@ -57,14 +67,6 @@ instance FromField Address where
 instance ToField Address where
     toField = renderAddress
 
-instance FromField Bool where
-    parseField "x" = pure True
-    parseField _ = pure False
-
-instance ToField Bool where
-    toField True = "x"
-    toField False = ""
-
 instance FromField Day where
     parseField = iso8601ParseM . T.unpack . decodeUtf8
 
@@ -83,14 +85,14 @@ instance FromNamedRecord CsvInvoice where
         <*> namedRecordToRows (foldr delete row [emailField, referenceField, paidField])
 
 instance ToNamedRecord CsvInvoice where
-    toNamedRecord CsvInvoice {invoiceRecipient, reference, isPaid, rows} = namedRecord $
+    toNamedRecord CsvInvoice {invoiceRecipient, reference, paid, rows} = namedRecord $
         [ emailField .= invoiceRecipient
         , referenceField .= reference
-        , paidField .= isPaid
+        , paidField .= paid
         ] <> (invoiceRowToField <$> rows)
 
 invoiceRowToField :: CsvInvoiceRow -> (BS.ByteString, BS.ByteString)
-invoiceRowToField CsvInvoiceRow {amount, name} = encodeUtf8 name .= amount
+invoiceRowToField CsvInvoiceRow {amount, price, name} = encodeUtf8 (name <> ":" <> renderEuro price) .= amount
 
 instance FromNamedRecord CsvTransaction where
     parseNamedRecord row = CsvTransaction
@@ -111,7 +113,7 @@ namedRecordToRows = mapM (parseInvoiceRow . bimap decodeUtf8 decodeUtf8) . HM.to
                   guard $ T.all isDigit x
                   pure $ read $ T.unpack x
               readHeader x = do
-                  [name, price'] <- pure $ T.strip <$> T.splitOn ":" x
+                  [name, price'] <- pure $ T.splitOn ":" x
                   price <- readEuro price'
                   pure (name, price)
 

src/Laskutin/Email.hs

@@ -19,11 +19,11 @@ import qualified Data.ByteString.Lazy as LBS
 
 import Laskutin.Types
 
-renderEmail :: Bool -> [Address] -> [Address] -> Invoice -> ByteString
-renderEmail isReminder senders recipients = renderMessage
+renderEmail :: Bool -> [Address] -> [Address] -> Invoice -> Maybe ByteString
+renderEmail isReminder senders recipients = fmap (renderMessage
     . set (headerBCC defaultCharsets) senders
     . set (headerTo defaultCharsets) recipients
-    . set (headerFrom defaultCharsets) senders
+    . set (headerFrom defaultCharsets) senders)
     . invoiceEmail isReminder
 
 sendEmail :: FilePath -> ByteString -> IO ()
@@ -36,8 +36,9 @@ sendEmail sendmail email = do
       ExitSuccess -> pure ()
       ExitFailure code -> throwIO $ ErrorCall ("sendmail exited with error code " <> show code)
 
-invoiceEmail :: Bool -> Invoice -> MIMEMessage
-invoiceEmail isReminder Invoice {rows, reference, account, recipient, due, subject, message} =
+invoiceEmail :: Bool -> Invoice -> Maybe MIMEMessage
+invoiceEmail _ Invoice {isPaid = True} = Nothing
+invoiceEmail isReminder Invoice {rows, reference, account, recipient, due, subject, message, isPaid = False} = Just $
     set (headerSubject defaultCharsets) (Just $ subjectPrefix <> " – " <> subject ) $ createTextPlainMessage $
         (if isReminder then "Muistutus alla olevan laskun maksamisesta. Jos olet juuri maksanut kyseisen laskun, tämä muistutus on aiheeton.\n\n" else mempty)
         <> (if T.null message then mempty else (message <> "\n\n\n"))