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

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

import Control.Monad.Reader
import Control.Monad.State hiding (get, modify)
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Read as T
import Text.Pandoc.Definition
import qualified Text.Pandoc.Builder as B
import Data.Default (def)
import Data.List
import Data.Maybe
import Text.Pandoc.Walk (walk)
import Lens.Micro
import Lens.Micro.Mtl
import Text.Pandoc.Shared (blocksToInlines)
import Control.Monad ((<=<))

import Text.Pandoc.CrossRef.References.Types
import Text.Pandoc.CrossRef.References.Monad
import Text.Pandoc.CrossRef.References.Blocks.Util
import Text.Pandoc.CrossRef.Util.Options
import Text.Pandoc.CrossRef.Util.Template
import Text.Pandoc.CrossRef.Util.Util

runSubfigures :: Attr -> [Block] -> [Inline] -> WS (ReplacedResult Block)
runSubfigures :: Attr -> [Block] -> [Inline] -> WS (ReplacedResult Block)
runSubfigures (Text
label, [Text]
cls, [(Text, Text)]
attrs) [Block]
images [Inline]
caption = do
  Options
opts <- WS Options
forall r (m :: * -> *). MonadReader r m => m r
ask
  [Inline]
idxStr <- Either Text Text
-> [(Text, Text)] -> [Inline] -> SPrefix -> WS [Inline]
replaceAttr (Text -> Either Text Text
forall a b. b -> Either a b
Right Text
label) [(Text, Text)]
attrs [Inline]
caption SPrefix
SPfxImg
  let ([Block]
cont, References
st) = (State References [Block] -> References -> ([Block], References))
-> References -> State References [Block] -> ([Block], References)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State References [Block] -> References -> ([Block], References)
forall s a. State s a -> s -> (a, s)
runState References
forall a. Default a => a
def
        (State References [Block] -> ([Block], References))
-> State References [Block] -> ([Block], References)
forall a b. (a -> b) -> a -> b
$ (ReaderT Options (StateT References Identity) [Block]
 -> Options -> State References [Block])
-> Options
-> ReaderT Options (StateT References Identity) [Block]
-> State References [Block]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Options (StateT References Identity) [Block]
-> Options -> State References [Block]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Options
opts'
        (ReaderT Options (StateT References Identity) [Block]
 -> State References [Block])
-> ReaderT Options (StateT References Identity) [Block]
-> State References [Block]
forall a b. (a -> b) -> a -> b
$ WS [Block] -> ReaderT Options (StateT References Identity) [Block]
forall a. WS a -> ReaderT Options (StateT References Identity) a
runWS
        (WS [Block]
 -> ReaderT Options (StateT References Identity) [Block])
-> WS [Block]
-> ReaderT Options (StateT References Identity) [Block]
forall a b. (a -> b) -> a -> b
$ GenRR WS -> GenericM WS
forall (m :: * -> *). Monad m => GenRR m -> GenericM m
runReplace (([Inline] -> WS (ReplacedResult [Inline]))
-> a -> WS (ReplacedResult a)
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m (ReplacedResult b)) -> a -> m (ReplacedResult a)
mkRR [Inline] -> WS (ReplacedResult [Inline])
replaceSubfigs (a -> WS (ReplacedResult a))
-> (Block -> WS (ReplacedResult Block))
-> a
-> WS (ReplacedResult a)
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m (ReplacedResult a))
-> (b -> m (ReplacedResult b)) -> a -> m (ReplacedResult a)
`extRR` Block -> WS (ReplacedResult Block)
doFigure) [Block]
images
      doFigure :: Block -> WS (ReplacedResult Block)
      doFigure :: Block -> WS (ReplacedResult Block)
doFigure (Figure Attr
attr Caption
caption' [Block]
content) = Bool -> Attr -> Caption -> [Block] -> WS (ReplacedResult Block)
runFigure Bool
True Attr
attr Caption
caption' [Block]
content
      doFigure Block
_ = WS (ReplacedResult Block)
forall (m :: * -> *) a. Monad m => m (ReplacedResult a)
noReplaceRecurse
      opts' :: Options
