{-
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>
Copyright (C) 2017  Masamichi Hosoda <trueroad@trueroad.jp>

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.Settings (getSettings, defaultMeta) where

import Text.Pandoc
import Text.Pandoc.Builder
import Control.Exception (handle,IOException)

import Text.Pandoc.CrossRef.Util.Settings.Gen
import Text.Pandoc.CrossRef.Util.Meta
import System.Directory
import System.FilePath
import System.IO
import qualified Data.Text as T

getSettings :: Maybe Format -> Meta -> IO Meta
getSettings :: Maybe Format -> Meta -> IO Meta
getSettings Maybe Format
fmt Meta
meta = do
  Meta
dirConfig <- FilePath -> IO Meta
readConfig (Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> Meta -> Text
getMetaString Text
"crossrefYaml" (Meta
defaultMeta Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Meta
meta))
  FilePath
home <- IO FilePath
getHomeDirectory
  Meta
globalConfig <- FilePath -> IO Meta
readConfig (FilePath
home FilePath -> FilePath -> FilePath
</> FilePath
".pandoc-crossref" FilePath -> FilePath -> FilePath
</> FilePath
"config.yaml")
  Meta
formatConfig <- IO Meta -> (Format -> IO Meta) -> Maybe Format -> IO Meta
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Meta -> IO Meta
forall (m :: * -> *) a. Monad m => a -> m a
return Meta
nullMeta) (FilePath -> Format -> IO Meta
readFmtConfig FilePath
home) Maybe Format
fmt
  Meta -> IO Meta
forall (m :: * -> *) a. Monad m => a -> m a
return (Meta -> IO Meta) -> Meta -> IO Meta
forall a b. (a -> b) -> a -> b
$ Meta
defaultMeta Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Meta
globalConfig Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Meta
formatConfig Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Meta
dirConfig Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Meta
meta
  where
    readConfig :: FilePath -> IO Meta
readConfig FilePath
path =
      (IOException -> IO Meta) -> IO Meta -> IO Meta
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle IOException -> IO Meta
handler (IO Meta -> IO Meta) -> IO Meta -> IO Meta
forall a b. (a -> b) -> a -> b
$ do
        Handle
h <- FilePath -> IOMode -> IO Handle
openFile FilePath
path IOMode
ReadMode
        Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
        FilePath
yaml <- Handle -> IO FilePath
hGetContents Handle
h
        Pandoc Meta
meta' [Block]
_ <- Text -> IO Pandoc
readMd (Text -> IO Pandoc) -> Text -> IO Pandoc
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [FilePath
"---", FilePath
yaml, FilePath
"---"]
        Meta -> IO Meta
forall (m :: * -> *) a. Monad m => a -> m a
return Meta
meta'
    readMd :: Text -> IO Pandoc
readMd = Either PandocError Pandoc -> IO Pandoc
forall a. Either PandocError a -> IO a
handleError (Either PandocError Pandoc -> IO Pandoc)
-> (Text -> Either PandocError Pandoc) -> Text -> IO Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
runPure (PandocPure Pandoc -> Either PandocError Pandoc)
-> (Text -> PandocPure Pandoc) -> Text -> Either PandocError Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readMarkdown ReaderOptions
forall a. Default a => a
def{readerExtensions :: Extensions
readerExtensions=Extensions
pandocExtensions}
    readFmtConfig :: FilePath -> Format -> IO Meta
