{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.LaTeX.Lang
   Copyright   : Copyright (C) 2018-2021 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.Pandoc.BCP47 (Lang(..), renderLang)
import Text.Pandoc.Class (PandocMonad(..), 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 :: LP m Inlines -> Bool -> Maybe Text -> LP m Inlines
enquote LP m Inlines
tok Bool
starred Maybe Text
mblang = do
  LP m ()
forall (m :: * -> *). PandocMonad m => LP m ()
skipopts
  let lang :: Maybe Lang
lang = Maybe Text
mblang Maybe Text -> (Text -> Maybe Lang) -> Maybe Lang
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Lang
babelLangToBCP47
  let langspan :: Inlines -> Inlines
langspan = case Maybe Lang
lang of
                      Maybe Lang
Nothing -> Inlines -> Inlines
forall a. a -> a
id
                      Just Lang
l  -> Attr -> Inlines -> Inlines
spanWith (Text
"",[],[(Text
"lang", Lang -> Text
renderLang Lang
l)])
  QuoteContext
quoteContext <- LaTeXState -> QuoteContext
sQuoteContext (LaTeXState -> QuoteContext)
-> ParsecT [Tok] LaTeXState m LaTeXState
-> ParsecT [Tok] LaTeXState m QuoteContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m LaTeXState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  if Bool
starred Bool -> Bool -> Bool
|| QuoteContext
quoteContext QuoteContext -> QuoteContext -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteContext
InDoubleQuote
     then Inlines -> Inlines
singleQuoted (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
langspan (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QuoteContext -> LP m Inlines -> LP m Inlines
forall st (m :: * -> *) s a.
HasQuoteContext st m =>
QuoteContext -> ParsecT s st m a -> ParsecT s st m a
withQuoteContext QuoteContext
InSingleQuote LP m Inlines
tok
     else Inlines -> Inlines
doubleQuoted (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Inlines
langspan (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QuoteContext -> LP m Inlines -> LP m Inlines
forall st (m :: * -> *) s a.
HasQuoteContext st m =>
QuoteContext -> ParsecT s st m a -> ParsecT s st m a
withQuoteContext QuoteContext
InDoubleQuote LP m Inlines
tok

enquoteCommands :: PandocMonad m
                => LP m Inlines -> M.Map Text (LP m Inlines)
enquoteCommands :: LP m Inlines -> Map Text (LP m Inlines)
enquoteCommands LP m Inlines
tok = [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Text
"enquote*", LP m Inlines -> Bool -> Maybe Text -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
LP m Inlines -> Bool -> Maybe Text -> LP m Inlines
enquote LP m Inlines
tok Bool
True Maybe Text
forall a. Maybe a
Nothing)
  , (Text
"enquote", LP m Inlines -> Bool -> Maybe Text -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
LP m Inlines -> Bool -> Maybe Text -> LP m Inlines
enquote LP m Inlines
tok Bool
False Maybe Text
forall a. Maybe a
Nothing)
  -- foreignquote is supposed to use native quote marks
  , (Text
"foreignquote*", LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> ([Tok] -> LP m Inlines) -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LP m Inlines -> Bool -> Maybe Text -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
LP m Inlines -> Bool -> Maybe Text -> LP m Inlines
enquote LP m Inlines
tok Bool
True (Maybe Text -> LP m Inlines)
-> ([Tok] -> Maybe Text) -> [Tok] -> LP m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize)
  , (Text
"foreignquote", LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> ([Tok] -> LP m Inlines) -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LP m Inlines -> Bool -> Maybe Text -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
LP m Inlines -> Bool -> Maybe Text -> LP m Inlines
enquote LP m Inlines
tok Bool
False (Maybe Text -> LP m Inlines)
-> ([Tok] -> Maybe Text) -> [Tok] -> LP m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize)
  -- hypehnquote uses regular quotes
  , (Text
"hyphenquote*", LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> ([Tok] -> LP m Inlines) -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LP m Inlines -> Bool -> Maybe Text -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
LP m Inlines -> Bool -> Maybe Text -> LP m Inlines
enquote LP m Inlines
tok Bool
True (Maybe Text -> LP m Inlines)
-> ([Tok] -> Maybe Text) -> [Tok] -> LP m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize)
  , (Text
"hyphenquote", LP m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced LP m [Tok] -> ([Tok] -> LP m Inlines) -> LP m Inlines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LP m Inlines -> Bool -> Maybe Text -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
LP m Inlines -> Bool -> Maybe Text -> LP m Inlines
enquote LP m Inlines
tok Bool
False (Maybe Text -> LP m Inlines)
-> ([Tok] -> Maybe Text) -> [Tok] -> LP m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Tok] -> Text) -> [Tok] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok] -> Text
untokenize)
  ]

foreignlanguage :: PandocMonad m => LP m Inlines -> LP m Inlines
foreignlanguage :: LP m Inlines -> LP m Inlines
foreignlanguage LP m Inlines
tok = do
  Text
babelLang <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
  case Text -> Maybe Lang
babelLangToBCP47 Text
babelLang of
       Just Lang
lang -> Attr -> Inlines -> Inlines
spanWith (Text
"", [], [(Text
"lang",  Lang -> Text
renderLang Lang
lang)]) (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
tok
       Maybe Lang
_ -> LP m Inlines
tok

inlineLanguageCommands :: PandocMonad m
                       => LP m Inlines -> M.Map Text (LP m Inlines)
inlineLanguageCommands :: LP m Inlines -> Map Text (LP m Inlines)
inlineLanguageCommands LP m Inlines
tok =
  [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, LP m Inlines)] -> Map Text (LP m Inlines))
-> [(Text, LP m Inlines)] -> Map Text (LP m Inlines)
forall a b. (a -> b) -> a -> b
$
    (Text
"foreignlanguage", LP m Inlines -> LP m Inlines
forall (m :: * -> *). PandocMonad m => LP m Inlines -> LP m Inlines
foreignlanguage LP m Inlines
tok) (Text, LP m Inlines)
-> [(Text, LP m Inlines)] -> [(Text, LP m Inlines)]
forall a. a -> [a] -> [a]
:
    ((Text, Text -> Lang) -> (Text, LP m Inlines)
forall a.
(Semigroup a, IsString a) =>
(a, Text -> Lang) -> (a, LP m Inlines)
mk ((Text, Text -> Lang) -> (Text, LP m Inlines))
-> [(Text, Text -> Lang)] -> [(Text, LP m Inlines)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Text -> Lang) -> [(Text, Text -> Lang)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text (Text -> Lang)
polyglossiaLangToBCP47)
  where
    mk :: (a, Text -> Lang) -> (a, LP m Inlines)
mk (a
polyglossia, Text -> Lang
bcp47Func) =
      (a
"text" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
polyglossia, LP m Inlines -> (Text -> Lang) -> LP m Inlines
forall (m :: * -> *).
PandocMonad m =>
LP m Inlines -> (Text -> Lang) -> LP m Inlines
inlineLanguage LP m Inlines
tok Text -> Lang
bcp47Func)

inlineLanguage :: PandocMonad m
               => LP m Inlines -> (Text -> Lang) -> LP m Inlines
inlineLanguage :: LP m Inlines -> (Text -> Lang) -> LP m Inlines
inlineLanguage LP m Inlines
tok Text -> Lang
bcp47Func = do
  Text
o <- Text
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" (ParsecT [Tok] LaTeXState m Text
 -> ParsecT [Tok] LaTeXState m Text)
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.filter (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'[' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']')
                (Text -> Text)
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => LP m Text
rawopt
  let lang :: Text
lang = Lang -> Text
renderLang (Lang -> Text) -> Lang -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Lang
bcp47Func Text
o
  (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces (Attr -> Inlines -> Inlines
spanWith (Text
"", [], [(Text
"lang", Text
lang)])) (Inlines -> Inlines) -> LP m Inlines -> LP m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LP m Inlines
tok

setDefaultLanguage :: PandocMonad m => LP m Blocks
setDefaultLanguage :: LP m Blocks
setDefaultLanguage = do
  Text
o <- Text
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" (ParsecT [Tok] LaTeXState m Text
 -> ParsecT [Tok] LaTeXState m Text)
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.filter (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'[' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']')
                (Text -> Text)
-> ParsecT [Tok] LaTeXState m Text
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m Text
forall (m :: * -> *). PandocMonad m => LP m Text
rawopt
  Text
polylang <- [Tok] -> Text
untokenize ([Tok] -> Text)
-> ParsecT [Tok] LaTeXState m [Tok]
-> ParsecT [Tok] LaTeXState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] LaTeXState m [Tok]
forall (m :: * -> *). PandocMonad m => LP m [Tok]
braced
  case Text -> Map Text (Text -> Lang) -> Maybe (Text -> Lang)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
