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

lookupAccent :: Char -> Maybe String
lookupAccent :: Char -> Maybe String
lookupAccent Char
'\779'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\H"
lookupAccent Char
'\768'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\`"
lookupAccent Char
'\769'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\'"
lookupAccent Char
'\770'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\^"
lookupAccent Char
'\771'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\~"
lookupAccent Char
'\776'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\\""
lookupAccent Char
'\775'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\."
lookupAccent Char
'\772'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\="
lookupAccent Char
'\781'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\|"
lookupAccent Char
'\817'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\b"
lookupAccent Char
'\807'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\c"
lookupAccent Char
'\783'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\G"
lookupAccent Char
'\777'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\h"
lookupAccent Char
'\803'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\d"
lookupAccent Char
'\785'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\f"
lookupAccent Char
'\778'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\r"
lookupAccent Char
'\865'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\t"
lookupAccent Char
'\782'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\U"
lookupAccent Char
'\780'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\v"
lookupAccent Char
'\774'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\u"
lookupAccent Char
'\808'  = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\k"
lookupAccent Char
'\8413' = String -> Maybe String
forall a. a -> Maybe a
Just String
"\\textcircled"
lookupAccent Char
_       = Maybe String
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 -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"ux" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%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
  Bool
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 -> Doc Text -> Doc Text
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
  Maybe Lang
lang <- Maybe Text -> StateT WriterState m (Maybe Lang)
forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang (Maybe Text -> StateT WriterState m (Maybe Lang))
-> Maybe Text -> StateT WriterState m (Maybe Lang)
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"lang" [(Text, Text)]
kvs
  let wrapColumns :: Doc Text -> Doc Text
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 = String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
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 :: Doc Text -> Doc Text
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
. String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> (Text -> String) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
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
"\\textwidth")
                               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 -> Text
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 :: Doc Text -> Doc Text
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 -> Doc Text
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
  Doc Text -> LW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> LW m (Doc Text)) -> Doc Text -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text -> Doc Text
wrapColumns (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
wrapColumn (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
wrapDir (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
wrapLang (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
t

hypertarget :: PandocMonad m => Bool -> Text -> Doc Text -> LW m (Doc Text)
hypertarget :: forall (m :: * -> *).
PandocMonad m =>
Bool -> Text -> Doc Text -> LW m (Doc Text)
hypertarget Bool
_ Text
"" Doc Text
x    = 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
x
hypertarget Bool
addnewline Text
ident Doc Text
x = do
  Doc Text
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
  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 -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"\\hypertarget"
              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
ref
              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 ((if Bool
addnewline Bool -> Bool -> Bool
&& Bool -> Bool
not (Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
x)
                             then Doc Text
"%" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr
                             else Doc Text
forall a. Doc a
empty) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
x)

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
  Doc Text
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
  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 -> StateT WriterState m (Doc Text))
-> Doc Text -> StateT WriterState m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"\\label" 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
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