e7cd3cb · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Writers.Shared: refactored getLang, splitLang...

e7cd3cbJohn MacFarlane9 years ago

src/Text/Pandoc/Writers/Docx.hs+5−3

compare with master

unifiedsplit

@@ -67,7 +67,7 @@ import Text.Pandoc.Shared hiding (Element)

67import qualified Text.Pandoc.UTF8 as UTF8

68import Text.Pandoc.Walk

69import Text.Pandoc.Writers.Math

70−import Text.Pandoc.Writers.Shared (fixDisplayMath, getLang)

70+import Text.Pandoc.Writers.Shared (fixDisplayMath, getLang, renderLang)

71import Text.Printf (printf)

72import Text.TeXMath

73import Text.XML.Light as XML

@@ -257,9 +257,11 @@ writeDocx opts doc@(Pandoc meta _) = do

257 )

258

259 -- styles

260− let lang = getLang opts meta

260+ lang <- getLang opts meta

261 let addLang :: Element -> Element

262+ addLang e = case lang >>= \l ->

263+ (return . XMLC.toTree . go (renderLang l)

262− addLang e = case lang >>= \l -> (return . XMLC.toTree . go l . XMLC.fromElement) e of

264+ . XMLC.fromElement) e of

263 Just (Elem e') -> e'

265 Just (Elem e') -> e'

264 _ -> e -- return original

266 _ -> e -- return original

265 where go :: String -> Cursor -> Cursor

267 where go :: String -> Cursor -> Cursor

src/Text/Pandoc/Writers/ODT.hs+13−13

@@ -50,7 +50,8 @@ import Text.Pandoc.Shared (stringify)

50import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toStringLazy)

51import Text.Pandoc.Walk

52import 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)

54import Text.Pandoc.XML

55import Text.Pandoc.XML

55import Text.TeXMath

56import Text.TeXMath

56import Text.XML.Light

57import Text.XML.Light

@@ -79,7 +80,7 @@ pandocToODT :: PandocMonad m

79pandocToODT opts doc@(Pandoc meta _) = do

80pandocToODT opts doc@(Pandoc meta _) = do

80 let datadir = writerUserDataDir opts

81 let datadir = writerUserDataDir opts

81 let title = docTitle meta

82 let title = docTitle meta

82− let lang = getLang opts meta

83+ lang <- getLang opts meta

83 refArchive <-

84 refArchive <-

84 case writerReferenceDoc opts of

85 case writerReferenceDoc opts of

85 Just f -> liftM toArchive $ lift $ P.readFileLazy f

86 Just f -> liftM toArchive $ lift $ P.readFileLazy f

@@ -140,7 +141,7 @@ pandocToODT opts doc@(Pandoc meta _) = do

140 $$

141 $$

141 case lang of

142 case lang of

142 Just l -> inTagsSimple "dc:language"

143 Just l -> inTagsSimple "dc:language"

143− (text (escapeStringForXML l))

144+ (text (escapeStringForXML (renderLang l)))

144 Nothing -> empty

145 Nothing -> empty

145 )

146 )

147 )

@@ -153,10 +154,9 @@ pandocToODT opts doc@(Pandoc meta _) = do

153 $ addEntryToArchive metaEntry archive'

154 $ addEntryToArchive metaEntry archive'

154 return $ fromArchive archive''

155 return $ fromArchive archive''

155

156

156−updateStyleWithLang :: PandocMonad m => Maybe String -> Archive -> O m Archive

157+updateStyleWithLang :: PandocMonad m => Maybe Lang -> Archive -> O m Archive

157updateStyleWithLang Nothing arch = return arch

158updateStyleWithLang Nothing arch = return arch

158−updateStyleWithLang (Just l) arch = do

159+updateStyleWithLang (Just lang) arch = do

159− (mblang, mbcountry) <- splitLang l

160 epochtime <- floor `fmap` (lift P.getPOSIXTime)

161 return arch{ zEntries = [if eRelativePath e == "styles.xml"

162 then case parseXMLDoc

@@ -166,16 +166,16 @@ updateStyleWithLang (Just l) arch = do

166 toEntry "styles.xml" epochtime

167 ( fromStringLazy

168 . ppTopElement

169− . addLang mblang mbcountry $ d )

169+ . addLang lang $ d )

170 else e

171 | e <- zEntries arch] }

172

173−addLang :: Maybe String -> Maybe String -> Element -> Element

173+addLang :: Lang -> Element -> Element

174−addLang mblang mbcountry = everywhere' (mkT updateLangAttr)

174+addLang (Lang lang country) = everywhere' (mkT updateLangAttr)

175− where updateLangAttr (Attr n@(QName "language" _ (Just "fo")) l)

175+ where updateLangAttr (Attr n@(QName "language" _ (Just "fo")) _)

176− = Attr n (maybe l id mblang)

176+ = Attr n lang

177− updateLangAttr (Attr n@(QName "country" _ (Just "fo")) c)

177+ updateLangAttr (Attr n@(QName "country" _ (Just "fo")) _)

178− = Attr n (maybe c id mbcountry)

178+ = Attr n country

179 updateLangAttr x = x

180

181-- | transform both Image and Math elements

src/Text/Pandoc/Writers/OpenDocument.hs+13−9

@@ -36,7 +36,6 @@ import Control.Arrow ((***), (>>>))

36import Control.Monad.State.Strict hiding (when)

37import Data.Char (chr)

38import Data.List (sortBy)