polylang Map Text (Text -> Lang)
polyglossiaLangToBCP47 of
       Maybe (Text -> Lang)
Nothing -> Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty -- TODO mzero? warning?
       Just Text -> Lang
langFunc -> do
         let l :: Lang
l = Text -> Lang
langFunc Text
o
         Lang -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *). PandocMonad m => Lang -> m ()
setTranslations Lang
l
         (LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ())
-> (LaTeXState -> LaTeXState) -> ParsecT [Tok] LaTeXState m ()
forall a b. (a -> b) -> a -> b
$ Text -> Inlines -> LaTeXState -> LaTeXState
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"lang" (Inlines -> LaTeXState -> LaTeXState)
-> Inlines -> LaTeXState -> LaTeXState
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Lang -> Text
renderLang Lang
l)
         Blocks -> LP m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty

polyglossiaLangToBCP47 :: M.Map T.Text (T.Text -> Lang)
polyglossiaLangToBCP47 :: Map Text (Text -> Lang)
polyglossiaLangToBCP47 = [(Text, Text -> Lang)] -> Map Text (Text -> Lang)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Text
"arabic", \Text
o -> case (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') Text
o of
       Text
"locale=algeria"    -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ar" Text
"" Text
"DZ" []
       Text
"locale=mashriq"    -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ar" Text
"" Text
"SY" []
       Text
"locale=libya"      -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ar" Text
"" Text
"LY" []
       Text
"locale=morocco"    -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ar" Text
"" Text
"MA" []
       Text
"locale=mauritania" -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ar" Text
"" Text
"MR" []
       Text
"locale=tunisia"    -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ar" Text
"" Text
"TN" []
       Text
_                   -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ar" Text
"" Text
"" [])
  , (Text
"german", \Text
o -> case (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') Text
o of
       Text
"spelling=old" -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"de" Text
"" Text
"DE" [Text
"1901"]
       Text
"variant=austrian,spelling=old"
                       -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"de" Text
"" Text
"AT" [Text
"1901"]
       Text
"variant=austrian" -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"de" Text
"" Text
"AT" []
       Text
"variant=swiss,spelling=old"
                       -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"de" Text
"" Text
"CH" [Text
"1901"]
       Text
"variant=swiss" -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"de" Text
"" Text
"CH" []
       Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"de" Text
"" Text
"" [])
  , (Text
"lsorbian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"dsb" Text
"" Text
"" [])
  , (Text
"greek", \Text
o -> case (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') Text
o of
       Text
"variant=poly"    -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"el" Text
"" Text
"polyton" []
       Text
"variant=ancient" -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"grc" Text
"" Text
"" []
       Text
_                 -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"el" Text
"" Text
"" [])
  , (Text
"english", \Text
o -> case (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') Text
o of
       Text
"variant=australian" -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"en" Text
"" Text
"AU" []
       Text
"variant=canadian"   -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"en" Text
"" Text
"CA" []
       Text
"variant=british"    -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"en" Text
"" Text
"GB" []
       Text
"variant=newzealand" -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"en" Text
"" Text
"NZ" []
       Text
"variant=american"   -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"en" Text
"" Text
"US" []
       Text
_                    -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"en" Text
"" Text
"" [])
  , (Text
"usorbian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"hsb" Text
"" Text
"" [])
  , (Text
"latin", \Text
o -> case (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') Text
o of
       Text
"variant=classic" -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"la" Text
"" Text
"" [Text
"x-classic"]
       Text
_                 -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"la" Text
"" Text
"" [])
  , (Text
"slovenian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"sl" Text
"" Text
"" [])
  , (Text
"serbianc", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"sr" Text
"cyrl" Text
"" [])
  , (Text
"pinyin", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"zh" Text
"Latn" Text
"" [Text
"pinyin"])
  , (Text
"afrikaans", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"af" Text
"" Text
"" [])
  , (Text
"amharic", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"am" Text
"" Text
"" [])
  , (Text
"assamese", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"as" Text
"" Text
"" [])
  , (Text
"asturian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ast" Text
"" Text
"" [])
  , (Text
"bulgarian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"bg" Text
"" Text
"" [])
  , (Text
"bengali", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"bn" Text
"" Text
"" [])
  , (Text
"tibetan", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"bo" Text
"" Text
"" [])
  , (Text
"breton", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"br" Text
"" Text
"" [])
  , (Text
"catalan", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ca" Text
"" Text
"" [])
  , (Text
"welsh", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"cy" Text
"" Text
"" [])
  , (Text
"czech", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"cs" Text
"" Text
"" [])
  , (Text
"coptic", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"cop" Text
"" Text
"" [])
  , (Text
"danish", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"da" Text
"" Text
"" [])
  , (Text
"divehi", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"dv" Text
"" Text
"" [])
  , (Text
"esperanto", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"eo" Text
"" Text
"" [])
  , (Text
"spanish", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"es" Text
"" Text
"" [])
  , (Text
"estonian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"et" Text
"" Text
"" [])
  , (Text
"basque", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"eu" Text
"" Text
"" [])
  , (Text
"farsi", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"fa" Text
"" Text
"" [])
  , (Text
"finnish", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"fi" Text
"" Text
"" [])
  , (Text
"french", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"fr" Text
"" Text
"" [])
  , (Text
"friulan", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"fur" Text
"" Text
"" [])
  , (Text
"irish", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ga" Text
"" Text
"" [])
  , (Text
"scottish", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"gd" Text
"" Text
"" [])
  , (Text
"ethiopic", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"gez" Text
"" Text
"" [])
  , (Text
"galician", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"gl" Text
"" Text
"" [])
  , (Text
"hebrew", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"he" Text
"" Text
"" [])
  , (Text
"hindi", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"hi" Text
"" Text
"" [])
  , (Text
"croatian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"hr" Text
"" Text
"" [])
  , (Text
"magyar", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"hu" Text
"" Text
"" [])
  , (Text
"armenian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"hy" Text
"" Text
"" [])
  , (Text
"interlingua", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ia" Text
"" Text
"" [])
  , (Text
"indonesian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"id" Text
"" Text
"" [])
  , (Text
"icelandic", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"is" Text
"" Text
"" [])
  , (Text
"italian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"it" Text
"" Text
"" [])
  , (Text
"japanese", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"jp" Text
"" Text
"" [])
  , (Text
"khmer", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"km" Text
"" Text
"" [])
  , (Text
"kurmanji", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"kmr" Text
"" Text
"" [])
  , (Text
"kannada", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"kn" Text
"" Text
"" [])
  , (Text
"korean", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ko" Text
"" Text
"" [])
  , (Text
"lao", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"lo" Text
"" Text
"" [])
  , (Text
"lithuanian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"lt" Text
"" Text
"" [])
  , (Text
"latvian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"lv" Text
"" Text
"" [])
  , (Text
"malayalam", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ml" Text
"" Text
"" [])
  , (Text
"mongolian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"mn" Text
"" Text
"" [])
  , (Text
"marathi", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"mr" Text
"" Text
"" [])
  , (Text
"dutch", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"nl" Text
"" Text
"" [])
  , (Text
"nynorsk", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"nn" Text
"" Text
"" [])
  , (Text
"norsk", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"no" Text
"" Text
"" [])
  , (Text
"nko", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"nqo" Text
"" Text
"" [])
  , (Text
"occitan", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"oc" Text
"" Text
"" [])
  , (Text
"panjabi", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"pa" Text
"" Text
"" [])
  , (Text
"polish", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"pl" Text
"" Text
"" [])
  , (Text
"piedmontese", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"pms" Text
"" Text
"" [])
  , (Text
"portuguese", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"pt" Text
"" Text
"" [])
  , (Text
"romansh", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"rm" Text
"" Text
"" [])
  , (Text
"romanian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ro" Text
"" Text
"" [])
  , (Text
"russian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ru" Text
"" Text
"" [])
  , (Text
"sanskrit", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"sa" Text
"" Text
"" [])
  , (Text
"samin", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"se" Text
"" Text
"" [])
  , (Text
"slovak", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"sk" Text
"" Text
"" [])
  , (Text
"albanian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"sq" Text
"" Text
"" [])
  , (Text
"serbian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"sr" Text
"" Text
"" [])
  , (Text
"swedish", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"sv" Text
"" Text
"" [])
  , (Text
"syriac", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"syr" Text
"" Text
"" [])
  , (Text
"tamil", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ta" Text
"" Text
"" [])
  , (Text
"telugu", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"te" Text
"" Text
"" [])
  , (Text
"thai", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"th" Text
"" Text
"" [])
  , (Text
"turkmen", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"tk" Text
"" Text
"" [])
  , (Text
"turkish", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"tr" Text
"" Text
"" [])
  , (Text
"ukrainian", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"uk" Text
"" Text
"" [])
  , (Text
"urdu", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"ur" Text
"" Text
"" [])
  , (Text
"vietnamese", \Text
_ -> Text -> Text -> Text -> [Text] -> Lang
Lang Text
"vi" Text
"" Text
"" [])
  ]

babelLangToBCP47 :: T.Text -> Maybe Lang
babelLangToBCP47 :: Text -> Maybe Lang
babelLangToBCP47 Text
s =
  case Text
s of
       Text
"austrian" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"de" Text
"" Text
"AT" [Text
"1901"]
       Text
"naustrian" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"de" Text
"" Text
"AT" []
       Text
"swissgerman" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"de" Text
"" Text
"CH" [Text
"1901"]
       Text
"nswissgerman" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"de" Text
"" Text
"CH" []
       Text
"german" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"de" Text
"" Text
"DE" [Text
"1901"]
       Text
"ngerman" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"de" Text
"" Text
"DE" []
       Text
"lowersorbian" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"dsb" Text
"" Text
"" []
       Text
"uppersorbian" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"hsb" Text
"" Text
"" []
       Text
"polutonikogreek" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"el" Text
"" Text
"" [Text
"polyton"]
       Text
"slovene" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"sl" Text
"" Text
"" []
       Text
"australian" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"en" Text
"" Text
"AU" []
       Text
"canadian" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"en" Text
"" Text
"CA" []
       Text
"british" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"en" Text
"" Text
"GB" []
       Text
"newzealand" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"en" Text
"" Text
"NZ" []
       Text
"american" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"en" Text
"" Text
"US" []
       Text
"classiclatin" -> Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [Text] -> Lang
Lang Text
"la" Text
"" Text
"" [Text
"x-classic"]
       Text
_ -> ((Text -> Lang) -> Text -> Lang
forall a b. (a -> b) -> a -> b
$ Text
"") ((Text -> Lang) -> Lang) -> Maybe (Text -> Lang) -> Maybe Lang
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text (Text -> Lang) -> Maybe (Text -> Lang)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
s Map Text (Text -> Lang)
polyglossiaLangToBCP47