readFmtConfig FilePath
home Format
fmt' = FilePath -> IO Meta
readConfig (FilePath
home FilePath -> FilePath -> FilePath
</> FilePath
".pandoc-crossref" FilePath -> FilePath -> FilePath
</> FilePath
"config-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Format -> FilePath
fmtStr Format
fmt' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".yaml")
    handler :: IOException -> IO Meta
    handler :: IOException -> IO Meta
handler IOException
_ = Meta -> IO Meta
forall (m :: * -> *) a. Monad m => a -> m a
return Meta
nullMeta
    fmtStr :: Format -> FilePath
fmtStr (Format Text
fmtstr) = Text -> FilePath
T.unpack Text
fmtstr


defaultMeta :: Meta
defaultMeta :: Meta
defaultMeta =
     Bool -> Meta
forall a. ToMetaValue a => a -> Meta
cref Bool
False
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Bool -> Meta
forall a. ToMetaValue a => a -> Meta
chapters Bool
False
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> MetaValue -> Meta
forall a. ToMetaValue a => a -> Meta
chaptersDepth (Text -> MetaValue
MetaString Text
"1")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Bool -> Meta
forall a. ToMetaValue a => a -> Meta
listings Bool
False
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Bool -> Meta
forall a. ToMetaValue a => a -> Meta
codeBlockCaptions Bool
False
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Bool -> Meta
forall a. ToMetaValue a => a -> Meta
autoSectionLabels Bool
False
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Bool -> Meta
forall a. ToMetaValue a => a -> Meta
numberSections Bool
False
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> MetaValue -> Meta
forall a. ToMetaValue a => a -> Meta
sectionsDepth (Text -> MetaValue
MetaString Text
"0")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> MetaValue -> Meta
forall a. ToMetaValue a => a -> Meta
figLabels (Text -> MetaValue
MetaString Text
"arabic")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> MetaValue -> Meta
forall a. ToMetaValue a => a -> Meta
eqLabels (Text -> MetaValue
MetaString Text
"arabic")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> MetaValue -> Meta
forall a. ToMetaValue a => a -> Meta
tblLabels (Text -> MetaValue
MetaString Text
"arabic")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> MetaValue -> Meta
forall a. ToMetaValue a => a -> Meta
lstLabels (Text -> MetaValue
MetaString Text
"arabic")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> MetaValue -> Meta
forall a. ToMetaValue a => a -> Meta
secLabels (Text -> MetaValue
MetaString Text
"arabic")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
figureTitle (Text -> Inlines
str Text
"Figure")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
tableTitle (Text -> Inlines
str Text
"Table")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
listingTitle (Text -> Inlines
str Text
"Listing")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
titleDelim (Text -> Inlines
str Text
":")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
chapDelim (Text -> Inlines
str Text
".")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
rangeDelim (Text -> Inlines
str Text
"-")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
pairDelim (Text -> Inlines
str Text
"," Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space)
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
lastDelim (Text -> Inlines
str Text
"," Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space)
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
refDelim (Text -> Inlines
str Text
"," Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space)
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> [Inlines] -> Meta
forall a. ToMetaValue a => a -> Meta
figPrefix [Text -> Inlines
str Text
"fig.", Text -> Inlines
str Text
"figs."]
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> [Inlines] -> Meta
forall a. ToMetaValue a => a -> Meta
eqnPrefix [Text -> Inlines
str Text
"eq." , Text -> Inlines
str Text
"eqns."]
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> [Inlines] -> Meta
forall a. ToMetaValue a => a -> Meta
tblPrefix [Text -> Inlines
str Text
"tbl.", Text -> Inlines
str Text
"tbls."]
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> [Inlines] -> Meta
forall a. ToMetaValue a => a -> Meta
lstPrefix [Text -> Inlines
str Text
"lst.", Text -> Inlines
str Text
"lsts."]
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> [Inlines] -> Meta
forall a. ToMetaValue a => a -> Meta
secPrefix [Text -> Inlines
str Text
"sec.", Text -> Inlines
str Text
"secs."]
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
figPrefixTemplate (Text -> Inlines
var Text
"p" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"\160" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"i")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
eqnPrefixTemplate (Text -> Inlines
var Text
"p" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"\160" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"i")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
tblPrefixTemplate (Text -> Inlines
var Text
"p" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"\160" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"i")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
lstPrefixTemplate (Text -> Inlines
var Text
"p" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"\160" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"i")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
secPrefixTemplate (Text -> Inlines
var Text
"p" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"\160" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"i")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
refIndexTemplate (Text -> Inlines
var Text
"i" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"suf")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
subfigureRefIndexTemplate (Text -> Inlines
var Text
"i" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"suf" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"(" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"s" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
")")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
secHeaderTemplate (Text -> Inlines
var Text
"i" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"secHeaderDelim[n]" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"t")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
secHeaderDelim Inlines
space
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Blocks -> Meta
forall a. ToMetaValue a => a -> Meta
lofTitle (Int -> Inlines -> Blocks
header Int
1 (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
"List of Figures")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Blocks -> Meta
forall a. ToMetaValue a => a -> Meta
lotTitle (Int -> Inlines -> Blocks
header Int
1 (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
"List of Tables")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Blocks -> Meta
forall a. ToMetaValue a => a -> Meta
lolTitle (Int -> Inlines -> Blocks
header Int
1 (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
"List of Listings")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
figureTemplate (Text -> Inlines
var Text
"figureTitle" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"i" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"titleDelim" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"t")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
tableTemplate (Text -> Inlines
var Text
"tableTitle" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"i" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"titleDelim" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"t")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
listingTemplate (Text -> Inlines
var Text
"listingTitle" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"i" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"titleDelim" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"t")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> MetaValue -> Meta
forall a. ToMetaValue a => a -> Meta
crossrefYaml (Text -> MetaValue
MetaString Text
"pandoc-crossref.yaml")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
subfigureChildTemplate (Text -> Inlines
var Text
"i")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
subfigureTemplate (Text -> Inlines
var Text
"figureTitle" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"i" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"titleDelim" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"t" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"." Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"ccs")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> MetaValue -> Meta
forall a. ToMetaValue a => a -> Meta
subfigLabels (Text -> MetaValue
MetaString Text
"alpha a")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
ccsDelim (Text -> Inlines
str Text
"," Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space)
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
ccsLabelSep (Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
str Text
"—" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space)
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Inlines -> Meta
forall a. ToMetaValue a => a -> Meta
ccsTemplate (Text -> Inlines
var Text
"i" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"ccsLabelSep" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
var Text
"t")
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Bool -> Meta
forall a. ToMetaValue a => a -> Meta
tableEqns Bool
False
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Bool -> Meta
forall a. ToMetaValue a => a -> Meta
autoEqnLabels Bool
False
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Bool -> Meta
forall a. ToMetaValue a => a -> Meta
subfigGrid Bool
False
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Bool -> Meta
forall a. ToMetaValue a => a -> Meta
linkReferences Bool
False
  Meta -> Meta -> Meta
forall a. Semigroup a => a -> a -> a
<> Bool -> Meta
forall a. ToMetaValue a => a -> Meta
nameInLink Bool
False
  where var :: Text -> Inlines
var = Text -> Inlines
displayMath