aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs8
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs26
-rw-r--r--src/Text/Pandoc/Writers/OpenDocument.hs22
-rw-r--r--src/Text/Pandoc/Writers/Shared.hs35
4 files changed, 55 insertions, 36 deletions
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index d93b99486..52ababb14 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -67,7 +67,7 @@ import Text.Pandoc.Shared hiding (Element)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Math
-import Text.Pandoc.Writers.Shared (fixDisplayMath, getLang)
+import Text.Pandoc.Writers.Shared (fixDisplayMath, getLang, renderLang)
import Text.Printf (printf)
import Text.TeXMath
import Text.XML.Light as XML
@@ -257,9 +257,11 @@ writeDocx opts doc@(Pandoc meta _) = do
)
-- styles
- let lang = getLang opts meta
+ lang <- getLang opts meta
let addLang :: Element -> Element
- addLang e = case lang >>= \l -> (return . XMLC.toTree . go l . XMLC.fromElement) e of
+ addLang e = case lang >>= \l ->
+ (return . XMLC.toTree . go (renderLang l)
+ . XMLC.fromElement) e of
Just (Elem e') -> e'
_ -> e -- return original
where go :: String -> Cursor -> Cursor
diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index dff4f8fcf..8573f5719 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -50,7 +50,8 @@ import Text.Pandoc.Shared (stringify)
import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toStringLazy)
import Text.Pandoc.Walk
import Text.Pandoc.Writers.OpenDocument (writeOpenDocument)
-import Text.Pandoc.Writers.Shared (fixDisplayMath, getLang, splitLang)
+import Text.Pandoc.Writers.Shared (fixDisplayMath, getLang, Lang(..),
+ renderLang)
import Text.Pandoc.XML
import Text.TeXMath
import Text.XML.Light
@@ -79,7 +80,7 @@ pandocToODT :: PandocMonad m
pandocToODT opts doc@(Pandoc meta _) = do
let datadir = writerUserDataDir opts
let title = docTitle meta
- let lang = getLang opts meta
+ lang <- getLang opts meta
refArchive <-
case writerReferenceDoc opts of
Just f -> liftM toArchive $ lift $ P.readFileLazy f
@@ -140,7 +141,7 @@ pandocToODT opts doc@(Pandoc meta _) = do
$$
case lang of
Just l -> inTagsSimple "dc:language"
- (text (escapeStringForXML l))
+ (text (escapeStringForXML (renderLang l)))
Nothing -> empty
)
)
@@ -153,10 +154,9 @@ pandocToODT opts doc@(Pandoc meta _) = do
$ addEntryToArchive metaEntry archive'
return $ fromArchive archive''
-updateStyleWithLang :: PandocMonad m => Maybe String -> Archive -> O m Archive
+updateStyleWithLang :: PandocMonad m => Maybe Lang -> Archive -> O m Archive
updateStyleWithLang Nothing arch = return arch
-updateStyleWithLang (Just l) arch = do
- (mblang, mbcountry) <- splitLang l
+updateStyleWithLang (Just lang) arch = do
epochtime <- floor `fmap` (lift P.getPOSIXTime)
return arch{ zEntries = [if eRelativePath e == "styles.xml"
then case parseXMLDoc
@@ -166,16 +166,16 @@ updateStyleWithLang (Just l) arch = do
toEntry "styles.xml" epochtime
( fromStringLazy
. ppTopElement
- . addLang mblang mbcountry $ d )
+ . addLang lang $ d )
else e
| e <- zEntries arch] }
-addLang :: Maybe String -> Maybe String -> Element -> Element
-addLang mblang mbcountry = everywhere' (mkT updateLangAttr)
- where updateLangAttr (Attr n@(QName "language" _ (Just "fo")) l)
- = Attr n (maybe l id mblang)
- updateLangAttr (Attr n@(QName "country" _ (Just "fo")) c)
- = Attr n (maybe c id mbcountry)
+addLang :: Lang -> Element -> Element
+addLang (Lang lang country) = everywhere' (mkT updateLangAttr)
+ where updateLangAttr (Attr n@(QName "language" _ (Just "fo")) _)
+ = Attr n lang
+ updateLangAttr (Attr n@(QName "country" _ (Just "fo")) _)
+ = Attr n country
updateLangAttr x = x
-- | transform both Image and Math elements
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs
index 3a720acdc..57f3c1194 100644
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ b/src/Text/Pandoc/Writers/OpenDocument.hs
@@ -36,7 +36,6 @@ import Control.Arrow ((***), (>>>))
import Control.Monad.State.Strict hiding (when)
import Data.Char (chr)
import Data.List (sortBy)
-import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Map as Map
import Data.Ord (comparing)
@@ -608,8 +607,14 @@ paraTableStyles t s (a:xs)
[ ("fo:text-align", x)
, ("style:justify-single-word", "false")]
-data TextStyle = Italic | Bold | Strike | Sub | Sup | SmallC | Pre
- | Lang String String
+data TextStyle = Italic
+ | Bold
+ | Strike
+ | Sub
+ | Sup
+ | SmallC
+ | Pre
+ | Language String String
deriving ( Eq,Ord )
textStyleAttr :: TextStyle -> [(String,String)]
@@ -627,7 +632,7 @@ textStyleAttr s
| Pre <- s = [("style:font-name" ,"Courier New")
,("style:font-name-asian" ,"Courier New")
,("style:font-name-complex" ,"Courier New")]
- | Lang lang country <- s
+ | Language lang country <- s
= [("fo:language" ,lang)
,("fo:country" ,country)]
| otherwise = []
@@ -637,9 +642,8 @@ withLangFromAttr (_,_,kvs) action =
case lookup "lang" kvs of
Nothing -> action
Just l -> do
- (mblang, mbcountry) <- splitLang l
- case (mblang, mbcountry) of
- (Just lang, _) -> withTextStyle
- (Lang lang (fromMaybe "" mbcountry))
- action
+ mblang <- parseBCP47 l
+ case mblang of
+ Just (Lang lang country) -> withTextStyle
+ (Language lang country) action
_ -> action
diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index 0b35d27f6..efb553ac2 100644
--- a/src/Text/Pandoc/Writers/Shared.hs
+++ b/src/Text/Pandoc/Writers/Shared.hs
@@ -30,7 +30,9 @@ Shared utility functions for pandoc writers.
-}
module Text.Pandoc.Writers.Shared (
getLang
- , splitLang
+ , parseBCP47
+ , Lang(..)
+ , renderLang
, metaToJSON
, metaToJSON'
, addVariablesToJSON
@@ -62,30 +64,41 @@ import Text.Pandoc.Shared (splitBy)
import Text.Pandoc.UTF8 (toStringLazy)
import Text.Pandoc.XML (escapeStringForXML)
+-- | Represents BCP 47 language/country code.
+data Lang = Lang String String
+
+-- | Render a Lang as BCP 47.
+renderLang :: Lang -> String
+renderLang (Lang la co) = la ++ if null co
+ then ""
+ else '-':co
+
-- | Get the contents of the `lang` metadata field or variable.
-getLang :: WriterOptions -> Meta -> Maybe String
-getLang opts meta =
- lookup "lang" (writerVariables opts)
+getLang :: PandocMonad m => WriterOptions -> Meta -> m (Maybe Lang)
+getLang opts meta = maybe (return Nothing) parseBCP47 $
+ case lookup "lang" (writerVariables opts) of
+ Just s -> Just s
+ _ -> Nothing
`mplus`
case lookupMeta "lang" meta of
Just (MetaInlines [Str s]) -> Just s
Just (MetaString s) -> Just s
_ -> Nothing
--- | Split `lang` field into lang and country, issuing warning
--- if it doesn't look valid.
-splitLang :: PandocMonad m => String -> m (Maybe String, Maybe String)
-splitLang lang =
+-- | Parse a BCP 47 string as a Lang, issuing a warning if there
+-- are issues.
+parseBCP47 :: PandocMonad m => String -> m (Maybe Lang)
+parseBCP47 lang =
case splitBy (== '-') lang of
[la,co]
| length la == 2 && length co == 2
- -> return (Just la, Just co)
+ -> return $ Just $ Lang la co
[la]
| length la == 2
- -> return (Just la, Nothing)
+ -> return $ Just $ Lang la ""
_ -> do
report $ InvalidLang lang
- return (Nothing, Nothing)
+ return Nothing
-- | Create JSON value for template from a 'Meta' and an association list
-- of variables, specified at the command line or in the writer.
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 23:04:39 +0000