opts' = Options
opts
          { figureTemplate = subfigureChildTemplate opts
          , customLabel = \Text
r Int
i -> Options -> Text -> Int -> Maybe Text
customLabel Options
opts (Text
"sub"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
r) Int
i
          }
      collectedCaptions :: [Inline]
collectedCaptions = Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList (Many Inline -> [Inline]) -> Many Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$
          Many Inline -> [Many Inline] -> Many Inline
forall a (f :: * -> *).
(Eq a, Monoid a, Foldable f) =>
a -> f a -> a
intercalate' ([Inline] -> Many Inline
forall a. [a] -> Many a
B.fromList ([Inline] -> Many Inline) -> [Inline] -> Many Inline
forall a b. (a -> b) -> a -> b
$ Options -> [Inline]
ccsDelim Options
opts)
        ([Many Inline] -> Many Inline) -> [Many Inline] -> Many Inline
forall a b. (a -> b) -> a -> b
$ ((Text, RefRec) -> Many Inline)
-> [(Text, RefRec)] -> [Many Inline]
forall a b. (a -> b) -> [a] -> [b]
map ([Inline] -> Many Inline
forall a. [a] -> Many a
B.fromList ([Inline] -> Many Inline)
-> ((Text, RefRec) -> [Inline]) -> (Text, RefRec) -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefRec -> [Inline]
forall {a}. MkTemplate a Template => RefRec -> [a]
collectCaps (RefRec -> [Inline])
-> ((Text, RefRec) -> RefRec) -> (Text, RefRec) -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, RefRec) -> RefRec
forall a b. (a, b) -> b
snd)
        ([(Text, RefRec)] -> [Many Inline])
-> [(Text, RefRec)] -> [Many Inline]
forall a b. (a -> b) -> a -> b
$ ((Text, RefRec) -> Index) -> [(Text, RefRec)] -> [(Text, RefRec)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (RefRec -> Index
refIndex (RefRec -> Index)
-> ((Text, RefRec) -> RefRec) -> (Text, RefRec) -> Index
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, RefRec) -> RefRec
forall a b. (a, b) -> b
snd)
        ([(Text, RefRec)] -> [(Text, RefRec)])
-> [(Text, RefRec)] -> [(Text, RefRec)]
forall a b. (a -> b) -> a -> b
$ ((Text, RefRec) -> Bool) -> [(Text, RefRec)] -> [(Text, RefRec)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Text, RefRec) -> Bool) -> (Text, RefRec) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Inline] -> Bool)
-> ((Text, RefRec) -> [Inline]) -> (Text, RefRec) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefRec -> [Inline]
refTitle (RefRec -> [Inline])
-> ((Text, RefRec) -> RefRec) -> (Text, RefRec) -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, RefRec) -> RefRec
forall a b. (a, b) -> b
snd)
        ([(Text, RefRec)] -> [(Text, RefRec)])
-> [(Text, RefRec)] -> [(Text, RefRec)]
forall a b. (a -> b) -> a -> b
$ Map Text RefRec -> [(Text, RefRec)]
forall k a. Map k a -> [(k, a)]
M.toList
        (Map Text RefRec -> [(Text, RefRec)])
-> Map Text RefRec -> [(Text, RefRec)]
forall a b. (a -> b) -> a -> b
$ References
st References
-> Getting (Map Text RefRec) References (Map Text RefRec)
-> Map Text RefRec
forall s a. s -> Getting a s a -> a
^. Prefix -> Lens' References (Map Text RefRec)
refsAt Prefix
PfxImg
      collectCaps :: RefRec -> [a]
collectCaps RefRec
v =
            [Inline] -> [Inline] -> Template -> [a]
forall a b. MkTemplate a b => [Inline] -> [Inline] -> b -> [a]
applyTemplate
              ([Inline] -> Index -> [Inline]
chapPrefix (Options -> [Inline]
chapDelim Options
opts) (RefRec -> Index
refIndex RefRec
v))
              (RefRec -> [Inline]
refTitle RefRec
v)
              (Options -> Template
ccsTemplate Options
opts)
      vars :: Map Text [Inline]
vars = [(Text, [Inline])] -> Map Text [Inline]
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList
                [ (Text
"ccs", [Inline]
collectedCaptions)
                , (Text
"i", [Inline]
idxStr)
                , (Text
"t", [Inline]
caption)
                ]
      capt :: [Inline]
