{-
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, ScopedTypeVariables, LambdaCase #-}
module Text.Pandoc.CrossRef.References.Blocks
  ( replaceAll
  ) where

import Control.Monad.Reader
import Data.List
import qualified Data.Text as T
import Lens.Micro
import Text.Pandoc.Definition
import Text.Pandoc.Shared (blocksToInlines)

import Text.Pandoc.CrossRef.References.Blocks.CodeBlock
import Text.Pandoc.CrossRef.References.Blocks.Header
import Text.Pandoc.CrossRef.References.Blocks.Math
import Text.Pandoc.CrossRef.References.Blocks.Subfigures
import Text.Pandoc.CrossRef.References.Blocks.Table
import Text.Pandoc.CrossRef.References.Blocks.Util
import Text.Pandoc.CrossRef.References.Monad
import Text.Pandoc.CrossRef.Util.Options
import Text.Pandoc.CrossRef.Util.Util

replaceAll :: (Data a) => a -> WS a
replaceAll :: forall a. Data a => a -> WS a
replaceAll a
x = do
  Options
opts <- forall r (m :: * -> *). MonadReader r m => m r
ask
  a
x forall a b. a -> (a -> b) -> b
& forall (m :: * -> *). Monad m => GenRR m -> GenericM m
runReplace (forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m (ReplacedResult b)) -> a -> m (ReplacedResult a)
mkRR Block -> WS (ReplacedResult Block)
replaceBlock
    forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m (ReplacedResult a))
-> (b -> m (ReplacedResult b)) -> a -> m (ReplacedResult a)
`extRR` [Inline] -> WS (ReplacedResult [Inline])
replaceInlineMany
    )
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Data a => Options -> a -> a
runSplitMath Options
opts
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere (forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT Block -> Block
divBlocks forall a b.
(Typeable a, Typeable b) =>
(a -> a) -> (b -> b) -> a -> a
`extT` Options -> [Inline] -> [Inline]
spanInlines Options
opts)
  where
    runSplitMath :: Options -> a -> a
runSplitMath Options
opts
      | Options -> Bool
tableEqns Options
opts
      , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Maybe Format -> Bool
isLatexFormat (Options -> Maybe Format
outFormat Options
opts)
      = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere (forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT [Block] -> [Block]
splitMath)
      | Bool
otherwise = forall a. a -> a
id

extractCaption :: Block -> Maybe [Inline]
extractCaption :: Block -> Maybe [Inline]
extractCaption = \case
  Para [Inline]
caption -> forall a. a -> Maybe a
Just [Inline]
caption
  Div (Text
_, [Text]
dcls, [(Text, Text)]
_) [Para [Inline]
caption] | Text
"caption" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
dcls -> forall a. a -> Maybe a
Just [Inline]
caption
  Block
_ -> forall a. Maybe a
Nothing

