{-# LANGUAGE OverloadedStrings #-}
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)
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
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
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
'\'':_ -> String
cs String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "\\," 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
xs
in case Char
x of
'?' | Bool
ligatures ->
case String
xs of
'`':_ -> String -> String
emits "?{}"
_ -> Char -> String
emitc Char
x
'!' | Bool
ligatures ->
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
('-':_) -> String -> String
emits "-\\/"
_ -> Char -> String
emitc '-'
'~' | Bool -> Bool
not Bool
isUrl -> String -> String
emitcseq "\\textasciitilde"
'^' -> String -> String
emits "\\^{}"
'\\'| Bool
isUrl -> Char -> String
emitc '/'
| 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 "{[}"
']' -> String -> String
emits "{]}"
'\'' | 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}"
'\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)
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
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