capt = Map Text [Inline] -> Template -> [Inline]
forall a b. MkTemplate a b => Map Text [Inline] -> b -> [a]
applyTemplate' Map Text [Inline]
vars (Template -> [Inline]) -> Template -> [Inline]
forall a b. (a -> b) -> a -> b
$ Options -> Template
subfigureTemplate Options
opts
  RefRec
lastRef <- Maybe RefRec -> RefRec
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe RefRec -> RefRec)
-> (Map Text RefRec -> Maybe RefRec) -> Map Text RefRec -> RefRec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Map Text RefRec -> Maybe RefRec
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
label (Map Text RefRec -> RefRec) -> WS (Map Text RefRec) -> WS RefRec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Map Text RefRec) References (Map Text RefRec)
-> WS (Map Text RefRec)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Prefix -> Lens' References (Map Text RefRec)
refsAt Prefix
PfxImg)
  let mangledSubfigures :: Map Text RefRec
mangledSubfigures = RefRec -> RefRec
mangleSubfigure (RefRec -> RefRec) -> Map Text RefRec -> Map Text RefRec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> References
st References
-> Getting (Map Text RefRec) References (Map Text RefRec)
-> Map Text RefRec
forall s a. s -> Getting a s a -> a
^. Prefix -> Lens' References (Map Text RefRec)
refsAt Prefix
PfxImg
      mangleSubfigure :: RefRec -> RefRec
mangleSubfigure RefRec
v = RefRec
v{refIndex = refIndex lastRef, refSubfigure = Just $ refIndex v}
  Prefix -> Lens' References (Map Text RefRec)
refsAt Prefix
PfxImg ((Map Text RefRec -> Identity (Map Text RefRec))
 -> References -> Identity References)
-> (Map Text RefRec -> Map Text RefRec) -> WS ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Map Text RefRec -> Map Text RefRec -> Map Text RefRec
forall a. Semigroup a => a -> a -> a
<> Map Text RefRec
mangledSubfigures)
  if  | Options -> Bool
isLatexFormat Options
opts ->
          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
$ Attr -> [Block] -> Block
Div Attr
nullAttr ([Block] -> Block) -> [Block] -> Block
forall a b. (a -> b) -> a -> b
$
            [ Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"latex") Text
"\\begin{pandoccrossrefsubfigures}" ]
            [Block] -> [Block] -> [Block]
forall a. Semigroup a => a -> a -> a
<> [Block]
cont [Block] -> [Block] -> [Block]
forall a. Semigroup a => a -> a -> a
<>
            [ [Inline] -> Block
Para [Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"latex") Text
"\\caption["
                      , Attr -> [Inline] -> Inline
Span Attr
nullAttr ([Inline] -> [Inline]
removeFootnotes [Inline]
caption)
                      , Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"latex") Text
"]"
                      , Attr -> [Inline] -> Inline
Span Attr
nullAttr [Inline]
caption]
            , Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"latex") (Text -> Block) -> Text -> Block
forall a b. (a -> b) -> a -> b
$ Text -> Text
mkLaTeXLabel Text
label
            , Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"latex") Text
"\\end{pandoccrossrefsubfigures}"]
      | Bool
otherwise ->
          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
$ Attr -> Caption -> [Block] -> Block
Figure (Text
label, Text
"subfigures"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
cls, Options -> [Inline] -> [(Text, Text)] -> [(Text, Text)]
setLabel Options
opts [Inline]
idxStr [(Text, Text)]
attrs)
                     (Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
forall a. Maybe a
Nothing [[Inline] -> Block
Para [Inline]
capt])
            ([Block] -> Block) -> [Block] -> Block
forall a b. (a -> b) -> a -> b
$ Options -> [Block] -> [Block]
toTable Options
opts [Block]
cont
  where
    removeFootnotes :: [Inline] -> [Inline]