replaceBlock :: Block -> WS (ReplacedResult Block)
replaceBlock :: Block -> WS (ReplacedResult Block)
replaceBlock (Header Int
n (Text, [Text], [(Text, Text)])
attr [Inline]
text') = Int
-> (Text, [Text], [(Text, Text)])
-> [Inline]
-> WS (ReplacedResult Block)
runHeader Int
n (Text, [Text], [(Text, Text)])
attr [Inline]
text'
replaceBlock (Figure attr :: (Text, [Text], [(Text, Text)])
attr@(Text
label, [Text]
_, [(Text, Text)]
_) Caption
caption [Block]
content)
  | Text
"fig:" Text -> Text -> Bool
`T.isPrefixOf` Text
label
  = Bool
-> (Text, [Text], [(Text, Text)])
-> Caption
-> [Block]
-> WS (ReplacedResult Block)
runFigure Bool
False (Text, [Text], [(Text, Text)])
attr Caption
caption [Block]
content
replaceBlock (Div attr :: (Text, [Text], [(Text, Text)])
attr@(Text
label, [Text]
_, [(Text, Text)]
_) [Block]
content)
  | Text
"fig:" Text -> Text -> Bool
`T.isPrefixOf` Text
label
  , Just [Inline]
caption <- Block -> Maybe [Inline]
extractCaption forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [Block]
content
  = case forall a. [a] -> [a]
init [Block]
content of
      [Figure (Text
"", [], []) Caption
_ [Block]
content'] -- nested figure due to implicit_figures...
        -> Bool
-> (Text, [Text], [(Text, Text)])
-> Caption
-> [Block]
-> WS (ReplacedResult Block)
runFigure Bool
False (Text, [Text], [(Text, Text)])
attr (Maybe [Inline] -> [Block] -> Caption
Caption forall a. Maybe a
Nothing [[Inline] -> Block
Para [Inline]
caption]) [Block]
content'
      [Block]
xs -> (Text, [Text], [(Text, Text)])
-> [Block] -> [Inline] -> WS (ReplacedResult Block)
runSubfigures (Text, [Text], [(Text, Text)])
attr [Block]
xs [Inline]
caption
replaceBlock (Div attr :: (Text, [Text], [(Text, Text)])
attr@(Text
label, [Text]
_, [(Text, Text)]
_) [Table (Text, [Text], [(Text, Text)])
tattr (Caption Maybe [Inline]
short (Block
btitle:[Block]
rest)) [ColSpec]
colspec TableHead
header [TableBody]
cells TableFoot
foot])
  | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ [Block] -> [Inline]
blocksToInlines [Block
btitle]
  , Text
"tbl:" Text -> Text -> Bool
`T.isPrefixOf` Text
label
  = (Text, [Text], [(Text, Text)])
-> Maybe (Text, [Text], [(Text, Text)])
-> Maybe [Inline]
-> Block
-> [Block]
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> WS (ReplacedResult Block)
runTable (Text, [Text], [(Text, Text)])
attr (forall a. a -> Maybe a
Just (Text, [Text], [(Text, Text)])
tattr) Maybe [Inline]
short Block
btitle [Block]
rest [ColSpec]
colspec TableHead
header [TableBody]
cells TableFoot
foot
replaceBlock (Table attr :: (Text, [Text], [(Text, Text)])
attr@(Text
label, [Text]
_, [(Text, Text)]
_) (Caption Maybe [Inline]
short (Block
btitle:[Block]
rest)) [ColSpec]
colspec TableHead
header [TableBody]
cells TableFoot
foot)
  | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ [Block] -> [Inline]
blocksToInlines [Block
btitle]
  , Text
"tbl:" Text -> Text -> Bool
`T.isPrefixOf` Text
label
  = (Text, [Text], [(Text, Text)])
-> Maybe (Text, [Text], [(Text, Text)])
-> Maybe [Inline]
-> Block
-> [Block]
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> WS (ReplacedResult Block)
runTable (Text, [Text], [(Text, Text)])
attr forall a. Maybe a
Nothing Maybe [Inline]
short Block
btitle [Block]
rest [ColSpec]
colspec TableHead
header [TableBody]
cells TableFoot
foot
replaceBlock (CodeBlock attr :: (Text, [Text], [(Text, Text)])
attr@(Text
label, [Text]
_, [(Text, Text)]
attrs) Text
code)
  | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
label
  , Text
"lst:" Text -> Text -> Bool
`T.isPrefixOf` Text
label
  , Just Text
caption <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"caption" [(Text, Text)]
attrs
  = (Text, [Text], [(Text, Text)])
-> Text -> Either Text [Inline] -> WS (ReplacedResult Block)
runCodeBlock (Text, [Text], [(Text, Text)])
attr Text
code forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
caption
replaceBlock
  (Div (Text
label,Text
"listing":[Text]
divClasses, [(Text, Text)]
divAttrs)
    [Para [Inline]
caption, CodeBlock (Text
"",[Text]
cbClasses,[(Text, Text)]
cbAttrs) Text
code])
  | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
label
  , Text
"lst:" Text -> Text -> Bool
`T.isPrefixOf` Text
label
  = (Text, [Text], [(Text, Text)])
-> Text -> Either Text [Inline] -> WS (ReplacedResult Block)
runCodeBlock (Text
label, forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [Text]
divClasses forall a. Semigroup a => a -> a -> a
<> [Text]
cbClasses, [(Text, Text)]
divAttrs forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
cbAttrs) Text
code forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right [Inline]
caption
replaceBlock (Para [Span (Text, [Text], [(Text, Text)])
attr [Math MathType
DisplayMath Text
eq]])
  = (Text, [Text], [(Text, Text)]) -> Text -> WS (ReplacedResult Block)
runBlockMath (Text, [Text], [(Text, Text)])
attr Text
eq
replaceBlock Block
_ = forall (m :: * -> *) a. Monad m => m (ReplacedResult a)
noReplaceRecurse

replaceInlineMany :: [Inline] -> WS (ReplacedResult [Inline])
replaceInlineMany :: [Inline] -> WS (ReplacedResult [Inline])
replaceInlineMany (Span spanAttr :: (Text, [Text], [(Text, Text)])
spanAttr@(Text
label,[Text]
clss,[(Text, Text)]
attrs) [Math MathType
DisplayMath Text
eq]:[Inline]
xs) = do
  Options
opts <- forall r (m :: * -> *). MonadReader r m => m r
ask
  if Text
"eq:" Text -> Text -> Bool
`T.isPrefixOf` Text
label Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
label Bool -> Bool -> Bool
&& Options -> Bool
autoEqnLabels Options
opts
  then do
    forall (m :: * -> *) a. Monad m => a -> m (ReplacedResult a)
replaceRecurse forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> [Inline]
xs) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< if Maybe Format -> Bool
isLatexFormat forall a b. (a -> b) -> a -> b
$ Options -> Maybe Format
outFormat Options
opts
      then
        forall (f :: * -> *) a. Applicative f => a -> f a
pure [Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"latex") Text
"\\begin{equation}"
        , (Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text, [Text], [(Text, Text)])
spanAttr [Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"latex") Text
eq]
        , Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"latex") forall a b. (a -> b) -> a -> b
