{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{- |
   Module      : Text.Pandoc.Chunks
   Copyright   : Copyright (C) 2022-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Functions and types for splitting a Pandoc into subdocuments,
e.g. for conversion into a set of HTML pages.
-}
module Text.Pandoc.Chunks
  ( Chunk(..)
  , ChunkedDoc(..)
  , PathTemplate(..)
  , splitIntoChunks
  , toTOCTree
  , tocToList
  , SecInfo(..)
  ) where

import Text.Pandoc.Definition
import Text.Pandoc.Shared (makeSections, stringify, inlineListToIdentifier)
import Text.Pandoc.Walk (Walkable(..))
import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import Text.Printf (printf)
import Data.Maybe (fromMaybe, isNothing)
import qualified Data.Map as M
import qualified Data.Text as T
import Data.String (IsString)
import GHC.Generics (Generic)
import Text.HTML.TagSoup (Tag (TagOpen), fromAttrib, parseTags)
import Data.Tree (Tree(..))
import Data.Data (Data)
import Data.Typeable (Typeable)

-- | Split 'Pandoc' into 'Chunk's, e.g. for conversion into
-- a set of HTML pages or EPUB chapters.
splitIntoChunks :: PathTemplate -- ^ Template for filepath
                -> Bool -- ^ Number sections
                -> Maybe Int -- ^ Base heading level
                -> Int -- ^ Chunk level -- level of section to split at
                -> Pandoc
                -> ChunkedDoc
splitIntoChunks :: PathTemplate -> Bool -> Maybe Int -> Int -> Pandoc -> ChunkedDoc
splitIntoChunks PathTemplate
pathTemplate Bool
numberSections Maybe Int
mbBaseLevel
                Int
chunklev (Pandoc Meta
meta [Block]
blocks) =
   ChunkedDoc -> ChunkedDoc
addNav (ChunkedDoc -> ChunkedDoc)
-> (ChunkedDoc -> ChunkedDoc) -> ChunkedDoc -> ChunkedDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ChunkedDoc -> ChunkedDoc
fixInternalReferences (ChunkedDoc -> ChunkedDoc)
-> (ChunkedDoc -> ChunkedDoc) -> ChunkedDoc -> ChunkedDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (Block -> Block) -> ChunkedDoc -> ChunkedDoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
rmNavAttrs (ChunkedDoc -> ChunkedDoc) -> ChunkedDoc -> ChunkedDoc
forall a b. (a -> b) -> a -> b
$
   ChunkedDoc{ chunkedMeta :: Meta
chunkedMeta = Meta
meta
             , chunkedChunks :: [Chunk]
chunkedChunks = [Chunk]
chunks
             , chunkedTOC :: Tree SecInfo
chunkedTOC = Tree SecInfo
tocTree }
 where
  tocTree :: Tree SecInfo
tocTree = [Chunk] -> Tree SecInfo -> Tree SecInfo
fixTOCTreePaths [Chunk]
chunks (Tree SecInfo -> Tree SecInfo) -> Tree SecInfo -> Tree SecInfo
forall a b. (a -> b) -> a -> b
$ [Block] -> Tree SecInfo
toTOCTree [Block]
sections
  chunks :: [Chunk]
chunks = Int -> PathTemplate -> Meta -> [Block] -> [Chunk]
makeChunks Int
chunklev PathTemplate
pathTemplate Meta
meta ([Block] -> [Chunk]) -> [Block] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ [Block]
sections
  sections :: [Block]
sections = Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
numberSections Maybe Int
mbBaseLevel ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Block]
blocks

-- | Add chunkNext, chunkPrev, chunkUp
addNav :: ChunkedDoc -> ChunkedDoc
addNav :: ChunkedDoc -> ChunkedDoc
addNav ChunkedDoc
chunkedDoc =
  ChunkedDoc
chunkedDoc{ chunkedChunks :: [Chunk]
chunkedChunks =
     [Chunk] -> [Chunk]
addNext ([Chunk] -> [Chunk]) -> ([Chunk] -> [Chunk]) -> [Chunk] -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk] -> [Chunk]
addPrev ([Chunk] -> [Chunk]) -> ([Chunk] -> [Chunk]) -> [Chunk] -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk] -> [Chunk]
addUp ([Chunk] -> [Chunk]) -> [Chunk] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ ChunkedDoc -> [Chunk]
chunkedChunks ChunkedDoc
chunkedDoc }

addUp :: [Chunk] -> [Chunk]
addUp :: [Chunk] -> [Chunk]
addUp (Chunk
c : Chunk
d : [Chunk]
ds)
  | Chunk -> Int
chunkLevel Chunk
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Chunk -> Int
chunkLevel Chunk
d
    = Chunk
c Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk] -> [Chunk]
addUp (Chunk
d{ chunkUp :: Maybe Chunk
chunkUp = Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just Chunk
c } Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk]
ds)
  | Chunk -> Int
chunkLevel Chunk
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Chunk -> Int
chunkLevel Chunk
d
    = Chunk
c Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk] -> [Chunk]
addUp (Chunk
d{ chunkUp :: Maybe Chunk
chunkUp = Chunk -> Maybe Chunk
chunkUp Chunk
c} Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk]
ds)
addUp (Chunk
c:[Chunk]
cs) = Chunk
c Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk] -> [Chunk]
addUp [Chunk]
cs
addUp [] = []

addNext :: [Chunk] -> [Chunk]
addNext :: [Chunk] -> [Chunk]
addNext [Chunk]
cs = (Chunk -> Maybe Chunk -> Chunk)
-> [Chunk] -> [Maybe Chunk] -> [Chunk]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Chunk -> Maybe Chunk -> Chunk
go [Chunk]
cs ((Chunk -> Maybe Chunk) -> [Chunk] -> [Maybe Chunk]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just ([Chunk] -> [Chunk]
forall a. HasCallStack => [a] -> [a]
tail [Chunk]
cs) [Maybe Chunk] -> [Maybe Chunk] -> [Maybe Chunk]
forall a. [a] -> [a] -> [a]
++ [Maybe Chunk
forall a. Maybe a
Nothing])
 where
  go :: Chunk -> Maybe Chunk -> Chunk
