pandoc-3.10: src/Text/Pandoc/Readers/LaTeX/Lang.hs
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Readers.LaTeX.Lang
Copyright : Copyright (C) 2018-2024 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
Portability : portable
Functions for parsing polyglossia and babel language specifiers to
BCP47 'Lang'.
-}
module Text.Pandoc.Readers.LaTeX.Lang
( setDefaultLanguage
, polyglossiaLangToBCP47
, babelLangToBCP47
, enquoteCommands
, inlineLanguageCommands
)
where
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Shared (extractSpaces)
import Text.Collate.Lang (Lang(..), renderLang)
import Text.Pandoc.Class (PandocMonad(..))
import Text.Pandoc.Translations (setTranslations)
import Text.Pandoc.Readers.LaTeX.Parsing
import Text.Pandoc.Parsing (updateState, option, getState, QuoteContext(..),
withQuoteContext)
import Text.Pandoc.Builder (Blocks, Inlines, setMeta, str, spanWith,
singleQuoted, doubleQuoted)
enquote :: PandocMonad m
=> LP m Inlines
-> Bool -> Maybe Text -> LP m Inlines
enquote tok starred mblang = do
skipopts
let lang = mblang >>= babelLangToBCP47
let langspan = case lang of
Nothing -> id
Just l -> spanWith ("",[],[("lang", renderLang l)])
quoteContext <- sQuoteContext <$> getState
if starred || quoteContext == InDoubleQuote
then singleQuoted . langspan <$> withQuoteContext InSingleQuote tok
else doubleQuoted . langspan <$> withQuoteContext InDoubleQuote tok
enquoteCommands :: PandocMonad m
=> LP m Inlines -> M.Map Text (LP m Inlines)
enquoteCommands tok = M.fromList
[ ("enquote*", enquote tok True Nothing)
, ("enquote", enquote tok False Nothing)
-- foreignquote is supposed to use native quote marks
, ("foreignquote*", braced >>= enquote tok True . Just . untokenize)
, ("foreignquote", braced >>= enquote tok False . Just . untokenize)
-- hypehnquote uses regular quotes
, ("hyphenquote*", braced >>= enquote tok True . Just . untokenize)
, ("hyphenquote", braced >>= enquote tok False . Just . untokenize)
]
foreignlanguage :: PandocMonad m => LP m Inlines -> LP m Inlines
foreignlanguage tok = do
babelLang <- untokenize <$> braced
case babelLangToBCP47 babelLang of
Just lang -> spanWith ("", [], [("lang", renderLang lang)]) <$> tok
_ -> tok
inlineLanguageCommands :: PandocMonad m
=> LP m Inlines -> M.Map Text (LP m Inlines)
inlineLanguageCommands tok =
M.fromList $
("foreignlanguage", foreignlanguage tok) :
(mk <$> M.toList polyglossiaLangToBCP47)
where
mk (polyglossia, bcp47Func) =
("text" <> polyglossia, inlineLanguage tok bcp47Func)
inlineLanguage :: PandocMonad m
=> LP m Inlines -> (Text -> Lang) -> LP m Inlines
inlineLanguage tok bcp47Func = do
o <- option "" $ T.filter (\c -> c /= '[' && c /= ']')
<$> rawopt
let lang = renderLang $ bcp47Func o
extractSpaces (spanWith ("", [], [("lang", lang)])) <$> tok
setDefaultLanguage :: PandocMonad m => LP m Blocks
setDefaultLanguage = do
o <- option "" $ T.filter (\c -> c /= '[' && c /= ']')
<$> rawopt
polylang <- untokenize <$> braced
case M.lookup polylang polyglossiaLangToBCP47 of
Nothing -> return mempty -- TODO mzero? warning?
Just langFunc -> do
let l = langFunc o
setTranslations l
updateState $ setMeta "lang" $ str (renderLang l)
return mempty
polyglossiaLangToBCP47 :: M.Map T.Text (T.Text -> Lang)
polyglossiaLangToBCP47 = M.fromList
[ ("arabic", \o -> case T.filter (/=' ') o of
"locale=algeria" -> Lang "ar" Nothing (Just "DZ") [] [] []
"locale=mashriq" -> Lang "ar" Nothing (Just "SY") [] [] []
"locale=libya" -> Lang "ar" Nothing (Just "LY") [] [] []
"locale=morocco" -> Lang "ar" Nothing (Just "MA") [] [] []
"locale=mauritania" -> Lang "ar" Nothing (Just "MR") [] [] []
"locale=tunisia" -> Lang "ar" Nothing (Just "TN") [] [] []
_ -> Lang "ar" Nothing Nothing [] [] [])
, ("german", \o -> case T.filter (/=' ') o of
"spelling=old" -> Lang "de" Nothing (Just "DE") ["1901"] [] []
"variant=austrian,spelling=old"
-> Lang "de" Nothing (Just "AT") ["1901"] [] []
"variant=austrian" -> Lang "de" Nothing (Just "AT") [] [] []
"variant=swiss,spelling=old"
-> Lang "de" Nothing (Just "CH") ["1901"] [] []
"variant=swiss" -> Lang "de" Nothing (Just "CH") [] [] []
_ -> Lang "de" Nothing Nothing [] [] [])
, ("lsorbian", \_ -> Lang "dsb" Nothing Nothing [] [] [])
, ("greek", \o -> case T.filter (/=' ') o of
"variant=poly" -> Lang "el" Nothing (Just "polyton") [] [] []
"variant=ancient" -> Lang "grc" Nothing Nothing [] [] []
_ -> Lang "el" Nothing Nothing [] [] [])
, ("english", \o -> case T.filter (/=' ') o of
"variant=australian" -> Lang "en" Nothing (Just "AU") [] [] []
"variant=canadian" -> Lang "en" Nothing (Just "CA") [] [] []
"variant=british" -> Lang "en" Nothing (Just "GB") [] [] []
"variant=newzealand" -> Lang "en" Nothing (Just "NZ") [] [] []
"variant=american" -> Lang "en" Nothing (Just "US") [] [] []
_ -> Lang "en" Nothing Nothing [] [] [])
, ("usorbian", \_ -> Lang "hsb" Nothing Nothing [] [] [])
, ("latin", \o -> case T.filter (/=' ') o of
"variant=classic" -> Lang "la" Nothing Nothing ["x-classic"] [] []
_ -> Lang "la" Nothing Nothing [] [] [])
, ("slovenian", \_ -> Lang "sl" Nothing Nothing [] [] [])
, ("serbianc", \_ -> Lang "sr" (Just "Cyrl") Nothing [] [] [])
, ("pinyin", \_ -> Lang "zh" (Just "Latn") Nothing ["pinyin"] [] [])
, ("afrikaans", \_ -> simpleLang "af")
, ("amharic", \_ -> simpleLang "am")
, ("assamese", \_ -> simpleLang "as")
, ("asturian", \_ -> simpleLang "ast")
, ("bulgarian", \_ -> simpleLang "bg")
, ("bengali", \_ -> simpleLang "bn")
, ("tibetan", \_ -> simpleLang "bo")
, ("breton", \_ -> simpleLang "br")
, ("catalan", \_ -> simpleLang "ca")
, ("welsh", \_ -> simpleLang "cy")
, ("czech", \_ -> simpleLang "cs")
, ("coptic", \_ -> simpleLang "cop")
, ("danish", \_ -> simpleLang "da")
, ("divehi", \_ -> simpleLang "dv")
, ("esperanto", \_ -> simpleLang "eo")
, ("spanish", \_ -> simpleLang "es")
, ("estonian", \_ -> simpleLang "et")
, ("basque", \_ -> simpleLang "eu")
, ("farsi", \_ -> simpleLang "fa")
, ("finnish", \_ -> simpleLang "fi")
, ("french", \_ -> simpleLang "fr")
, ("friulan", \_ -> simpleLang "fur")
, ("irish", \_ -> simpleLang "ga")
, ("scottish", \_ -> simpleLang "gd")
, ("ethiopic", \_ -> simpleLang "gez")
, ("galician", \_ -> simpleLang "gl")
, ("hebrew", \_ -> simpleLang "he")
, ("hindi", \_ -> simpleLang "hi")
, ("croatian", \_ -> simpleLang "hr")
, ("magyar", \_ -> simpleLang "hu")
, ("armenian", \_ -> simpleLang "hy")
, ("gujarati", \_ -> simpleLang "gu")
, ("interlingua", \_ -> simpleLang "ia")
, ("indonesian", \_ -> simpleLang "id")
, ("icelandic", \_ -> simpleLang "is")
, ("italian", \_ -> simpleLang "it")
, ("japanese", \_ -> simpleLang "ja")
, ("khmer", \_ -> simpleLang "km")
, ("kurmanji", \_ -> simpleLang "kmr")
, ("kannada", \_ -> simpleLang "kn")
, ("korean", \_ -> simpleLang "ko")
, ("lao", \_ -> simpleLang "lo")
, ("lithuanian", \_ -> simpleLang "lt")
, ("latvian", \_ -> simpleLang "lv")
, ("malayalam", \_ -> simpleLang "ml")
, ("mongolian", \_ -> simpleLang "mn")
, ("marathi", \_ -> simpleLang "mr")
, ("dutch", \_ -> simpleLang "nl")
, ("nynorsk", \_ -> simpleLang "nn")
, ("norsk", \_ -> simpleLang "no")
, ("nko", \_ -> simpleLang "nqo")
, ("occitan", \_ -> simpleLang "oc")
, ("oriya", \_ -> simpleLang "or")
, ("punjabi", \_ -> simpleLang "pa")
, ("polish", \_ -> simpleLang "pl")
, ("piedmontese", \_ -> simpleLang "pms")
, ("portuguese", \_ -> simpleLang "pt")
, ("romansh", \_ -> simpleLang "rm")
, ("romanian", \_ -> simpleLang "ro")
, ("russian", \_ -> simpleLang "ru")
, ("sanskrit", \_ -> simpleLang "sa")
, ("samin", \_ -> simpleLang "se")
, ("slovak", \_ -> simpleLang "sk")
, ("albanian", \_ -> simpleLang "sq")
, ("serbian", \_ -> simpleLang "sr")
, ("swedish", \_ -> simpleLang "sv")
, ("syriac", \_ -> simpleLang "syr")
, ("tamil", \_ -> simpleLang "ta")
, ("telugu", \_ -> simpleLang "te")
, ("thai", \_ -> simpleLang "th")
, ("turkmen", \_ -> simpleLang "tk")
, ("turkish", \_ -> simpleLang "tr")
, ("ukrainian", \_ -> simpleLang "uk")
, ("urdu", \_ -> simpleLang "ur")
, ("vietnamese", \_ -> simpleLang "vi")
]
simpleLang :: Text -> Lang
simpleLang l = Lang l Nothing Nothing [] [] []
babelLangToBCP47 :: T.Text -> Maybe Lang
babelLangToBCP47 s =
case s of
"austrian" -> Just $ Lang "de" Nothing (Just "AT") ["1901"] [] []
"naustrian" -> Just $ Lang "de" Nothing (Just "AT") [] [] []
"swissgerman" -> Just $ Lang "de" Nothing (Just "CH") ["1901"] [] []
"nswissgerman" -> Just $ Lang "de" Nothing (Just "CH") [] [] []
"german" -> Just $ Lang "de" Nothing (Just "DE") ["1901"] [] []
"ngerman" -> Just $ Lang "de" Nothing (Just "DE") [] [] []
"lowersorbian" -> Just $ Lang "dsb" Nothing Nothing [] [] []
"uppersorbian" -> Just $ Lang "hsb" Nothing Nothing [] [] []
"polytonicgreek" -> Just $ Lang "el" Nothing Nothing ["polyton"] [] []
"polutonikogreek" -> Just $ Lang "el" Nothing Nothing ["polyton"] [] []
"slovene" -> Just $ simpleLang "sl"
"australian" -> Just $ Lang "en" Nothing (Just "AU") [] [] []
"canadian" -> Just $ Lang "en" Nothing (Just "CA") [] [] []
"british" -> Just $ Lang "en" Nothing (Just "GB") [] [] []
"newzealand" -> Just $ Lang "en" Nothing (Just "NZ") [] [] []
"american" -> Just $ Lang "en" Nothing (Just "US") [] [] []
"classiclatin" -> Just $ Lang "la" Nothing Nothing ["x-classic"] [] []
_ -> ($ "") <$> M.lookup s polyglossiaLangToBCP47