$ Text -> Text
mkLaTeXLabel Text
label forall a. Semigroup a => a -> a -> a
<> Text
"\\end{equation}"]
      else do
        (Text
eq', [Inline]
idxStr) <- (Text, [Text], [(Text, Text)]) -> Text -> WS (Text, [Inline])
replaceEqn (Text, [Text], [(Text, Text)])
spanAttr Text
eq
        forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text
label,[Text]
clss,Options -> [Inline] -> [(Text, Text)] -> [(Text, Text)]
setLabel Options
opts [Inline]
idxStr [(Text, Text)]
attrs) [MathType -> Text -> Inline
Math MathType
DisplayMath Text
eq']]
  else forall (m :: * -> *) a. Monad m => m (ReplacedResult a)
noReplaceRecurse
replaceInlineMany [Inline]
_ = forall (m :: * -> *) a. Monad m => m (ReplacedResult a)
noReplaceRecurse

divBlocks :: Block -> Block
divBlocks :: Block -> Block
divBlocks (Table (Text, [Text], [(Text, Text)])
tattr (Caption Maybe [Inline]
short (Block
btitle:[Block]
rest)) [ColSpec]
colspec TableHead
header [TableBody]
cells TableFoot
foot)
  | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
title
  , Just Text
label <- Text -> [Inline] -> Maybe Text
getRefLabel Text
"tbl" [forall a. [a] -> a
last [Inline]
title]
  = (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
label,[],[]) [
    (Text, [Text], [(Text, Text)])
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table (Text, [Text], [(Text, Text)])
tattr (Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
short forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline] -> Block -> Block
walkReplaceInlines (forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Inline -> Bool
isSpace (forall a. [a] -> [a]
init [Inline]
title)) [Inline]
title Block
btitleforall a. a -> [a] -> [a]
:[Block]
rest) [ColSpec]
colspec TableHead
header [TableBody]
cells TableFoot
foot]
  where
    title :: [Inline]
title = [Block] -> [Inline]
blocksToInlines [Block
btitle]
divBlocks Block
x = Block
x

spanInlines :: Options -> [Inline] -> [Inline]
spanInlines :: Options -> [Inline] -> [Inline]
spanInlines Options
opts (math :: Inline
math@(Math MathType
DisplayMath Text
_eq):[Inline]
ils)
  | Inline
c:[Inline]
ils' <- forall a. (a -> Bool) -> [a] -> [a]
dropWhile Inline -> Bool
isSpace [Inline]
ils
  , Just Text
label <- Text -> [Inline] -> Maybe Text
getRefLabel Text
"eq" [Inline
c]
  = (Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text
label,[],[]) [Inline
math]forall a. a -> [a] -> [a]
:[Inline]
ils'
  | Options -> Bool
autoEqnLabels Options
opts
  = (Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text, [Text], [(Text, Text)])
nullAttr [Inline
math]forall a. a -> [a] -> [a]
:[Inline]
ils
spanInlines Options
_ [Inline]
x = [Inline]
x