{-
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 #-}

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 Text.Pandoc.CrossRef.References.Types
import Text.Pandoc.CrossRef.References.Monad
import Text.Pandoc.CrossRef.References.Blocks.Util (setLabel, replaceAttr, walkReplaceInlines)
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 <- forall r (m :: * -> *). MonadReader r m => m r
ask
  [Inline]
idxStr <- Either Text Text
-> Maybe Text
-> [Inline]
-> Lens References References (Map Text RefRec) (Map Text RefRec)
-> WS [Inline]
replaceAttr (forall a b. b -> Either a b
Right Text
label) (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"label" [(Text, Text)]
attrs) [Inline]
caption Lens References References (Map Text RefRec) (Map Text RefRec)
imgRefs
  let ([Block]
cont, References
st) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> (a, s)
runState forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Options
opts' forall a b. (a -> b) -> a -> b
$ forall a. WS a -> ReaderT Options (State References) a
runWS forall a b. (a -> b) -> a -> 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 [Inline] -> WS (ReplacedResult [Inline])
replaceSubfigs 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) forall a b. (a -> b) -> a -> b
$ [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
_ = forall (m :: * -> *) a. Monad m => m (ReplacedResult a)
noReplaceRecurse
      opts' :: Options
opts' = Options
opts
          { figureTemplate :: Template
figureTemplate = Options -> Template
subfigureChildTemplate Options
opts
          , customLabel :: Text -> Int -> Maybe Text
customLabel = \Text
r Int
i -> Options -> Text -> Int -> Maybe Text
customLabel Options
opts (Text
"sub"forall a. Semigroup a => a -> a -> a
<>Text
r) Int
i
          }
      collectedCaptions :: [Inline]
collectedCaptions = forall a. Many a -> [a]
B.toList forall a b. (a -> b) -> a -> b
$
          forall a (f :: * -> *).
(Eq a, Monoid a, Foldable f) =>
a -> f a -> a
intercalate' (forall a. [a] -> Many a
B.fromList forall a b. (a -> b) -> a -> b
$ Options -> [Inline]
ccsDelim Options
opts)
        forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> Many a
B.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. MkTemplate a Template => RefRec -> [a]
collectCaps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
        forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (RefRec -> Index
refIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
        forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefRec -> [Inline]
refTitle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
        forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList
        forall a b. (a -> b) -> a -> b
$ References
stforall s a. s -> Getting a s a -> a
^.Lens References References (Map Text RefRec) (Map Text RefRec)
imgRefs
      collectCaps :: RefRec -> [a]
collectCaps RefRec
v =
            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 = 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 = forall a b. MkTemplate a b => Map Text [Inline] -> b -> [a]
applyTemplate' Map Text [Inline]
vars forall a b. (a -> b) -> a -> b
$ Options -> Template
subfigureTemplate Options
opts
  RefRec
lastRef <- forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
label forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens References References (Map Text RefRec) (Map Text RefRec)
imgRefs
  forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying Lens References References (Map Text RefRec) (Map Text RefRec)
imgRefs forall a b. (a -> b) -> a -> b
$ \Map Text RefRec
old ->
      forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union
        Map Text RefRec
old
        (forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\RefRec
v -> RefRec
v{refIndex :: Index
refIndex = RefRec -> Index
refIndex RefRec
lastRef, refSubfigure :: Maybe Index
refSubfigure = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ RefRec -> Index
refIndex RefRec
v})
        forall a b. (a -> b) -> a -> b
$ References
stforall s a. s -> Getting a s a -> a
^.Lens References References (Map Text RefRec) (Map Text RefRec)
imgRefs)
  case Options -> Maybe Format
outFormat Options
opts of
    Maybe Format
f | Maybe Format -> Bool
isLatexFormat Maybe Format
f ->
      forall (m :: * -> *) a. Monad m => a -> m (ReplacedResult a)
replaceNoRecurse forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
Div Attr
nullAttr forall a b. (a -> b) -> a -> b
$
        [ Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"latex") Text
"\\begin{pandoccrossrefsubfigures}" ]
        forall a. Semigroup a => a -> a -> a
<> [Block]
cont 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") forall a b. (a -> b) -> a -> b
$ Text -> Text
mkLaTeXLabel Text
label
        , Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"latex") Text
"\\end{pandoccrossrefsubfigures}"]
    Maybe Format
_ -> forall (m :: * -> *) a. Monad m => a -> m (ReplacedResult a)
replaceNoRecurse
      forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> [Block] -> Block
Figure (Text
label, Text
"subfigures"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 forall a. Maybe a
Nothing [[Inline] -> Block
Para [Inline]
capt])
      forall a b. (a -> b) -> a -> b
$ Options -> [Block] -> [Block]
toTable Options
opts [Block]
cont
  where
    removeFootnotes :: [Inline] -> [Inline]
removeFootnotes = 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
      | Maybe Format -> Bool
isLatexFormat forall a b. (a -> b) -> a -> b
$ Options -> Maybe Format
outFormat Options
opts = 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 (forall a b. (a -> b) -> [a] -> [b]
map Double -> ColWidth
ColWidth [Double]
widths) (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Inline -> Maybe Double
getWidth [Inline]
ils) Alignment
AlignCenter
              | Bool
otherwise = 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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Inline -> Maybe Double
getWidth [Inline]
ils
               | Bool
otherwise = 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)
_)
          = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 Text -> Double
percToDouble forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"width" [(Text, Text)]
as
        getWidth Inline
_ = forall a. Maybe a
Nothing
        fixZeros :: [Double] -> [Double]
        fixZeros :: [Double] -> [Double]
fixZeros [Double]
ws
          = let nz :: Int
