git.iko.soy/typeable/pandoc
on master help sign in
Writers.Shared: refactored getLang, splitLang...

into `Lang(..)`, `getLang`, `parceBCP47`.

commite7cd3cb4668b119b61eb69eed857b0254a614ad9 authorJohn MacFarlane <jgm@berkeley.edu> dateSun 25 Jun 2017, 15:36 (9 years ago) parent3ae4105
4 files changed+55−36
compare with master
unifiedsplit
src/Text/Pandoc/Writers/Docx.hs+5−3 src/Text/Pandoc/Writers/ODT.hs+13−13 src/Text/Pandoc/Writers/OpenDocument.hs+13−9 src/Text/Pandoc/Writers/Shared.hs+24−11
src/Text/Pandoc/Writers/Docx.hs+5−3
@@ -67,7 +67,7 @@ import Text.Pandoc.Shared hiding (Element)
6767import qualified Text.Pandoc.UTF8 as UTF8
6868import Text.Pandoc.Walk
6969import Text.Pandoc.Writers.Math
70−import Text.Pandoc.Writers.Shared (fixDisplayMath, getLang)
70+import Text.Pandoc.Writers.Shared (fixDisplayMath, getLang, renderLang)
7171import Text.Printf (printf)
7272import Text.TeXMath
7373import Text.XML.Light as XML
@@ -257,9 +257,11 @@ writeDocx opts doc@(Pandoc meta _) = do
257257 )
258258
259259 -- styles
260− let lang = getLang opts meta
260+ lang <- getLang opts meta
261261 let addLang :: Element -> Element
262− addLang e = case lang >>= \l -> (return . XMLC.toTree . go l . XMLC.fromElement) e of
262+ addLang e = case lang >>= \l ->
263+ (return . XMLC.toTree . go (renderLang l)
264+ . XMLC.fromElement) e of
263265 Just (Elem e') -> e'
264266 _ -> e -- return original
265267 where go :: String -> Cursor -> Cursor
src/Text/Pandoc/Writers/ODT.hs+13−13
@@ -50,7 +50,8 @@ import Text.Pandoc.Shared (stringify)
5050import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toStringLazy)
5151import Text.Pandoc.Walk
5252import Text.Pandoc.Writers.OpenDocument (writeOpenDocument)
53−import Text.Pandoc.Writers.Shared (fixDisplayMath, getLang, splitLang)
53+import Text.Pandoc.Writers.Shared (fixDisplayMath, getLang, Lang(..),
54+ renderLang)
5455import Text.Pandoc.XML
5556import Text.TeXMath
5657import Text.XML.Light
@@ -79,7 +80,7 @@ pandocToODT :: PandocMonad m
7980pandocToODT opts doc@(Pandoc meta _) = do
8081 let datadir = writerUserDataDir opts
8182 let title = docTitle meta
82− let lang = getLang opts meta
83+ lang <- getLang opts meta
8384 refArchive <-
8485 case writerReferenceDoc opts of
8586 Just f -> liftM toArchive $ lift $ P.readFileLazy f
@@ -140,7 +141,7 @@ pandocToODT opts doc@(Pandoc meta _) = do
140141 $$
141142 case lang of
142143 Just l -> inTagsSimple "dc:language"
143− (text (escapeStringForXML l))
144+ (text (escapeStringForXML (renderLang l)))
144145 Nothing -> empty
145146 )
146147 )
@@ -153,10 +154,9 @@ pandocToODT opts doc@(Pandoc meta _) = do
153154 $ addEntryToArchive metaEntry archive'
154155 return $ fromArchive archive''
155156
156−updateStyleWithLang :: PandocMonad m => Maybe String -> Archive -> O m Archive
157+updateStyleWithLang :: PandocMonad m => Maybe Lang -> Archive -> O m Archive
157158updateStyleWithLang Nothing arch = return arch
158−updateStyleWithLang (Just l) arch = do
159− (mblang, mbcountry) <- splitLang l
159+updateStyleWithLang (Just lang) arch = do
160160 epochtime <- floor `fmap` (lift P.getPOSIXTime)
161161 return arch{ zEntries = [if eRelativePath e == "styles.xml"
162162 then case parseXMLDoc
@@ -166,16 +166,16 @@ updateStyleWithLang (Just l) arch = do
166166 toEntry "styles.xml" epochtime
167167 ( fromStringLazy
168168 . ppTopElement
169− . addLang mblang mbcountry $ d )
169+ . addLang lang $ d )
170170 else e
171171 | e <- zEntries arch] }
172172
173−addLang :: Maybe String -> Maybe String -> Element -> Element
174−addLang mblang mbcountry = everywhere' (mkT updateLangAttr)
175− where updateLangAttr (Attr n@(QName "language" _ (Just "fo")) l)
176− = Attr n (maybe l id mblang)
177− updateLangAttr (Attr n@(QName "country" _ (Just "fo")) c)
178− = Attr n (maybe c id mbcountry)
173+addLang :: Lang -> Element -> Element
174+addLang (Lang lang country) = everywhere' (mkT updateLangAttr)
175+ where updateLangAttr (Attr n@(QName "language" _ (Just "fo")) _)
176+ = Attr n lang
177+ updateLangAttr (Attr n@(QName "country" _ (Just "fo")) _)
178+ = Attr n country
179179 updateLangAttr x = x
180180
181181-- | transform both Image and Math elements
src/Text/Pandoc/Writers/OpenDocument.hs+13−9
@@ -36,7 +36,6 @@ import Control.Arrow ((***), (>>>))
3636import Control.Monad.State.Strict hiding (when)
3737import Data.Char (chr)
3838import Data.List (sortBy)
39−import Data.Maybe (fromMaybe)
4039import Data.Text (Text)
4140import qualified Data.Map as Map
4241import Data.Ord (comparing)
@@ -608,8 +607,14 @@ paraTableStyles t s (a:xs)
608607 [ ("fo:text-align", x)
609608 , ("style:justify-single-word", "false")]
610609
611−data TextStyle = Italic | Bold | Strike | Sub | Sup | SmallC | Pre
612− | Lang String String
610+data TextStyle = Italic
611+ | Bold
612+ | Strike
613+ | Sub
614+ | Sup
615+ | SmallC
616+ | Pre
617+ | Language String String
613618 deriving ( Eq,Ord )
614619
615620textStyleAttr :: TextStyle -> [(String,String)]
@@ -627,7 +632,7 @@ textStyleAttr s
627632 | Pre <- s = [("style:font-name" ,"Courier New")
628633 ,("style:font-name-asian" ,"Courier New")
629634 ,("style:font-name-complex" ,"Courier New")]
630− | Lang lang country <- s
635+ | Language lang country <- s
631636 = [("fo:language" ,lang)
632637 ,("fo:country" ,country)]
633638 | otherwise = []
@@ -637,9 +642,8 @@ withLangFromAttr (_,_,kvs) action =
637642 case lookup "lang" kvs of
638643 Nothing -> action
639644 Just l -> do
640− (mblang, mbcountry) <- splitLang l
641− case (mblang, mbcountry) of
642− (Just lang, _) -> withTextStyle
643− (Lang lang (fromMaybe "" mbcountry))
644− action
645+ mblang <- parseBCP47 l
646+ case mblang of
647+ Just (Lang lang country) -> withTextStyle
648+ (Language lang country) action
645649 _ -> action
src/Text/Pandoc/Writers/Shared.hs+24−11
@@ -30,7 +30,9 @@ Shared utility functions for pandoc writers.
3030-}
3131module Text.Pandoc.Writers.Shared (
3232 getLang
33− , splitLang
33+ , parseBCP47
34+ , Lang(..)
35+ , renderLang
3436 , metaToJSON
3537 , metaToJSON'
3638 , addVariablesToJSON
@@ -62,30 +64,41 @@ import Text.Pandoc.Shared (splitBy)
6264import Text.Pandoc.UTF8 (toStringLazy)
6365import Text.Pandoc.XML (escapeStringForXML)
6466
67+-- | Represents BCP 47 language/country code.
68+data Lang = Lang String String
69+
70+-- | Render a Lang as BCP 47.
71+renderLang :: Lang -> String
72+renderLang (Lang la co) = la ++ if null co
73+ then ""
74+ else '-':co
75+
6576-- | Get the contents of the `lang` metadata field or variable.
66−getLang :: WriterOptions -> Meta -> Maybe String
67−getLang opts meta =
68− lookup "lang" (writerVariables opts)
77+getLang :: PandocMonad m => WriterOptions -> Meta -> m (Maybe Lang)
78+getLang opts meta = maybe (return Nothing) parseBCP47 $
79+ case lookup "lang" (writerVariables opts) of
80+ Just s -> Just s
81+ _ -> Nothing
6982 `mplus`
7083 case lookupMeta "lang" meta of
7184 Just (MetaInlines [Str s]) -> Just s
7285 Just (MetaString s) -> Just s
7386 _ -> Nothing
7487
75−-- | Split `lang` field into lang and country, issuing warning
76−-- if it doesn't look valid.
77−splitLang :: PandocMonad m => String -> m (Maybe String, Maybe String)
78−splitLang lang =
88+-- | Parse a BCP 47 string as a Lang, issuing a warning if there
89+-- are issues.
90+parseBCP47 :: PandocMonad m => String -> m (Maybe Lang)
91+parseBCP47 lang =
7992 case splitBy (== '-') lang of
8093 [la,co]
8194 | length la == 2 && length co == 2
82− -> return (Just la, Just co)
95+ -> return $ Just $ Lang la co
8396 [la]
8497 | length la == 2
85− -> return (Just la, Nothing)
98+ -> return $ Just $ Lang la ""
8699 _ -> do
87100 report $ InvalidLang lang
88− return (Nothing, Nothing)
101+ return Nothing
89102
90103-- | Create JSON value for template from a 'Meta' and an association list
91104-- of variables, specified at the command line or in the writer.