From 3be7c4a77835676ff24e228eb27dfe7dd2792054 Mon Sep 17 00:00:00 2001
From: Saku Laesvuori <saku@laesvuori.fi>
Date: Tue, 12 Sep 2023 17:21:42 +0300
Subject: [PATCH] =?UTF-8?q?Taita=20vain=20metadatalliset=20tiedostot=20s?=
 =?UTF-8?q?=C3=A4hk=C3=B6posteiksi?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Tämä säästää resursseja, kun kaikkia mahdollisia tiedostoja ei yritetä
ensin latoa ja tarkistaa vasta sitten, oliko niissä tarvittavat tiedot.
---
 src/TiedoteMD/Read.hs | 28 ++++++++++++++++++----------
 1 file changed, 18 insertions(+), 10 deletions(-)

diff --git a/src/TiedoteMD/Read.hs b/src/TiedoteMD/Read.hs
index 364f495..97e5d9c 100644
--- a/src/TiedoteMD/Read.hs
+++ b/src/TiedoteMD/Read.hs
@@ -22,11 +22,12 @@ import Data.Time.Format.ISO8601 (iso8601ParseM)
 import System.Exit (ExitCode(..))
 import System.IO (hClose)
 import System.Process (createProcess, proc, waitForProcess, CreateProcess(..), StdStream(..))
-import Text.Pandoc (Pandoc(..), ReaderOptions(..), WriterOptions(..), Meta, MetaValue(..), nullMeta, Inline, Block(Plain), runIO, lookupMeta, runPure, pandocExtensions)
+import Text.Pandoc (Pandoc(..), ReaderOptions(..), WriterOptions(..), Meta(..), MetaValue(..), nullMeta, Inline, Block(Plain), runIO, lookupMeta, runPure, pandocExtensions)
 import Text.Pandoc.Readers (readMarkdown)
 import Text.Pandoc.Writers (writePlain, writeMarkdown, writeHtml5String)
 
 import qualified Data.ByteString as BS
+import qualified Data.Map as Map
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 
@@ -58,15 +59,22 @@ parseMessageFile :: ByteString -> T.Text -> IO (Either Error Message)
 parseMessageFile hash text = fmap (join . first PandocError) . runIO $ do
     pandoc@(Pandoc meta _) <- flip readMarkdown text
         def {readerStandalone = True, readerExtensions = pandocExtensions}
-    plainTextMessage <- renderHelper writePlain plainTemplate pandoc
-    markdownMessage <- renderHelper writeMarkdown markdownTemplate pandoc
-    htmlMessage <- liftIO . inlineCSS =<< renderHelper writeHtml5String htmlTemplate pandoc
-    pure $ do
-        previewTo <- lookupMeta' "tarkistaja" meta >>= metaToEmails
-        previewTime <- lookupMeta' "deadline" meta >>= metaToTime
-        sendTime <- lookupMeta' "lähetysaika" meta >>= metaToTime
-        subject <- lookupMeta' "otsikko" meta >>= metaToText
-        pure Message
+    let tiedoteMeta = do
+            previewTo <- lookupMeta' "tarkistaja" meta >>= metaToEmails
+            previewTime <- lookupMeta' "deadline" meta >>= metaToTime
+            sendTime <- lookupMeta' "lähetysaika" meta >>= metaToTime
+            subject <- lookupMeta' "otsikko" meta >>= metaToText
+            pure (previewTo, previewTime, sendTime, subject)
+    case tiedoteMeta of
+      (Left err) -> pure $ Left err
+      Right (previewTo, previewTime, sendTime, subject) -> do
+          plainTextMessage <- renderHelper writePlain plainTemplate pandoc
+          markdownMessage <- renderHelper writeMarkdown markdownTemplate pandoc
+          let htmlPandoc = let Pandoc meta' blocks' = pandoc in Pandoc
+                  (Meta $ Map.insertWith (flip const) "pagetitle" (MetaString subject) $ unMeta meta')
+                  blocks'
+          htmlMessage <- liftIO . inlineCSS =<< renderHelper writeHtml5String htmlTemplate htmlPandoc
+          pure $ pure $ Message
             { recipients = []
             , messageHash = hash
             , messageContent = MessageContent {..}