{-# LANGUAGE OverloadedStrings   #-}
{- |
   Module      : Text.Pandoc.Writers.ChunkedHTML
   Copyright   : Copyright (C) 2023 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Conversion of 'Pandoc' documents to "chunked" HTML (a folder of
linked HTML documents, split by sections.
-}
module Text.Pandoc.Writers.ChunkedHTML (
  writeChunkedHTML
  ) where
import Text.Pandoc.Definition
import Text.Pandoc.Options (WriterOptions(..))
import Text.Pandoc.Shared (stringify, tshow)
import Text.Pandoc.Class (PandocMonad, getPOSIXTime, runPure,
                          fetchItem, insertMedia, getMediaBag)
import Text.Pandoc.MediaBag (mediaItems)
import qualified Data.ByteString.Lazy as BL
import Text.Pandoc.Chunks (splitIntoChunks, Chunk(..), ChunkedDoc(..),
                           SecInfo(..), tocToList)
import Text.Pandoc.URI (isURI)
import Data.Text (Text)
import Data.Tree
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Text.Pandoc.Writers.HTML (writeHtml5String)
import Codec.Archive.Zip (Entry, addEntryToArchive, emptyArchive, toEntry,
                          fromArchive)
import qualified Data.Map as M
import Text.DocTemplates (Context(..), Val(..))
import Text.DocLayout (literal)
import Text.Pandoc.Writers.Shared (defField)
import Data.Aeson (toJSON, encode)
import System.FilePath (isRelative, normalise)
import Data.List (isInfixOf)
import Text.Pandoc.Walk (walkM)
import Text.Pandoc.Builder (setMeta)
import Text.Pandoc.Templates (compileTemplate, WithDefaultPartials(..))
import Control.Monad.Except (throwError)
import Text.Pandoc.Error

-- | Splits document into HTML chunks, dividing them by section,
-- and returns a zip archive of a folder of files.
writeChunkedHTML :: PandocMonad m
                 => WriterOptions -> Pandoc -> m BL.ByteString
writeChunkedHTML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeChunkedHTML WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
  (Inline -> m Inline) -> Pandoc -> m Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Inline -> m Inline) -> Pandoc -> m Pandoc
walkM Inline -> m Inline
forall (m :: * -> *). PandocMonad m => Inline -> m Inline
addMedia (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blocks)
  Integer
epochtime <- POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer) -> m POSIXTime -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m POSIXTime
forall (m :: * -> *). PandocMonad m => m POSIXTime
getPOSIXTime
  let toMediaEntry :: (FilePath, b, ByteString) -> Entry
toMediaEntry (FilePath
fp, b
_mt, ByteString
bs) = FilePath -> Integer -> ByteString -> Entry
toEntry FilePath
fp Integer
epochtime ByteString
bs
  [Entry]
