----------------------------------------------------------------------
--
-- Module      :   applying a template (using pandoc)
--
----------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- {-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Lib.Templating where -- (openMain, htf_thisModuelsTests)

import Uniform.Http -- ( HTMLout(HTMLout) )

import Uniform.Json ( Value, ErrIO )
import Uniform.PandocHTMLwriter ( applyTemplate4 )
import UniformBase

putValinMaster :: NoticeLevel -> [Value] -> Path Abs File -> ErrIO HTMLout
{- ^ get the master html template and put the val into it
 takes the master filename from val
 not clear what intended
 for now: use the master TODO
-}
putValinMaster :: NoticeLevel -> [Value] -> Path Abs File -> ErrIO HTMLout
putValinMaster NoticeLevel
debug [Value]
vals Path Abs File
masterfn = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"putValinMaster", Text
"masterfn", forall {a}. Show a => a -> Text
showT Path Abs File
masterfn]

    Text
template2 :: Text <- forall fp fc. FileOps2 fp fc => fp -> ErrIO fc
readFile2 (forall b t. Path b t -> FilePath
toFilePath Path Abs File
masterfn)

    -- templatapplyTemplate3 debug masterfn vals -- inTemplate.html
    Text
html2 <- Bool -> Text -> [Value] -> ErrIO Text
applyTemplate4 (NoticeLevel -> Bool
inform NoticeLevel
debug) Text
template2 [Value]
vals  
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HTMLout
HTMLout forall a b. (a -> b) -> a -> b
$ Text
html2

{- list of variables potentially used by Master5.dtpl:
css - name of stylesheet
date 
keywords  (list)
page-title 
page-title-isPostfix 
include-before 
siteHeader
    sitename 
    byline 
    banner 
    bannerCaption
menu 
    link 
    text 
title 
subtitle 
author 
menu2 
    link2 
    title2 
    abstract2
    author2 
    date2 
    -- publish2 
table-of-contents 
beforeContent
abstract 
contentHtml 
afterContent 
dainoversion
today
Filenames 
filename3  -- the current filename producing the page
include_after  
dainoversion
-}