Lisää mahdollisuus katsoa lähetettäviä viestejä ennen lähettämistä

src/Laskutin.hs

@@ -33,13 +33,23 @@ main = do
       UpdateTable bankCsv -> updateTableMain csv bankCsv
 
 sendInvoicesMain :: FilePath -> SendOptions -> IO ()
-sendInvoicesMain csvPath options@SendOptions {email, sendmail, reminders} = do
+sendInvoicesMain csvPath options@SendOptions {email, sendmail, reminders, dryRun} = do
-    invoices <- mapMaybe (\(address, invoice) -> (address,) <$> renderEmail reminders [email] address invoice) <$> readInvoices csvPath options
+    invoices <- readInvoices csvPath options
-    forM_ invoices $ \(address, invoiceMail) -> do
+    forM_ invoices $ \(address, invoice) -> do
-        sendEmail sendmail invoiceMail
+        case renderInvoice reminders invoice of
-        putStr "Lähetetty osoitteeseen: "
+          Nothing -> pure ()
-        T.putStrLn $ decodeUtf8 $ renderAddresses address
+          Just (subject, body) -> do
-        threadDelay (3 * 1000 * 1000)
+              case dryRun of
+                False -> do
+                    sendEmail sendmail $ renderEmail [email] address subject body
+                    putStr "Lähetetty osoitteeseen: "
+                    T.putStrLn $ decodeUtf8 $ renderAddresses address
+                    threadDelay (3 * 1000 * 1000)
+                True -> do
+                    T.putStrLn $ "To: " <> decodeUtf8 (renderAddresses address)
+                    T.putStrLn $ "From: " <> decodeUtf8 (renderAddresses [email])
+                    T.putStrLn $ "\n" <> body
+                    T.putStrLn "-------\n"
 
 updateTableMain :: FilePath -> FilePath -> IO ()
 updateTableMain invoiceCsv transactionCsv = do

src/Laskutin/Email.hs

@@ -3,7 +3,7 @@
 module Laskutin.Email where
 
 import Data.Text (Text)
-import Data.MIME (MIMEMessage, Address, createTextPlainMessage, defaultCharsets, headerSubject, headerFrom, headerTo, headerBCC, renderMessage)
+import Data.MIME (Address, createTextPlainMessage, defaultCharsets, headerSubject, headerFrom, headerTo, headerBCC, renderMessage)
 import Control.Lens (set)
 import Data.Semigroup (sconcat)
 import Data.Time.Calendar
@@ -19,12 +19,13 @@ import qualified Data.ByteString.Lazy as LBS
 
 import Laskutin.Types
 
-renderEmail :: Bool -> [Address] -> [Address] -> Invoice -> Maybe ByteString
+renderEmail :: [Address] -> [Address] -> Text -> Text -> ByteString
-renderEmail isReminder senders recipients = fmap (renderMessage
+renderEmail senders recipients subject = renderMessage
     . set (headerBCC defaultCharsets) senders
     . set (headerTo defaultCharsets) recipients
-    . set (headerFrom defaultCharsets) senders)
+    . set (headerFrom defaultCharsets) senders
-    . invoiceEmail isReminder
+    . set (headerSubject defaultCharsets) (Just subject)
+    . createTextPlainMessage
 
 sendEmail :: FilePath -> ByteString -> IO ()
 sendEmail sendmail email = do
@@ -36,10 +37,9 @@ sendEmail sendmail email = do
       ExitSuccess -> pure ()
       ExitFailure code -> throwIO $ ErrorCall ("sendmail exited with error code " <> show code)
 
-invoiceEmail :: Bool -> Invoice -> Maybe MIMEMessage
+renderInvoice :: Bool -> Invoice -> Maybe (Text, Text)
-invoiceEmail _ Invoice {isPaid = True} = Nothing
+renderInvoice _ Invoice {isPaid = True} = Nothing
-invoiceEmail isReminder Invoice {rows, reference, account, recipient, due, subject, message, isPaid = False} = Just $
+renderInvoice isReminder Invoice {rows, reference, account, recipient, due, subject, message, isPaid = False} = Just $ (subjectPrefix <> " – " <> subject,) $
-    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"))
         <> sconcat (NE.map renderInvoiceRow rows) <> "\n"

src/Laskutin/Options.hs

@@ -32,6 +32,7 @@ data SendOptions = SendOptions
     , email :: Address
     , sendmail :: FilePath
     , reminders :: Bool
+    , dryRun :: Bool
     }
 
 parseOptions :: IO Options
@@ -60,3 +61,4 @@ sendOptions = fmap Send $ SendOptions
         (long "email" <> help "Invoice sender email address" <> metavar "EMAIL")
     <*> strOption (long "sendmail" <> short 'm' <> metavar "FILE" <> help "The sendmail program to use")
     <*> switch (long "reminders" <> short 'r' <> help "Send reminder emails")
+    <*> switch (long "dry-run" <> short 'd' <> help "Only print what invoices would be sent. Do not send anything")