mediaEntries <- ((FilePath, Text, ByteString) -> Entry)
-> [(FilePath, Text, ByteString)] -> [Entry]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, Text, ByteString) -> Entry
forall {b}. (FilePath, b, ByteString) -> Entry
toMediaEntry ([(FilePath, Text, ByteString)] -> [Entry])
-> (MediaBag -> [(FilePath, Text, ByteString)])
-> MediaBag
-> [Entry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaBag -> [(FilePath, Text, ByteString)]
mediaItems (MediaBag -> [Entry]) -> m MediaBag -> m [Entry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  let chunkedDoc :: ChunkedDoc
chunkedDoc = PathTemplate -> Bool -> Maybe Int -> Int -> Pandoc -> ChunkedDoc
splitIntoChunks (WriterOptions -> PathTemplate
writerChunkTemplate WriterOptions
opts)
                     Bool
True
                     (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
                     (WriterOptions -> Int
writerSplitLevel WriterOptions
opts)
                     (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blocks)
  let topChunk :: Chunk
topChunk =
        Chunk
          { chunkHeading :: [Inline]
chunkHeading = Meta -> [Inline]
docTitle Meta
meta
          , chunkId :: Text
chunkId = Text
"top"
          , chunkLevel :: Int
chunkLevel = Int
0
          , chunkNumber :: Int
chunkNumber = Int
0
          , chunkSectionNumber :: Maybe Text
chunkSectionNumber = Maybe Text
forall a. Maybe a
Nothing
          , chunkPath :: FilePath
chunkPath = FilePath
"index.html"
          , chunkUp :: Maybe Chunk
chunkUp = Maybe Chunk
forall a. Maybe a
Nothing
          , chunkPrev :: Maybe Chunk
chunkPrev = Maybe Chunk
forall a. Maybe a
Nothing
          , chunkNext :: Maybe Chunk
chunkNext = case ChunkedDoc -> [Chunk]
chunkedChunks ChunkedDoc
chunkedDoc of
                          [] -> Maybe Chunk
forall a. Maybe a
Nothing
                          (Chunk
x:[Chunk]
_) -> Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just Chunk
x
          , chunkUnlisted :: Bool
chunkUnlisted = Bool
True
          , chunkContents :: [Block]
chunkContents = [Block]
forall a. Monoid a => a
mempty
          }

  let chunks :: [Chunk]
chunks = (Chunk -> Chunk) -> [Chunk] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map (\Chunk
x -> case Chunk -> Maybe Chunk
chunkUp Chunk
x of
                             Maybe Chunk
Nothing -> Chunk
x{ chunkUp = Just topChunk }
                             Maybe Chunk
_ -> Chunk
x)
               ([Chunk] -> [Chunk]) -> [Chunk] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ case ChunkedDoc -> [Chunk]
chunkedChunks ChunkedDoc
chunkedDoc of
                   [] -> []
                   (Chunk
x:[Chunk]
xs) -> Chunk
x{ chunkPrev = Just topChunk } Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk]
xs

  let Node SecInfo
secinfo [Tree SecInfo]
secs = ChunkedDoc -> Tree SecInfo
chunkedTOC ChunkedDoc
chunkedDoc
  let tocTree :: Tree SecInfo
tocTree = SecInfo -> [Tree SecInfo] -> Tree SecInfo
forall a. a -> [Tree a] -> Tree a
Node SecInfo
secinfo{ secTitle = docTitle meta,
                              secPath = "index.html" } [Tree SecInfo]
secs
  let tree :: Block
tree = WriterOptions -> Tree SecInfo -> Block
buildTOC WriterOptions
opts Tree SecInfo
tocTree
  Text
renderedTOC <- WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
opts{ writerTemplate = Nothing }
                    (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [Block
tree])
  -- see #8915 -- we need to set the math variable in the top chunk:
  Either FilePath (Template Text)
res <- WithDefaultPartials m (Either FilePath (Template Text))
-> m (Either FilePath (Template Text))
forall (m :: * -> *) a. WithDefaultPartials m a -> m a
runWithDefaultPartials (WithDefaultPartials m (Either FilePath (Template Text))
 -> m (Either FilePath (Template Text)))
-> WithDefaultPartials m (Either FilePath (Template Text))
-> m (Either FilePath (Template Text))
forall a b. (a -> b) -> a -> b
$ FilePath
-> Text -> WithDefaultPartials m (Either FilePath (Template Text))
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
FilePath -> Text -> m (Either FilePath (Template a))
compileTemplate FilePath
"mathvar" Text
"$math$"
  Template Text
mathVar <- case Either FilePath (Template Text)
res of
    Left FilePath
e   -> PandocError -> m (Template Text)
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m (Template Text))
-> PandocError -> m (Template Text)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocTemplateError (FilePath -> Text
T.pack FilePath
e)
    Right Template Text
t  -> Template Text -> m (Template Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Template Text
t
  Text
tocMathVariable <- WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
opts{ writerTemplate = Just mathVar }
                    (Meta -> [Block] -> Pandoc
Pandoc Meta
meta (Block
treeBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
blocks))
  let opts' :: WriterOptions
opts' = WriterOptions
opts{ writerVariables =
                        defField "table-of-contents" renderedTOC
                      . defField "math" tocMathVariable
                      $ writerVariables opts }
  [Entry]
entries <- (Chunk -> m Entry) -> [Chunk] -> m [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Meta -> Chunk -> Chunk -> m Entry
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Meta -> Chunk -> Chunk -> m Entry
chunkToEntry WriterOptions
opts' Meta
meta Chunk
topChunk) (Chunk
topChunk Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk]
chunks)
  let sitemap :: Entry
sitemap = FilePath -> Integer -> ByteString -> Entry
toEntry FilePath
"sitemap.json" Integer
epochtime
                  (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ Context Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Context Text -> Value) -> Context Text -> Value
forall a b. (a -> b) -> a -> b
$ Tree SecInfo -> Context Text
tocTreeToContext Tree SecInfo
tocTree)
  let archive :: Archive
