{-# LANGUAGE OverloadedStrings #-}
module Knit.Report.Output
  (
    -- * Pandoc Writer Configuration
    PandocWriterConfig(..)
  , TemplateVariables
  , WriterOptionsF
  , mkPandocWriterConfig

    -- * Pandoc Template Types
  , TemplatePath(..)
  , CssPath(..)
  , addCss

    -- * file writing helpers
  , 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
  {
    PandocWriterConfig -> Maybe FilePath
templateFP :: Maybe FilePath
    -- ^ optional path to pandoc <https://pandoc.org/MANUAL.html#templates template>
  , PandocWriterConfig -> TemplateVariables
templateVars :: TemplateVariables
  -- ^ variable substitutions for the <https://pandoc.org/MANUAL.html#templates template>
  , PandocWriterConfig -> WriterOptionsF
optionsF :: WriterOptionsF
  -- ^ change default <https://pandoc.org/MANUAL.html#general-writer-options options>
  }

-- | Make a 'PandocWriterConfig' from a PandocTemplate specification
mkPandocWriterConfig
  :: TemplatePath
  -> TemplateVariables
  -> WriterOptionsF
  -> IO PandocWriterConfig
mkPandocWriterConfig :: TemplatePath
-> TemplateVariables -> WriterOptionsF -> IO PandocWriterConfig
mkPandocWriterConfig tp :: TemplatePath
tp tv :: TemplateVariables
tv wf :: WriterOptionsF
wf = do
  Maybe FilePath
templateFPM <- TemplatePath -> IO (Maybe FilePath)
pandocTemplatePath TemplatePath
tp
  PandocWriterConfig -> IO PandocWriterConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (PandocWriterConfig -> IO PandocWriterConfig)
-> PandocWriterConfig -> IO PandocWriterConfig
forall a b. (a -> b) -> a -> b
$ Maybe FilePath
-> TemplateVariables -> WriterOptionsF -> PandocWriterConfig
PandocWriterConfig Maybe FilePath
templateFPM TemplateVariables
tv WriterOptionsF
wf

-- | Type to specify path to template,
-- which may be in a directory installed with knit-haskell.
data TemplatePath = DefaultTemplate
                  | FromIncludedTemplateDir T.Text
                  | FullySpecifiedTemplatePath T.Text

-- | get correct path to give Pandoc, depending on how things are installed
pandocTemplatePath :: TemplatePath -> IO (Maybe String)
pandocTemplatePath :: TemplatePath -> IO (Maybe FilePath)
pandocTemplatePath DefaultTemplate                = Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
pandocTemplatePath (FullySpecifiedTemplatePath x :: Text
x) = Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Text -> FilePath
T.unpack Text
x)
pandocTemplatePath (FromIncludedTemplateDir x :: Text
x) =
  (FilePath -> Maybe FilePath) -> IO FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> (FilePath -> FilePath) -> FilePath -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "/knit-haskell-templates/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Text -> FilePath
T.unpack Text
x))) IO FilePath
Paths.getDataDir

-- | Type to specify path to Css,
-- which may be in a directory installed with knit-haskell or not.
data CssPath = FromIncludedCssDir T.Text
             | FullySpecifiedCssPath T.Text

-- | Add a CssPath to an existing TemplateVariables
-- which may already have Css paths specified
addCss :: CssPath -> TemplateVariables -> IO TemplateVariables
addCss :: CssPath -> TemplateVariables -> IO TemplateVariables
addCss (FullySpecifiedCssPath x :: Text
x) pt :: TemplateVariables
pt = TemplateVariables -> IO TemplateVariables
forall (m :: * -> *) a. Monad m => a -> m a
return (TemplateVariables -> IO TemplateVariables)
-> TemplateVariables -> IO TemplateVariables
forall a b. (a -> b) -> a -> b
$ Text -> TemplateVariables -> TemplateVariables
appendCss Text
x TemplateVariables
pt
addCss (FromIncludedCssDir    x :: Text
x) pt :: TemplateVariables
pt = do
  FilePath
dir <- IO FilePath
Paths.getDataDir
  let fp :: Text
fp = (FilePath -> Text
T.pack FilePath
dir) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/knit-haskell-css/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x
  TemplateVariables -> IO TemplateVariables
forall (m :: * -> *) a. Monad m => a -> m a
return (TemplateVariables -> IO TemplateVariables)
-> TemplateVariables -> IO TemplateVariables
forall a b. (a -> b) -> a -> b
$ Text -> TemplateVariables -> TemplateVariables
appendCss Text
fp TemplateVariables
pt


