{-# 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 :: WriterOptions
htmlWriterOptions = WriterOptions
forall a. Default a => a
PA.def
  { writerExtensions :: Extensions
PA.writerExtensions     = [Extension] -> Extensions
PA.extensionsFromList [Extension
PA.Ext_raw_html]
  , writerHTMLMathMethod :: HTMLMathMethod
PA.writerHTMLMathMethod = Text -> HTMLMathMethod
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 :: Maybe FilePath -> Map FilePath FilePath -> m WriterOptions
htmlFullDocWriterOptions pathM :: Maybe FilePath
pathM tVars :: Map FilePath FilePath
tVars = do
  let tContext :: Context Text
tContext = Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
DT.Context (Map Text (Val Text) -> Context Text)
-> Map Text (Val Text) -> Context Text
forall a b. (a -> b) -> a -> b
$ (FilePath -> Text)
-> Map FilePath (Val Text) -> Map Text (Val Text)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys FilePath -> Text
T.pack (Map FilePath (Val Text) -> Map Text (Val Text))
-> Map FilePath (Val Text) -> Map Text (Val Text)
forall a b. (a -> b) -> a -> b
$ (FilePath -> Val Text)
-> Map FilePath FilePath -> Map FilePath (Val Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Val Text
forall a b. ToContext a b => b -> Val a
DT.toVal (Text -> Val Text) -> (FilePath -> Text) -> FilePath -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack) Map FilePath FilePath
tVars
      makeTemplateM :: FilePath -> m T.Text -> m (Maybe (DT.Template T.Text))
      makeTemplateM :: FilePath -> m Text -> m (Maybe (Template Text))
makeTemplateM pfp :: FilePath
pfp getText :: m Text
getText = do
        Text
txt <- m Text
getText
        Either FilePath (Template FilePath)
compiled <- FilePath -> Text -> m (Either FilePath (Template FilePath))
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
FilePath -> Text -> m (Either FilePath (Template a))
PA.compileTemplate FilePath
pfp Text
txt
        case Either FilePath (Template FilePath)
compiled of
          Left msg :: FilePath
msg -> PandocError -> m (Maybe (Template Text))
forall e (m :: * -> *) a. MonadError e m => e -> m a
X.throwError (PandocError -> m (Maybe (Template Text)))
-> PandocError -> m (Maybe (Template Text))
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PA.PandocTemplateError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$  FilePath -> Text
T.pack FilePath
msg
          Right tmplt :: Template FilePath
tmplt -> Maybe (Template Text) -> m (Maybe (Template Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Template Text) -> m (Maybe (Template Text)))
-> Maybe (Template Text) -> m (Maybe (Template Text))
forall a b. (a -> b) -> a -> b
$ Template Text -> Maybe (Template Text)
forall a. a -> Maybe a
Just (Template Text -> Maybe (Template Text))
-> Template Text -> Maybe (Template Text)
forall a b. (a -> b) -> a -> b
$ (FilePath -> Text) -> Template FilePath -> Template Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack Template FilePath
tmplt
      defaultTemplateM :: m (Maybe (Template Text))
defaultTemplateM = FilePath -> m Text -> m (Maybe (Template Text))
makeTemplateM "default.Html5" (Text -> m Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
PA.getDefaultTemplate "Html5")
  Maybe (Template Text)
templateM <- case Maybe FilePath
pathM of
    Nothing -> m (Maybe (Template Text))
defaultTemplateM
    Just fp :: FilePath
fp -> do
      Bool
exists <- FilePath -> m Bool
forall (m :: * -> *). PandocMonad m => FilePath -> m Bool
PA.fileExists FilePath
fp
      if Bool
exists
        then FilePath -> m Text -> m (Maybe (Template Text))
makeTemplateM "" (m Text -> m (Maybe (Template Text)))
-> m Text -> m (Maybe (Template Text))
forall a b. (a -> b) -> a -> b
$ (ByteString -> Text) -> m ByteString -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Text
T.pack (FilePath -> Text)
-> (ByteString -> FilePath) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
BS.unpack) (FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
PA.readFileStrict FilePath
fp)
        else
          LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
PA.logOutput
              (Text -> LogMessage
PA.IgnoredIOError
                (Text -> Text
PM.textToPandocText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ "Couldn't find " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
fp))
              )
            m () -> m (Maybe (Template Text)) -> m (Maybe (Template Text))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m (Maybe (Template Text))
defaultTemplateM
  WriterOptions -> m WriterOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (WriterOptions -> m WriterOptions)
