{-# LANGUAGE OverloadedStrings   #-}
{- |
   Module      : Text.Pandoc.Writers.LaTeX.Util
   Copyright   : Copyright (C) 2006-2022 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, elemText)
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
/= :: StringContext -> StringContext -> Bool
$c/= :: StringContext -> StringContext -> Bool
== :: StringContext -> StringContext -> Bool
$c== :: StringContext -> StringContext -> Bool
Eq)

-- escape things as needed for LaTeX
stringToLaTeX :: PandocMonad m => StringContext -> Text -> LW m Text
stringToLaTeX :: StringContext -> Text -> LW m Text
stringToLaTeX context :: StringContext
context zs :: 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 ('\x200c' Char -> Text -> Bool
`elemText` 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 (\s :: WriterState
s -> WriterState
s { stZwnj :: Bool
stZwnj = Bool
True })
  Text -> LW m Text
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 (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 opts :: WriterOptions
opts ctx :: StringContext
ctx x :: Char
x xs :: 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(c :: Char
c,_) -> Char -> Maybe String
lookupAccent Char
c
             else Maybe String
forall a. Maybe a
Nothing
        emits :: String -> String
emits s :: String
s =
          case Maybe String
mbAccentCmd of
               Just cmd :: String
cmd ->
                 String
cmd String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "{" 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
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String
forall a. Int -> [a] -> [a]
drop 1 String
xs -- drop combining accent
               Nothing  -> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
xs
        emitc :: Char -> String
emitc c :: Char
c =
          case Maybe String
mbAccentCmd of
               Just cmd :: String
cmd ->
                 String
cmd String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "{" 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
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String
forall a. Int -> [a] -> [a]
drop 1 String
xs -- drop combining accent
               Nothing  -> Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
        emitcseq :: String -> String
emitcseq cs :: String
cs =
          case String
xs of
            c :: Char
c:_ | 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
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
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
cs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "{}" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
xs
        emitquote :: String -> String
emitquote cs :: String
cs =
          case String
xs of
            '`':_  -> String
cs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "\\," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
xs -- add thin space
            '\'':_ -> String
cs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "\\," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
xs -- add thin space
            _      -> String
cs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
xs
    in case Char
x of
         '?' | Bool
ligatures ->  -- avoid ?` ligature
           case String
xs of
             '`':_ -> String -> String
emits "?{}"
             _     -> Char -> String
emitc Char
x
         '!' | Bool
ligatures ->  -- avoid !` ligature
           case String
xs of
             '`':_ -> String -> String
emits "!{}"
             _     -> Char -> String
emitc Char
x
         '{' -> String -> String
emits "\\{"
         '}' -> String -> String
emits "\\}"
         '`' | StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
CodeString -> String -> String
emitcseq "\\textasciigrave"
         '$' | Bool -> Bool
not Bool
isUrl -> String -> String
emits "\\$"
         '%' -> String -> String
emits "\\%"
         '&' -> String -> String
emits "\\&"
         '_' | Bool -> Bool
not Bool
isUrl -> String -> String
emits "\\_"
         '#' -> String -> String
emits "\\#"
         '-' | Bool -> Bool
not Bool
isUrl -> case String
xs of
                     -- prevent adjacent hyphens from forming ligatures
                     ('-':_) -> String -> String
emits "-\\/"
                     _       -> Char -> String
emitc '-'
         '~' | Bool -> Bool
not Bool
isUrl -> String -> String
emitcseq "\\textasciitilde"
         '^' -> String -> String
emits "\\^{}"
         '\\'| Bool
isUrl     -> Char -> String
emitc '/' -- NB. / works as path sep even on Windows
             | Bool
otherwise -> String -> String
emitcseq "\\textbackslash"
         '|' | Bool -> Bool
not Bool
isUrl -> String -> String
emitcseq "\\textbar"
         '<' -> String -> String
emitcseq "\\textless"
         '>' -> String -> String
emitcseq "\\textgreater"
         '[' -> String -> String
emits "{[}"  -- to avoid interpretation as
         ']' -> String -> String
emits "{]}"  -- optional arguments
         '\'' | StringContext
ctx StringContext -> StringContext -> Bool
forall a. Eq a => a -> a -> Bool
== StringContext
CodeString -> String -> String
emitcseq "\\textquotesingle"
         '\160' -> String -> String
emits "~"
         '\x200B' -> String -> String
emits "\\hspace{0pt}"  -- zero-width space
         '\x202F' -> String -> String
emits "\\,"
         '\x2026' | Bool
ligatures -> String -> String
emitcseq "\\ldots"
         '\x2018' | Bool
ligatures -> String -> String
emitquote "`"
         '\x2019' | Bool
ligatures -> String -> String
emitquote "'"
         '\x201C' | Bool
ligatures -> String -> String
emitquote "``"
         '\x201D' | Bool
ligatures -> String -> String
emitquote "''"
         '\x2014' | Bool
ligatures -> String -> String
emits "---"
         '\x2013' | Bool
ligatures -> String -> String
emits "--"
         _ | WriterOptions -> Bool
writerPreferAscii WriterOptions
opts
             -> case Char
x of
                  'ı' -> String -> String
emitcseq "\\i"
                  'ȷ' -> String -> String
emitcseq "\\j"
                  'å' -> String -> String
emitcseq "\\aa"
                  'Å' -> String -> String
emitcseq "\\AA"
                  'ß' -> String -> String
emitcseq "\\ss"
                  'ø' -> String -> String
emitcseq "\\o"
                  'Ø' -> String -> String
emitcseq "\\O"
                  'Ł' -> String -> String
emitcseq "\\L"
                  'ł' -> String -> String
emitcseq "\\l"
                  'æ' -> String -> String
emitcseq "\\ae"
                  'Æ' -> String -> String
emitcseq "\\AE"
                  'œ' -> String -> String
emitcseq "\\oe"
                  'Œ' -> String -> String
emitcseq "\\OE"
                  '£' -> String -> String
emitcseq "\\pounds"
                  '€' -> String -> String
emitcseq "\\euro"
                  '©' -> String -> String
emitcseq "\\copyright"
                  _   -> Char -> String
emitc Char
x
           | Bool
otherwise -> Char -> String
emitc Char
x

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

toLabel :: PandocMonad m => Text -> LW m Text
toLabel :: Text -> LW m Text
toLabel z :: Text
z = Text -> Text
go (Text -> Text) -> LW m Text -> LW m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` StringContext -> Text -> LW 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
$ \x :: Char
x -> case Char
x of
     _ | (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
x Char -> Text -> Bool
`elemText` "_-+=:;." -> Char -> Text
T.singleton Char
x
       | Bool
otherwise -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "ux" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> Int -> String
forall r. PrintfType r => String -> r
printf "%x" (Char -> Int
ord Char
x)

-- | Puts contents into LaTeX command.
inCmd :: Text -> Doc Text -> Doc Text
inCmd :: Text -> Doc Text -> Doc Text
inCmd cmd :: Text
cmd contents :: Doc Text
contents = Char -> Doc Text
forall a. HasChars a => Char -> Doc a
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 a :: Text
a = case Text
a of
                   "top" -> "T"
                   "top-baseline" -> "t"
                   "bottom" -> "b"
                   "center" -> "c"
                   _ -> Text
a

wrapDiv :: PandocMonad m => Attr -> Doc Text -> LW m (Doc Text)
wrapDiv :: Attr -> Doc Text -> LW m (Doc Text)
wrapDiv (_,classes :: [Text]
classes,kvs :: [(Text, Text)]
kvs) t :: 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 dir :: Doc Text
dir txt :: Doc Text
txt = Text -> Doc Text -> Doc Text
inCmd "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 "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 "lang" [(Text, Text)]
kvs
  let wrapColumns :: Doc Text -> Doc Text
wrapColumns = if Bool
beamer Bool -> Bool -> Bool
&& "columns" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                    then \contents :: Doc Text
contents ->
                           let valign :: Text
valign = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "T" Text -> Text
mapAlignment (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "align" [(Text, Text)]
kvs)
                               totalwidth :: [Text]
totalwidth = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\x :: Text
x -> ["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 "totalwidth" [(Text, Text)]
kvs)
                               onlytextwidth :: [Text]
onlytextwidth = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ("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
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 "begin" "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 "end" "columns"
                    else Doc Text -> Doc Text
forall a. a -> a
id
      wrapColumn :: Doc Text -> Doc Text
wrapColumn  = if Bool
beamer Bool -> Bool -> Bool
&& "column" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
                    then \contents :: 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
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 "align" [(Text, Text)]
kvs)
                               w :: Text
w = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "0.48" Text -> Text
fromPct (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "width" [(Text, Text)]
kvs)
                           in  Text -> Doc Text -> Doc Text
inCmd "begin" "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
<> "\\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 "end" "column"
                    else Doc Text -> Doc Text
forall a. a -> a
id
      fromPct :: Text -> Text
fromPct xs :: Text
xs =
        case Text -> Maybe (Text, Char)
T.unsnoc Text
xs of
          Just (ds :: Text
ds, '%') -> case Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
ds of
                              Just digits :: Double
digits -> Double -> Text
forall a. RealFloat a => a -> Text
showFl (Double
digits Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 100 :: Double)
                              Nothing -> Text
xs
          _              -> 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 "dir" [(Text, Text)]
kvs of
                  Just "rtl" -> Doc Text -> Doc Text -> Doc Text
align "RTL"
                  Just "ltr" -> Doc Text -> Doc Text -> Doc Text
align "LTR"
                  _          -> Doc Text -> Doc Text
forall a. a -> a
id
      wrapLang :: Doc Text -> Doc Text
wrapLang txt :: Doc Text
txt = case Maybe Lang
lang of
                       Just lng :: Lang
lng -> let l :: Text
l = Lang -> Text
toBabel Lang
lng
                                   in  Text -> Doc Text -> Doc Text
inCmd "begin" "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 "end" "otherlanguage"
                       Nothing  -> Doc Text
txt
  Doc Text -> LW m (Doc Text)
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 :: Bool -> Text -> Doc Text -> LW m (Doc Text)
hypertarget _ "" x :: Doc Text
x    = Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
x
hypertarget addnewline :: Bool
addnewline ident :: Text
ident x :: 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 -> LW m (Doc Text)
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 -> LW m (Doc Text)
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
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "\\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
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 :: Text -> LW m (Doc Text)
labelFor ""    = Doc Text -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
labelFor ident :: Text
ident = do
  Doc Text
ref <- Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> StateT WriterState m Text -> LW m (Doc Text)
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 -> LW m (Doc Text)
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
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text "\\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 xs :: [Text]
xs
  = (Text -> Maybe Text -> Maybe Text)
-> Maybe Text -> [Text] -> Maybe Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe Text -> Maybe Text -> Maybe Text
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 x :: Text
x = if Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAlphaNum Text
x)
                then "{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "}"
                else Text
x