archive = (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
emptyArchive
                 (Entry
sitemap Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
: [Entry]
entries [Entry] -> [Entry] -> [Entry]
forall a. [a] -> [a] -> [a]
++ [Entry]
mediaEntries)
  ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Archive -> ByteString
fromArchive Archive
archive


-- We include in the zip only local media that is in the working directory
-- or below.
addMedia :: PandocMonad m => Inline -> m Inline
addMedia :: forall (m :: * -> *). PandocMonad m => Inline -> m Inline
addMedia il :: Inline
il@(Image Attr
_ [Inline]
_ (Text
src,Text
_))
  | Bool -> Bool
not (Text -> Bool
isURI Text
src)
  , FilePath
fp <- FilePath -> FilePath
normalise (Text -> FilePath
T.unpack Text
src)
  , FilePath -> Bool
isRelative FilePath
fp
  , Bool -> Bool
not (FilePath
".." FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
fp) = do
  (ByteString
bs, Maybe Text
mbMime) <- Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem (FilePath -> Text
T.pack FilePath
fp)
  FilePath -> Maybe Text -> ByteString -> m ()
forall (m :: * -> *).
PandocMonad m =>
FilePath -> Maybe Text -> ByteString -> m ()
insertMedia FilePath
fp Maybe Text
mbMime (ByteString -> ByteString
BL.fromStrict ByteString
bs)
  Inline -> m Inline
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
il
addMedia Inline
il = Inline -> m Inline
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
il

buildTOC :: WriterOptions -> Tree SecInfo -> Block
buildTOC :: WriterOptions -> Tree SecInfo -> Block
buildTOC WriterOptions
opts = Bool -> Int -> Tree SecInfo -> Block
tocToList (WriterOptions -> Bool
writerNumberSections WriterOptions
opts) (WriterOptions -> Int
writerTOCDepth WriterOptions
opts)

chunkToEntry :: PandocMonad m
             => WriterOptions -> Meta -> Chunk -> Chunk -> m Entry
chunkToEntry :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Meta -> Chunk -> Chunk -> m Entry
chunkToEntry WriterOptions
opts Meta
meta Chunk
topChunk Chunk
chunk = do
  Text
html <- WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
opts' (Meta -> [Block] -> Pandoc
Pandoc Meta
meta' [Block]
blocks)
  Integer
epochtime <- POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer) -> m POSIXTime -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m POSIXTime
forall (m :: * -> *). PandocMonad m => m POSIXTime
getPOSIXTime
  let htmlLBS :: ByteString
htmlLBS = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
html
  Entry -> m Entry
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry -> m Entry) -> Entry -> m Entry
forall a b. (a -> b) -> a -> b
$ FilePath -> Integer -> ByteString -> Entry
toEntry (Chunk -> FilePath
chunkPath Chunk
chunk) Integer
epochtime ByteString
htmlLBS
 where
  opts' :: WriterOptions
