Textile reader: Handle attributes on headers.

Includes `[lang]`, `(class #id)`, `{color:red}` styles.

src/Text/Pandoc/Readers/Textile.hs

@@ -36,9 +36,7 @@ Implemented and parsed:
  - Inlines : strong, emph, cite, code, deleted, superscript,
    subscript, links
  - footnotes
-
+ - HTML-specific and CSS-specific attributes on headers
-Implemented but discarded:
- - HTML-specific and CSS-specific attributes
 
 Left to be implemented:
  - dimension sign
@@ -171,19 +169,16 @@ header :: Parser [Char] ParserState Block
 header = try $ do
   char 'h'
   level <- digitToInt <$> oneOf "123456"
-  attr <- option "" attributes
+  attr <- attributes
-  let ident = case attr of
-                   '#':xs -> xs
-                   _      -> ""
   char '.'
   whitespace
   name <- normalizeSpaces <$> manyTill inline blockBreak
-  return $ Header level (ident,[],[]) name
+  return $ Header level attr name
 
 -- | Blockquote of the form "bq. content"
 blockQuote :: Parser [Char] ParserState Block
 blockQuote = try $ do
-  string "bq" >> optional attributes >> char '.' >> whitespace
+  string "bq" >> attributes >> char '.' >> whitespace
   BlockQuote . singleton <$> para
 
 -- Horizontal rule
@@ -237,7 +232,7 @@ orderedListItemAtDepth = genericListItemAtDepth '#'
 -- | Common implementation of list items
 genericListItemAtDepth :: Char -> Int -> Parser [Char] ParserState [Block]
 genericListItemAtDepth c depth = try $ do
-  count depth (char c) >> optional attributes >> whitespace
+  count depth (char c) >> attributes >> whitespace
   p <- many listInline
   newline
   sublist <- option [] (singleton <$> anyListAtDepth (depth + 1))
@@ -348,7 +343,7 @@ maybeExplicitBlock :: String  -- ^ block tag name
                     -> Parser [Char] ParserState Block -- ^ implicit block
                     -> Parser [Char] ParserState Block
 maybeExplicitBlock name blk = try $ do
-  optional $ try $ string name >> optional attributes >> char '.' >>
+  optional $ try $ string name >> attributes >> char '.' >>
     optional whitespace >> optional endline
   blk
 
@@ -553,10 +548,32 @@ code2 = do
   Code nullAttr <$> manyTill anyChar (try $ htmlTag $ tagClose (=="tt"))
 
 -- | Html / CSS attributes
-attributes :: Parser [Char] ParserState String
+attributes :: Parser [Char] ParserState Attr
-attributes = choice [ enclosed (char '(') (char ')') anyChar,
+attributes = (foldl (flip ($)) ("",[],[])) `fmap` many attribute
-                      enclosed (char '{') (char '}') anyChar,
+
-                      enclosed (char '[') (char ']') anyChar]
+attribute :: Parser [Char] ParserState (Attr -> Attr)
+attribute = classIdAttr <|> styleAttr <|> langAttr
+
+classIdAttr :: Parser [Char] ParserState (Attr -> Attr)
+classIdAttr = try $ do -- (class class #id)
+  char '('
+  ws <- words `fmap` manyTill anyChar (char ')')
+  case reverse ws of
+       []                      -> return $ \(_,_,keyvals) -> ("",[],keyvals)
+       (('#':ident'):classes') -> return $ \(_,_,keyvals) ->
+                                             (ident',classes',keyvals)
+       classes'                -> return $ \(_,_,keyvals) ->
+                                             ("",classes',keyvals)
+
+styleAttr :: Parser [Char] ParserState (Attr -> Attr)
+styleAttr = do
+  style <- try $ enclosed (char '{') (char '}') anyChar
+  return $ \(id',classes,keyvals) -> (id',classes,("style",style):keyvals)
+
+langAttr :: Parser [Char] ParserState (Attr -> Attr)
+langAttr = do
+  lang <- try $ enclosed (char '[') (char ']') anyChar
+  return $ \(id',classes,keyvals) -> (id',classes,("lang",lang):keyvals)
 
 -- | Parses material surrounded by a parser.
 surrounded :: Parser [Char] st t   -- ^ surrounding parser

tests/textile-reader.native

@@ -123,7 +123,7 @@ Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []})
 ,Header 1 ("",[],[]) [Str "Images"]
 ,Para [Str "Textile",Space,Str "inline",Space,Str "image",Space,Str "syntax",Str ",",Space,Str "like",Space,LineBreak,Str "here",Space,Image [Str "this is the alt text"] ("this_is_an_image.png","this is the alt text"),LineBreak,Str "and",Space,Str "here",Space,Image [Str ""] ("this_is_an_image.png",""),Str "."]
 ,Header 1 ("",[],[]) [Str "Attributes"]
-,Header 2 ("",[],[]) [Str "HTML",Space,Str "and",Space,Str "CSS",Space,Str "attributes",Space,Str "are",Space,Str "ignored"]
+,Header 2 ("ident",["bar","foo"],[("style","color:red"),("lang","en")]) [Str "HTML",Space,Str "and",Space,Str "CSS",Space,Str "attributes",Space,Str "are",Space,Str "parsed",Space,Str "in",Space,Str "headers",Str "."]
 ,Para [Str "as",Space,Str "well",Space,Str "as",Space,Strong [Str "inline",Space,Str "attributes"],Space,Str "of",Space,Str " all kind"]
 ,Para [Str "and",Space,Str "paragraph",Space,Str "attributes",Str ",",Space,Str "and",Space,Str "table",Space,Str "attributes",Str "."]
 ,Table [] [AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0]

tests/textile-reader.textile

@@ -193,7 +193,7 @@ and here !this_is_an_image.png!.
 
 h1. Attributes
 
-h2{color:red}. HTML and CSS attributes are ignored
+h2[en]{color:red}(foo bar #ident). HTML and CSS attributes are parsed in headers.
 
 as well as *(foo)inline attributes* of %{color:red} all kind%