git.iko.soy/typeable/pandoc
on master help sign in
Refactored ConTeXt writer to use BCP47.

BCP47 - consistent case for BCP47 fields (e.g. uppercase for region).

commitd0d2443f2e069c9aa4510579f10ed8fe0b5f20ab authorJohn MacFarlane <jgm@berkeley.edu> dateSun 25 Jun 2017, 21:56 (9 years ago) parentac9423e
2 files changed+39−39
compare with master
unifiedsplit
src/Text/Pandoc/BCP47.hs+5−5 src/Text/Pandoc/Writers/ConTeXt.hs+34−34
src/Text/Pandoc/BCP47.hs+5−5
@@ -35,7 +35,7 @@ module Text.Pandoc.BCP47 (
3535 )
3636where
3737import Control.Monad (guard)
38−import Data.Char (isAscii, isLetter, isUpper, isLower)
38+import Data.Char (isAscii, isLetter, isUpper, isLower, toUpper, toLower)
3939import Data.List (intercalate)
4040import Text.Pandoc.Definition
4141import Text.Pandoc.Class (PandocMonad, report)
@@ -93,19 +93,19 @@ parseBCP47 lang =
9393 cs <- P.many1 asciiLetter
9494 let lcs = length cs
9595 guard $ lcs == 2 || lcs == 3
96− return cs
96+ return $ map toLower cs
9797 pScript = P.try $ do
9898 P.char '-'
9999 x <- P.satisfy (\c -> isAscii c && isLetter c && isUpper c)
100100 xs <- P.count 3
101101 (P.satisfy (\c -> isAscii c && isLetter c && isLower c))
102− return (x:xs)
102+ return $ map toLower (x:xs)
103103 pRegion = P.try $ do
104104 P.char '-'
105105 cs <- P.many1 asciiLetter
106106 let lcs = length cs
107107 guard $ lcs == 2 || lcs == 3
108− return cs
108+ return $ map toUpper cs
109109 pVariant = P.try $ do
110110 P.char '-'
111111 ds <- P.option "" (P.count 1 P.digit)
@@ -114,4 +114,4 @@ parseBCP47 lang =
114114 guard $ if null ds
115115 then length var >= 5 && length var <= 8
116116 else length var == 4
117− return var
117+ return $ map toLower var
src/Text/Pandoc/Writers/ConTeXt.hs+34−34
@@ -35,6 +35,7 @@ import Data.List (intercalate, intersperse)
3535import Data.Maybe (catMaybes)
3636import Data.Text (Text)
3737import Network.URI (unEscapeString)
38+import Text.Pandoc.BCP47
3839import Text.Pandoc.Class (PandocMonad, report)
3940import Text.Pandoc.Logging
4041import Text.Pandoc.Definition
@@ -88,6 +89,7 @@ pandocToConTeXt options (Pandoc meta blocks) = do
8889 ,("top","margin-top")
8990 ,("bottom","margin-bottom")
9091 ]
92+ lang <- maybe "" fromBCP47 <$> getLang options meta
9193 let context = defField "toc" (writerTableOfContents options)
9294 $ defField "placelist" (intercalate ("," :: String) $
9395 take (writerTOCDepth options +
@@ -100,11 +102,10 @@ pandocToConTeXt options (Pandoc meta blocks) = do
100102 $ defField "body" main
101103 $ defField "layout" layoutFromMargins
102104 $ defField "number-sections" (writerNumberSections options)
105+ $ defField "context-lang" lang
103106 $ metadata
104− let context' = defField "context-lang" (maybe "" (fromBcp47 . splitBy (=='-')) $
105− getField "lang" context)
106− $ defField "context-dir" (toContextDir $ getField "dir" context)
107− $ context
107+ let context' = defField "context-dir" (toContextDir
108+ $ getField "dir" context) context
108109 case writerTemplate options of
109110 Nothing -> return main
110111 Just tpl -> renderTemplate' tpl context'
@@ -196,7 +197,7 @@ blockToConTeXt (Div (ident,_,kvs) bs) = do
196197 _ -> id
197198 wrapLang txt = case lookup "lang" kvs of
198199 Just lng -> "\\start\\language["
199− <> text (fromBcp47' lng) <> "]" $$ txt $$ "\\stop"
200+ <> text (fromBCP47' lng) <> "]" $$ txt $$ "\\stop"
200201 Nothing -> txt
201202 wrapBlank txt = blankline <> txt <> blankline
202203 fmap (wrapBlank . wrapLang . wrapDir . wrapRef) $ blockListToConTeXt bs
@@ -421,7 +422,7 @@ inlineToConTeXt (Span (_,_,kvs) ils) = do
421422 Just "ltr" -> braces $ "\\lefttoright " <> txt
422423 _ -> txt
423424 wrapLang txt = case lookup "lang" kvs of
424− Just lng -> "\\start\\language[" <> text (fromBcp47' lng)
425+ Just lng -> "\\start\\language[" <> text (fromBCP47' lng)
425426 <> "]" <> txt <> "\\stop "
426427 Nothing -> txt
427428 fmap (wrapLang . wrapDir) $ inlineListToConTeXt ils
@@ -458,36 +459,35 @@ sectionHeader (ident,classes,_) hdrLevel lst = do
458459 <> blankline
459460 _ -> contents <> blankline
460461
461−fromBcp47' :: String -> String
462−fromBcp47' = fromBcp47 . splitBy (=='-')
462+fromBCP47' :: String -> String
463+fromBCP47' s = case parseBCP47 s of
464+ Right r -> fromBCP47 r
465+ Left _ -> ""
463466
464467-- Takes a list of the constituents of a BCP 47 language code
465468-- and irons out ConTeXt's exceptions
466469-- https://tools.ietf.org/html/bcp47#section-2.1
467470-- http://wiki.contextgarden.net/Language_Codes
468−fromBcp47 :: [String] -> String
469−fromBcp47 [] = ""
470−fromBcp47 ("ar":"SY":_) = "ar-sy"
471−fromBcp47 ("ar":"IQ":_) = "ar-iq"
472−fromBcp47 ("ar":"JO":_) = "ar-jo"
473−fromBcp47 ("ar":"LB":_) = "ar-lb"
474−fromBcp47 ("ar":"DZ":_) = "ar-dz"
475−fromBcp47 ("ar":"MA":_) = "ar-ma"
476−fromBcp47 ("de":"1901":_) = "deo"
477−fromBcp47 ("de":"DE":_) = "de-de"
478−fromBcp47 ("de":"AT":_) = "de-at"
479−fromBcp47 ("de":"CH":_) = "de-ch"
480−fromBcp47 ("el":"poly":_) = "agr"
481−fromBcp47 ("en":"US":_) = "en-us"
482−fromBcp47 ("en":"GB":_) = "en-gb"
483−fromBcp47 ("grc":_) = "agr"
484−fromBcp47 x = fromIso $ head x
485− where
486− fromIso "el" = "gr"
487− fromIso "eu" = "ba"
488− fromIso "he" = "il"
489− fromIso "jp" = "ja"
490− fromIso "uk" = "ua"
491− fromIso "vi" = "vn"
492− fromIso "zh" = "cn"
493− fromIso l = l
471+fromBCP47 :: Lang -> String
472+fromBCP47 (Lang "ar" _ "SY" _) = "ar-sy"
473+fromBCP47 (Lang "ar" _ "IQ" _) = "ar-iq"
474+fromBCP47 (Lang "ar" _ "JO" _) = "ar-jo"
475+fromBCP47 (Lang "ar" _ "LB" _) = "ar-lb"
476+fromBCP47 (Lang "ar" _ "DZ" _) = "ar-dz"
477+fromBCP47 (Lang "ar" _ "MA" _) = "ar-ma"
478+fromBCP47 (Lang "de" _ _ ["1901"]) = "deo"
479+fromBCP47 (Lang "de" _ "DE" _) = "de-de"
480+fromBCP47 (Lang "de" _ "AT" _) = "de-at"
481+fromBCP47 (Lang "de" _ "CH" _) = "de-ch"
482+fromBCP47 (Lang "el" _ _ ["poly"]) = "agr"
483+fromBCP47 (Lang "en" _ "US" _) = "en-us"
484+fromBCP47 (Lang "en" _ "GB" _) = "en-gb"
485+fromBCP47 (Lang "grc"_ _ _) = "agr"
486+fromBCP47 (Lang "el" _ _ _) = "gr"
487+fromBCP47 (Lang "eu" _ _ _) = "ba"
488+fromBCP47 (Lang "he" _ _ _) = "il"
489+fromBCP47 (Lang "jp" _ _ _) = "ja"
490+fromBCP47 (Lang "uk" _ _ _) = "ua"
491+fromBCP47 (Lang "vi" _ _ _) = "vn"
492+fromBCP47 (Lang "zh" _ _ _) = "cn"
493+fromBCP47 (Lang l _ _ _) = l