go Chunk
c Maybe Chunk
nxt = Chunk
c{ chunkNext :: Maybe Chunk
chunkNext = Maybe Chunk
nxt }

addPrev :: [Chunk] -> [Chunk]
addPrev :: [Chunk] -> [Chunk]
addPrev [Chunk]
cs = (Chunk -> Maybe Chunk -> Chunk)
-> [Chunk] -> [Maybe Chunk] -> [Chunk]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Chunk -> Maybe Chunk -> Chunk
go [Chunk]
cs (Maybe Chunk
forall a. Maybe a
Nothing Maybe Chunk -> [Maybe Chunk] -> [Maybe Chunk]
forall a. a -> [a] -> [a]
: (Chunk -> Maybe Chunk) -> [Chunk] -> [Maybe Chunk]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Maybe Chunk
forall a. a -> Maybe a
Just [Chunk]
cs)
 where
  go :: Chunk -> Maybe Chunk -> Chunk
go Chunk
c Maybe Chunk
prev = Chunk
c{ chunkPrev :: Maybe Chunk
chunkPrev = Maybe Chunk
prev }

-- | Fix internal references so they point to the path of the chunk.
fixInternalReferences :: ChunkedDoc -> ChunkedDoc
fixInternalReferences :: ChunkedDoc -> ChunkedDoc
fixInternalReferences ChunkedDoc
chunkedDoc = (Inline -> Inline) -> ChunkedDoc -> ChunkedDoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
fixInternalRefs ChunkedDoc
chunkedDoc
 where
  fixInternalRefs :: Inline -> Inline
  fixInternalRefs :: Inline -> Inline
fixInternalRefs il :: Inline
il@(Link Attr
attr [Inline]
ils (Text
src,Text
tit))
    = case Text -> Maybe (Char, Text)
T.uncons Text
src of
        Just (Char
'#', Text
ident) -> Attr -> [Inline] -> (Text, Text) -> Inline
Link Attr
attr [Inline]
ils (Text
src', Text
tit)
          where src' :: Text
src' = case Text -> Map Text Chunk -> Maybe Chunk
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
ident Map Text Chunk
refMap of
                         Just Chunk
chunk -> String -> Text
T.pack (Chunk -> String
chunkPath Chunk
chunk) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src
                         Maybe Chunk
Nothing -> Text
src
        Maybe (Char, Text)
_ -> Inline
il
  fixInternalRefs Inline
il = Inline
il

  refMap :: Map Text Chunk
refMap = (Chunk -> Map Text Chunk -> Map Text Chunk)
-> Map Text Chunk -> [Chunk] -> Map Text Chunk
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Chunk -> Map Text Chunk -> Map Text Chunk
chunkToRefs Map Text Chunk
forall a. Monoid a => a
mempty (ChunkedDoc -> [Chunk]
chunkedChunks ChunkedDoc
chunkedDoc)

  chunkToRefs :: Chunk -> Map Text Chunk -> Map Text Chunk
chunkToRefs Chunk
chunk Map Text Chunk
m =
    let idents :: [Text]
idents = Chunk -> Text
chunkId Chunk
chunk Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Block] -> [Text]
forall {b}. (Walkable Block b, Walkable Inline b) => b -> [Text]
getIdents (Chunk -> [Block]
chunkContents Chunk
chunk)
    in  (Text -> Map Text Chunk -> Map Text Chunk)
-> Map Text Chunk -> [Text] -> Map Text Chunk
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Text
ident -> Text -> Chunk -> Map Text Chunk -> Map Text Chunk
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
ident Chunk
chunk) Map Text Chunk
m [Text]
idents

  getIdents :: b -> [Text]
getIdents b
bs = (Block -> [Text]) -> b -> [Text]
forall c. Monoid c => (Block -> c) -> b -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> [Text]
getBlockIdent b
bs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Inline -> [Text]) -> b -> [Text]
forall c. Monoid c => (Inline -> c) -> b -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [Text]
getInlineIdent b
bs

  getBlockIdent :: Block -> [Text]
  getBlockIdent :: Block -> [Text]
getBlockIdent (Div (Text
ident, [Text]
_, [(Text, Text)]
_) [Block]
_)
    | Bool -> Bool
not (Text -> Bool
T.null Text
ident) = [Text
ident]
  getBlockIdent (Header Int
_ (Text
ident, [Text]
_, [(Text, Text)]
_) [Inline]
_)
    | Bool -> Bool
not (Text -> Bool
T.null Text
ident) = [Text
ident]
  getBlockIdent (Table (Text
ident,[Text]
_,[(Text, Text)]
_) Caption
_ [ColSpec]
_ TableHead
_ [TableBody]
_ TableFoot
_)
    | Bool -> Bool
not (Text -> Bool
T.null Text
ident) = [Text
ident]
  getBlockIdent (RawBlock Format
fmt Text
raw)
    | Format -> Bool
isHtmlFormat Format
fmt
    = (Tag Text -> [Text] -> [Text]) -> [Text] -> [Tag Text] -> [Text]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Tag Text
tag ->
                case Tag Text
tag of
                  TagOpen{} ->
                    case Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"id" Tag Text
tag of
                      Text
"" -> [Text] -> [Text]
forall a. a -> a
id
                      Text
x  -> (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
                  Tag Text
_ -> [Text] -> [Text]
forall a. a -> a
id)
        [] (Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
parseTags Text
raw)
  getBlockIdent Block
_ = []

  getInlineIdent :: Inline -> [Text]
  getInlineIdent :: Inline -> [Text]
getInlineIdent (Span (Text
ident, [Text]
_, [(Text, Text)]
_) [Inline]
_)
    | Bool -> Bool
not (Text -> Bool
T.null Text
ident) = [Text
ident]
  getInlineIdent (Link (Text
ident, [Text]
_, [(Text, Text)]
_) [Inline]
_ (Text, Text)
_)
    | Bool -> Bool
