{-
pandoc-crossref is a pandoc filter for numbering figures,
equations, tables and cross-references to them.
Copyright (C) 2015  Nikolay Yakimov <root@livid.pp.ru>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-}

{-# LANGUAGE Rank2Types, OverloadedStrings, FlexibleContexts, RecordWildCards, NamedFieldPuns #-}

module Text.Pandoc.CrossRef.References.Blocks.Header where

import Control.Monad.Reader.Class
import Control.Monad (when)
import qualified Data.Map as M
import qualified Data.Sequence as S
import Data.Sequence (ViewR(..))
import qualified Data.Text as T
import Text.Pandoc.Definition
import Text.Read (readMaybe)

import Control.Applicative
import Lens.Micro.Mtl
import Text.Pandoc.CrossRef.References.Types
import Text.Pandoc.CrossRef.References.Monad
import Text.Pandoc.CrossRef.References.Blocks.Util (setLabel)
import Text.Pandoc.CrossRef.Util.Options
import Text.Pandoc.CrossRef.Util.Template
import Text.Pandoc.CrossRef.Util.Util

runHeader :: Int -> Attr -> [Inline] -> WS (ReplacedResult Block)
runHeader :: Int -> Attr -> [Inline] -> WS (ReplacedResult Block)
runHeader Int
n (Text
label, [Text]
cls, [(Text, Text)]
attrs) [Inline]
text'
  | Text
"unnumbered" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls = do
      Text
label' <- WS Text
mangleLabel
      Block -> WS (ReplacedResult Block)
forall (m :: * -> *) a. Monad m => a -> m (ReplacedResult a)
replaceNoRecurse (Block -> WS (ReplacedResult Block))
-> Block -> WS (ReplacedResult Block)
forall a b. (a -> b) -> a -> b
$ Int -> Attr -> [Inline] -> Block
Header Int
n (Text
label', [Text]
cls, [(Text, Text)]
attrs) [Inline]
text'
  | Bool
otherwise = do
      opts :: Options
opts@Options{Bool
Int
[Inline]
[Block]
Maybe Format
Text
BlockTemplate
Template
Bool -> Int -> [Inline]
Int -> Int -> Maybe Text
Text -> Template
Text -> Int -> Maybe Text
cref :: Bool
chaptersDepth :: Int
listings :: Bool
codeBlockCaptions :: Bool
autoSectionLabels :: Bool
numberSections :: Bool
sectionsDepth :: Int
figPrefix :: Bool -> Int -> [Inline]
eqnPrefix :: Bool -> Int -> [Inline]
tblPrefix :: Bool -> Int -> [Inline]
lstPrefix :: Bool -> Int -> [Inline]
secPrefix :: Bool -> Int -> [Inline]
figPrefixTemplate :: Template
eqnPrefixTemplate :: Template
tblPrefixTemplate :: Template
lstPrefixTemplate :: Template
secPrefixTemplate :: Template
lofItemTemplate :: BlockTemplate
lotItemTemplate :: BlockTemplate
lolItemTemplate :: BlockTemplate
eqnBlockTemplate :: BlockTemplate
eqnBlockInlineMath :: Bool
eqnIndexTemplate :: Template
eqnInlineTemplate :: Template
refIndexTemplate :: Text -> Template
subfigureRefIndexTemplate :: Template
secHeaderTemplate :: Template
chapDelim :: [Inline]
rangeDelim :: [Inline]
pairDelim :: [Inline]
lastDelim :: [Inline]
refDelim :: [Inline]
lofTitle :: [Block]
lotTitle :: [Block]
lolTitle :: [Block]
outFormat :: Maybe Format
figureTemplate :: Template
subfigureTemplate :: Template
subfigureChildTemplate :: Template
ccsTemplate :: Template
tableTemplate :: Template
listingTemplate :: Template
customLabel :: Text -> Int -> Maybe Text
customHeadingLabel :: Int -> Int -> Maybe Text
ccsDelim :: [Inline]
ccsLabelSep :: [Inline]
tableEqns :: Bool
autoEqnLabels :: Bool
subfigGrid :: Bool
linkReferences :: Bool
nameInLink :: Bool
setLabelAttribute :: Bool
equationNumberTeX :: Text
cref :: Options -> Bool
chaptersDepth :: Options -> Int
listings :: Options -> Bool
codeBlockCaptions :: Options -> Bool
autoSectionLabels :: Options -> Bool
numberSections :: Options -> Bool
sectionsDepth :: Options -> Int
figPrefix :: Options -> Bool -> Int -> [Inline]
eqnPrefix :: Options -> Bool -> Int -> [Inline]
tblPrefix :: Options -> Bool -> Int -> [Inline]
lstPrefix :: Options -> Bool -> Int -> [Inline]
secPrefix :: Options -> Bool -> Int -> [Inline]
figPrefixTemplate :: Options -> Template
eqnPrefixTemplate :: Options -> Template
tblPrefixTemplate :: Options -> Template
lstPrefixTemplate :: Options -> Template
secPrefixTemplate :: Options -> Template
lofItemTemplate :: Options -> BlockTemplate
lotItemTemplate :: Options -> BlockTemplate
lolItemTemplate :: Options -> BlockTemplate
eqnBlockTemplate :: Options -> BlockTemplate
eqnBlockInlineMath :: Options -> Bool
eqnIndexTemplate :: Options -> Template
eqnInlineTemplate :: Options -> Template
refIndexTemplate :: Options -> Text -> Template
subfigureRefIndexTemplate :: Options -> Template
secHeaderTemplate :: Options -> Template
chapDelim :: Options -> [Inline]
rangeDelim :: Options -> [Inline]
pairDelim :: Options -> [Inline]
lastDelim :: Options -> [Inline]
refDelim :: Options -> [Inline]
lofTitle :: Options -> [Block]
lotTitle :: Options -> [Block]
lolTitle :: Options -> [Block]
outFormat :: Options -> Maybe Format
figureTemplate :: Options -> Template
subfigureTemplate :: Options -> Template
subfigureChildTemplate :: Options -> Template
ccsTemplate :: Options -> Template
tableTemplate :: Options -> Template
listingTemplate :: Options -> Template
customLabel :: Options -> Text -> Int -> Maybe Text
customHeadingLabel :: Options -> Int -> Int -> Maybe Text
ccsDelim :: Options -> [Inline]
ccsLabelSep :: Options -> [Inline]
tableEqns :: Options -> Bool
autoEqnLabels :: Options -> Bool
subfigGrid :: Options -> Bool
linkReferences :: Options -> Bool
nameInLink :: Options -> Bool
setLabelAttribute :: Options -> Bool
equationNumberTeX :: Options -> Text
..} <- WS Options
forall r (m :: * -> *). MonadReader r m => m r
ask
      Text
label' <- WS Text
mangleLabel
      Prefix -> Lens' References Index
ctrsAt Prefix
PfxSec ((Index -> Identity Index) -> References -> Identity References)
-> (Index -> Index) -> WS ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \Index
cc ->
        let ln :: Int
ln = Index -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Index
cc
            cl :: Int -> Maybe Text
cl Int
i = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"label" [(Text, Text)]
attrs Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Int -> Maybe Text
customHeadingLabel Int
n Int
i Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Int -> Maybe Text
customLabel Text
"sec" Int
i
            inc :: Index -> Index
inc Index
l = case Index -> ViewR (Int, Maybe Text)
forall a. Seq a -> ViewR a
S.viewr Index
l of
              ViewR (Int, Maybe Text)
EmptyR -> [Char] -> Index
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"
              Index
init' :> (Int, Maybe Text)
last' ->
                let i :: Int
i = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int, Maybe Text) -> Int
forall a b. (a, b) -> a
fst ((Int, Maybe Text) -> Int) -> (Int, Maybe Text) -> Int
forall a b. (a -> b) -> a -> b
$ (Int, Maybe Text)
last'
                in Index
