{-# LANGUAGE OverloadedStrings   #-}
{- |
   Module      : Text.Pandoc.Writers.LaTeX.Util
   Copyright   : Copyright (C) 2006-2024 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable
-}
module Text.Pandoc.Writers.LaTeX.Util (
    stringToLaTeX
  , StringContext(..)
  , toLabel
  , inCmd
  , wrapDiv
  , hypertarget
  , labelFor
  , getListingsLanguage
  , mbBraced
  )
where

import Control.Applicative ((<|>))
import Control.Monad (when)
import Text.Pandoc.Class (PandocMonad, toLang)
import Text.Pandoc.Options (WriterOptions(..), isEnabled)
import Text.Pandoc.Writers.LaTeX.Types (LW, WriterState(..))
import Text.Pandoc.Writers.LaTeX.Lang (toBabel)
import Text.Pandoc.Highlighting (toListingsLanguage)
import Text.DocLayout
import Text.Pandoc.Definition
import Text.Pandoc.ImageSize (showFl)
import Control.Monad.State.Strict (gets, modify)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Extensions (Extension(Ext_smart))
import Data.Char (isLetter, isSpace, isDigit, isAscii, ord, isAlphaNum)
import Text.Printf (printf)
import Text.Pandoc.Shared (safeRead)
import qualified Data.Text.Normalize as Normalize
import Data.List (uncons)

data StringContext = TextString
                   | URLString
                   | CodeString
                   deriving (StringContext -> StringContext -> Bool
(StringContext -> StringContext -> Bool)
-> (StringContext -> StringContext -> Bool) -> Eq StringContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StringContext -> StringContext -> Bool
== :: StringContext -> StringContext -> Bool
$c/= :: StringContext -> StringContext -> Bool
/= :: StringContext -> StringContext -> Bool
Eq)

-- escape things as needed for LaTeX
stringToLaTeX :: PandocMonad m => StringContext -> Text -> LW m Text
stringToLaTeX :: forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
context Text
zs = do
  opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
  when (T.any (== '\x200c') zs) $
    modify (\WriterState
s -> WriterState
s { stZwnj = True })
  return $ T.pack $
    foldr (go opts context) mempty $ T.unpack $
    if writerPreferAscii opts
       then Normalize.normalize Normalize.NFD zs
       else zs
 where
  go :: WriterOptions -> StringContext -> Char -> String -> String
  go :: WriterOptions -> StringContext -> Char -> [Char] -> [Char]
go WriterOptions
opts StringContext
ctx Char
x [Char]
xs   =
    let ligatures :: Bool
ligatures = Extension -> WriterOptions -> Bool
forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_smart WriterOptions
opts Bool -> Bool -> Bool
&& StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
TextString
        isUrl :: Bool
isUrl = StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
URLString
        mbAccentCmd :: Maybe [Char]
mbAccentCmd =
          if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts Bool -> Bool -> Bool
&& StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
TextString
             then [Char] -> Maybe (Char, [Char])
forall a. [a] -> Maybe (a, [a])
uncons [Char]
xs Maybe (Char, [Char])
-> ((Char, [Char]) -> Maybe [Char]) -> Maybe [Char]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Char
c,[Char]
_) -> Char -> Maybe [Char]
lookupAccent Char
c
             else Maybe [Char]
forall a. Maybe a
Nothing
        emits :: [Char] -> [Char]
emits [Char]
s =
          case Maybe [Char]
mbAccentCmd of
               Just [Char]
cmd ->
                 [Char]