not (Text -> Bool
T.null Text
ident) = [Text
ident]
  getInlineIdent (Image (Text
ident, [Text]
_, [(Text, Text)]
_) [Inline]
_ (Text, Text)
_)
    | Bool -> Bool
not (Text -> Bool
T.null Text
ident) = [Text
ident]
  getInlineIdent (RawInline Format
fmt Text
raw)
    | Format -> Bool
isHtmlFormat Format
fmt
    = (Tag Text -> [Text] -> [Text]) -> [Text] -> [Tag Text] -> [Text]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Tag Text
tag ->
                case Tag Text
tag of
                  TagOpen{} ->
                    case Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"id" Tag Text
tag of
                      Text
"" -> [Text] -> [Text]
forall a. a -> a
id
                      Text
x  -> (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
                  Tag Text
_ -> [Text] -> [Text]
forall a. a -> a
id)
        [] (Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
parseTags Text
raw)
  getInlineIdent Inline
_ = []

  isHtmlFormat :: Format -> Bool
  isHtmlFormat :: Format -> Bool
isHtmlFormat (Format Text
"html") = Bool
True
  isHtmlFormat (Format Text
"html4") = Bool
True
  isHtmlFormat (Format Text
"html5") = Bool
True
  isHtmlFormat Format
_ = Bool
False


makeChunks :: Int -> PathTemplate -> Meta -> [Block] -> [Chunk]
makeChunks :: Int -> PathTemplate -> Meta -> [Block] -> [Chunk]
makeChunks Int
chunklev PathTemplate
pathTemplate Meta
meta = Int -> [Block] -> [Chunk]
secsToChunks Int
1
 where
  isChunkHeader :: Block -> Bool
  isChunkHeader :: Block -> Bool
isChunkHeader (Div (Text
_,Text
"section":[Text]
_,[(Text, Text)]
_) (Header Int
n Attr
_ [Inline]
_:[Block]
_)) = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
chunklev
  isChunkHeader Block
_ = Bool
False

  secsToChunks :: Int -> [Block] -> [Chunk]
  secsToChunks :: Int -> [Block] -> [Chunk]
secsToChunks Int
chunknum [Block]
bs =
    case (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isChunkHeader [Block]
bs of
      ([], []) -> []
      ([], (d :: Block
d@(Div attr :: Attr
attr@(Text
_,Text
"section":[Text]
_,[(Text, Text)]
_) (h :: Block
h@(Header Int
lvl Attr
_ [Inline]
_) : [Block]
bs')) : [Block]
rest))
        | Int
chunklev Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lvl ->
          -- If the header is of the same level as chunks, create a chunk
          Int -> Block -> Chunk
toChunk Int
chunknum Block
d Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:
            Int -> [Block] -> [Chunk]
secsToChunks (Int
chunknum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Block]
rest
        | Int
chunklev Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lvl ->
          case (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Block -> Bool
isChunkHeader [Block]
bs' of
            ([Block]
xs, [Block]
ys) -> Int -> Block -> Chunk
toChunk Int
chunknum (Attr -> [Block] -> Block
Div Attr
attr (Block
hBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
xs)) Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:
                          Int -> [Block] -> [Chunk]
secsToChunks (Int
chunknum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Block]
ys [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [Block]
rest)
      ([Block]
xs, [Block]
ys) -> Int -> Block -> Chunk
toChunk Int
chunknum
                     (Attr -> [Block] -> Block
Div (Text
"",[Text
"preamble"],[]) [Block]
xs) Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:
                    Int -> [Block] -> [Chunk]
secsToChunks (Int
chunknum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Block]
ys

  toChunk :: Int -> Block -> Chunk
  toChunk :: Int -> Block -> Chunk
toChunk Int
chunknum
    (Div (Text
divid,Text
"section":[Text]
classes,[(Text, Text)]
kvs) (h :: Block
h@(Header Int
lvl Attr
_ [Inline]
ils) : [Block]
bs)) =
    Chunk
      { chunkHeading :: [Inline]
chunkHeading = [Inline]
ils
      , chunkId :: Text
chunkId = Text
divid
      , chunkLevel :: Int
chunkLevel = Int
lvl
      , chunkNumber :: Int
chunkNumber = Int
chunknum
      , chunkSectionNumber :: Maybe Text
chunkSectionNumber = Maybe Text
secnum
      , chunkPath :: String
chunkPath = String
chunkpath
      , chunkUp :: Maybe Chunk
chunkUp = Maybe Chunk
forall a. Maybe a
Nothing
      , chunkNext :: Maybe Chunk
chunkNext = Maybe Chunk
forall a. Maybe a
Nothing
      , chunkPrev :: Maybe Chunk
chunkPrev = Maybe Chunk
forall a. Maybe a
Nothing
      , chunkUnlisted :: Bool
chunkUnlisted = Text
"unlisted" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
      , chunkContents :: [Block]
chunkContents =
         [Attr -> [Block] -> Block
Div (Text
divid,Text
"section"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
classes,[(Text, Text)]
kvs') (Block
h Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs)]
      }
     where kvs' :: [(Text, Text)]
kvs' = [(Text, Text)]
kvs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text
"nav-path", String -> Text
T.pack String
chunkpath)]
           secnum :: Maybe Text
secnum = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
kvs
           chunkpath :: String
chunkpath = PathTemplate -> Int -> Text -> Text -> Text -> String
resolvePathTemplate PathTemplate
pathTemplate Int
chunknum
                        ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils)
                        Text
divid
                        (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
secnum)
  toChunk Int
chunknum (Div (Text
"",[Text
"preamble"],[]) [Block]
bs) =
    Chunk
      { chunkHeading :: [Inline]
chunkHeading = Meta -> [Inline]
docTitle Meta
meta
      , chunkId :: Text
chunkId = Extensions -> [Inline] -> Text
inlineListToIdentifier Extensions
forall a. Monoid a => a
mempty ([Inline] -> Text) -> [Inline] -> Text
forall a b. (a -> b) -> a -> b
$ Meta -> [Inline]
docTitle Meta
meta
      , chunkLevel :: Int
chunkLevel = Int
0
      , chunkNumber :: Int
chunkNumber = Int
chunknum
      , chunkSectionNumber :: Maybe Text
chunkSectionNumber = Maybe Text
forall a. Maybe a
Nothing
      , chunkPath :: String
chunkPath = PathTemplate -> Int -> Text -> Text -> Text -> String
resolvePathTemplate PathTemplate
pathTemplate Int
chunknum
                        ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify (Meta -> [Inline]
docTitle Meta
meta))
                        (Extensions -> [Inline] -> Text
inlineListToIdentifier Extensions
forall a. Monoid a => a
mempty (Meta -> [Inline]
docTitle Meta
meta))
                        Text
"0"
      , 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 = Maybe Chunk
forall a. Maybe a
Nothing
      , chunkUnlisted :: Bool
chunkUnlisted = Bool
False
      , chunkContents :: [Block]
chunkContents = [Block]
bs
      }
  toChunk Int
