{-
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, ViewPatterns
  , LambdaCase #-}

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

import Control.Monad.Reader.Class
import qualified Data.Map as M
import qualified Data.Text as T
import Text.Pandoc.Definition
import Text.Pandoc.Shared (stringify)
import Text.Pandoc.Walk (walk)
import Control.Monad (when)

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.Util.Options
import Text.Pandoc.CrossRef.Util.Util
import qualified Data.Sequence as S
import Data.Sequence (ViewR(..))

setLabel :: Options -> [Inline] -> [(T.Text, T.Text)] -> [(T.Text, T.Text)]
setLabel :: Options -> [Inline] -> [(Text, Text)] -> [(Text, Text)]
setLabel Options
opts [Inline]
idx
  | Options -> Bool
setLabelAttribute Options
opts
  = ((Text
"label", [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
idx) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:)
  ([(Text, Text)] -> [(Text, Text)])
-> ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)]
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"label") (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst)
  | Bool
otherwise = [(Text, Text)] -> [(Text, Text)]
forall a. a -> a
id

walkReplaceInlines :: [Inline] -> [Inline] -> Block -> Block
walkReplaceInlines :: [Inline] -> [Inline] -> Block -> Block
walkReplaceInlines [Inline]
newTitle [Inline]
title = ([Inline] -> [Inline]) -> Block -> Block
forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
replaceInlines
  where
  replaceInlines :: [Inline] -> [Inline]
replaceInlines [Inline]
xs
    | [Inline]
xs [Inline] -> [Inline] -> Bool
forall a. Eq a => a -> a -> Bool
== [Inline]
title = [Inline]
newTitle
    | Bool
otherwise = [Inline]
xs

-- | Exactly like 'Prefix' but doesn't have 'PfxSec'. @S@ stands for "safer".
-- Sections are handled specially, see
-- "Text.Pandoc.CrossRef.References.Blocks.Header"
data SPrefix
  = SPfxImg
  | SPfxEqn
  | SPfxTbl
  | SPfxLst

toPrefix :: SPrefix -> Prefix
toPrefix :: SPrefix -> Prefix
toPrefix = \case
  SPrefix
SPfxImg -> Prefix
PfxImg
  SPrefix
SPfxEqn -> Prefix
PfxEqn
  SPrefix
SPfxTbl -> Prefix
PfxTbl
  SPrefix
SPfxLst -> Prefix
PfxLst

replaceAttr
  :: Either T.Text T.Text -- ^ Reference id
  -> [(T.Text, T.Text)] -- ^ Attributes
  -> [Inline] -- ^ Title
  -> SPrefix -- ^ Prefix type
  -> WS [Inline]
replaceAttr :: Either Text Text
-> [(Text, Text)] -> [Inline] -> SPrefix -> WS [Inline]
replaceAttr Either Text Text
label [(Text, Text)]
attrs [Inline]
title (SPrefix -> Prefix
toPrefix -> Prefix
pfx) = do
  let refLabel :: Maybe Text
refLabel = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"label" [(Text, Text)]
attrs
      number :: Maybe Int
number = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
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
  Options{Bool
Int
[Inline]
[Block]
Maybe Format
Text
BlockTemplate
Template
Bool -> Int -> [Inline]
Int -> Int -> Maybe Text
Text -> Template
Text -> Int -> Maybe Text
setLabelAttribute :: Options -> Bool
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
equationNumberTeX :: Options -> Text
..} <- WS Options
forall r (m :: * -> *). MonadReader r m => m r
ask
  Seq (Int, Maybe Text)
chap  <- Int -> Seq (Int, Maybe Text) -> Seq (Int, Maybe Text)
forall a. Int -> Seq a -> Seq a
S.take Int
chaptersDepth (Seq (Int, Maybe Text) -> Seq (Int, Maybe Text))
-> WS (Seq (Int, Maybe Text)) -> WS (Seq (Int, Maybe Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Seq (Int, Maybe Text)) References (Seq (Int, Maybe Text))
-> WS (Seq (Int, Maybe Text))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Prefix -> Lens' References (Seq (Int, Maybe Text))
ctrsAt Prefix
PfxSec)
  RefMap
prop' <- Getting RefMap References RefMap -> WS RefMap
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting RefMap References RefMap -> WS RefMap)
-> Getting RefMap References RefMap -> WS RefMap
forall a b. (a -> b) -> a -> b
$ Prefix -> Lens' References RefMap
refsAt Prefix
pfx
  Seq (Int, Maybe Text)