cmd [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"{" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
s [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"}" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
xs -- drop combining accent
               Maybe [Char]
Nothing  -> [Char]
s [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
xs
        emitc :: Char -> [Char]
emitc Char
c =
          case Maybe [Char]
mbAccentCmd of
               Just [Char]
cmd ->
                 [Char]
cmd [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"{" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char
c] [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"}" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
xs -- drop combining accent
               Maybe [Char]
Nothing  -> Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
xs
        emitcseq :: [Char] -> [Char]
emitcseq [Char]
cs =
          case [Char]
xs of
            Char
c:[Char]
_ | Char -> Bool
isLetter Char
c
                , StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
TextString
                             -> [Char]
cs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
xs
                | Char -> Bool
isSpace Char
c  -> [Char]
cs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"{}" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
xs
                | StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
TextString
                             -> [Char]
cs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
xs
            [Char]
_ -> [Char]
cs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"{}" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
xs
        emitquote :: [Char] -> [Char]
emitquote [Char]
cs =
          case [Char]
xs of
            Char
'`':[Char]
_  -> [Char]
cs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\\," [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
xs -- add thin space
            Char
'\'':[Char]
_ -> [Char]
cs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\\," [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
xs -- add thin space
            [Char]
_      -> [Char]
cs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
xs
    in case Char
x of
         Char
_ | Bool
isUrl ->
           case Char
x of
             Char
'\\' -> Char -> [Char]
emitc Char
'/' -- NB / works as path sep even on Windows
             Char
'#' -> [Char] -> [Char]
emits [Char]
"\\#" -- #9014
             Char
'%' -> [Char] -> [Char]
emits [Char]
"\\%" -- #9014
             Char
'{' -> [Char] -> [Char]
emits [Char]
"\\%7B"
             Char
'}' -> [Char] -> [Char]
emits [Char]
"\\%7D"
             Char
'|' -> [Char] -> [Char]
emits [Char]
"\\%7C"
             Char
'^' -> [Char] -> [Char]
emits [Char]
"\\%5E"
             Char
'[' -> [Char] -> [Char]
emits [Char]
"\\%5B"
             Char
']' -> [Char] -> [Char]
emits [Char]
"\\%5D"
             Char
'`' -> [Char] -> [Char]
emits [Char]
"\\%60"
             Char
_ -> Char -> [Char]
emitc Char
x
         Char
'{' -> [Char] -> [Char]
emits [Char]
"\\{"
         Char
'}' -> [Char] -> [Char]
emits [Char]
"\\}"
         Char
'?' | Bool
ligatures ->  -- avoid ?` ligature
           case [Char]
xs of
             Char
'`':[Char]
_ -> [Char] -> [Char]
emits [Char]
"?{\\kern0pt}" -- se #10610
             [Char]
_     -> Char -> [Char]
emitc Char
x
         Char
'!' | Bool
ligatures ->  -- avoid !` ligature
           case [Char]
xs of
             Char
'`':[Char]
_ -> [Char] -> [Char]
emits [Char]
"!{\\kern0pt}"
             [Char]
_     -> Char -> [Char]
emitc Char
x
         Char
'`' | StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
CodeString -> [Char] -> [Char]
emitcseq [Char]
"\\textasciigrave"
         Char
'$' -> [Char] -> [Char]
emits [Char]
"\\$"
         Char
'%' -> [Char] -> [Char]
emits [Char]
"\\%"
         Char
'&' -> [Char] -> [Char]
emits [Char]
"\\&"
         Char
'_' -> [Char] -> [Char]
emits [Char]
"\\_"
         Char
'#' -> [Char] -> [Char]
emits [Char]
"\\#"
         Char
'-' -> case [Char]
xs of
                     -- prevent adjacent hyphens from forming ligatures
                     (Char
'-':[Char]
_) -> [Char] -> [Char]
emits [Char]
"-\\/"
                     [Char]
_       -> Char -> [Char]
emitc Char
'-'
         Char
'~' -> [Char] -> [Char]
emitcseq [Char]
"\\textasciitilde"
         Char
'^' -> [Char] -> [Char]
emits [Char]
"\\^{}"
         Char
'\\' -> [Char] -> [Char]
emitcseq [Char]
"\\textbackslash"
         Char
'|'  -> [Char] -> [Char]
emitcseq [Char]
"\\textbar"
         Char
'<'  -> [Char] -> [Char]
emitcseq [Char]
"\\textless"
         Char
'>'  -> [Char] -> [Char]
emitcseq [Char]
"\\textgreater"
         Char
'['  -> [Char] -> [Char]
emits [Char]
"{[}"  -- to avoid interpretation as
         Char
']'  -> [Char] -> [Char]
emits [Char]
"{]}"  -- optional arguments
         Char
'\'' -> [Char] -> [Char]
emitcseq [Char]
"\\textquotesingle"
         Char
'\160' -> [Char] -> [Char]
emits [Char]
"~"
         Char
'\x00AD' -> [Char] -> [Char]
emits [Char]
"\\-"  -- shy hyphen
         Char
'\x200B' -> [Char] -> [Char]
emits [Char]
"\\hspace{0pt}"  -- zero-width space
         Char
'\x202F' -> [Char] -> [Char]
emits [Char]
"\\,"
         Char
'\x2026' | Bool
ligatures -> [Char] -> [Char]
emitcseq [Char]
"\\ldots"
         Char
'\x2018' | Bool
ligatures -> [Char] -> [Char]
emitquote [Char]
"`"
         Char
'\x2019' | Bool
ligatures -> [Char] -> [Char]
emitquote [Char]
"'"
         Char
'\x201C' | Bool
ligatures -> [Char] -> [Char]
emitquote [Char]
"``"
         Char
'\x201D' | Bool
ligatures -> [Char] -> [Char]
emitquote [Char]
"''"
         Char
'\x2014' | Bool
ligatures -> [Char] -> [Char]
emits [Char]
"---"
         Char
'\x2013' | Bool
ligatures -> [Char] -> [Char]
emits [Char]
"--"
         Char
_ | WriterOptions -> Bool
writerPreferAscii WriterOptions
opts
             -> case Char
x of
                  Char
'ı' -> [Char] -> [Char]
emitcseq [Char]
"\\i"
                  Char
'ȷ' -> [Char] -> [Char]
emitcseq [Char]
"\\j"
                  Char
'å' -> [Char] -> [Char]
emitcseq [Char]
"\\aa"
                  Char
'Å' -> [Char] -> [Char]
emitcseq [Char]
"\\AA"
                  Char
'ß' -> [Char] -> [Char]
emitcseq [Char]
"\\ss"
                  Char
'ø' -> [Char] -> [Char]
emitcseq [Char]
"\\o"
                  Char
'Ø' -> [Char] -> [Char]
emitcseq [Char]
"\\O"
                  Char
'Ł' -> [Char] -> [Char]
emitcseq [Char]
"\\L"
                  Char
'ł' -> [Char] -> [Char]
emitcseq [Char]
"\\l"
                  Char
'æ' -> [Char] -> [Char]
emitcseq [Char]
"\\ae"
                  Char
'Æ' -> [Char] -> [Char]
emitcseq [Char]
"\\AE"
                  Char
'œ' -> [Char] -> [Char]
emitcseq [Char]
"\\oe"
                  Char
'Œ' -> [Char] -> [Char]
emitcseq [Char]
"\\OE"
                  Char
'£' -> [Char] -> [Char]
emitcseq [Char]
"\\pounds"
                  Char
'€' -> [Char] -> [Char]
emitcseq [Char]
"\\euro"
                  Char
'©' -> [Char] -> [Char]
emitcseq [Char]
"\\copyright"
                  Char
_   -> Char -> [Char]
emitc Char
x
           | Bool
otherwise -> Char -> [Char]
emitc Char
x

lookupAccent :: Char -> Maybe String
lookupAccent :: Char -> Maybe [Char]
lookupAccent Char
'\779'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\H"
lookupAccent Char
'\768'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\`"
lookupAccent Char
'\769'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\'"
lookupAccent Char
'\770'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\^"
lookupAccent Char
'\771'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\~"
lookupAccent Char
'\776'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\\""
lookupAccent Char
'\775'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\."
lookupAccent Char
'\772'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\="
lookupAccent Char
'\781'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\|"
lookupAccent Char
'\817'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\b"
lookupAccent Char
'\807'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\c"
lookupAccent Char
'\783'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\G"
lookupAccent Char
'\777'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\h"
lookupAccent Char
'\803'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\d"
lookupAccent Char
'\785'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\f"
lookupAccent Char
'\778'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\r"
lookupAccent Char
'\865'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\t"
lookupAccent Char
'\782'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\U"
lookupAccent Char
'\780'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\v"
lookupAccent Char
'\774'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\u"
lookupAccent Char
'\808'  = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\k"
lookupAccent Char
'\8413' = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"\\textcircled"
lookupAccent Char
_       = Maybe [Char]
forall a. Maybe a
Nothing

toLabel :: PandocMonad m => Text -> LW m Text
toLabel :: forall (m :: * -> *). PandocMonad m => Text -> LW m Text
toLabel Text
z = Text -> Text
go (Text -> Text)
-> StateT WriterState m Text -> StateT WriterState m Text
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` StringContext -> Text -> StateT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
StringContext -> Text -> LW m Text
stringToLaTeX StringContext
URLString Text
z
 where
   go :: Text -> Text
go = (Char -> Text) -> Text -> Text
T.concatMap ((Char -> Text) -> Text -> Text) -> (Char -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
x -> case Char
x of
     Char
_ | (Char -> Bool
isLetter Char
x Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
x) Bool -> Bool -> Bool
&& Char -> Bool
isAscii Char
x -> Char -> Text
T.singleton Char
x
       | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x) Text
"_-+=:;." -> Char -> Text
T.singleton Char
x
       | Bool
otherwise -> [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"ux" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%x" (Char -> Int
ord Char
x)

-- | Puts contents into LaTeX command.
inCmd :: Text -> Doc Text -> Doc Text
inCmd :: Text -> Doc Text -> Doc Text
inCmd Text
cmd Doc Text
contents = Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'\\' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
cmd Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
contents

mapAlignment :: Text -> Text
mapAlignment :: Text -> Text
mapAlignment Text
a = case Text
a of
                   Text
"top" -> Text
"T"
                   Text
"top-baseline" -> Text
"t"
                   Text
"bottom" -> Text
"b"
                   Text
"center" -> Text
"c"
                   Text
_ -> Text
a

wrapDiv :: PandocMonad m => Attr -> Doc Text -> LW m (Doc Text)
wrapDiv :: forall (m :: * -> *).
PandocMonad m =>
Attr -> Doc Text -> LW m (Doc Text)
wrapDiv (Text
_,[Text]
classes,[(Text, Text)]
kvs) Doc Text
t = do
  beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
  let align Doc Text
dir Doc Text
txt = Text -> Doc Text -> Doc Text
inCmd Text
"begin" Doc Text
dir Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
txt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text -> Doc Text
inCmd Text
"end" Doc Text
dir
  lang <- toLang $ lookup "lang" kvs
  let wrapColumns = if Bool
beamer Bool -> Bool -> Bool
&& Text
"columns" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                    then \Doc Text
contents ->
                           let valign :: Text
valign = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"T" Text -> Text
mapAlignment (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"align" [(Text, Text)]
kvs)
                               totalwidth :: [Text]
totalwidth = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
x -> [Text
"totalwidth=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x])
                                 (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"totalwidth" [(Text, Text)]
kvs)
                               onlytextwidth :: [Text]
onlytextwidth = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text
"onlytextwidth" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) [Text]
classes
                               options :: Doc Text
options = [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text ([Char] -> Doc Text) -> [Char] -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
                                 Text
valign Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
totalwidth [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
onlytextwidth
                           in Text -> Doc Text -> Doc Text
inCmd Text
"begin" Doc Text
"columns" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets Doc Text
options
                              Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
                              Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text -> Doc Text
inCmd Text
"end" Doc Text
"columns"
                    else Doc Text -> Doc Text
forall a. a -> a
id
      wrapColumn  = if Bool
beamer Bool -> Bool -> Bool
&& Text
"column" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                    then \Doc Text
contents ->
                           let valign :: Doc Text
valign =
                                 Doc Text -> (Text -> Doc Text) -> Maybe Text -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
""
                                 (Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (Doc Text -> Doc Text) -> (Text -> Doc Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Doc Text
forall a. HasChars a => [Char] -> Doc a
text ([Char] -> Doc Text) -> (Text -> [Char]) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> [Char]) -> (Text -> Text) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
mapAlignment)
                                 (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"align" [(Text, Text)]
kvs)
                               w :: Text
w = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"0.48" Text -> Text
fromPct (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"width" [(Text, Text)]
kvs)
                           in  Text -> Doc Text -> Doc Text
inCmd Text
"begin" Doc Text
"column" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                               Doc Text
valign Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
                               Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
w Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\linewidth")
                               Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
                               Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text -> Doc Text
inCmd Text
"end" Doc Text
"column"
                    else Doc Text -> Doc Text
forall a. a -> a
id
      fromPct Text
xs =
        case Text -> Maybe (Text, Char)
T.unsnoc Text
xs of
          Just (Text
ds, Char
'%') -> case Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
ds of
                              Just Double
digits -> Double -> Text
forall a. RealFloat a => a -> Text
showFl (Double
digits Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100 :: Double)
                              Maybe Double
Nothing -> Text
xs
          Maybe (Text, Char)
_              -> Text
xs
      wrapDir = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"dir" [(Text, Text)]
kvs of
                  Just Text
"rtl" -> Doc Text -> Doc Text -> Doc Text
align Doc Text
"RTL"
                  Just Text
"ltr" -> Doc Text -> Doc Text -> Doc Text
align Doc Text
"LTR"
                  Maybe Text
_          -> Doc Text -> Doc Text
forall a. a -> a
id
      wrapLang Doc Text
txt = case Maybe Lang
lang Maybe Lang -> (Lang -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Lang -> Maybe Text
toBabel of
                       Just Text
l -> Text -> Doc Text -> Doc Text
inCmd Text
"begin" Doc Text
"otherlanguage"
                                            Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> (Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
l))
                                       Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
txt Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline
                                       Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> Doc Text -> Doc Text
inCmd Text
"end" Doc Text
"otherlanguage"
                       Maybe Text
Nothing  -> Doc Text
txt
  return $ wrapColumns . wrapColumn . wrapDir . wrapLang $ t

hypertarget :: PandocMonad m => Text -> LW m (Doc Text)
hypertarget :: forall (m :: * -> *). PandocMonad m => Text -> LW m (Doc Text)
hypertarget Text
"" = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
hypertarget Text
ident = do
  inHeading <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInHeading
  if inHeading
     then do -- see #9209 (these cases should be rare)
      ref <- literal <$> toLabel ident
      return $ text "\\protect\\hypertarget" <> braces ref <> "{}"
     else do
      label <- labelFor ident
      return $ text "\\protect\\phantomsection" <> label

labelFor :: PandocMonad m => Text -> LW m (Doc Text)
labelFor :: forall (m :: * -> *). PandocMonad m => Text -> LW m (Doc Text)
labelFor Text
""    = Doc Text -> StateT WriterState m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
labelFor Text
ident = do
  ref <- Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text)
-> StateT WriterState m Text -> StateT WriterState m (Doc Text)
forall a b.
(a -> b) -> StateT WriterState m a -> StateT WriterState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> StateT WriterState m Text
forall (m :: * -> *). PandocMonad m => Text -> LW m Text
toLabel Text
ident
  return $ text "\\label" <> braces ref

-- Determine listings language from list of class attributes.
getListingsLanguage :: [Text] -> Maybe Text
getListingsLanguage :: [Text] -> Maybe Text
getListingsLanguage [Text]
xs
  = (Text -> Maybe Text -> Maybe Text)
-> Maybe Text -> [Text] -> Maybe Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (Maybe Text -> Maybe Text -> Maybe Text)
-> (Text -> Maybe Text) -> Text -> Maybe Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
toListingsLanguage) Maybe Text
forall a. Maybe a
Nothing [Text]
xs

mbBraced :: Text -> Text
mbBraced :: Text -> Text
mbBraced Text
x = if Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlphaNum Text
x)
                then Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
                else Text
x