nz = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
ws
                rzw :: Double
rzw = (Double
0.99 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
ws) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nz
            in if Int
nzforall a. Ord a => a -> a -> Bool
>Int
0
                then forall a b. (a -> b) -> [a] -> [b]
map (\Double
x -> if Double
x 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
percforall a. Fractional a => a -> a -> a
/Double
100.0
          | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"Only percent allowed in subfigure width!"
        blkToRow :: Block -> [Block]
        blkToRow :: Block -> [Block]
blkToRow (Para [Inline]
inls) = 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) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
          Attr -> Caption -> [Block] -> Block
Figure (Text
id', [Text]
cs, [(Text, Text)]
as) (Maybe [Inline] -> [Block] -> Caption
Caption forall a. Maybe a
Nothing [[Inline] -> Block
Para [Inline]
txt]) [[Inline] -> Block
Plain [Attr -> [Inline] -> (Text, Text) -> Inline
Image (Text
"", [Text]
cs, forall {b} {b}.
(IsString b, IsString b, Eq b) =>
[(b, b)] -> [(b, b)]
setW [(Text, Text)]
as) [Inline]
txt (Text, Text)
tgt]]
        inlToCell Inline
_ = forall a. Maybe a
Nothing
        setW :: [(b, b)] -> [(b, b)]
setW [(b, b)]
as = (b
"width", b
"100%")forall a. a -> [a] -> [a]
:forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/=b
"width") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(b, b)]
as

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

imagesToFigures :: Block -> [Block]
imagesToFigures :: Block -> [Block]
imagesToFigures = \case
  x :: Block
x@Figure{} -> [Block
x]
  Para [Inline]
xs -> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Inline -> Maybe Block
imageToFigure [Inline]
xs
  Plain [Inline]
xs -> 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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> [Block] -> Block
Figure (Text
label, [Text]
cls, [(Text, Text)]
attrs) (Maybe [Inline] -> [Block] -> Caption
Caption 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
_ -> 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 <- 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
-> Maybe Text
-> [Inline]
-> Lens References References (Map Text RefRec) (Map Text RefRec)
-> WS [Inline]
replaceAttr Either Text Text
label' (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"label" [(Text, Text)]
attrs) [Inline]
alt Lens References References (Map Text RefRec) (Map Text RefRec)
imgRefs
      let alt' :: [Inline]
alt' = forall a b. MkTemplate a b => [Inline] -> [Inline] -> b -> [a]
applyTemplate [Inline]
idxStr [Inline]
alt forall a b. (a -> b) -> a -> b
$ Options -> Template
figureTemplate Options
opts
      case Options -> Maybe Format
outFormat Options
opts of
        Maybe Format
f | Maybe Format -> Bool
isLatexFormat Maybe Format
f ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Inline -> Text -> [Inline]
latexSubFigure Inline
x Text
label
        Maybe Format
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [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 = forall (m :: * -> *) a. Monad m => a -> m a
return [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' = forall a. a -> Maybe a -> a
fromMaybe Text
title 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") forall a b. (a -> b) -> a -> b
$ Text -> Text
mkLaTeXLabel Text
label]
    texalt :: [Inline]
texalt | Text
"nocaption" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cls  = []
           | Bool
otherwise = 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 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 forall a b. (a -> b) -> a -> b
$ Inline
imgforall 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 = forall a b. b -> Either a b
Right Text
label
  | Text -> Bool
T.null Text
label = forall a b. a -> Either a b
Left Text
"fig"
  | Bool
otherwise  = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text
"fig:" 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 (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) [] (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 (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 forall a. Maybe a
Nothing 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 <- 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]
      attrs :: [(Text, Text)]
attrs = forall a. a -> Maybe a -> a
fromMaybe [(Text, Text)]
fattrs forall a b. (a -> b) -> a -> b
$ case [Block] -> [Inline]
blocksToInlines [Block]
content of
        [Image (Text
_, [Text]
_, [(Text, Text)]
as) [Inline]
_ (Text, Text)
_] -> forall a. a -> Maybe a
Just [(Text, Text)]
as
        [Inline]
_ -> forall a. Maybe a
Nothing
  [Inline]
idxStr <- Either Text Text
-> Maybe Text
-> [Inline]
-> Lens References References (Map Text RefRec) (Map Text RefRec)
-> WS [Inline]
replaceAttr Either Text Text
label' (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"label" [(Text, Text)]
attrs) [Inline]
title Lens References References (Map Text RefRec) (Map Text RefRec)
imgRefs
  let title' :: [Inline]
title' = case Options -> Maybe Format
outFormat Options
opts of
        Maybe Format
f | Maybe Format -> Bool
isLatexFormat Maybe Format
f -> [Inline]
title
        Maybe Format
_  -> forall a b. MkTemplate a b => [Inline] -> [Inline] -> b -> [a]
applyTemplate [Inline]
idxStr [Inline]
title 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
btitleforall a. a -> [a] -> [a]
:[Block]
rest)
  forall (m :: * -> *) a. Monad m => a -> m (ReplacedResult a)
replaceNoRecurse forall a b. (a -> b) -> a -> b
$
    if Bool
subFigure Bool -> Bool -> Bool
&& Maybe Format -> Bool
isLatexFormat (Options -> Maybe Format
outFormat Options
opts)
    then [Inline] -> Block
Plain forall a b. (a -> b) -> a -> b
$ Inline -> Text -> [Inline]
latexSubFigure (forall a. [a] -> a
head 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)]
attrs) Caption
caption' [Block]
content
runFigure Bool
_ Attr
_ Caption
_ [Block]
_ = forall (m :: * -> *) a. Monad m => m (ReplacedResult a)
noReplaceNoRecurse