_ Block
b = String -> Chunk
forall a. HasCallStack => String -> a
error (String -> Chunk) -> String -> Chunk
forall a b. (a -> b) -> a -> b
$ String
"toChunk called on inappropriate block " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Block -> String
forall a. Show a => a -> String
show Block
b
  -- should not happen


-- Remove some attributes we added just to construct chunkNext etc.
rmNavAttrs :: Block -> Block
rmNavAttrs :: Block -> Block
rmNavAttrs (Div (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Block]
bs) =
  Attr -> [Block] -> Block
Div (Text
ident,[Text]
classes,((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Text, Text) -> Bool) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Bool
forall {b}. (Text, b) -> Bool
isNavAttr) [(Text, Text)]
kvs) [Block]
bs
 where
  isNavAttr :: (Text, b) -> Bool
isNavAttr (Text
k,b
_) = Text
"nav-" Text -> Text -> Bool
`T.isPrefixOf` Text
k
rmNavAttrs Block
b = Block
b

resolvePathTemplate :: PathTemplate
                    -> Int -- ^ Chunk number
                    -> Text -- ^ Stringified heading text
                    -> Text -- ^ Section identifier
                    -> Text -- ^ Section number
                    -> FilePath
resolvePathTemplate :: PathTemplate -> Int -> Text -> Text -> Text -> String
resolvePathTemplate (PathTemplate Text
templ) Int
chunknum Text
headingText Text
ident Text
secnum =
  Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Char -> Bool) -> Text -> Text
T.filter (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"%n" (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%03d" Int
chunknum) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"%s" Text
secnum (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"%h" Text
headingText (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"%i" Text
ident (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
  Text
templ

-- | A 'PathTemplate' is a FilePath in which certain codes
-- will be substituted with information from a 'Chunk'.
-- @%n@ will be replaced with the chunk number
-- (padded with leading 0s to 3 digits),
-- @%s@ with the section number of the heading,
-- @%h@ with the (stringified) heading text,
-- @%i@ with the section identifier.
-- For example, @"section-%s-%i.html"@ might be resolved to
-- @"section-1.2-introduction.html"@.
newtype PathTemplate =
  PathTemplate { PathTemplate -> Text
unPathTemplate :: Text }
  deriving (Int -> PathTemplate -> String -> String
[PathTemplate] -> String -> String
PathTemplate -> String
(Int -> PathTemplate -> String -> String)
-> (PathTemplate -> String)
-> ([PathTemplate] -> String -> String)
-> Show PathTemplate
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PathTemplate -> String -> String
showsPrec :: Int -> PathTemplate -> String -> String
$cshow :: PathTemplate -> String
show :: PathTemplate -> String
$cshowList :: [PathTemplate] -> String -> String
showList :: [PathTemplate] -> String -> String
Show, String -> PathTemplate
(String -> PathTemplate) -> IsString PathTemplate
forall a. (String -> a) -> IsString a
$cfromString :: String -> PathTemplate
fromString :: String -> PathTemplate
IsString, Typeable PathTemplate
Typeable PathTemplate
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PathTemplate -> c PathTemplate)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PathTemplate)
-> (PathTemplate -> Constr)
-> (PathTemplate -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PathTemplate))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PathTemplate))
-> ((forall b. Data b => b -> b) -> PathTemplate -> PathTemplate)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PathTemplate -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PathTemplate -> r)
-> (forall u. (forall d. Data d => d -> u) -> PathTemplate -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PathTemplate -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PathTemplate -> m PathTemplate)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PathTemplate -> m PathTemplate)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PathTemplate -> m PathTemplate)
-> Data PathTemplate
PathTemplate -> Constr
PathTemplate -> DataType
(forall b. Data b => b -> b) -> PathTemplate -> PathTemplate
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PathTemplate -> u
forall u. (forall d. Data d => d -> u) -> PathTemplate -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PathTemplate -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PathTemplate -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PathTemplate -> m PathTemplate
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathTemplate -> m PathTemplate
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PathTemplate
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PathTemplate -> c PathTemplate
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PathTemplate)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PathTemplate)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PathTemplate -> c PathTemplate
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PathTemplate -> c PathTemplate
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PathTemplate
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PathTemplate
$ctoConstr :: PathTemplate -> Constr
toConstr :: PathTemplate -> Constr
$cdataTypeOf :: PathTemplate -> DataType
dataTypeOf :: PathTemplate -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PathTemplate)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PathTemplate)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PathTemplate)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PathTemplate)
$cgmapT :: (forall b. Data b => b -> b) -> PathTemplate -> PathTemplate
gmapT :: (forall b. Data b => b -> b) -> PathTemplate -> PathTemplate
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PathTemplate -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PathTemplate -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PathTemplate -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PathTemplate -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PathTemplate -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PathTemplate -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PathTemplate -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PathTemplate -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PathTemplate -> m PathTemplate
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PathTemplate -> m PathTemplate
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathTemplate -> m PathTemplate
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathTemplate -> m PathTemplate
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathTemplate -> m PathTemplate
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathTemplate -> m PathTemplate
Data, Typeable, (forall x. PathTemplate -> Rep PathTemplate x)
-> (forall x. Rep PathTemplate x -> PathTemplate)
-> Generic PathTemplate
forall x. Rep PathTemplate x -> PathTemplate
forall x. PathTemplate -> Rep PathTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PathTemplate -> Rep PathTemplate x
from :: forall x. PathTemplate -> Rep PathTemplate x
$cto :: forall x. Rep PathTemplate x -> PathTemplate
to :: forall x. Rep PathTemplate x -> PathTemplate
Generic, [PathTemplate] -> Value
[PathTemplate] -> Encoding
PathTemplate -> Value
PathTemplate -> Encoding
(PathTemplate -> Value)
-> (PathTemplate -> Encoding)
-> ([PathTemplate] -> Value)
-> ([PathTemplate] -> Encoding)
-> ToJSON PathTemplate
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PathTemplate -> Value
toJSON :: PathTemplate -> Value
$ctoEncoding :: PathTemplate -> Encoding
toEncoding :: PathTemplate -> Encoding
$ctoJSONList :: [PathTemplate] -> Value
toJSONList :: [PathTemplate] -> Value
$ctoEncodingList :: [PathTemplate] -> Encoding
toEncodingList :: [PathTemplate] -> Encoding
ToJSON, Value -> Parser [PathTemplate]
Value -> Parser PathTemplate
(Value -> Parser PathTemplate)
-> (Value -> Parser [PathTemplate]) -> FromJSON PathTemplate
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PathTemplate
parseJSON :: Value -> Parser PathTemplate
$cparseJSONList :: Value -> Parser [PathTemplate]
parseJSONList :: Value -> Parser [PathTemplate]
FromJSON)