removeFootnotes = (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
removeFootnote
    removeFootnote :: Inline -> Inline
removeFootnote Note{} = Text -> Inline
Str Text
""
    removeFootnote Inline
x = Inline
x
    toTable :: Options -> [Block] -> [Block]
    toTable :: Options -> [Block] -> [Block]
toTable Options
opts [Block]
blks
      | Options -> Bool
isLatexFormat Options
opts = (Block -> [Block]) -> [Block] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block -> [Block]
imagesToFigures [Block]
blks
      | Options -> Bool
subfigGrid Options
opts = [[Alignment] -> [ColWidth] -> [[[Block]]] -> Block
simpleTable [Alignment]
align ((Double -> ColWidth) -> [Double] -> [ColWidth]
forall a b. (a -> b) -> [a] -> [b]
map Double -> ColWidth
ColWidth [Double]
widths) ((Block -> [[Block]]) -> [Block] -> [[[Block]]]
forall a b. (a -> b) -> [a] -> [b]
map ((Block -> [Block]) -> [Block] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block -> [Block]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Block] -> [[Block]]) -> (Block -> [Block]) -> Block -> [[Block]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [Block]
blkToRow) [Block]
blks)]
      | Bool
otherwise = [Block]
blks
      where
        align :: [Alignment]
align | Block
b:[Block]
_ <- [Block]
blks = let ils :: [Inline]
ils = [Block] -> [Inline]
blocksToInlines [Block
b] in Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate ([Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int) -> [Double] -> Int
forall a b. (a -> b) -> a -> b
$ (Inline -> Maybe Double) -> [Inline] -> [Double]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Inline -> Maybe Double
getWidth [Inline]
ils) Alignment
AlignCenter
              | Bool
otherwise = [Char] -> [Alignment]
forall a. HasCallStack => [Char] -> a
error [Char]
"Misformatted subfigures block"
        widths :: [Double]
widths | Block
b:[Block]
_ <- [Block]
blks = let ils :: [Inline]
ils = [Block] -> [Inline]
blocksToInlines [Block
b] in [Double] -> [Double]
fixZeros ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (Inline -> Maybe Double) -> [Inline] -> [Double]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Inline -> Maybe Double
getWidth [Inline]
ils
               | Bool
otherwise = [Char] -> [Double]
forall a. HasCallStack => [Char] -> a
error [Char]
"Misformatted subfigures block"
        getWidth :: Inline -> Maybe Double
getWidth (Image (Text
_id, [Text]
_class, [(Text, Text)]
as) [Inline]
_ (Text, Text)
_)
          = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double -> (Text -> Double) -> Maybe Text -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 Text -> Double
percToDouble (Maybe Text -> Double) -> Maybe Text -> Double
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"width" [(Text, Text)]
as
        getWidth Inline
_ = Maybe Double
forall a. Maybe a
Nothing
        fixZeros :: [Double] -> [Double]
        fixZeros :: [Double] -> [Double]
fixZeros [Double]
ws
          = let nz :: Int