-- | Append a filepath (given as Text) to the existing Css paths in TemplateVariables
appendCss :: T.Text -> TemplateVariables -> TemplateVariables
appendCss :: Text -> TemplateVariables -> TemplateVariables
appendCss x :: Text
x tv :: TemplateVariables
tv =
  let curValM :: Maybe FilePath
curValM = FilePath -> TemplateVariables -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup "css" TemplateVariables
tv
      newVal :: FilePath
newVal  = FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> FilePath
T.unpack Text
x) (\y :: FilePath
y -> FilePath
y FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "," FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack Text
x) Maybe FilePath
curValM
  in  FilePath -> FilePath -> TemplateVariables -> TemplateVariables
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert "css" FilePath
newVal TemplateVariables
tv

-- utilities for file output

-- | Write each lazy text from a list of 'KD.DocWithInfo'
-- to disk. File names come from the 'KP.PandocInfo'
-- Directory and file extension are function arguments.
writeAllPandocResultsWithInfo
  :: T.Text -> T.Text -> [KP.DocWithInfo KP.PandocInfo TL.Text] -> IO ()
writeAllPandocResultsWithInfo :: Text -> Text -> [DocWithInfo PandocInfo Text] -> IO ()
writeAllPandocResultsWithInfo dir :: Text
dir extension :: Text
extension =
  ([()] -> ()) -> IO [()] -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> [()] -> ()
forall a b. a -> b -> a
const ()) (IO [()] -> IO ())
-> ([DocWithInfo PandocInfo Text] -> IO [()])
-> [DocWithInfo PandocInfo Text]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DocWithInfo PandocInfo Text -> IO ())
-> [DocWithInfo PandocInfo Text] -> IO [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text -> Text -> DocWithInfo PandocInfo Text -> IO ()
writePandocResultWithInfo Text
dir Text
extension) -- fmap (const ()) :: IO [()] -> IO ()

-- | Write the Lazy Text in a 'KD.DocWithInfo' to disk
-- Name comes from the 'KP.PandocInfo'
-- Directory and file extection are arguments to the function
-- Create the parent directory or directories, if necessary.
writePandocResultWithInfo
  :: T.Text -- ^ directory
  -> T.Text -- ^ extension
  -> KD.DocWithInfo KP.PandocInfo TL.Text
  -> IO ()
writePandocResultWithInfo :: Text -> Text -> DocWithInfo PandocInfo Text -> IO ()
writePandocResultWithInfo dir :: Text
dir extension :: Text
extension (KD.DocWithInfo (KP.PandocInfo n :: Text
n _) x :: Text
x)
  = do
    let fPath :: Text
fPath = Text
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
extension
    Text -> Text -> IO ()
writeAndMakePathLT Text
fPath Text
x

-- | Write Lazy Text (Pandoc's Html result) to disk.
-- Create the parent directory or directories, if necessary.
writeAndMakePathLT :: T.Text -> TL.Text -> IO ()
writeAndMakePathLT :: Text -> Text -> IO ()
writeAndMakePathLT fPath :: Text
fPath = Text -> (Text -> Text) -> Text -> IO ()
forall a. Text -> (a -> Text) -> a -> IO ()
writeAndMakePath Text
fPath Text -> Text
TL.toStrict

-- | Write (to disk) something which can be converted to text.
-- Create the parent directory or directories, if necessary.
writeAndMakePath :: T.Text -> (a -> T.Text) -> a -> IO ()
writeAndMakePath :: Text -> (a -> Text) -> a -> IO ()
writeAndMakePath fPath :: Text
fPath toStrictText :: a -> Text
toStrictText x :: a
x = do
  let (dirPath :: Text
dirPath, fName :: Text
fName) = Text -> Text -> (Text, Text)
T.breakOnEnd "/" Text
fPath
  FilePath -> IO ()
putStrLn
    (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$  Text -> FilePath
T.unpack
    (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$  "If necessary, creating "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dirPath
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " (and parents), and writing "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fName
  Bool -> FilePath -> IO ()
SD.createDirectoryIfMissing Bool
True (Text -> FilePath
T.unpack Text
dirPath)
  FilePath -> Text -> IO ()
T.writeFile (Text -> FilePath
T.unpack Text
fPath) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> Text
toStrictText a
x