@@ -0,0 +1,253 @@
1+{-
2+Copyright (C) 2010 Paul Rivier <paul*rivier#demotera*com> | tr '*#' '.@'
3+
4+This program is free software; you can redistribute it and/or modify
5+it under the terms of the GNU General Public License as published by
6+the Free Software Foundation; either version 2 of the License, or
7+(at your option) any later version.
8+
9+This program is distributed in the hope that it will be useful,
10+but WITHOUT ANY WARRANTY; without even the implied warranty of
11+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+GNU General Public License for more details.
13+
14+You should have received a copy of the GNU General Public License
15+along with this program; if not, write to the Free Software
16+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17+-}
18+
19+{- |
20+ Module : Text.Pandoc.Readers.Textile
21+ Copyright : Copyright (C) 2010 Paul Rivier
22+ License : GNU GPL, version 2 or above
23+
24+ Maintainer : Paul Rivier <paul*rivier#demotera*com>
25+ Stability : alpha
26+ Portability : portable
27+
28+Conversion from Textile to 'Pandoc' document.
29+
30+Implemented :
31+ - Paragraphs
32+ - Code blocks
33+ - Lists
34+ - blockquote
35+ - Inlines : strong, emph, cite, code, deleted, inserted, superscript, subscript
36+
37+
38+Not implemented :
39+ - HTML-specific and CSS-specific inlines
40+-}
41+
42+
43+module Text.Pandoc.Readers.Textile (
44+ readTextile
45+ ) where
46+import Text.Pandoc.Definition
47+import Text.Pandoc.Shared
48+import Text.Pandoc.Readers.HTML ( htmlTag, htmlEndTag )
49+import Text.ParserCombinators.Parsec
50+import Data.Char ( digitToInt )
51+
52+-- | Parse a Textile text and return a Pandoc document.
53+readTextile :: ParserState -- ^ Parser state, including options for parser
54+ -> String -- ^ String to parse (assuming @'\n'@ line endings)
55+ -> Pandoc
56+readTextile state s = (readWith parseTextile) state (s ++ "\n\n")
57+
58+
59+--
60+-- Constants and data structure definitions
61+--
62+
63+-- | Special chars border strings parsing
64+specialChars :: [Char]
65+specialChars = "\\[]*#_@~<>!?-+^&'\";:"
66+
67+-- | Generate a Pandoc ADT from a textile document
68+parseTextile :: GenParser Char ParserState Pandoc
69+parseTextile = do
70+ many blankline
71+ blocks <- parseBlocks
72+ return $ Pandoc (Meta [Str ""] [[Str ""]] [Str ""]) blocks -- FIXME
73+
74+-- | Parse document blocks
75+parseBlocks :: GenParser Char ParserState [Block]
76+parseBlocks = manyTill block eof
77+
78+-- | Block parsers list tried in definition order
79+blockParsers :: [GenParser Char ParserState Block]
80+blockParsers = [ codeBlock
81+ , header
82+ , blockQuote
83+ , anyList
84+ , para
85+ , nullBlock ]
86+
87+-- | Any block in the order of definition of blockParsers
88+block :: GenParser Char ParserState Block
89+block = choice blockParsers <?> "block"
90+
91+-- | Code Blocks in Textile are between <pre> and </pre>
92+codeBlock :: GenParser Char ParserState Block
93+codeBlock = try $ do
94+ htmlTag "pre"
95+ content <- manyTill anyChar (try $ htmlEndTag "pre" >> blockBreak)
96+ return $ CodeBlock ("",[],[]) content
97+
98+-- | Header of the form "hN. content" with N in 1..6
99+header :: GenParser Char ParserState Block
100+header = try $ do
101+ char 'h'
102+ level <- oneOf "123456" >>= return . digitToInt
103+ char '.'
104+ whitespace
105+ name <- manyTill inline blockBreak
106+ return $ Header level (normalizeSpaces name)
107+
108+-- | Blockquote of the form "bq. content"
109+blockQuote :: GenParser Char ParserState Block
110+blockQuote = try $ do
111+ string "bq."
112+ whitespace
113+ para >>= return . BlockQuote . (:[])
114+
115+-- Lists handling
116+
117+-- | Can be a bullet list or an ordered list. This implementation is
118+-- strict in the nesting, sublist must start at exactly "parent depth
119+-- plus one"
120+anyList :: GenParser Char ParserState Block
121+anyList = try $ do
122+ l <- anyListAtDepth 1
123+ blanklines
124+ return l
125+
126+-- | This allow one type of list to be nested into an other type,
127+-- provided correct nesting
128+anyListAtDepth :: Int -> GenParser Char ParserState Block
129+anyListAtDepth depth = choice [ bulletListAtDepth depth,
130+ orderedListAtDepth depth ]
131+
132+-- | Bullet List of given depth, depth being the number of leading '*'
133+bulletListAtDepth :: Int -> GenParser Char ParserState Block
134+bulletListAtDepth depth = try $ do
135+ items <- many1 (bulletListItemAtDepth depth)
136+ return (BulletList items)
137+
138+-- | Bullet List Item of given depth, depth being the number of
139+-- leading '*'
140+bulletListItemAtDepth :: Int -> GenParser Char ParserState [Block]
141+bulletListItemAtDepth depth = try $ do
142+ count depth (char '*')
143+ whitespace
144+ p <- inlines >>= return . Plain
145+ sublist <- option [] (anyListAtDepth (depth + 1) >>= return . (:[]))
146+ return (p:sublist)
147+
148+-- | Ordered List of given depth, depth being the number of
149+-- leading '#'
150+orderedListAtDepth :: Int -> GenParser Char ParserState Block
151+orderedListAtDepth depth = try $ do
152+ items <- many1 (orderedListItemAtDepth depth)
153+ return (OrderedList (1, DefaultStyle, DefaultDelim) items)
154+
155+-- | Ordered List Item of given depth, depth being the number of
156+-- leading '#'
157+orderedListItemAtDepth :: Int -> GenParser Char ParserState [Block]
158+orderedListItemAtDepth depth = try $ do
159+ count depth (char '#')
160+ whitespace
161+ p <- inlines >>= return . Plain
162+ sublist <- option [] (anyListAtDepth (depth + 1) >>= return . (:[]))
163+ return (p:sublist)
164+
165+-- | This terminates a block such as a paragraph.
166+blockBreak :: GenParser Char ParserState ()
167+blockBreak = try $ newline >> blanklines >> return ()
168+
169+-- | In textile, paragraphs are separated by blank lines.
170+para :: GenParser Char ParserState Block
171+para = try $ do
172+ content <- manyTill inline blockBreak
173+ return $ Para $ normalizeSpaces content
174+
175+-- | Any inline element
176+inline :: GenParser Char ParserState Inline
177+inline = choice inlineParsers <?> "inline"
178+
179+-- | List of consecutive inlines before a newline
180+inlines :: GenParser Char ParserState [Inline]
181+inlines = manyTill inline newline
182+
183+-- | Inline parsers tried in order
184+inlineParsers :: [GenParser Char ParserState Inline]
185+inlineParsers = [ str
186+ , whitespace
187+ , endline
188+ , code
189+ , simpleInline (string "??") (Cite [])
190+ , simpleInline (char '*') Strong
191+ , simpleInline (char '_') Emph
192+ , simpleInline (string "**") Strong
193+ , simpleInline (string "__") Emph
194+ , simpleInline (char '-') Strikeout
195+ , simpleInline (char '+') Inserted
196+ , simpleInline (char '^') Superscript
197+ , simpleInline (char '~') Subscript
198+ -- , link
199+ -- , image
200+ -- , math
201+ -- , autoLink
202+ , symbol
203+ ]
204+
205+-- | Any string
206+str :: GenParser Char ParserState Inline
207+str = many1 (noneOf (specialChars ++ "\t\n ")) >>= return . Str
208+
209+-- | Some number of space chars
210+whitespace :: GenParser Char ParserState Inline
211+whitespace = many1 spaceChar >> return Space <?> "whitespace"
212+
213+-- | In Textile, an endline character that can be treated as a space,
214+-- not a structural break
215+endline :: GenParser Char ParserState Inline
216+endline = try $ do
217+ newline >> notFollowedBy blankline
218+ return Space
219+
220+-- | Any special symbol defined in specialChars
221+symbol :: GenParser Char ParserState Inline
222+symbol = do
223+ result <- oneOf specialChars
224+ return $ Str [result]
225+
226+-- | Inline code
227+code :: GenParser Char ParserState Inline
228+code = surrounded (char '@') anyChar >>=
229+ return . Code
230+
231+-- | Parses material surrounded by a parser.
232+surrounded :: GenParser Char st t -- ^ surrounding parser
233+ -> GenParser Char st a -- ^ content parser (to be used repeatedly)
234+ -> GenParser Char st [a]
235+surrounded border = enclosed border border
236+
237+-- | Inlines are most of the time of the same form
238+simpleInline :: GenParser Char ParserState t -- ^ surrounding parser
239+ -> ([Inline] -> Inline) -- ^ Inline constructor
240+ -> GenParser Char ParserState Inline -- ^ content parser (to be used repeatedly)
241+simpleInline border construct = surrounded border inline >>=
242+ return . construct . normalizeSpaces
243+
244+
245+-- TODO
246+--
247+-- - Pandoc Meta Information
248+-- - footnotes
249+-- - hyperlink "label":target
250+-- - tables
251+-- - doc
252+-- - tests
253+-- - Inserted inline handling in writers