{-
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 OverloadedStrings #-}
module Text.Pandoc.CrossRef.Util.ModifyMeta
    (
    modifyMeta
    ) where

import Text.Pandoc
import Text.Pandoc.Builder hiding ((<>))
import Text.Pandoc.CrossRef.Util.Options
import Text.Pandoc.CrossRef.Util.Meta
import Text.Pandoc.CrossRef.Util.Util
import qualified Data.Text as T
import Control.Monad.Writer

modifyMeta :: Options -> Meta -> Meta
modifyMeta :: Options -> Meta -> Meta
modifyMeta Options
opts Meta
meta
  | Maybe Format -> Bool
isLatexFormat (Options -> Maybe Format
outFormat Options
opts)
  = Text -> MetaValue -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"header-includes"
      (Maybe MetaValue -> MetaValue
headerInc (Maybe MetaValue -> MetaValue) -> Maybe MetaValue -> MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Maybe MetaValue
lookupMeta Text
"header-includes" Meta
meta)
      Meta
meta
  | Bool
otherwise = Meta
meta
  where
    headerInc :: Maybe MetaValue -> MetaValue
    headerInc :: Maybe MetaValue -> MetaValue
headerInc Maybe MetaValue
Nothing = MetaValue
incList
    headerInc (Just (MetaList [MetaValue]
x)) = [MetaValue] -> MetaValue
MetaList ([MetaValue] -> MetaValue) -> [MetaValue] -> MetaValue
forall a b. (a -> b) -> a -> b
$ [MetaValue]
x [MetaValue] -> [MetaValue] -> [MetaValue]
forall a. Semigroup a => a -> a -> a
<> [MetaValue
incList]
    headerInc (Just MetaValue
x) = [MetaValue] -> MetaValue
MetaList [MetaValue
x, MetaValue
incList]
    incList :: MetaValue
incList = [Block] -> MetaValue
MetaBlocks ([Block] -> MetaValue) -> [Block] -> MetaValue
forall a b. (a -> b) -> a -> b
$ Block -> [Block]
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> [Block]) -> Block -> [Block]
forall a b. (a -> b) -> a -> b
$ Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"latex") (Text -> Block) -> Text -> Block
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Writer [Text] () -> [Text]
forall w a. Writer w a -> w
execWriter (Writer [Text] () -> [Text]) -> Writer [Text] () -> [Text]
forall a b. (a -> b) -> a -> b
$ do
        [Text] -> Writer [Text] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Text
"\\makeatletter" ]
        [Text] -> Writer [Text] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text]
subfig
        [Text] -> Writer [Text] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text]
floatnames
        [Text] -> Writer [Text] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text]
listnames
        Bool -> Writer [Text] () -> Writer [Text] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
listings Options
opts) (Writer [Text] () -> Writer [Text] ())
-> Writer [Text] () -> Writer [Text] ()
forall a b. (a -> b) -> a -> b
$
          [Text] -> Writer [Text] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text]
codelisting
        [Text] -> Writer [Text] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text]
lolcommand
        Bool -> Writer [Text] () -> Writer [Text] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
cref Options
opts) (Writer [Text] () -> Writer [Text] ())
-> Writer [Text] () -> Writer [Text] ()
forall a b. (a -> b) -> a -> b
$ do
          [Text] -> Writer [Text] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text]
cleveref
          Bool -> Writer [Text] () -> Writer [Text] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
listings Options
opts) (Writer [Text] () -> Writer [Text] ())
-> Writer [Text] () -> Writer [Text] ()
forall a b. (a -> b) -> a -> b
$
            [Text] -> Writer [Text] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text]
cleverefCodelisting
        [Text] -> Writer [Text] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Text
"\\makeatother" ]
      where
        subfig :: [Text]
subfig = [
            [Text] -> Text -> Text
usepackage [] Text
"subfig"
          , [Text] -> Text -> Text
usepackage [] Text
"caption"
          , Text
"\\captionsetup[subfloat]{margin=0.5em}"
          ]
        floatnames :: [Text]
floatnames = [
            Text
"\\AtBeginDocument{%"
          , Text
"\\renewcommand*\\figurename{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
metaString Text
"figureTitle" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
          , Text
"\\renewcommand*\\tablename{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
metaString Text
"tableTitle" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
          , Text
"}"
          ]
        listnames :: [Text]
listnames = [
            Text
"\\AtBeginDocument{%"
          , Text
"\\renewcommand*\\listfigurename{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
metaString' Text
"lofTitle" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
          , Text
"\\renewcommand*\\listtablename{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
metaString' Text
"lotTitle" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
          , Text
"}"
          ]
        codelisting :: [Text]
codelisting = [
            [Text] -> Text -> Text
usepackage [] Text
"float"
          , Text
"\\floatstyle{ruled}"
          , Text
"\\@ifundefined{c@chapter}{\\newfloat{codelisting}{h}{lop}}{\\newfloat{codelisting}{h}{lop}[chapter]}"
          , Text
"\\floatname{codelisting}{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
metaString Text
"listingTitle" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
          ]
        lolcommand :: [Text]
lolcommand
          | Options -> Bool
listings Options
opts = [
              Text
"\\newcommand*\\listoflistings\\lstlistoflistings"
            , Text
"\\AtBeginDocument{%"
            , Text
"\\renewcommand*{\\lstlistlistingname}{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
metaString' Text
"lolTitle" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
            , Text
"}"
            ]
          | Bool
otherwise = [Text
"\\newcommand*\\listoflistings{\\listof{codelisting}{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
metaString' Text
"lolTitle" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}}"]
        cleveref :: [Text]
cleveref = [ [Text] -> Text -> Text
usepackage [Text]
cleverefOpts Text
"cleveref" ]
          [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> (Options -> Bool -> Int -> [Inline]) -> [Text]
forall t.
Num t =>
Text -> (Options -> Bool -> t -> [Inline]) -> [Text]
crefname Text
"figure" Options -> Bool -> Int -> [Inline]
figPrefix
          [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> (Options -> Bool -> Int -> [Inline]) -> [Text]
forall t.
Num t =>
Text -> (Options -> Bool -> t -> [Inline]) -> [Text]
crefname Text
"table" Options -> Bool -> Int -> [Inline]
tblPrefix
          [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> (Options -> Bool -> Int -> [Inline]) -> [Text]
forall t.
Num t =>
Text -> (Options -> Bool -> t -> [Inline]) -> [Text]
crefname Text
"equation" Options -> Bool -> Int -> [Inline]
eqnPrefix
          [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> (Options -> Bool -> Int -> [Inline]) -> [Text]
forall t.
Num t =>
Text -> (Options -> Bool -> t -> [Inline]) -> [Text]
crefname Text
"listing" Options -> Bool -> Int -> [Inline]
lstPrefix
          [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> (Options -> Bool -> Int -> [Inline]) -> [Text]
forall t.
Num t =>
Text -> (Options -> Bool -> t -> [Inline]) -> [Text]
crefname Text
"section" Options -> Bool -> Int -> [Inline]
secPrefix
        cleverefCodelisting :: [Text]
cleverefCodelisting = [
            Text
"\\crefname{codelisting}{\\cref@listing@name}{\\cref@listing@name@plural}"
          , Text
"\\Crefname{codelisting}{\\Cref@listing@name}{\\Cref@listing@name@plural}"
          ]
        cleverefOpts :: [Text]
cleverefOpts | Options -> Bool
nameInLink Options
opts = [ Text
"nameinlink" ]
                     | Bool
otherwise = []
        crefname :: Text -> (Options -> Bool -> t -> [Inline]) -> [Text]
crefname Text
n Options -> Bool -> t -> [Inline]
f = [
            Text
"\\crefname{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Options -> Bool -> t -> [Inline]) -> Bool -> Text
forall t t. Num t => (Options -> t -> t -> [Inline]) -> t -> Text
prefix Options -> Bool -> t -> [Inline]
f Bool
False
          , Text
"\\Crefname{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Options -> Bool -> t -> [Inline]) -> Bool -> Text
forall t t. Num t => (Options -> t -> t -> [Inline]) -> t -> Text
prefix Options -> Bool -> t -> [Inline]
f Bool
True
          ]
        usepackage :: [Text] -> Text -> Text
usepackage [] Text
p = Text
"\\@ifpackageloaded{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}{}{\\usepackage{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}}"
        usepackage [Text]
xs Text
p = Text
"\\@ifpackageloaded{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}{}{\\usepackage" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
o Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}}"
          where o :: Text
o = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," [Text]
xs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
        toLatex :: [Inline] -> Text
toLatex = (PandocError -> Text)
-> (Text -> Text) -> Either PandocError Text -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> (PandocError -> [Char]) -> PandocError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocError -> [Char]
forall a. Show a => a -> [Char]
show) Text -> Text
forall a. a -> a
id (Either PandocError Text -> Text)
-> ([Inline] -> Either PandocError Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
runPure (PandocPure Text -> Either PandocError Text)
-> ([Inline] -> PandocPure Text)
-> [Inline]
-> Either PandocError Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> Pandoc -> PandocPure Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeLaTeX WriterOptions
forall a. Default a => a
def (Pandoc -> PandocPure Text)
-> ([Inline] -> Pandoc) -> [Inline] -> PandocPure Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta ([Block] -> Pandoc) -> ([Inline] -> [Block]) -> [Inline] -> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [Block]
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
Plain
        metaString :: Text -> Text
metaString Text
s = [Inline] -> Text
toLatex ([Inline] -> Text) -> [Inline] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> [Inline]
getMetaInlines Text
s Meta
meta
        metaString' :: Text -> Text
metaString' Text
s = [Inline] -> Text
toLatex [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Text
getMetaString Text
s Meta
meta]
        prefix :: (Options -> t -> t -> [Inline]) -> t -> Text
prefix Options -> t -> t -> [Inline]
f t
uc = Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
toLatex (Options -> t -> t -> [Inline]
f Options
opts t
uc t
0) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                      Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Text
toLatex (Options -> t -> t -> [Inline]
f Options
opts t
uc t
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"