@@ -46,11 +46,12 @@ module Text.Pandoc.Writers.Shared (
4646 , gridTable
4747 )
4848where
49−import Control.Monad (liftM, zipWithM, mplus)
49+import Control.Monad (liftM, zipWithM, guard)
5050import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (Object),
5151 encode, fromJSON)
52+import Data.Char (isAscii, isLetter, isUpper, isLower)
5253import qualified Data.HashMap.Strict as H
53−import Data.List (groupBy, intersperse, transpose)
54+import Data.List (groupBy, intersperse, transpose, intercalate)
5455import qualified Data.Map as M
5556import Data.Maybe (isJust)
5657import qualified Data.Text as T
@@ -60,45 +61,82 @@ import Text.Pandoc.Class (PandocMonad, report)
6061import Text.Pandoc.Logging
6162import Text.Pandoc.Options
6263import Text.Pandoc.Pretty
63−import Text.Pandoc.Shared (splitBy)
6464import Text.Pandoc.UTF8 (toStringLazy)
6565import Text.Pandoc.XML (escapeStringForXML)
66+import qualified Text.Parsec as P
6667
6768-- | Represents BCP 47 language/country code.
68−data Lang = Lang String String
69+data Lang = Lang{ langLanguage :: String
70+ , langScript :: String
71+ , langRegion :: String
72+ , langVariants :: [String] }
73+ deriving (Eq, Ord, Show)
6974
7075-- | Render a Lang as BCP 47.
7176renderLang :: Lang -> String
72−renderLang (Lang la co) = la ++ if null co
73− then ""
74− else '-':co
77+renderLang lang = intercalate "-" (langLanguage lang : filter (not . null)
78+ ([langScript lang, langRegion lang] ++ langVariants lang))
7579
7680-- | Get the contents of the `lang` metadata field or variable.
7781getLang :: 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
82− `mplus`
83− case lookupMeta "lang" meta of
84− Just (MetaInlines [Str s]) -> Just s
85− Just (MetaString s) -> Just s
86− _ -> Nothing
82+getLang opts meta = case
83+ (case lookup "lang" (writerVariables opts) of
84+ Just s -> Just s
85+ _ ->
86+ case lookupMeta "lang" meta of
87+ Just (MetaInlines [Str s]) -> Just s
88+ Just (MetaString s) -> Just s
89+ _ -> Nothing) of
90+ Nothing -> return Nothing
91+ Just s -> case parseBCP47 s of
92+ Left _ -> do
93+ report $ InvalidLang s
94+ return Nothing
95+ Right l -> return (Just l)
8796
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)
97+-- | Parse a BCP 47 string as a Lang.
98+parseBCP47 :: String -> Either String Lang
9199parseBCP47 lang =
92− case splitBy (== '-') lang of
93− [la,co]
94− | length la == 2 && length co == 2
95− -> return $ Just $ Lang la co
96− [la]
97− | length la == 2
98− -> return $ Just $ Lang la ""
99− _ -> do
100− report $ InvalidLang lang
101− return Nothing
100+ case P.parse bcp47 "lang" lang of
101+ Right r -> Right r
102+ Left e -> Left $ show e
103+ where bcp47 = do
104+ language <- pLanguage
105+ script <- P.option "" pScript
106+ region <- P.option "" pRegion
107+ variants <- P.many pVariant
108+ () <$ P.char '-' P.<|> P.eof
109+ return $ Lang{ langLanguage = language
110+ , langScript = script
111+ , langRegion = region
112+ , langVariants = variants }
113+ asciiLetter = P.satisfy (\c -> isAscii c && isLetter c)
114+ pLanguage = do
115+ cs <- P.many1 asciiLetter
116+ let lcs = length cs
117+ guard $ lcs == 2 || lcs == 3
118+ return cs
119+ pScript = P.try $ do
120+ P.char '-'
121+ x <- P.satisfy (\c -> isAscii c && isLetter c && isUpper c)
122+ xs <- P.count 3
123+ (P.satisfy (\c -> isAscii c && isLetter c && isLower c))
124+ return (x:xs)
125+ pRegion = P.try $ do
126+ P.char '-'
127+ cs <- P.many1 asciiLetter
128+ let lcs = length cs
129+ guard $ lcs == 2 || lcs == 3
130+ return cs
131+ pVariant = P.try $ do
132+ P.char '-'
133+ ds <- P.option "" (P.count 1 P.digit)
134+ cs <- P.many1 asciiLetter
135+ let var = ds ++ cs
136+ guard $ if null ds
137+ then length var >= 5 && length var <= 8
138+ else length var == 4
139+ return var
102140
103141-- | Create JSON value for template from a 'Meta' and an association list
104142-- of variables, specified at the command line or in the writer.