39−import Data.Maybe (fromMaybe)

40import Data.Text (Text)

39import Data.Text (Text)

41import qualified Data.Map as Map

40import qualified Data.Map as Map

42import Data.Ord (comparing)

41import Data.Ord (comparing)

@@ -608,8 +607,14 @@ paraTableStyles t s (a:xs)

608 [ ("fo:text-align", x)

607 [ ("fo:text-align", x)

609 , ("style:justify-single-word", "false")]

608 , ("style:justify-single-word", "false")]

610

609

611−data TextStyle = Italic | Bold | Strike | Sub | Sup | SmallC | Pre

610+data TextStyle = Italic

611+ | Bold

612+ | Strike

613+ | Sub

614+ | Sup

615+ | SmallC

616+ | Pre

612− | Lang String String

617+ | Language String String

613 deriving ( Eq,Ord )

618 deriving ( Eq,Ord )

614

619

615textStyleAttr :: TextStyle -> [(String,String)]

620textStyleAttr :: TextStyle -> [(String,String)]

@@ -627,7 +632,7 @@ textStyleAttr s

627 | Pre <- s = [("style:font-name" ,"Courier New")

632 | Pre <- s = [("style:font-name" ,"Courier New")

628 ,("style:font-name-asian" ,"Courier New")

633 ,("style:font-name-asian" ,"Courier New")

629 ,("style:font-name-complex" ,"Courier New")]

634 ,("style:font-name-complex" ,"Courier New")]

630− | Lang lang country <- s

635+ | Language lang country <- s

631 = [("fo:language" ,lang)

636 = [("fo:language" ,lang)

632 ,("fo:country" ,country)]

637 ,("fo:country" ,country)]

633 | otherwise = []

638 | otherwise = []

@@ -637,9 +642,8 @@ withLangFromAttr (_,_,kvs) action =

637 case lookup "lang" kvs of

642 case lookup "lang" kvs of

638 Nothing -> action

643 Nothing -> action

639 Just l -> do

644 Just l -> do

640− (mblang, mbcountry) <- splitLang l

645+ mblang <- parseBCP47 l

641− case (mblang, mbcountry) of

646+ case mblang of

642− (Just lang, _) -> withTextStyle

647+ Just (Lang lang country) -> withTextStyle

643− (Lang lang (fromMaybe "" mbcountry))

648+ (Language lang country) action

644− action

645 _ -> action

649 _ -> action

src/Text/Pandoc/Writers/Shared.hs+24−11

@@ -30,7 +30,9 @@ Shared utility functions for pandoc writers.

30-}

31module Text.Pandoc.Writers.Shared (

32 getLang

33− , splitLang

33+ , parseBCP47

34+ , Lang(..)

35+ , renderLang

34 , metaToJSON

36 , metaToJSON

35 , metaToJSON'

37 , metaToJSON'

36 , addVariablesToJSON

38 , addVariablesToJSON

@@ -62,30 +64,41 @@ import Text.Pandoc.Shared (splitBy)

62import Text.Pandoc.UTF8 (toStringLazy)

64import Text.Pandoc.UTF8 (toStringLazy)

63import Text.Pandoc.XML (escapeStringForXML)

65import Text.Pandoc.XML (escapeStringForXML)

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+

65-- | Get the contents of the `lang` metadata field or variable.

76-- | Get the contents of the `lang` metadata field or variable.

66−getLang :: WriterOptions -> Meta -> Maybe String

77+getLang :: PandocMonad m => WriterOptions -> Meta -> m (Maybe Lang)

67−getLang opts meta =

78+getLang opts meta = maybe (return Nothing) parseBCP47 $

68− lookup "lang" (writerVariables opts)

79+ case lookup "lang" (writerVariables opts) of

80+ Just s -> Just s

81+ _ -> Nothing

69 `mplus`

82 `mplus`

70 case lookupMeta "lang" meta of

83 case lookupMeta "lang" meta of

71 Just (MetaInlines [Str s]) -> Just s

84 Just (MetaInlines [Str s]) -> Just s

72 Just (MetaString s) -> Just s

85 Just (MetaString s) -> Just s

73 _ -> Nothing

86 _ -> Nothing

75−-- | Split `lang` field into lang and country, issuing warning

88+-- | Parse a BCP 47 string as a Lang, issuing a warning if there

76−-- if it doesn't look valid.

89+-- are issues.

77−splitLang :: PandocMonad m => String -> m (Maybe String, Maybe String)

90+parseBCP47 :: PandocMonad m => String -> m (Maybe Lang)

78−splitLang lang =

91+parseBCP47 lang =

79 case splitBy (== '-') lang of

92 case splitBy (== '-') lang of

80 [la,co]

93 [la,co]

81 | length la == 2 && length co == 2

94 | length la == 2 && length co == 2

82− -> return (Just la, Just co)

95+ -> return $ Just $ Lang la co

83 [la]

96 [la]

84 | length la == 2

97 | length la == 2

85− -> return (Just la, Nothing)

98+ -> return $ Just $ Lang la ""

86 _ -> do

99 _ -> do

87 report $ InvalidLang lang

100 report $ InvalidLang lang

88− return (Nothing, Nothing)

101+ return Nothing

102

90-- | Create JSON value for template from a 'Meta' and an association list

103-- | Create JSON value for template from a 'Meta' and an association list

91-- of variables, specified at the command line or in the writer.

104-- of variables, specified at the command line or in the writer.