{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-| Module : Knit.Report.Output.Html Description : Output Pandoc as Html Copyright : (c) Adam Conner-Sax 2019 License : BSD-3-Clause Maintainer : adam_conner_sax@yahoo.com Stability : experimental Functions to produce Html output for a Pandoc report. -} module Knit.Report.Output.Html ( -- * Default Options htmlWriterOptions -- * Formatted output , toBlazeDocument , pandocWriterToBlazeDocument -- * Options helper , mindocOptionsF -- * Other helpers , markDownTextToBlazeFragment -- * File writing helpers , writeAllPandocResultsWithInfoAsHtml , writePandocResultWithInfoAsHtml ) where import qualified Data.ByteString.Char8 as BS import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Map as M import qualified Text.Blaze.Html as BH import qualified Text.Pandoc as PA import qualified Polysemy as P import qualified Knit.Effect.Pandoc as PE import qualified Knit.Effect.PandocMonad as PM import Knit.Report.Input.MarkDown.PandocMarkDown ( markDownReaderOptions ) import Knit.Report.Output as KO #if MIN_VERSION_pandoc (2,8,0) import qualified Text.DocTemplates as DT import qualified Control.Monad.Except as X #endif -- | Base Html writer options, with support for MathJax htmlWriterOptions :: PA.WriterOptions htmlWriterOptions = PA.def { PA.writerExtensions = PA.extensionsFromList [PA.Ext_raw_html] , PA.writerHTMLMathMethod = PA.MathJax "" } -- | Full writer options which use pandoc monad for template access #if MIN_VERSION_pandoc (2,8,0) htmlFullDocWriterOptions :: forall m. (PA.PandocMonad m, DT.TemplateMonad m) => Maybe FilePath -- ^ path to template to include, @Nothing@ for no template. -> M.Map String String -- ^ template Variable substitutions -> m PA.WriterOptions htmlFullDocWriterOptions pathM tVars = do let tContext = DT.Context $ M.mapKeys T.pack $ fmap (DT.toVal . T.pack) tVars makeTemplateM :: FilePath -> m T.Text -> m (Maybe (DT.Template T.Text)) makeTemplateM pfp getText = do txt <- getText compiled <- PA.compileTemplate pfp txt case compiled of Left msg -> X.throwError $ PA.PandocTemplateError $ T.pack msg Right tmplt -> return $ Just $ fmap T.pack tmplt defaultTemplateM = makeTemplateM "default.Html5" (PA.getDefaultTemplate "Html5") templateM <- case pathM of Nothing -> defaultTemplateM Just fp -> do exists <- PA.fileExists fp if exists then makeTemplateM "" $ fmap (T.pack . BS.unpack) (PA.readFileStrict fp) else PA.logOutput (PA.IgnoredIOError (PM.textToPandocText $ "Couldn't find " <> (T.pack $ show fp)) ) >> defaultTemplateM return $ htmlWriterOptions { PA.writerTemplate = templateM , PA.writerVariables = tContext --M.toList tVars , PA.writerSetextHeaders = True } -- Incudes support for template and template variables and changes to the default writer options toBlazeDocument :: PM.PandocEffects effs => KO.PandocWriterConfig -> PE.PandocWithRequirements -- ^ Document and union of input requirements -> P.Sem effs BH.Html toBlazeDocument writeConfig pdocWR = PM.absorbTemplateMonad $ PM.absorbPandocMonad $ do writerOptions <- htmlFullDocWriterOptions (templateFP writeConfig) (templateVars writeConfig) PE.fromPandoc PE.WriteHtml5 (optionsF writeConfig writerOptions) pdocWR #else htmlFullDocWriterOptions :: PA.PandocMonad m => Maybe FilePath -- ^ path to template to include, @Nothing@ for no template. -> M.Map String String -- ^ template Variable substitutions -> m PA.WriterOptions htmlFullDocWriterOptions pathM tVars = do template <- case pathM of Nothing -> PA.getDefaultTemplate "Html5" Just fp -> do exists <- PA.fileExists fp if exists then fmap BS.unpack (PA.readFileStrict fp) else PA.logOutput (PA.IgnoredIOError (PM.textToPandocText $ "Couldn't find " <> (T.pack $ show fp)) ) >> PA.getDefaultTemplate "Html5" return $ htmlWriterOptions { PA.writerTemplate = Just template , PA.writerVariables = M.toList tVars , PA.writerSetextHeaders = True } -- Incudes support for template and template variables and changes to the default writer options toBlazeDocument :: PM.PandocEffects effs => KO.PandocWriterConfig -> PE.PandocWithRequirements -- ^ Document and union of input requirements -> P.Sem effs BH.Html toBlazeDocument writeConfig pdocWR = PM.absorbPandocMonad $ do writerOptions <- htmlFullDocWriterOptions (templateFP writeConfig) (templateVars writeConfig) PE.fromPandoc PE.WriteHtml5 (optionsF writeConfig writerOptions) pdocWR #endif -- | Convert markDown to Blaze markDownTextToBlazeFragment :: PM.PandocEffects effs => T.Text -- ^ markDown Text -> P.Sem effs BH.Html markDownTextToBlazeFragment = PE.fromPandocE PE.WriteHtml5 htmlWriterOptions . PE.addFrom PE.ReadMarkDown markDownReaderOptions -- | Convert given Pandoc to Blaze Html. -- | Convert current Pandoc document (from the ToPandoc effect) into a Blaze Html document. -- Incudes support for template and template variables and changes to the default writer options. pandocWriterToBlazeDocument :: PM.PandocEffects effs => KO.PandocWriterConfig -- ^ Configuration info for the Pandoc writer -> P.Sem (PE.ToPandoc ': effs) () -- ^ Effects stack to run to get Pandoc -> P.Sem effs BH.Html -- ^ Blaze Html (in remaining effects) pandocWriterToBlazeDocument writeConfig pw = PE.runPandocWriter pw >>= toBlazeDocument writeConfig -- | options for the mindoc template mindocOptionsF :: PA.WriterOptions -> PA.WriterOptions mindocOptionsF op = op { PA.writerSectionDivs = True } -- file output -- | Write each lazy text from a list of 'KD.DocWithInfo' -- to disk. File names come from the 'KP.PandocInfo' -- Directory is a function arguments. -- File extension is "html" writeAllPandocResultsWithInfoAsHtml :: T.Text -> [PE.DocWithInfo PE.PandocInfo TL.Text] -> IO () writeAllPandocResultsWithInfoAsHtml dir = KO.writeAllPandocResultsWithInfo dir "html" -- | Write the Lazy Text in a 'KD.DocWithInfo' to disk, -- Name comes from the 'KP.PandocInfo' -- Directory is an argument to the function -- File extension is "html" -- Create the parent directory or directories, if necessary. writePandocResultWithInfoAsHtml :: T.Text -> PE.DocWithInfo PE.PandocInfo TL.Text -> IO () writePandocResultWithInfoAsHtml dir dwi = KO.writePandocResultWithInfo dir "html" dwi