--------------------------------------------------------------------------
--
-- Module      :  Uniform.PandocImports
-- | read and write pandoc files (intenal rep of pandoc written to disk)
-- von hier Pandoc spezifisches imortieren
-- nich exportieren nach aussen
-------------------------------
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LiberalTypeSynonyms #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans 
            -fno-warn-missing-signatures
            -fno-warn-missing-methods 
            -fno-warn-duplicate-exports   #-}

module Uniform.PandocHTMLwriter
  ( module Uniform.PandocHTMLwriter,
    Pandoc (..),
  )
where


import Uniform.Json
import UniformBase

-- import Uniform.PandocImports (  unPandocM )
import Text.Pandoc

import Text.Pandoc.Highlighting (tango)
import qualified Text.Pandoc as Pandoc
import Uniform.PandocImports
import Text.DocLayout (render)
import Text.DocTemplates as DocTemplates

writeHtml5String2 :: Pandoc -> ErrIO Text
writeHtml5String2 :: Pandoc -> ErrIO Text
writeHtml5String2 Pandoc
pandocRes = do
    Text
p <- forall a. PandocIO a -> ErrIO a
unPandocM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
html5Options Pandoc
pandocRes
    forall (m :: * -> *) a. Monad m => a -> m a
return  Text
p

-- | Reasonable options for rendering to HTML
html5Options :: WriterOptions
html5Options :: WriterOptions
html5Options =
    forall a. Default a => a
def
        { writerHighlightStyle :: Maybe Style
writerHighlightStyle = forall a. a -> Maybe a
Just Style
tango
        , writerExtensions :: Extensions
writerExtensions = WriterOptions -> Extensions
writerExtensions forall a. Default a => a
def
        }

-- | apply the template 
-- concentrating the specific pandoc ops 
applyTemplate4 ::  Bool -- ^ 
  -> Text -- ^ the template as text
  -> [Value]-- ^ the values to fill in (produce with toJSON)
  -- possibly Map (Text, Text) from Data.Map 
  -> ErrIO Text -- ^ the resulting html text 
applyTemplate4 :: Bool -> Text -> [Value] -> ErrIO Text
applyTemplate4 Bool
debug Text
t1 [Value]
vals = do
    Either FilePath (Template Text)
templ1 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
FilePath -> Text -> m (Either FilePath (Template a))
DocTemplates.compileTemplate forall a. Monoid a => a
mempty Text
t1
    -- err1 :: Either String (Doc Text) <- liftIO $ DocTemplates.applyTemplate mempty (unwrap7 templText) (unDocValue val)
    
    let templ3 :: Template Text
templ3 = case Either FilePath (Template Text)
templ1 of
            Left FilePath
msg -> forall a. [Text] -> a
errorT [Text
"applyTemplate4 error", forall {a}. Show a => a -> Text
showT FilePath
msg]
            Right Template Text
tmp2 -> Template Text
tmp2
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"applyTemplate3 temp2",  forall {a}. Show a => a -> Text
showT Template Text
templ3]
    -- renderTemplate :: (TemplateTarget a, ToContext a b) => Template a -> b -> Doc a
    let valmerged :: Value
valmerged = [Value] -> Value
mergeLeftPref [Value]
vals
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"the valmerged is ", forall a. PrettyStrings a => a -> Text
showPretty Value
valmerged]
    let res :: Doc Text
res = forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
templ3 ( Value
valmerged)
    -- when debug $ putIOwords ["applyTemplate3 res",  showT res]
    let res2 :: Text
res2 = forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing Doc Text
res  -- macht reflow (zeileneinteilung)
    forall (m :: * -> *) a. Monad m => a -> m a
return Text
res2

writeAST2md :: Pandoc -> ErrIO Text

-- | write the AST to markdown
writeAST2md :: Pandoc -> ErrIO Text
writeAST2md Pandoc
dat = do
    Text
r <- forall a. PandocIO a -> ErrIO a
unPandocM forall a b. (a -> b) -> a -> b
$ do
        Text
r1 <-
            forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
Pandoc.writeMarkdown
                forall a. Default a => a
Pandoc.def{writerSetextHeaders :: Bool
Pandoc.writerSetextHeaders = Bool
False}
                Pandoc
dat
        forall (m :: * -> *) a. Monad m => a -> m a
return Text
r1
    forall (m :: * -> *) a. Monad m => a -> m a
return  Text
r

writeAST3md :: Pandoc.WriterOptions -> Pandoc -> ErrIO Text

-- | write the AST to markdown
writeAST3md :: WriterOptions -> Pandoc -> ErrIO Text
writeAST3md WriterOptions
options Pandoc
dat = do
    Text
r <- forall a. PandocIO a -> ErrIO a
unPandocM forall a b. (a -> b) -> a -> b
$ do
        Text
r1 <-
            forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
Pandoc.writeMarkdown
                WriterOptions
options -- Pandoc.def { Pandoc.writerSetextHeaders = False }
                Pandoc
dat
        forall (m :: * -> *) a. Monad m => a -> m a
return Text
r1
    forall (m :: * -> *) a. Monad m => a -> m a
return Text
r