{-# 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,
                           tshow, uniqueIdent)
import Text.Pandoc.Walk (Walkable(..), query)
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)
import qualified Data.Set as Set
import Control.Monad.State

-- | 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 = [Block] -> [Block]
ensureIds ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
numberSections Maybe Int
mbBaseLevel [Block]
blocks

-- The TOC won't work if we don't have unique identifiers for all sections.
ensureIds :: [Block] -> [Block]
ensureIds :: [Block] -> [Block]
ensureIds [Block]
bs = State (Set Text) [Block] -> Set Text -> [Block]
forall s a. State s a -> s -> a
evalState ((Block -> StateT (Set Text) Identity Block)
-> [Block] -> State (Set Text) [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 -> StateT (Set Text) Identity Block
go [Block]
bs) Set Text
forall a. Monoid a => a
mempty
 where
   go :: Block -> State (Set.Set Text) Block
   go :: Block -> StateT (Set Text) Identity Block
go b :: Block
b@(Div (Text
ident,Text
"section":[Text]
cls,[(Text, Text)]
kvs) bs' :: [Block]
bs'@(Header Int
_ (Text, [Text], [(Text, Text)])
_ [Inline]
ils : [Block]
_))
     | Text -> Bool
T.null Text
ident
       = do Set Text
ids <- StateT (Set Text) Identity (Set Text)
forall s (m :: * -> *). MonadState s m => m s
get
            let newid :: Text
newid = Extensions -> [Inline] -> Set Text -> Text
uniqueIdent Extensions
forall a. Monoid a => a
mempty [Inline]
ils Set Text
ids
            (Set Text -> Set Text) -> StateT (Set Text) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Set Text -> Set Text) -> StateT (Set Text) Identity ())
-> (Set Text -> Set Text) -> StateT (Set Text) Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
newid
            Block -> StateT (Set Text) Identity Block
forall a. a -> StateT (Set Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> StateT (Set Text) Identity Block)
-> Block -> StateT (Set Text) Identity Block
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
newid,Text
"section"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
cls,[(Text, Text)]
kvs) [Block]
bs'
     | Bool
otherwise
       = do (Set Text -> Set Text) -> StateT (Set Text) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Set Text -> Set Text) -> StateT (Set Text) Identity ())
-> (Set Text -> Set Text) -> StateT (Set Text) Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert Text
ident
            Block -> StateT (Set Text) Identity Block
forall a. a -> StateT (Set Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
b
   go Block
b = Block -> StateT (Set Text) Identity Block
forall a. a -> StateT (Set Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
b

-- | Add chunkNext, chunkPrev, chunkUp
addNav :: ChunkedDoc -> ChunkedDoc
addNav :: ChunkedDoc -> ChunkedDoc
addNav ChunkedDoc
chunkedDoc =
  ChunkedDoc
chunkedDoc{ chunkedChunks =
     addNext . addPrev . addUp $ chunkedChunks 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 = Just 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 = chunkUp 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 = 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 = 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 (Text, [Text], [(Text, Text)])
attr [Inline]
ils (Text
src,Text
tit))
    = case Text -> Maybe (Char, Text)
T.uncons Text
src of
        Just (Char
'#', Text
ident) -> (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
Link (Text, [Text], [(Text, Text)])
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 (Text, [Text], [(Text, Text)])
_ [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 :: (Text, [Text], [(Text, Text)])
attr@(Text
_,Text
"section":[Text]
_,[(Text, Text)]
_) (h :: Block
h@(Header Int
lvl (Text, [Text], [(Text, Text)])
_ [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 ((Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text, [Text], [(Text, Text)])
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
                     ((Text, [Text], [(Text, Text)]) -> [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 (Text, [Text], [(Text, Text)])
_ [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 =
         [(Text, [Text], [(Text, Text)]) -> [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 = Text
chunkid
      , chunkLevel :: Int
chunkLevel = Int
0
      , chunkNumber :: Int
chunkNumber = Int
chunknum
      , chunkSectionNumber :: Maybe Text
chunkSectionNumber = Maybe Text
forall a. Maybe a
Nothing
      , chunkPath :: String
chunkPath = String
chunkpath
      , 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
      }
    where
      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))
                        Text
chunkid
                        Text
"0"
      chunkid :: Text
chunkid = Extensions -> [Inline] -> Text
inlineListToIdentifier Extensions
forall a. Monoid a => a
mempty (Meta -> [Inline]
docTitle Meta
meta) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                      Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
chunknum
  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) =
  (Text, [Text], [(Text, Text)]) -> [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 -> Bool
PathTemplate -> Value
PathTemplate -> Encoding
(PathTemplate -> Value)
-> (PathTemplate -> Encoding)
-> ([PathTemplate] -> Value)
-> ([PathTemplate] -> Encoding)
-> (PathTemplate -> Bool)
-> ToJSON PathTemplate
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> 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
$comitField :: PathTemplate -> Bool
omitField :: PathTemplate -> Bool
ToJSON, Maybe PathTemplate
Value -> Parser [PathTemplate]
Value -> Parser PathTemplate
(Value -> Parser PathTemplate)
-> (Value -> Parser [PathTemplate])
-> Maybe PathTemplate
-> FromJSON PathTemplate
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser PathTemplate
parseJSON :: Value -> Parser PathTemplate
$cparseJSONList :: Value -> Parser [PathTemplate]
parseJSONList :: Value -> Parser [PathTemplate]
$comittedField :: Maybe PathTemplate
omittedField :: Maybe 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 = walk f (chunkContents 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 = 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 = walk f (chunkContents 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 = 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 = walk f (chunkedMeta doc)
                  , chunkedChunks = walk f (chunkedChunks 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'
                , chunkedChunks = 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 = walk f (chunkedMeta doc)
                  , chunkedChunks = walk f (chunkedChunks 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'
                , chunkedChunks = 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 = walk f (secTitle 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 = 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 (Text, [Text], [(Text, Text)])
_ [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 Map Text String
m ->
                   let ids :: [Text]
ids = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
                               (Chunk -> Text
chunkId Chunk
chunk Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
                                  (Block -> [Text]) -> [Block] -> [Text]
forall c. Monoid c => (Block -> c) -> [Block] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> [Text]
getIds (Chunk -> [Block]
chunkContents Chunk
chunk))
                    in (Text -> Map Text String -> Map Text String)
-> Map Text String -> [Text] -> 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 (\Text
i -> Text -> String -> Map Text String -> Map Text String
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
i (Chunk -> String
chunkPath Chunk
chunk)) Map Text String
m [Text]
ids)
                Map Text String
forall a. Monoid a => a
mempty [Chunk]
chunks
  getIds :: Block -> [Text]
  getIds :: Block -> [Text]
getIds (Div (Text
i,Text
"section":[Text]
_,[(Text, Text)]
_) [Block]
_) = [Text
i]
  getIds Block
_ = []
  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 = Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SecInfo -> Text
secId SecInfo
secinfo
     in SecInfo -> [Tree SecInfo] -> Tree SecInfo
forall a. a -> [Tree a] -> Tree a
Node SecInfo
secinfo{ secPath = T.pack fp' <> 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
                        -> ((Text, [Text], [(Text, Text)]) -> [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 (Text, [Text], [(Text, Text)])
_ [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 [(Text, [Text], [(Text, Text)])
-> [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]