-- | A part of a document (typically a chapter or section, or
-- the part of a section before its subsections).
data Chunk =
  Chunk
  { Chunk -> [Inline]
chunkHeading :: [Inline]
  , Chunk -> Text
chunkId :: Text
  , Chunk -> Int
chunkLevel :: Int
  , Chunk -> Int
chunkNumber :: Int
  , Chunk -> Maybe Text
chunkSectionNumber :: Maybe Text
  , Chunk -> String
chunkPath :: FilePath
  , Chunk -> Maybe Chunk
chunkUp :: Maybe Chunk
  , Chunk -> Maybe Chunk
chunkPrev :: Maybe Chunk
  , Chunk -> Maybe Chunk
chunkNext :: Maybe Chunk
  , Chunk -> Bool
chunkUnlisted :: Bool
  , Chunk -> [Block]
chunkContents :: [Block]
  }
  deriving (Int -> Chunk -> String -> String
[Chunk] -> String -> String
Chunk -> String
(Int -> Chunk -> String -> String)
-> (Chunk -> String) -> ([Chunk] -> String -> String) -> Show Chunk
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Chunk -> String -> String
showsPrec :: Int -> Chunk -> String -> String
$cshow :: Chunk -> String
show :: Chunk -> String
$cshowList :: [Chunk] -> String -> String
showList :: [Chunk] -> String -> String
Show, Chunk -> Chunk -> Bool
(Chunk -> Chunk -> Bool) -> (Chunk -> Chunk -> Bool) -> Eq Chunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Chunk -> Chunk -> Bool
== :: Chunk -> Chunk -> Bool
$c/= :: Chunk -> Chunk -> Bool
/= :: Chunk -> Chunk -> Bool
Eq, (forall x. Chunk -> Rep Chunk x)
-> (forall x. Rep Chunk x -> Chunk) -> Generic Chunk
forall x. Rep Chunk x -> Chunk
forall x. Chunk -> Rep Chunk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Chunk -> Rep Chunk x
from :: forall x. Chunk -> Rep Chunk x
$cto :: forall x. Rep Chunk x -> Chunk
to :: forall x. Rep Chunk x -> Chunk
Generic)

instance Walkable Inline Chunk where
  query :: forall c. Monoid c => (Inline -> c) -> Chunk -> c
query Inline -> c
f Chunk
chunk = (Inline -> c) -> [Block] -> c
forall c. Monoid c => (Inline -> c) -> [Block] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> c
f (Chunk -> [Block]
chunkContents Chunk
chunk)
  walk :: (Inline -> Inline) -> Chunk -> Chunk
walk Inline -> Inline
f Chunk
chunk = Chunk
chunk{ chunkContents :: [Block]
chunkContents = (Inline -> Inline) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
f (Chunk -> [Block]
chunkContents Chunk
chunk) }
  walkM :: forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Inline -> m Inline) -> Chunk -> m Chunk
walkM Inline -> m Inline
f Chunk
chunk = do
    [Block]
contents <- (Inline -> m Inline) -> [Block] -> m [Block]
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) -> [Block] -> m [Block]
walkM Inline -> m Inline
f (Chunk -> [Block]
chunkContents Chunk
chunk)
    Chunk -> m Chunk
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Chunk
chunk{ chunkContents :: [Block]
chunkContents = [Block]
contents }

instance Walkable Block Chunk where
  query :: forall c. Monoid c => (Block -> c) -> Chunk -> c
query Block -> c
f Chunk
chunk = (Block -> c) -> [Block] -> c
forall c. Monoid c => (Block -> c) -> [Block] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> c
f (Chunk -> [Block]
chunkContents Chunk
chunk)
  walk :: (Block -> Block) -> Chunk -> Chunk
walk Block -> Block
f Chunk
chunk = Chunk
chunk{ chunkContents :: [Block]
chunkContents = (Block -> Block) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
f (Chunk -> [Block]
chunkContents Chunk
chunk) }
  walkM :: forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Block -> m Block) -> Chunk -> m Chunk
walkM Block -> m Block
f Chunk
chunk = do
    [Block]
contents <- (Block -> m Block) -> [Block] -> m [Block]
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) =>
(Block -> m Block) -> [Block] -> m [Block]
walkM Block -> m Block
f (Chunk -> [Block]
chunkContents Chunk
chunk)
    Chunk -> m Chunk
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Chunk
chunk{ chunkContents :: [Block]
chunkContents = [Block]
contents }