init' Index -> (Int, Maybe Text) -> Index
forall a. Seq a -> a -> Seq a
S.|> (Int
i, Int -> Maybe Text
cl Int
i)
            cc' :: Index
cc' | Just Int
num <- [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Int) -> (Text -> [Char]) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> Maybe Int) -> Maybe Text -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
attrs
                = Int -> Index -> Index
forall a. Int -> Seq a -> Seq a
S.take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Index
cc Index -> (Int, Maybe Text) -> Index
forall a. Seq a -> a -> Seq a
S.|> (Int
num, Int -> Maybe Text
cl Int
num)
                | Int
ln Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = Index -> Index
inc (Index -> Index) -> Index -> Index
forall a b. (a -> b) -> a -> b
$ Int -> Index -> Index
forall a. Int -> Seq a -> Seq a
S.take Int
n Index
cc
                | Int
ln Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Index -> Index
inc Index
cc
                | Bool
otherwise = Index
cc Index -> Index -> Index
forall a. Semigroup a => a -> a -> a
<> Index
forall {a}. Seq (Int, Maybe a)
implicitChapters Index -> (Int, Maybe Text) -> Index
forall a. Seq a -> a -> Seq a
S.|> (Int
1,Int -> Maybe Text
cl Int
1)
            implicitChapters :: Seq (Int, Maybe a)
