OMS/tiedote.md
3
0
Fork 0
Code Issues 14 Pull Requests Projects Releases Wiki Activity

Taita vain metadatalliset tiedostot sähköposteiksi

Browse Source 
Tämä säästää resursseja, kun kaikkia mahdollisia tiedostoja ei yritetä
ensin latoa ja tarkistaa vasta sitten, oliko niissä tarvittavat tiedot.
This commit is contained in:
Saku Laesvuori 2023-09-12 17:21:42 +03:00
parent 67eb35f7d3
commit 3be7c4a778
Signed by: slaesvuo
GPG Key ID: 257D284A2A1D3A32
1 changed files with 18 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/TiedoteMD/Read.hs
View File

@ -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
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 Message
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 {..}