opts' = WriterOptions
opts{ writerVariables =
                  addContextVars opts' topChunk chunk $ writerVariables opts }
  meta' :: Meta
meta' = Text -> MetaValue -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
setMeta Text
"pagetitle" (Text -> MetaValue
MetaString ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([Inline] -> Text) -> [Inline] -> Text
forall a b. (a -> b) -> a -> b
$ Chunk -> [Inline]
chunkHeading Chunk
chunk)) Meta
meta
  blocks :: [Block]
blocks = Chunk -> [Block]
chunkContents Chunk
chunk

tocTreeToContext :: Tree SecInfo -> Context Text
tocTreeToContext :: Tree SecInfo -> Context Text
tocTreeToContext (Node SecInfo
secinfo [Tree SecInfo]
subs) =
  Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val Text) -> Context Text)
-> Map Text (Val Text) -> Context Text
forall a b. (a -> b) -> a -> b
$ [(Text, Val Text)] -> Map Text (Val Text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Text
"section", Context Text -> Val Text
forall a. Context a -> Val a
MapVal (Context Text -> Val Text) -> Context Text -> Val Text
forall a b. (a -> b) -> a -> b
$ SecInfo -> Context Text
secInfoToContext SecInfo
secinfo)
  , (Text
"subsections", [Val Text] -> Val Text
forall a. [Val a] -> Val a
ListVal ([Val Text] -> Val Text) -> [Val Text] -> Val Text
forall a b. (a -> b) -> a -> b
$ (Tree SecInfo -> Val Text) -> [Tree SecInfo] -> [Val Text]
forall a b. (a -> b) -> [a] -> [b]
map (Context Text -> Val Text
forall a. Context a -> Val a
MapVal (Context Text -> Val Text)
-> (Tree SecInfo -> Context Text) -> Tree SecInfo -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree SecInfo -> Context Text
tocTreeToContext) [Tree SecInfo]
subs)
  ]

secInfoToContext :: SecInfo -> Context Text
secInfoToContext :: SecInfo -> Context Text
secInfoToContext SecInfo
sec =
  Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val Text) -> Context Text)
-> Map Text (Val Text) -> Context Text
forall a b. (a -> b) -> a -> b
$ [(Text, Val Text)] -> Map Text (Val Text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Text
"title", Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> Doc Text -> Val Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([Inline] -> Text) -> [Inline] -> Text
forall a b. (a -> b) -> a -> b
$ SecInfo -> [Inline]
secTitle SecInfo
sec)
  , (Text
"number", Val Text -> (Text -> Val Text) -> Maybe Text -> Val Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Val Text
forall a. Val a
NullVal (Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> (Text -> Doc Text) -> Text -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal) (SecInfo -> Maybe Text
secNumber SecInfo
sec))
  , (Text
"id", Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> Doc Text -> Val Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ SecInfo -> Text
secId SecInfo
sec)
  , (Text
"path", Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> Doc Text -> Val Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ SecInfo -> Text
secPath SecInfo
sec)
  , (Text
"level", Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> Doc Text -> Val Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ SecInfo -> Int
secLevel SecInfo
sec)
  ]

addContextVars
  :: WriterOptions -> Chunk -> Chunk -> Context Text -> Context Text
addContextVars :: WriterOptions -> Chunk -> Chunk -> Context Text -> Context Text
addContextVars WriterOptions
opts Chunk
topChunk Chunk
chunk Context Text
context =
     (Context Text -> Context Text)
-> (Chunk -> Context Text -> Context Text)
-> Maybe Chunk
-> Context Text
-> Context Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Context Text -> Context Text
forall a. a -> a
id (Text -> Val Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"next" (Val Text -> Context Text -> Context Text)
-> (Chunk -> Val Text) -> Chunk -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Val Text
navlinks) (Chunk -> Maybe Chunk
chunkNext Chunk
chunk)
   (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context Text -> Context Text)