-- | A 'Pandoc' broken into 'Chunk's for writing to separate files.
data ChunkedDoc =
  ChunkedDoc
  { ChunkedDoc -> Meta
chunkedMeta :: Meta
  , ChunkedDoc -> Tree SecInfo
chunkedTOC :: Tree SecInfo
  , ChunkedDoc -> [Chunk]
chunkedChunks :: [Chunk]
  } deriving (Int -> ChunkedDoc -> String -> String
[ChunkedDoc] -> String -> String
ChunkedDoc -> String
(Int -> ChunkedDoc -> String -> String)
-> (ChunkedDoc -> String)
-> ([ChunkedDoc] -> String -> String)
-> Show ChunkedDoc
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ChunkedDoc -> String -> String
showsPrec :: Int -> ChunkedDoc -> String -> String
$cshow :: ChunkedDoc -> String
show :: ChunkedDoc -> String
$cshowList :: [ChunkedDoc] -> String -> String
showList :: [ChunkedDoc] -> String -> String
Show, ChunkedDoc -> ChunkedDoc -> Bool
(ChunkedDoc -> ChunkedDoc -> Bool)
-> (ChunkedDoc -> ChunkedDoc -> Bool) -> Eq ChunkedDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChunkedDoc -> ChunkedDoc -> Bool
== :: ChunkedDoc -> ChunkedDoc -> Bool
$c/= :: ChunkedDoc -> ChunkedDoc -> Bool
/= :: ChunkedDoc -> ChunkedDoc -> Bool
Eq, (forall x. ChunkedDoc -> Rep ChunkedDoc x)
-> (forall x. Rep ChunkedDoc x -> ChunkedDoc) -> Generic ChunkedDoc
forall x. Rep ChunkedDoc x -> ChunkedDoc
forall x. ChunkedDoc -> Rep ChunkedDoc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChunkedDoc -> Rep ChunkedDoc x
from :: forall x. ChunkedDoc -> Rep ChunkedDoc x
$cto :: forall x. Rep ChunkedDoc x -> ChunkedDoc
to :: forall x. Rep ChunkedDoc x -> ChunkedDoc
Generic)

instance Walkable Inline ChunkedDoc where
  query :: forall c. Monoid c => (Inline -> c) -> ChunkedDoc -> c
query Inline -> c
f ChunkedDoc
doc = (Inline -> c) -> [Chunk] -> c
forall c. Monoid c => (Inline -> c) -> [Chunk] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> c
f (ChunkedDoc -> [Chunk]
chunkedChunks ChunkedDoc
doc) c -> c -> c
forall a. Semigroup a => a -> a -> a
<> (Inline -> c) -> Meta -> c
forall c. Monoid c => (Inline -> c) -> Meta -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> c
f (ChunkedDoc -> Meta
chunkedMeta ChunkedDoc
doc)
  walk :: (Inline -> Inline) -> ChunkedDoc -> ChunkedDoc
walk Inline -> Inline
f ChunkedDoc
doc = ChunkedDoc
doc{ chunkedMeta :: Meta
chunkedMeta = (Inline -> Inline) -> Meta -> Meta
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
f (ChunkedDoc -> Meta
chunkedMeta ChunkedDoc
doc)
                  , chunkedChunks :: [Chunk]
chunkedChunks = (Inline -> Inline) -> [Chunk] -> [Chunk]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
f (ChunkedDoc -> [Chunk]
chunkedChunks ChunkedDoc
doc)
                  }
  walkM :: forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Inline -> m Inline) -> ChunkedDoc -> m ChunkedDoc
walkM Inline -> m Inline
f ChunkedDoc
doc = do
    Meta
meta' <- (Inline -> m Inline) -> Meta -> m Meta
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) -> Meta -> m Meta
walkM Inline -> m Inline
f (ChunkedDoc -> Meta
chunkedMeta ChunkedDoc
doc)
    [Chunk]
chunks' <- (Inline -> m Inline) -> [Chunk] -> m [Chunk]
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) -> [Chunk] -> m [Chunk]
walkM Inline -> m Inline
f (ChunkedDoc -> [Chunk]
chunkedChunks ChunkedDoc
doc)
    ChunkedDoc -> m ChunkedDoc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChunkedDoc -> m ChunkedDoc) -> ChunkedDoc -> m ChunkedDoc
forall a b. (a -> b) -> a -> b
$ ChunkedDoc
doc{ chunkedMeta :: Meta
chunkedMeta = Meta
meta'
                , chunkedChunks :: [Chunk]
chunkedChunks = [Chunk]
chunks' }

instance Walkable Block ChunkedDoc where
  query :: forall c. Monoid c => (Block -> c) -> ChunkedDoc -> c
query Block -> c
f ChunkedDoc
doc = (Block -> c) -> [Chunk] -> c
forall c. Monoid c => (Block -> c) -> [Chunk] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> c
f (ChunkedDoc -> [Chunk]
chunkedChunks ChunkedDoc
doc) c -> c -> c
forall a. Semigroup a => a -> a -> a
<> (Block -> c) -> Meta -> c
forall c. Monoid c => (Block -> c) -> Meta -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> c
f (ChunkedDoc -> Meta
chunkedMeta ChunkedDoc
doc)
  walk :: (Block -> Block) -> ChunkedDoc -> ChunkedDoc
walk Block -> Block
f ChunkedDoc
doc = ChunkedDoc
doc{ chunkedMeta :: Meta
chunkedMeta = (Block -> Block) -> Meta -> Meta
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
f (ChunkedDoc -> Meta
chunkedMeta ChunkedDoc
doc)
                  , chunkedChunks :: [Chunk]
chunkedChunks = (Block -> Block) -> [Chunk] -> [Chunk]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
f (ChunkedDoc -> [Chunk]
chunkedChunks ChunkedDoc
doc)
                  }
  walkM :: forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Block -> m Block) -> ChunkedDoc -> m ChunkedDoc
walkM Block -> m Block
f ChunkedDoc
doc = do
    Meta
meta' <- (Block -> m Block) -> Meta -> m Meta
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) =>
(Block -> m Block) -> Meta -> m Meta
walkM Block -> m Block
f (ChunkedDoc -> Meta
chunkedMeta ChunkedDoc
doc)
    [Chunk]