nz = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int) -> [Double] -> Int
forall a b. (a -> b) -> a -> b
$ (Double -> Bool) -> [Double] -> [Double]
forall a. (a -> Bool) -> [a] -> [a]
filter (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
ws
                rzw :: Double
rzw = (Double
0.99 Double -> Double -> Double
forall a. Num a => a -> a -> a
- [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
ws) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nz
            in if Int
nzInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0
                then (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
x -> if Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 then Double
rzw else Double
x) [Double]
ws
                else [Double]
ws
        percToDouble :: T.Text -> Double
        percToDouble :: Text -> Double
percToDouble Text
percs
          | Right (Double
perc, Text
"%") <- Reader Double
T.double Text
percs
          = Double
percDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
100.0
          | Bool
otherwise = [Char] -> Double
forall a. HasCallStack => [Char] -> a
error [Char]
"Only percent allowed in subfigure width!"
        blkToRow :: Block -> [Block]
        blkToRow :: Block -> [Block]
blkToRow (Para [Inline]
inls) = (Inline -> Maybe Block) -> [Inline] -> [Block]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Inline -> Maybe Block
inlToCell [Inline]
inls
        blkToRow Block
x = [Block
x]
        inlToCell :: Inline -> Maybe Block
        inlToCell :: Inline -> Maybe Block
inlToCell (Image (Text
id', [Text]
cs, [(Text, Text)]
as) [Inline]
txt (Text, Text)
tgt) = Block -> Maybe Block
forall a. a -> Maybe a
Just (Block -> Maybe Block) -> Block -> Maybe Block
forall a b. (a -> b) -> a -> b
$
          Attr -> Caption -> [Block] -> Block
Figure (Text
id', [Text]
cs, []) (Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
forall a. Maybe a
Nothing [[Inline] -> Block
Para [Inline]
txt]) [[Inline] -> Block
Plain [Attr -> [Inline] -> (Text, Text) -> Inline
Image (Text
"", [Text]
cs, [(Text, Text)] -> [(Text, Text)]
forall {b} {b}.
(IsString b, IsString b, Eq b) =>
[(b, b)] -> [(b, b)]
setW [(Text, Text)]
as) [Inline]
txt (Text, Text)
tgt]]
        inlToCell Inline
_ = Maybe Block
forall a. Maybe a
Nothing
        setW :: [(b, b)] -> [(b, b)]
setW [(b, b)]
as = (b
"width", b
"100%")(b, b) -> [(b, b)] -> [(b, b)]
forall a. a -> [a] -> [a]
:((b, b) -> Bool) -> [(b, b)] -> [(b, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/=b
"width") (b -> Bool) -> ((b, b) -> b) -> (b, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, b) -> b
forall a b. (a, b) -> a
fst) [(b, b)]
as

replaceSubfigs :: [Inline] -> WS (ReplacedResult [Inline])
replaceSubfigs :: [Inline] -> WS (ReplacedResult [Inline])
replaceSubfigs = ([Inline] -> WS (ReplacedResult [Inline])
forall (m :: * -> *) a. Monad m => a -> m (ReplacedResult a)
replaceNoRecurse ([Inline] -> WS (ReplacedResult [Inline]))
-> ([[Inline]] -> [Inline])
-> [[Inline]]
-> WS (ReplacedResult [Inline])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Inline]] -> [Inline]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([[Inline]] -> WS (ReplacedResult [Inline]))
-> ([Inline] -> WS [[Inline]])
-> [Inline]
-> WS (ReplacedResult [Inline])
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Inline -> WS [Inline]) -> [Inline] -> WS [[Inline]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Inline -> WS [Inline]
replaceSubfig

imagesToFigures :: Block -> [Block]
imagesToFigures :: Block -> [Block]
imagesToFigures = \case
  x :: Block
x@Figure{} -> [Block
x]
  Para [Inline]
xs -> (Inline -> Maybe Block) -> [Inline] -> [Block]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Inline -> Maybe Block
imageToFigure [Inline]
xs
  Plain [Inline]
xs -> (Inline -> Maybe Block) -> [Inline] -> [Block]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Inline -> Maybe Block
imageToFigure [Inline]
xs
  Block
_ -> []

imageToFigure :: Inline -> Maybe Block
imageToFigure :: Inline -> Maybe Block
imageToFigure = \case
  Image (Text
label,[Text]
cls,[(Text, Text)]
attrs) [Inline]
alt (Text, Text)
tgt -> Block -> Maybe Block
forall a. a -> Maybe a
Just (Block -> Maybe Block) -> Block -> Maybe Block
forall a b. (a -> b) -> a -> b
$
    Attr -> Caption -> [Block] -> Block
Figure (Text
label, [Text]
cls, []) (Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
forall a. Maybe a
Nothing [[Inline] -> Block
Para [Inline]
alt])
      [[Inline] -> Block
Plain [Attr -> [Inline] -> (Text, Text) -> Inline
Image (Text
"",[Text]
cls,[(Text, Text)]
attrs) [Inline]
alt (Text, Text)
tgt]]
  Inline
_ -> Maybe Block
forall a. Maybe a
Nothing

replaceSubfig :: Inline -> WS [Inline]
replaceSubfig :: Inline -> WS [Inline]
replaceSubfig x :: Inline
x@(Image (Text
label,[Text]
cls,[(Text, Text)]
attrs) [Inline]
alt (Text, Text)
tgt) = do
  Options
opts <- WS Options
forall r (m :: * -> *). MonadReader r m => m r
ask
  let label' :: Either Text Text
label' = Text -> Either Text Text
normalizeLabel Text
label
  [Inline]
idxStr <- Either Text Text
-> [(Text, Text)] -> [Inline] -> SPrefix -> WS [Inline]
replaceAttr Either Text Text
label' [(Text, Text)]
attrs [Inline]
alt SPrefix
SPfxImg
  let alt' :: [Inline]
alt' = [Inline] -> [Inline] -> Template -> [Inline]
forall a b. MkTemplate a b => [Inline] -> [Inline] -> b -> [a]
applyTemplate [Inline]
idxStr [Inline]
alt (Template -> [Inline]) -> Template -> [Inline]
forall a b. (a -> b) -> a -> b
$ Options -> Template
figureTemplate Options
opts
  [Inline] -> WS [Inline]
forall a. a -> WS a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Inline] -> WS [Inline]) -> [Inline] -> WS [Inline]
forall a b. (a -> b) -> a -> b
$ if Options -> Bool
isLatexFormat Options
opts
    then Inline -> Text -> [Inline]
