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

28
src/TiedoteMD/Read.hs
View File

@ -22,11 +22,12 @@ import Data.Time.Format.ISO8601 (iso8601ParseM)
import System.Exit (ExitCode(..)) import System.Exit (ExitCode(..))
import System.IO (hClose) import System.IO (hClose)
import System.Process (createProcess, proc, waitForProcess, CreateProcess(..), StdStream(..)) 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.Readers (readMarkdown)
import Text.Pandoc.Writers (writePlain, writeMarkdown, writeHtml5String) import Text.Pandoc.Writers (writePlain, writeMarkdown, writeHtml5String)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.Map as Map
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO 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 parseMessageFile hash text = fmap (join . first PandocError) . runIO $ do
pandoc@(Pandoc meta _) <- flip readMarkdown text pandoc@(Pandoc meta _) <- flip readMarkdown text
def {readerStandalone = True, readerExtensions = pandocExtensions} def {readerStandalone = True, readerExtensions = pandocExtensions}
plainTextMessage <- renderHelper writePlain plainTemplate pandoc let tiedoteMeta = do
markdownMessage <- renderHelper writeMarkdown markdownTemplate pandoc previewTo <- lookupMeta' "tarkistaja" meta >>= metaToEmails
htmlMessage <- liftIO . inlineCSS =<< renderHelper writeHtml5String htmlTemplate pandoc previewTime <- lookupMeta' "deadline" meta >>= metaToTime
pure $ do sendTime <- lookupMeta' "lähetysaika" meta >>= metaToTime
previewTo <- lookupMeta' "tarkistaja" meta >>= metaToEmails subject <- lookupMeta' "otsikko" meta >>= metaToText
previewTime <- lookupMeta' "deadline" meta >>= metaToTime pure (previewTo, previewTime, sendTime, subject)
sendTime <- lookupMeta' "lähetysaika" meta >>= metaToTime case tiedoteMeta of
subject <- lookupMeta' "otsikko" meta >>= metaToText (Left err) -> pure $ Left err
pure Message 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 = [] { recipients = []
, messageHash = hash , messageHash = hash
, messageContent = MessageContent {..} , messageContent = MessageContent {..}