implicitChapters
              | Bool
numberSections = Int -> (Int, Maybe a) -> Seq (Int, Maybe a)
forall a. Int -> a -> Seq a
S.replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lnInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
1, Maybe a
forall a. Maybe a
Nothing)
              | Bool
otherwise = Int -> (Int, Maybe a) -> Seq (Int, Maybe a)
forall a. Int -> a -> Seq a
S.replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lnInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
0, Maybe a
forall a. Maybe a
Nothing)
        in Index
cc'
      Index
cc <- Getting Index References Index -> WS Index
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Index References Index -> WS Index)
-> Getting Index References Index -> WS Index
forall a b. (a -> b) -> a -> b
$ Prefix -> Lens' References Index
ctrsAt Prefix
PfxSec
      Bool -> WS () -> WS ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
"sec:" Text -> Text -> Bool
`T.isPrefixOf` Text
label') (WS () -> WS ()) -> WS () -> WS ()
forall a b. (a -> b) -> a -> b
$
        Prefix -> Lens' References RefMap
refsAt Prefix
PfxSec ((RefMap -> Identity RefMap) -> References -> Identity References)
-> (RefMap -> RefMap) -> WS ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> RefRec -> RefMap -> RefMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
label' RefRec {
          refIndex :: Index
refIndex = Index
cc
        , refTitle :: [Inline]
refTitle = [Inline]
text'
        , refSubfigure :: Maybe Index
refSubfigure = Maybe Index
forall a. Maybe a
Nothing
        }
      let textCC :: [Inline]
textCC
            | Bool
numberSections
            , Int
sectionsDepth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
            Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= if Int
sectionsDepth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
chaptersDepth else Int
sectionsDepth
            = Map Text [Inline] -> Template -> [Inline]
forall a b. MkTemplate a b => Map Text [Inline] -> b -> [a]
applyTemplate' ([(Text, [Inline])] -> Map Text [Inline]
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList [
                (Text
"i", [Inline]
idxStr)
              , (Text
"n", [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
              , (Text
"t", [Inline]
text')
              ]) (Template -> [Inline]) -> Template -> [Inline]
forall a b. (a -> b) -> a -> b
$ Template
secHeaderTemplate
            | Bool
otherwise = [Inline]
text'
          idxStr :: [Inline]
idxStr = [Inline] -> Index -> [Inline]
chapPrefix [Inline]
chapDelim Index
cc
          attrs' :: [(Text, Text)]
attrs' = Options -> [Inline] -> [(Text, Text)] -> [(Text, Text)]
setLabel Options
opts [Inline]
idxStr [(Text, Text)]
attrs
      Block -> WS (ReplacedResult Block)
forall (m :: * -> *) a. Monad m => a -> m (ReplacedResult a)
replaceNoRecurse (Block -> WS (ReplacedResult Block))
-> Block -> WS (ReplacedResult Block)
forall a b. (a -> b) -> a -> b
$ Int -> Attr -> [Inline] -> Block
Header Int
n (Text
label', [Text]
cls, [(Text, Text)]
attrs') [Inline]
textCC
  where
    mangleLabel :: WS Text
mangleLabel = do
      Options{Bool
autoSectionLabels :: Options -> Bool
autoSectionLabels :: Bool
autoSectionLabels} <- WS Options
forall r (m :: * -> *). MonadReader r m => m r
ask
      Text -> WS Text
forall a. a -> WS a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> WS Text) -> Text -> WS Text
forall a b. (a -> b) -> a -> b
$
        if Bool
autoSectionLabels Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
"sec:" Text -> Text -> Bool
`T.isPrefixOf` Text
label)
        then Text
"sec:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label
        else Text
label