chunks' <- (Block -> m Block) -> [Chunk] -> m [Chunk]
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) =>
(Block -> m Block) -> [Chunk] -> m [Chunk]
walkM Block -> m Block
f (ChunkedDoc -> [Chunk]
chunkedChunks ChunkedDoc
doc)
    ChunkedDoc -> m ChunkedDoc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChunkedDoc -> m ChunkedDoc) -> ChunkedDoc -> m ChunkedDoc
forall a b. (a -> b) -> a -> b
$ ChunkedDoc
doc{ chunkedMeta :: Meta
chunkedMeta = Meta
meta'
                , chunkedChunks :: [Chunk]
chunkedChunks = [Chunk]
chunks' }

-- | Data for a section in a hierarchical document.
data SecInfo =
  SecInfo
  { SecInfo -> [Inline]
secTitle :: [Inline]
  , SecInfo -> Maybe Text
secNumber :: Maybe Text
  , SecInfo -> Text
secId :: Text
  , SecInfo -> Text
secPath :: Text -- including fragment, e.g. chunk001.html#section-one
  , SecInfo -> Int
secLevel :: Int
  } deriving (Int -> SecInfo -> String -> String
[SecInfo] -> String -> String
SecInfo -> String
(Int -> SecInfo -> String -> String)
-> (SecInfo -> String)
-> ([SecInfo] -> String -> String)
-> Show SecInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SecInfo -> String -> String
showsPrec :: Int -> SecInfo -> String -> String
$cshow :: SecInfo -> String
show :: SecInfo -> String
$cshowList :: [SecInfo] -> String -> String
showList :: [SecInfo] -> String -> String
Show, SecInfo -> SecInfo -> Bool
(SecInfo -> SecInfo -> Bool)
-> (SecInfo -> SecInfo -> Bool) -> Eq SecInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecInfo -> SecInfo -> Bool
== :: SecInfo -> SecInfo -> Bool
$c/= :: SecInfo -> SecInfo -> Bool
/= :: SecInfo -> SecInfo -> Bool
Eq, (forall x. SecInfo -> Rep SecInfo x)
-> (forall x. Rep SecInfo x -> SecInfo) -> Generic SecInfo
forall x. Rep SecInfo x -> SecInfo
forall x. SecInfo -> Rep SecInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SecInfo -> Rep SecInfo x
from :: forall x. SecInfo -> Rep SecInfo x
$cto :: forall x. Rep SecInfo x -> SecInfo
to :: forall x. Rep SecInfo x -> SecInfo
Generic)

instance Walkable Inline SecInfo where
  query :: forall c. Monoid c => (Inline -> c) -> SecInfo -> c
query Inline -> c
f SecInfo
sec = (Inline -> c) -> [Inline] -> c
forall c. Monoid c => (Inline -> c) -> [Inline] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> c
f (SecInfo -> [Inline]
secTitle SecInfo
sec)
  walk :: (Inline -> Inline) -> SecInfo -> SecInfo
walk Inline -> Inline
f SecInfo
sec = SecInfo
sec{ secTitle :: [Inline]
secTitle = (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
f (SecInfo -> [Inline]
secTitle SecInfo
sec) }
  walkM :: forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Inline -> m Inline) -> SecInfo -> m SecInfo
walkM Inline -> m Inline
f SecInfo
sec = do
    [Inline]
st <- (Inline -> m Inline) -> [Inline] -> m [Inline]
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) -> [Inline] -> m [Inline]
walkM Inline -> m Inline
f (SecInfo -> [Inline]
secTitle SecInfo
sec)
    SecInfo -> m SecInfo
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SecInfo
sec{ secTitle :: [Inline]
secTitle = [Inline]
st }

-- | Create tree of sections with titles, links, and numbers,
-- in a form that can be turned into a table of contents.
-- Presupposes that the '[Block]' is the output of 'makeSections'.
toTOCTree :: [Block] -> Tree SecInfo
toTOCTree :: [Block] -> Tree SecInfo
toTOCTree =
  SecInfo -> [Tree SecInfo] -> Tree SecInfo
forall a. a -> [Tree a] -> Tree a
Node SecInfo{ secTitle :: [Inline]
secTitle = []
              , secNumber :: Maybe Text
secNumber = Maybe Text
forall a. Maybe a
Nothing
              , secId :: Text
secId = Text
""
              , secPath :: Text
secPath = Text
""
              , secLevel :: Int
secLevel = Int
0 } ([Tree SecInfo] -> Tree SecInfo)
-> ([Block] -> [Tree SecInfo]) -> [Block] -> Tree SecInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> [Tree SecInfo] -> [Tree SecInfo])
-> [Tree SecInfo] -> [Block] -> [Tree SecInfo]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Block -> [Tree SecInfo] -> [Tree SecInfo]
go []
 where
  go :: Block -> [Tree SecInfo] -> [Tree SecInfo]
  go :: Block -> [Tree SecInfo] -> [Tree SecInfo]
