diff options
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r-- | src/Text/Pandoc/BCP47.hs | 26 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/ConTeXt.hs | 67 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 6 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/ODT.hs | 4 |
4 files changed, 55 insertions, 48 deletions
diff --git a/src/Text/Pandoc/BCP47.hs b/src/Text/Pandoc/BCP47.hs index 956130fb7..16dd3a032 100644 --- a/src/Text/Pandoc/BCP47.hs +++ b/src/Text/Pandoc/BCP47.hs @@ -29,6 +29,7 @@ Functions for parsing and rendering BCP47 language identifiers. -} module Text.Pandoc.BCP47 ( getLang + , toLang , parseBCP47 , Lang(..) , renderLang @@ -56,21 +57,26 @@ renderLang lang = intercalate "-" (langLanguage lang : filter (not . null) ([langScript lang, langRegion lang] ++ langVariants lang)) -- | Get the contents of the `lang` metadata field or variable. -getLang :: PandocMonad m => WriterOptions -> Meta -> m (Maybe Lang) -getLang opts meta = case - (case lookup "lang" (writerVariables opts) of +getLang :: WriterOptions -> Meta -> Maybe String +getLang opts meta = + case lookup "lang" (writerVariables opts) of Just s -> Just s _ -> case lookupMeta "lang" meta of Just (MetaInlines [Str s]) -> Just s Just (MetaString s) -> Just s - _ -> Nothing) of - Nothing -> return Nothing - Just s -> case parseBCP47 s of - Left _ -> do - report $ InvalidLang s - return Nothing - Right l -> return (Just l) + _ -> Nothing + +-- | Convert BCP47 string to a Lang, issuing warning +-- if there are problems. +toLang :: PandocMonad m => Maybe String -> m (Maybe Lang) +toLang Nothing = return Nothing +toLang (Just s) = + case parseBCP47 s of + Left _ -> do + report $ InvalidLang s + return Nothing + Right l -> return (Just l) -- | Parse a BCP 47 string as a Lang. parseBCP47 :: String -> Either String Lang diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index ae6cb482f..7886bc052 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -89,7 +89,7 @@ pandocToConTeXt options (Pandoc meta blocks) = do ,("top","margin-top") ,("bottom","margin-bottom") ] - lang <- maybe "" fromBCP47 <$> getLang options meta + mblang <- fromBCP47 (getLang options meta) let context = defField "toc" (writerTableOfContents options) $ defField "placelist" (intercalate ("," :: String) $ take (writerTOCDepth options + @@ -102,7 +102,7 @@ pandocToConTeXt options (Pandoc meta blocks) = do $ defField "body" main $ defField "layout" layoutFromMargins $ defField "number-sections" (writerNumberSections options) - $ defField "context-lang" lang + $ maybe id (defField "context-lang") mblang $ metadata let context' = defField "context-dir" (toContextDir $ getField "dir" context) context @@ -187,6 +187,7 @@ blockToConTeXt b@(RawBlock _ _ ) = do return empty blockToConTeXt (Div (ident,_,kvs) bs) = do let align dir txt = "\\startalignment[" <> dir <> "]" $$ txt $$ "\\stopalignment" + mblang <- fromBCP47 (lookup "lang" kvs) let wrapRef txt = if null ident then txt else ("\\reference" <> brackets (text $ toLabel ident) <> @@ -195,9 +196,9 @@ blockToConTeXt (Div (ident,_,kvs) bs) = do Just "rtl" -> align "righttoleft" Just "ltr" -> align "lefttoright" _ -> id - wrapLang txt = case lookup "lang" kvs of + wrapLang txt = case mblang of Just lng -> "\\start\\language[" - <> text (fromBCP47' lng) <> "]" $$ txt $$ "\\stop" + <> text lng <> "]" $$ txt $$ "\\stop" Nothing -> txt wrapBlank txt = blankline <> txt <> blankline fmap (wrapBlank . wrapLang . wrapDir . wrapRef) $ blockListToConTeXt bs @@ -417,12 +418,13 @@ inlineToConTeXt (Note contents) = do else text "\\startbuffer " <> nest 2 contents' <> text "\\stopbuffer\\footnote{\\getbuffer}" inlineToConTeXt (Span (_,_,kvs) ils) = do + mblang <- fromBCP47 (lookup "lang" kvs) let wrapDir txt = case lookup "dir" kvs of Just "rtl" -> braces $ "\\righttoleft " <> txt Just "ltr" -> braces $ "\\lefttoright " <> txt _ -> txt - wrapLang txt = case lookup "lang" kvs of - Just lng -> "\\start\\language[" <> text (fromBCP47' lng) + wrapLang txt = case mblang of + Just lng -> "\\start\\language[" <> text lng <> "]" <> txt <> "\\stop " Nothing -> txt fmap (wrapLang . wrapDir) $ inlineListToConTeXt ils @@ -459,35 +461,34 @@ sectionHeader (ident,classes,_) hdrLevel lst = do <> blankline _ -> contents <> blankline -fromBCP47' :: String -> String -fromBCP47' s = case parseBCP47 s of - Right r -> fromBCP47 r - Left _ -> "" +fromBCP47 :: PandocMonad m => Maybe String -> WM m (Maybe String) +fromBCP47 mbs = fromBCP47' <$> toLang mbs -- Takes a list of the constituents of a BCP 47 language code -- and irons out ConTeXt's exceptions -- https://tools.ietf.org/html/bcp47#section-2.1 -- http://wiki.contextgarden.net/Language_Codes -fromBCP47 :: Lang -> String -fromBCP47 (Lang "ar" _ "SY" _) = "ar-sy" -fromBCP47 (Lang "ar" _ "IQ" _) = "ar-iq" -fromBCP47 (Lang "ar" _ "JO" _) = "ar-jo" -fromBCP47 (Lang "ar" _ "LB" _) = "ar-lb" -fromBCP47 (Lang "ar" _ "DZ" _) = "ar-dz" -fromBCP47 (Lang "ar" _ "MA" _) = "ar-ma" -fromBCP47 (Lang "de" _ _ ["1901"]) = "deo" -fromBCP47 (Lang "de" _ "DE" _) = "de-de" -fromBCP47 (Lang "de" _ "AT" _) = "de-at" -fromBCP47 (Lang "de" _ "CH" _) = "de-ch" -fromBCP47 (Lang "el" _ _ ["poly"]) = "agr" -fromBCP47 (Lang "en" _ "US" _) = "en-us" -fromBCP47 (Lang "en" _ "GB" _) = "en-gb" -fromBCP47 (Lang "grc"_ _ _) = "agr" -fromBCP47 (Lang "el" _ _ _) = "gr" -fromBCP47 (Lang "eu" _ _ _) = "ba" -fromBCP47 (Lang "he" _ _ _) = "il" -fromBCP47 (Lang "jp" _ _ _) = "ja" -fromBCP47 (Lang "uk" _ _ _) = "ua" -fromBCP47 (Lang "vi" _ _ _) = "vn" -fromBCP47 (Lang "zh" _ _ _) = "cn" -fromBCP47 (Lang l _ _ _) = l +fromBCP47' :: Maybe Lang -> Maybe String +fromBCP47' (Just (Lang "ar" _ "SY" _) ) = Just "ar-sy" +fromBCP47' (Just (Lang "ar" _ "IQ" _) ) = Just "ar-iq" +fromBCP47' (Just (Lang "ar" _ "JO" _) ) = Just "ar-jo" +fromBCP47' (Just (Lang "ar" _ "LB" _) ) = Just "ar-lb" +fromBCP47' (Just (Lang "ar" _ "DZ" _) ) = Just "ar-dz" +fromBCP47' (Just (Lang "ar" _ "MA" _) ) = Just "ar-ma" +fromBCP47' (Just (Lang "de" _ _ ["1901"]) ) = Just "deo" +fromBCP47' (Just (Lang "de" _ "DE" _) ) = Just "de-de" +fromBCP47' (Just (Lang "de" _ "AT" _) ) = Just "de-at" +fromBCP47' (Just (Lang "de" _ "CH" _) ) = Just "de-ch" +fromBCP47' (Just (Lang "el" _ _ ["poly"]) ) = Just "agr" +fromBCP47' (Just (Lang "en" _ "US" _) ) = Just "en-us" +fromBCP47' (Just (Lang "en" _ "GB" _) ) = Just "en-gb" +fromBCP47' (Just (Lang "grc"_ _ _) ) = Just "agr" +fromBCP47' (Just (Lang "el" _ _ _) ) = Just "gr" +fromBCP47' (Just (Lang "eu" _ _ _) ) = Just "ba" +fromBCP47' (Just (Lang "he" _ _ _) ) = Just "il" +fromBCP47' (Just (Lang "jp" _ _ _) ) = Just "ja" +fromBCP47' (Just (Lang "uk" _ _ _) ) = Just "ua" +fromBCP47' (Just (Lang "vi" _ _ _) ) = Just "vn" +fromBCP47' (Just (Lang "zh" _ _ _) ) = Just "cn" +fromBCP47' (Just (Lang l _ _ _) ) = Just l +fromBCP47' Nothing = Nothing diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index bc8568cd1..06318b20c 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -68,7 +68,7 @@ import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Walk import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Shared (fixDisplayMath) -import Text.Pandoc.BCP47 (getLang, renderLang) +import Text.Pandoc.BCP47 (getLang, renderLang, toLang) import Text.Printf (printf) import Text.TeXMath import Text.XML.Light as XML @@ -258,9 +258,9 @@ writeDocx opts doc@(Pandoc meta _) = do ) -- styles - lang <- getLang opts meta + mblang <- toLang $ getLang opts meta let addLang :: Element -> Element - addLang e = case lang >>= \l -> + addLang e = case mblang >>= \l -> (return . XMLC.toTree . go (renderLang l) . XMLC.fromElement) e of Just (Elem e') -> e' diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 98aa3b30b..785891a9f 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -51,7 +51,7 @@ import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toStringLazy) import Text.Pandoc.Walk import Text.Pandoc.Writers.OpenDocument (writeOpenDocument) import Text.Pandoc.Writers.Shared (fixDisplayMath) -import Text.Pandoc.BCP47 (getLang, Lang(..), renderLang) +import Text.Pandoc.BCP47 (getLang, toLang, Lang(..), renderLang) import Text.Pandoc.XML import Text.TeXMath import Text.XML.Light @@ -80,7 +80,7 @@ pandocToODT :: PandocMonad m pandocToODT opts doc@(Pandoc meta _) = do let datadir = writerUserDataDir opts let title = docTitle meta - lang <- getLang opts meta + lang <- toLang (getLang opts meta) refArchive <- case writerReferenceDoc opts of Just f -> liftM toArchive $ lift $ P.readFileLazy f |