{-# LANGUAGE OverloadedStrings #-}
module Knit.Report.Output
(
PandocWriterConfig(..)
, TemplateVariables
, WriterOptionsF
, mkPandocWriterConfig
, TemplatePath(..)
, CssPath(..)
, addCss
, writeAllPandocResultsWithInfo
, writePandocResultWithInfo
, writeAndMakePathLT
, writeAndMakePath
)
where
import qualified Paths_knit_haskell as Paths
import qualified Data.Map as M
import qualified Text.Pandoc as PA
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as TL
import qualified System.Directory as SD
import qualified Knit.Effect.Docs as KD
import qualified Knit.Effect.Pandoc as KP
type TemplateVariables = M.Map String String
type WriterOptionsF = PA.WriterOptions -> PA.WriterOptions
data PandocWriterConfig =
PandocWriterConfig
{
templateFP :: Maybe FilePath
, templateVars :: TemplateVariables
, optionsF :: WriterOptionsF
}
mkPandocWriterConfig
:: TemplatePath
-> TemplateVariables
-> WriterOptionsF
-> IO PandocWriterConfig
mkPandocWriterConfig tp tv wf = do
templateFPM <- pandocTemplatePath tp
return $ PandocWriterConfig templateFPM tv wf
data TemplatePath = DefaultTemplate
| FromIncludedTemplateDir T.Text
| FullySpecifiedTemplatePath T.Text
pandocTemplatePath :: TemplatePath -> IO (Maybe String)
pandocTemplatePath DefaultTemplate = return Nothing
pandocTemplatePath (FullySpecifiedTemplatePath x) = return $ Just (T.unpack x)
pandocTemplatePath (FromIncludedTemplateDir x) =
fmap (Just . (++ "/knit-haskell-templates/" ++ (T.unpack x))) Paths.getDataDir
data CssPath = FromIncludedCssDir T.Text
| FullySpecifiedCssPath T.Text
addCss :: CssPath -> TemplateVariables -> IO TemplateVariables
addCss (FullySpecifiedCssPath x) pt = return $ appendCss x pt
addCss (FromIncludedCssDir x) pt = do
dir <- Paths.getDataDir
let fp = (T.pack dir) <> "/knit-haskell-css/" <> x
return $ appendCss fp pt
appendCss :: T.Text -> TemplateVariables -> TemplateVariables
appendCss x tv =
let curValM = M.lookup "css" tv
newVal = maybe (T.unpack x) (\y -> y ++ "," ++ T.unpack x) curValM
in M.insert "css" newVal tv
writeAllPandocResultsWithInfo
:: T.Text -> T.Text -> [KP.DocWithInfo KP.PandocInfo TL.Text] -> IO ()
writeAllPandocResultsWithInfo dir extension =
fmap (const ()) . traverse (writePandocResultWithInfo dir extension)
writePandocResultWithInfo
:: T.Text
-> T.Text
-> KD.DocWithInfo KP.PandocInfo TL.Text
-> IO ()
writePandocResultWithInfo dir extension (KD.DocWithInfo (KP.PandocInfo n _) x)
= do
let fPath = dir <> "/" <> n <> "." <> extension
writeAndMakePathLT fPath x
writeAndMakePathLT :: T.Text -> TL.Text -> IO ()
writeAndMakePathLT fPath = writeAndMakePath fPath TL.toStrict
writeAndMakePath :: T.Text -> (a -> T.Text) -> a -> IO ()
writeAndMakePath fPath toStrictText x = do
let (dirPath, fName) = T.breakOnEnd "/" fPath
putStrLn
$ T.unpack
$ "If necessary, creating "
<> dirPath
<> " (and parents), and writing "
<> fName
SD.createDirectoryIfMissing True (T.unpack dirPath)
T.writeFile (T.unpack fPath) $ toStrictText x