go (Div (Text
ident,[Text]
_,[(Text, Text)]
_) (Header Int
lev (Text
_,[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils : [Block]
subsecs))
    | Bool -> Bool
not (Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
kvs) Bool -> Bool -> Bool
&& Text
"unlisted" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes)
    = ((SecInfo -> [Tree SecInfo] -> Tree SecInfo
forall a. a -> [Tree a] -> Tree a
Node SecInfo{ secTitle :: [Inline]
secTitle = [Inline]
ils
                    , secNumber :: Maybe Text
secNumber = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
kvs
                    , secId :: Text
secId = Text
ident
                    , secPath :: Text
secPath = Text
""
                    , secLevel :: Int
secLevel = Int
lev } ((Block -> [Tree SecInfo] -> [Tree SecInfo])
-> [Tree SecInfo] -> [Block] -> [Tree SecInfo]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Block -> [Tree SecInfo] -> [Tree SecInfo]
go [] [Block]
subsecs)) Tree SecInfo -> [Tree SecInfo] -> [Tree SecInfo]
forall a. a -> [a] -> [a]
:)
  go (Div Attr
_ [d :: Block
d@Div{}]) = Block -> [Tree SecInfo] -> [Tree SecInfo]
go Block
d -- #8402
  go Block
_ = [Tree SecInfo] -> [Tree SecInfo]
forall a. a -> a
id

-- | Adjusts paths in the TOC tree generated by 'toTOCTree'
-- to reflect division into Chunks.
fixTOCTreePaths :: [Chunk] -> Tree SecInfo -> Tree SecInfo
fixTOCTreePaths :: [Chunk] -> Tree SecInfo -> Tree SecInfo
fixTOCTreePaths [Chunk]
chunks = String -> Tree SecInfo -> Tree SecInfo
go String
""
 where
  idMap :: Map Text String
idMap = (Chunk -> Map Text String -> Map Text String)
-> Map Text String -> [Chunk] -> Map Text String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Chunk
chunk -> Text -> String -> Map Text String -> Map Text String
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Chunk -> Text
chunkId Chunk
chunk) (Chunk -> String
chunkPath Chunk
chunk))
                Map Text String
forall a. Monoid a => a
mempty [Chunk]
chunks
  go :: FilePath -> Tree SecInfo -> Tree SecInfo
  go :: String -> Tree SecInfo -> Tree SecInfo
go String
fp (Node SecInfo
secinfo [Tree SecInfo]
subtrees) =
    let newpath :: Maybe String
newpath = Text -> Map Text String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (SecInfo -> Text
secId SecInfo
secinfo) Map Text String
idMap
        fp' :: String
fp' = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
fp Maybe String
newpath
        fragment :: Text
fragment = case Maybe String
newpath of
                     Maybe String
Nothing -> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SecInfo -> Text
secId SecInfo
secinfo
                     Just String
_  -> Text
"" -- link to top of file
     in SecInfo -> [Tree SecInfo] -> Tree SecInfo
forall a. a -> [Tree a] -> Tree a
Node SecInfo
secinfo{ secPath :: Text
secPath = String -> Text
T.pack String
fp' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fragment }
             ((Tree SecInfo -> Tree SecInfo) -> [Tree SecInfo] -> [Tree SecInfo]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Tree SecInfo -> Tree SecInfo
go String
fp') [Tree SecInfo]
subtrees)

-- | Creates a TOC link to the respective document section.
tocEntryToLink :: Bool -> SecInfo -> [Inline]
tocEntryToLink :: Bool -> SecInfo -> [Inline]
tocEntryToLink Bool
includeNumbers SecInfo
secinfo = [Inline]
headerLink
 where
  addNumber :: [Inline] -> [Inline]
addNumber  = case SecInfo -> Maybe Text
secNumber SecInfo
secinfo of
                 Just Text
num | Bool
includeNumbers
                        -> (Attr -> [Inline] -> Inline
Span (Text
"",[Text
"toc-section-number"],[])
                               [Text -> Inline
Str Text
num] Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:) ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:)
                 Maybe Text
_ -> [Inline] -> [Inline]
forall a. a -> a
id
  clean :: Inline -> [Inline]
clean (Link Attr
_ [Inline]
xs (Text, Text)
_) = [Inline]
xs
  clean (Note [Block]
_) = []
  clean Inline
x = [Inline
x]
  anchor :: Text
anchor = if Text -> Bool
T.null (SecInfo -> Text
secPath SecInfo
secinfo)
              then if Text -> Bool
T.null (SecInfo -> Text
secId SecInfo
secinfo)
                      then Text
""
                      else Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SecInfo -> Text
secId SecInfo
secinfo
              else SecInfo -> Text
secPath SecInfo
secinfo
  headerText :: [Inline]
headerText = [Inline] -> [Inline]
addNumber ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk ((Inline -> [Inline]) -> [Inline] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Inline -> [Inline]
clean) (SecInfo -> [Inline]
secTitle SecInfo
secinfo)
  headerLink :: [Inline]
headerLink = if Text -> Bool
T.null Text
anchor
                  then [Inline]
headerText
                  else [Attr -> [Inline] -> (Text, Text) -> Inline
Link ((if Text -> Bool
T.null (SecInfo -> Text
secId SecInfo
secinfo)
                                  then Text
""
                                  else Text
"toc-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SecInfo -> Text
secId SecInfo
secinfo), [], [])
                         [Inline]
headerText (Text
anchor, Text
"")]

-- | Generate a table of contents of the given depth.
tocToList :: Bool -> Int -> Tree SecInfo -> Block
tocToList :: Bool -> Int -> Tree SecInfo -> Block
tocToList Bool
includeNumbers Int
tocDepth (Node SecInfo
_ [Tree SecInfo]
subtrees) = [[Block]] -> Block
BulletList ([Tree SecInfo] -> [[Block]]
toItems [Tree SecInfo]
subtrees)
 where
  toItems :: [Tree SecInfo] -> [[Block]]
toItems = (Tree SecInfo -> [Block]) -> [Tree SecInfo] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
map Tree SecInfo -> [Block]
go ([Tree SecInfo] -> [[Block]])
-> ([Tree SecInfo] -> [Tree SecInfo])
-> [Tree SecInfo]
-> [[Block]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree SecInfo -> Bool) -> [Tree SecInfo] -> [Tree SecInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter Tree SecInfo -> Bool
isBelowTocDepth
  isBelowTocDepth :: Tree SecInfo -> Bool
isBelowTocDepth (Node SecInfo
sec [Tree SecInfo]
_) = SecInfo -> Int
secLevel SecInfo
sec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
tocDepth
  go :: Tree SecInfo -> [Block]
go (Node SecInfo
secinfo [Tree SecInfo]
xs) =
    [Inline] -> Block
Plain (Bool -> SecInfo -> [Inline]
tocEntryToLink Bool
includeNumbers SecInfo
secinfo) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:
      case [Tree SecInfo] -> [[Block]]
toItems [Tree SecInfo]
xs of
        [] -> []
        [[Block]]
ys -> [[[Block]] -> Block
BulletList [[Block]]
ys]