-> (Chunk -> Context Text -> Context Text)
-> Maybe Chunk
-> Context Text
-> Context Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Context Text -> Context Text
forall a. a -> a
id (Text -> Val Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"previous" (Val Text -> Context Text -> Context Text)
-> (Chunk -> Val Text) -> Chunk -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Val Text
navlinks) (Chunk -> Maybe Chunk
chunkPrev Chunk
chunk)
   (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context Text -> Context Text)
-> (Chunk -> Context Text -> Context Text)
-> Maybe Chunk
-> Context Text
-> Context Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Context Text -> Context Text
forall a. a -> a
id (Text -> Val Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"up" (Val Text -> Context Text -> Context Text)
-> (Chunk -> Val Text) -> Chunk -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Val Text
navlinks) (Chunk -> Maybe Chunk
chunkUp Chunk
chunk)
   (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context Text -> Context Text)
-> (Chunk -> Context Text -> Context Text)
-> Maybe Chunk
-> Context Text
-> Context Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Context Text -> Context Text
forall a. a -> a
id (Text -> Val Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"top" (Val Text -> Context Text -> Context Text)
-> (Chunk -> Val Text) -> Chunk -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Val Text
navlinks) (if Chunk
chunk Chunk -> Chunk -> Bool
forall a. Eq a => a -> a -> Bool
== Chunk
topChunk
                                              then Maybe Chunk
forall a. Maybe a
Nothing
                                              else Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just Chunk
topChunk)
   (Context Text -> Context Text)
-> (Context Text -> Context Text) -> Context Text -> Context Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (Chunk
chunk Chunk -> Chunk -> Bool
forall a. Eq a => a -> a -> Bool
== Chunk
topChunk Bool -> Bool -> Bool
&& WriterOptions -> Bool
writerTableOfContents WriterOptions
opts)
    (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Context Text
context
 where
  navlinks :: Chunk -> Val Text
navlinks Chunk
ch = [(Text, Val Text)] -> Val Text
forall {a}. [(Text, Val a)] -> Val a
toMapVal [(Text
"url", Chunk -> Val Text
formatPath Chunk
ch), (Text
"title", Chunk -> Val Text
formatHeading Chunk
ch)]
  toMapVal :: [(Text, Val a)] -> Val a
toMapVal = Context a -> Val a
forall a. Context a -> Val a
MapVal (Context a -> Val a)
-> ([(Text, Val a)] -> Context a) -> [(Text, Val a)] -> Val a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text (Val a) -> Context a
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val a) -> Context a)
-> ([(Text, Val a)] -> Map Text (Val a))
-> [(Text, Val a)]
-> Context a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Val a)] -> Map Text (Val a)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  formatPath :: Chunk -> Val Text
formatPath = Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> (Chunk -> Doc Text) -> Chunk -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Chunk -> Text) -> Chunk -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (Chunk -> FilePath) -> Chunk -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> FilePath
chunkPath
  formatHeading :: Chunk -> Val Text
formatHeading Chunk
ch = Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text)
-> (PandocPure Text -> Doc Text) -> PandocPure Text -> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text)
-> (PandocPure Text -> Text) -> PandocPure Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PandocError -> Text)
-> (Text -> Text) -> Either PandocError Text -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> PandocError -> Text
forall a b. a -> b -> a
const Text
"") Text -> Text
forall a. a -> a
id (Either PandocError Text -> Text)
-> (PandocPure Text -> Either PandocError Text)
-> PandocPure Text
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
runPure (PandocPure Text -> Val Text) -> PandocPure Text -> Val Text
forall a b. (a -> b) -> a -> b
$
    WriterOptions -> Pandoc -> PandocPure Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
opts{ writerTemplate = Nothing }
      (Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [[Inline] -> Block
Plain ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ Chunk -> [Inline]
chunkHeading Chunk
ch])