git.iko.soy/typeable/pandoc
on master help sign in
Merge pull request #2327 from hftf/list-style
74c31abJohn MacFarlane
pandoc.cabal+2−1
compare with master
unifiedsplit
@@ -362,7 +362,8 @@ Library
362 Text.Pandoc.Templates,
362 Text.Pandoc.Templates,
363 Text.Pandoc.XML,
363 Text.Pandoc.XML,
364 Text.Pandoc.SelfContained,
364 Text.Pandoc.SelfContained,
365− Text.Pandoc.Process
365+ Text.Pandoc.Process,
366+ Text.Pandoc.CSS
366 Other-Modules: Text.Pandoc.Readers.Docx.Lists,
367 Other-Modules: Text.Pandoc.Readers.Docx.Lists,
367 Text.Pandoc.Readers.Docx.Reducible,
368 Text.Pandoc.Readers.Docx.Reducible,
368 Text.Pandoc.Readers.Docx.Parse,
369 Text.Pandoc.Readers.Docx.Parse,
src/Text/Pandoc/CSS.hsnew file+35
@@ -0,0 +1,35 @@
1+module Text.Pandoc.CSS ( foldOrElse,
2+ pickStyleAttrProps
3+ )
4+where
5+
6+import Text.Pandoc.Shared (trim)
7+import Text.Parsec
8+import Text.Parsec.String
9+import Control.Applicative ((<*))
10+
11+ruleParser :: Parser (String, String)
12+ruleParser = do
13+ p <- many1 (noneOf ":") <* char ':'
14+ v <- many1 (noneOf ":;") <* char ';' <* spaces
15+ return (trim p, trim v)
16+
17+styleAttrParser :: Parser [(String, String)]
18+styleAttrParser = do
19+ p <- many1 ruleParser
20+ return p
21+
22+orElse :: Eq a => a -> a -> a -> a
23+orElse v x y = if v == x then y else x
24+
25+foldOrElse :: Eq a => a -> [a] -> a
26+foldOrElse v xs = foldr (orElse v) v xs
27+
28+eitherToMaybe :: Either a b -> Maybe b
29+eitherToMaybe (Right x) = Just x
30+eitherToMaybe _ = Nothing
31+
32+pickStyleAttrProps :: [String] -> String -> Maybe String
33+pickStyleAttrProps lookupProps styleAttr = do
34+ styles <- eitherToMaybe $ parse styleAttrParser "" styleAttr
35+ foldOrElse Nothing $ map (flip lookup styles) lookupProps
src/Text/Pandoc/Readers/HTML.hs+35−23
@@ -64,6 +64,7 @@ import Data.Default (Default (..), def)
64import Control.Monad.Reader (Reader,ask, asks, local, runReader)
64import Control.Monad.Reader (Reader,ask, asks, local, runReader)
65import Network.URI (isURI)
65import Network.URI (isURI)
66import Text.Pandoc.Error
66import Text.Pandoc.Error
67+import Text.Pandoc.CSS (foldOrElse, pickStyleAttrProps)
67
68
68import Text.Parsec.Error
69import Text.Parsec.Error
69
70
@@ -252,6 +253,22 @@ pListItem nonItem = do
252 let liDiv = maybe mempty (\x -> B.divWith (x, [], []) mempty) (lookup "id" attr)
253 let liDiv = maybe mempty (\x -> B.divWith (x, [], []) mempty) (lookup "id" attr)
253 (liDiv <>) <$> pInTags "li" block <* skipMany nonItem
254 (liDiv <>) <$> pInTags "li" block <* skipMany nonItem
254
255
256+parseListStyleType :: String -> ListNumberStyle
257+parseListStyleType "lower-roman" = LowerRoman
258+parseListStyleType "upper-roman" = UpperRoman
259+parseListStyleType "lower-alpha" = LowerAlpha
260+parseListStyleType "upper-alpha" = UpperAlpha
261+parseListStyleType "decimal" = Decimal
262+parseListStyleType _ = DefaultStyle
263+
264+parseTypeAttr :: String -> ListNumberStyle
265+parseTypeAttr "i" = LowerRoman
266+parseTypeAttr "I" = UpperRoman
267+parseTypeAttr "a" = LowerAlpha
268+parseTypeAttr "A" = UpperAlpha
269+parseTypeAttr "1" = Decimal
270+parseTypeAttr _ = DefaultStyle
271+
255pOrderedList :: TagParser Blocks
272pOrderedList :: TagParser Blocks
256pOrderedList = try $ do
273pOrderedList = try $ do
257 TagOpen _ attribs <- pSatisfy (~== TagOpen "ol" [])
274 TagOpen _ attribs <- pSatisfy (~== TagOpen "ol" [])
@@ -261,23 +278,19 @@ pOrderedList = try $ do
261 sta' = if all isDigit sta
278 sta' = if all isDigit sta
262 then read sta
279 then read sta
263 else 1
280 else 1
264− sty = fromMaybe (fromMaybe "" $
281+
282+ pickListStyle = pickStyleAttrProps ["list-style-type", "list-style"]
283+
265− lookup "style" attribs) $
284+ typeAttr = fromMaybe "" $ lookup "type" attribs
266− lookup "class" attribs
285+ classAttr = fromMaybe "" $ lookup "class" attribs
267− sty' = case sty of
286+ styleAttr = fromMaybe "" $ lookup "style" attribs
268− "lower-roman" -> LowerRoman
287+ listStyle = fromMaybe "" $ pickListStyle styleAttr
269− "upper-roman" -> UpperRoman
288+
270− "lower-alpha" -> LowerAlpha
271− "upper-alpha" -> UpperAlpha
272− "decimal" -> Decimal
273− _ ->
274− case lookup "type" attribs of
275− Just "1" -> Decimal
276− Just "I" -> UpperRoman
277− Just "i" -> LowerRoman
278− Just "A" -> UpperAlpha
279− Just "a" -> LowerAlpha
280− _ -> DefaultStyle
289+ sty' = foldOrElse DefaultStyle
290+ [ parseTypeAttr typeAttr
291+ , parseListStyleType classAttr
292+ , parseListStyleType listStyle
293+ ]
281 let nonItem = pSatisfy (\t ->
294 let nonItem = pSatisfy (\t ->
282 not (tagOpen (`elem` ["li","ol","ul","dl"]) (const True) t) &&
295 not (tagOpen (`elem` ["li","ol","ul","dl"]) (const True) t) &&
283 not (t ~== TagClose "ol"))
296 not (t ~== TagClose "ol"))
@@ -622,12 +635,11 @@ pSpan = try $ do
622 guardEnabled Ext_native_spans
635 guardEnabled Ext_native_spans
623 TagOpen _ attr <- lookAhead $ pSatisfy $ tagOpen (=="span") (const True)
636 TagOpen _ attr <- lookAhead $ pSatisfy $ tagOpen (=="span") (const True)
624 contents <- pInTags "span" inline
637 contents <- pInTags "span" inline
625− let attr' = mkAttr attr
638+ let isSmallCaps = fontVariant == "small-caps"
626− return $ case attr' of
639+ where styleAttr = fromMaybe "" $ lookup "style" attr
627− ("",[],[("style",s)])
640+ fontVariant = fromMaybe "" $ pickStyleAttrProps ["font-variant"] styleAttr
628− | filter (`notElem` " \t;") s == "font-variant:small-caps" ->
629− B.smallcaps contents
630− _ -> B.spanWith (mkAttr attr) contents
641+ let tag = if isSmallCaps then B.smallcaps else B.spanWith (mkAttr attr)
642+ return $ tag contents
631
643
632pRawHtmlInline :: TagParser Inlines
644pRawHtmlInline :: TagParser Inlines
633pRawHtmlInline = do
645pRawHtmlInline = do
tests/html-reader.html+7
@@ -185,6 +185,13 @@ These should not be escaped: \$ \\ \> \[ \{
185<li><p>Item 3.</p>
185<li><p>Item 3.</p>
186</li>
186</li>
187</ol>
187</ol>
188+<p>List styles:</p>
189+<ol></ol>
190+<ol type="i"></ol>
191+<ol class="lower-roman"></ol>
192+<ol style="lower-roman"></ol>
193+<ol style="list-style: lower-roman;"></ol>
194+<ol style="list-style-type: lower-roman;"></ol>
188<h2>Nested</h2>
195<h2>Nested</h2>
189<ul>
196<ul>
190<li>Tab<ul>
197<li>Tab<ul>
tests/html-reader.native+13
@@ -116,6 +116,19 @@ Pandoc (Meta {unMeta = fromList [("generator",MetaInlines [Str "pandoc"]),("titl
116 ,Para [Str "Item",Space,Str "1.",Space,Str "graf",Space,Str "two.",Space,Str "The",Space,Str "quick",Space,Str "brown",Space,Str "fox",Space,Str "jumped",Space,Str "over",Space,Str "the",Space,Str "lazy",Space,Str "dog's",Space,Str "back."]]
116 ,Para [Str "Item",Space,Str "1.",Space,Str "graf",Space,Str "two.",Space,Str "The",Space,Str "quick",Space,Str "brown",Space,Str "fox",Space,Str "jumped",Space,Str "over",Space,Str "the",Space,Str "lazy",Space,Str "dog's",Space,Str "back."]]
117 ,[Para [Str "Item",Space,Str "2."]]
117 ,[Para [Str "Item",Space,Str "2."]]
118 ,[Para [Str "Item",Space,Str "3."]]]
118 ,[Para [Str "Item",Space,Str "3."]]]
119+,Para [Str "List",Space,Str "styles:"]
120+,OrderedList (1,DefaultStyle,DefaultDelim)
121+ []
122+,OrderedList (1,LowerRoman,DefaultDelim)
123+ []
124+,OrderedList (1,LowerRoman,DefaultDelim)
125+ []
126+,OrderedList (1,DefaultStyle,DefaultDelim)
127+ []
128+,OrderedList (1,LowerRoman,DefaultDelim)
129+ []
130+,OrderedList (1,LowerRoman,DefaultDelim)
131+ []
119,Header 2 ("",[],[]) [Str "Nested"]
132,Header 2 ("",[],[]) [Str "Nested"]
120,BulletList
133,BulletList
121 [[Plain [Str "Tab"]
134 [[Plain [Str "Tab"]