latexSubFigure Inline
x Text
label
    else [Attr -> [Inline] -> (Text, Text) -> Inline
Image (Text
label, [Text]
cls, Options -> [Inline] -> [(Text, Text)] -> [(Text, Text)]
setLabel Options
opts [Inline]
idxStr [(Text, Text)]
attrs) [Inline]
alt' (Text, Text)
tgt]
replaceSubfig Inline
x = [Inline] -> WS [Inline]
forall a. a -> WS a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Inline
x]

latexSubFigure :: Inline -> T.Text -> [Inline]
latexSubFigure :: Inline -> Text -> [Inline]
latexSubFigure (Image (Text
_, [Text]
cls, [(Text, Text)]
attrs) [Inline]
alt (Text
src, Text
title)) Text
label =
  let
    title' :: Text
title' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
title (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
"fig:" Text
title
    texlabel :: [Inline]
texlabel | Text -> Bool
T.null Text
label = []
             | Bool
otherwise = [Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"latex") (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Text -> Text
mkLaTeXLabel Text
label]
    texalt :: [Inline]
texalt | Text
"nocaption" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls  = []
           | Bool
otherwise = [[Inline]] -> [Inline]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ [ Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"latex") Text
"["]
              , [Inline]
alt
              , [ Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"latex") Text
"]"]
              ]
    img :: Inline
img = Attr -> [Inline] -> (Text, Text) -> Inline
Image (Text
label, [Text]
cls, [(Text, Text)]
attrs) [Inline]
alt (Text
src, Text
title')
  in [[Inline]] -> [Inline]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
      [ Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"latex") Text
"\\subfloat" ]
      , [Inline]
texalt
      , [Attr -> [Inline] -> Inline
Span Attr
nullAttr ([Inline] -> Inline) -> [Inline] -> Inline
forall a b. (a -> b) -> a -> b
$ Inline
imgInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
texlabel]
      ]
latexSubFigure Inline
x Text
_ = [Inline
x]

normalizeLabel :: T.Text -> Either T.Text T.Text
normalizeLabel :: Text -> Either Text Text
normalizeLabel Text
label
  | Text
"fig:" Text -> Text -> Bool
`T.isPrefixOf` Text
label = Text -> Either Text Text
forall a b. b -> Either a b
Right Text
label
  | Text -> Bool
T.null Text
label = Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"fig"
  | Bool
otherwise  = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ Text
"fig:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label

simpleTable :: [Alignment] -> [ColWidth] -> [[[Block]]] -> Block
simpleTable :: [Alignment] -> [ColWidth] -> [[[Block]]] -> Block
simpleTable [Alignment]
align [ColWidth]
width [[[Block]]]
bod = Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
nullAttr Caption
noCaption ([Alignment] -> [ColWidth] -> [ColSpec]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
align [ColWidth]
width)
  TableHead
noTableHead [[[[Block]]] -> TableBody
mkBody [[[Block]]]
bod] TableFoot
noTableFoot
  where
  mkBody :: [[[Block]]] -> TableBody