-> WriterOptions -> m WriterOptions
forall a b. (a -> b) -> a -> b
$ WriterOptions
htmlWriterOptions { writerTemplate :: Maybe (Template Text)
PA.writerTemplate      = Maybe (Template Text)
templateM
                             , writerVariables :: Context Text
PA.writerVariables     = Context Text
tContext --M.toList tVars
                             , writerSetextHeaders :: Bool
PA.writerSetextHeaders = Bool
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 :: PandocWriterConfig -> PandocWithRequirements -> Sem effs Html
toBlazeDocument writeConfig :: PandocWriterConfig
writeConfig pdocWR :: PandocWithRequirements
pdocWR = (TemplateMonad (Sem effs) => Sem effs Html) -> Sem effs Html
forall (r :: [(* -> *) -> * -> *]) a.
Member Template r =>
(TemplateMonad (Sem r) => Sem r a) -> Sem r a
PM.absorbTemplateMonad ((TemplateMonad (Sem effs) => Sem effs Html) -> Sem effs Html)
-> (TemplateMonad (Sem effs) => Sem effs Html) -> Sem effs Html
forall a b. (a -> b) -> a -> b
$ (PandocMonad (Sem effs) => Sem effs Html) -> Sem effs Html
forall (r :: [(* -> *) -> * -> *]) a.
Members '[Error PandocError, Pandoc] r =>
(PandocMonad (Sem r) => Sem r a) -> Sem r a
PM.absorbPandocMonad ((PandocMonad (Sem effs) => Sem effs Html) -> Sem effs Html)
-> (PandocMonad (Sem effs) => Sem effs Html) -> Sem effs Html
forall a b. (a -> b) -> a -> b
$ do
  WriterOptions
writerOptions <- Maybe FilePath -> Map FilePath FilePath -> Sem effs WriterOptions
forall (m :: * -> *).
(PandocMonad m, TemplateMonad m) =>
Maybe FilePath -> Map FilePath FilePath -> m WriterOptions
htmlFullDocWriterOptions (PandocWriterConfig -> Maybe FilePath
templateFP PandocWriterConfig
writeConfig)
                                            (PandocWriterConfig -> Map FilePath FilePath
templateVars PandocWriterConfig
writeConfig)
  PandocWriteFormat Html
-> WriterOptions -> PandocWithRequirements -> Sem effs Html
forall (m :: * -> *) a.
PandocMonad m =>
PandocWriteFormat a
-> WriterOptions -> PandocWithRequirements -> m a
PE.fromPandoc PandocWriteFormat Html
PE.WriteHtml5 (PandocWriterConfig -> WriterOptionsF
optionsF PandocWriterConfig
writeConfig WriterOptions
writerOptions) PandocWithRequirements
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 :: Text -> Sem effs Html
markDownTextToBlazeFragment =
  PandocWriteFormat Html
-> WriterOptions -> Sem (ToPandoc : effs) () -> Sem effs Html
forall (effs :: [(* -> *) -> * -> *]) a.
PandocEffects effs =>
PandocWriteFormat a
-> WriterOptions -> Sem (ToPandoc : effs) () -> Sem effs a
PE.fromPandocE PandocWriteFormat Html
PE.WriteHtml5 WriterOptions
htmlWriterOptions
    (Sem (ToPandoc : effs) () -> Sem effs Html)
-> (Text -> Sem (ToPandoc : effs) ()) -> Text -> Sem effs Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocReadFormat Text
-> ReaderOptions -> Text -> Sem (ToPandoc : effs) ()
forall (effs :: [(* -> *) -> * -> *]) a.
Member ToPandoc effs =>
PandocReadFormat a -> ReaderOptions -> a -> Sem effs ()
PE.addFrom PandocReadFormat Text
PE.ReadMarkDown ReaderOptions
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 :: PandocWriterConfig -> Sem (ToPandoc : effs) () -> Sem effs Html
pandocWriterToBlazeDocument writeConfig :: PandocWriterConfig
writeConfig pw :: Sem (ToPandoc : effs) ()
pw =
  Sem (ToPandoc : effs) () -> Sem effs PandocWithRequirements
forall (effs :: [(* -> *) -> * -> *]).
PandocEffects effs =>
Sem (ToPandoc : effs) () -> Sem effs PandocWithRequirements
PE.runPandocWriter Sem (ToPandoc : effs) ()
pw Sem effs PandocWithRequirements
-> (PandocWithRequirements -> Sem effs Html) -> Sem effs Html
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PandocWriterConfig -> PandocWithRequirements -> Sem effs Html
forall (effs :: [(* -> *) -> * -> *]).
PandocEffects effs =>
PandocWriterConfig -> PandocWithRequirements -> Sem effs Html
toBlazeDocument PandocWriterConfig
writeConfig

-- | options for the mindoc template
mindocOptionsF :: PA.WriterOptions -> PA.WriterOptions
mindocOptionsF :: WriterOptionsF
mindocOptionsF op :: WriterOptions
op = WriterOptions
op { writerSectionDivs :: Bool
PA.writerSectionDivs = Bool
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 :: Text -> [DocWithInfo PandocInfo Text] -> IO ()
writeAllPandocResultsWithInfoAsHtml dir :: Text
dir =
  Text -> Text -> [DocWithInfo PandocInfo Text] -> IO ()
KO.writeAllPandocResultsWithInfo Text
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 :: Text -> DocWithInfo PandocInfo Text -> IO ()
writePandocResultWithInfoAsHtml dir :: Text
dir dwi :: DocWithInfo PandocInfo Text
dwi =
  Text -> Text -> DocWithInfo PandocInfo Text -> IO ()
KO.writePandocResultWithInfo Text
dir "html" DocWithInfo PandocInfo Text
dwi