curIdx <- Getting (Seq (Int, Maybe Text)) References (Seq (Int, Maybe Text))
-> WS (Seq (Int, Maybe Text))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Seq (Int, Maybe Text)) References (Seq (Int, Maybe Text))
 -> WS (Seq (Int, Maybe Text)))
-> Getting
     (Seq (Int, Maybe Text)) References (Seq (Int, Maybe Text))
-> WS (Seq (Int, Maybe Text))
forall a b. (a -> b) -> a -> b
$ Prefix -> Lens' References (Seq (Int, Maybe Text))
ctrsAt Prefix
pfx
  let i :: Int
i | Just Int
n <- Maybe Int
number = Int
n
        | Seq (Int, Maybe Text)
chap' :> (Int, Maybe Text)
last' <- Seq (Int, Maybe Text) -> ViewR (Int, Maybe Text)
forall a. Seq a -> ViewR a
S.viewr Seq (Int, Maybe Text)
curIdx
        , Seq (Int, Maybe Text)
chap' Seq (Int, Maybe Text) -> Seq (Int, Maybe Text) -> Bool
forall a. Eq a => a -> a -> Bool
== Seq (Int, Maybe Text)
chap
        = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int)
-> ((Int, Maybe Text) -> Int) -> (Int, Maybe Text) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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'
        | Bool
otherwise = Int
1
      index :: Seq (Int, Maybe Text)
index = Seq (Int, Maybe Text)
chap Seq (Int, Maybe Text) -> (Int, Maybe Text) -> Seq (Int, Maybe Text)
forall a. Seq a -> a -> Seq a
S.|> (Int
i, Maybe Text
refLabel 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
ref Int
i)
      ref :: Text
ref = (Text -> Text) -> (Text -> Text) -> Either Text Text -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> Text
forall a. a -> a
id ((Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
':')) Either Text Text
label
      label' :: Text
label' = (Text -> Text) -> (Text -> Text) -> Either Text Text -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: Seq (Int, Maybe Text) -> String
forall a. Show a => a -> String
show Seq (Int, Maybe Text)
index)) Text -> Text
forall a. a -> a
id Either Text Text
label
  Bool -> WS () -> WS ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> RefMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Text
label' RefMap
prop') (WS () -> WS ()) -> WS () -> WS ()
forall a b. (a -> b) -> a -> b
$
    String -> WS ()
forall a. HasCallStack => String -> a
error (String -> WS ()) -> (Text -> String) -> Text -> WS ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> WS ()) -> Text -> WS ()
forall a b. (a -> b) -> a -> b
$ Text
"Duplicate label: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label'
  Prefix -> Lens' References (Seq (Int, Maybe Text))
ctrsAt Prefix
pfx ((Seq (Int, Maybe Text) -> Identity (Seq (Int, Maybe Text)))
 -> References -> Identity References)
-> Seq (Int, Maybe Text) -> WS ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Seq (Int, Maybe Text)
index
  Prefix -> Lens' References RefMap
refsAt Prefix
pfx ((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 :: Seq (Int, Maybe Text)
refIndex= Seq (Int, Maybe Text)
index
  , refTitle :: [Inline]
refTitle= [Inline]
title
  , refSubfigure :: Maybe (Seq (Int, Maybe Text))
refSubfigure = Maybe (Seq (Int, Maybe Text))
forall a. Maybe a
Nothing
  }
  [Inline] -> WS [Inline]
forall a. a -> WS a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inline] -> WS [Inline]) -> [Inline] -> WS [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Seq (Int, Maybe Text) -> [Inline]
chapPrefix [Inline]
chapDelim Seq (Int, Maybe Text)
index

mkCaption :: Options -> T.Text -> [Inline] -> Block
mkCaption :: Options -> Text -> [Inline] -> Block
mkCaption Options
opts Text
style
  | Options -> Maybe Format
outFormat Options
opts Maybe Format -> Maybe Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format -> Maybe Format
forall a. a -> Maybe a
Just (Text -> Format
Format Text
"docx") = Attr -> [Block] -> Block
Div (Text
"", [], [(Text
"custom-style", Text
style)]) ([Block] -> Block) -> ([Inline] -> [Block]) -> [Inline] -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [Block]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> [Block]) -> ([Inline] -> Block) -> [Inline] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Para
  | Bool
otherwise = [Inline] -> Block
Para