mkBody [[[Block]]]
xs = Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr (Int -> RowHeadColumns
RowHeadColumns Int
0) [] (([[Block]] -> Row) -> [[[Block]]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [[Block]] -> Row
mkRow [[[Block]]]
xs)
  mkRow :: [[Block]] -> Row
mkRow [[Block]]
xs = Attr -> [Cell] -> Row
Row Attr
nullAttr (([Block] -> Cell) -> [[Block]] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Cell
mkCell [[Block]]
xs)
  mkCell :: [Block] -> Cell
mkCell [Block]
xs = Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
Cell Attr
nullAttr Alignment
AlignDefault (Int -> RowSpan
RowSpan Int
1) (Int -> ColSpan
ColSpan Int
1) [Block]
xs
  noCaption :: Caption
noCaption = Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
forall a. Maybe a
Nothing [Block]
forall a. Monoid a => a
mempty
  noTableHead :: TableHead
noTableHead = Attr -> [Row] -> TableHead
TableHead Attr
nullAttr []
  noTableFoot :: TableFoot
noTableFoot = Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr []

runFigure :: Bool -> Attr -> Caption -> [Block] -> WS (ReplacedResult Block)
runFigure :: Bool -> Attr -> Caption -> [Block] -> WS (ReplacedResult Block)
runFigure Bool
subFigure (Text
label, [Text]
cls, [(Text, Text)]
fattrs) (Caption Maybe [Inline]
short (Block
btitle : [Block]
rest)) [Block]
content = do
  Options
opts <- WS Options
forall r (m :: * -> *). MonadReader r m => m r
ask
  let label' :: Either Text Text
label' = Text -> Either Text Text
normalizeLabel Text
label
  let title :: [Inline]
title = [Block] -> [Inline]
blocksToInlines [Block
btitle]
      ([(Text, Text)]
attrs, [Inline] -> [Block]
content') = case [Block] -> [Inline]
blocksToInlines [Block]
content of
        [Image attr :: Attr
attr@(Text
_, [Text]
_, [(Text, Text)]
as) [Inline]
_ (Text, Text)
tgt] ->
            -- the second argument is a fix for
            -- https://github.com/jgm/pandoc/issues/9720
            ([(Text, Text)]
fattrs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
as, \[Inline]
capt -> [[Inline] -> Block
Plain [Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
capt (Text, Text)
tgt]])
        [Inline]
_ -> ([(Text, Text)]
fattrs, [Block] -> [Inline] -> [Block]
forall a b. a -> b -> a
const [Block]
content)
  [Inline]
idxStr <- Either Text Text
-> [(Text, Text)] -> [Inline] -> SPrefix -> WS [Inline]
replaceAttr Either Text Text
label' [(Text, Text)]
attrs [Inline]
title SPrefix
SPfxImg
  let title' :: [Inline]
title'
        | Options -> Bool
isLatexFormat Options
opts = [Inline]
title
        | Bool
otherwise = [Inline] -> [Inline] -> Template -> [Inline]
forall a b. MkTemplate a b => [Inline] -> [Inline] -> b -> [a]
applyTemplate [Inline]
idxStr [Inline]
title (Template -> [Inline]) -> Template -> [Inline]
forall a b. (a -> b) -> a -> b
$ Options -> Template
figureTemplate Options
opts
      caption' :: Caption
caption' = Maybe [Inline] -> [Block] -> Caption
Caption Maybe [Inline]
short ([Inline] -> [Inline] -> Block -> Block
walkReplaceInlines [Inline]
title' [Inline]
title Block
btitleBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
rest)
  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
$
    if Bool
subFigure Bool -> Bool -> Bool
&& Options -> Bool
isLatexFormat Options
opts
    then [Inline] -> Block
Plain ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ Inline -> Text -> [Inline]
latexSubFigure ([Inline] -> Inline
forall a. HasCallStack => [a] -> a
head ([Inline] -> Inline) -> [Inline] -> Inline
forall a b. (a -> b) -> a -> b
$ [Block] -> [Inline]
blocksToInlines [Block]
content) Text
label
    else Attr -> Caption -> [Block] -> Block
Figure (Text
label,[Text]
cls,Options -> [Inline] -> [(Text, Text)] -> [(Text, Text)]
setLabel Options
opts [Inline]
idxStr [(Text, Text)]
fattrs) Caption
caption' ([Inline] -> [Block]
content' [Inline]
title')
runFigure Bool
_ Attr
_ Caption
_ [Block]
_ = WS (ReplacedResult Block)
forall (m :: * -> *) a. Monad m => m (ReplacedResult a)
noReplaceNoRecurse