Writers.Shared: refactored getLang, splitLang...
into `Lang(..)`, `getLang`, `parceBCP47`.
This commit is contained in:
John MacFarlane
parent
3ae4105d14
commit
e7cd3cb466
4 changed files with 55 additions and 36 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue