@@ -0,0 +1,658 @@
1+{-# LANGUAGE RelaxedPolyRec, FlexibleInstances, TypeSynonymInstances #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+
5+{- |
6+ Module : Text.Pandoc.Readers.TikiWiki
7+ Copyright : Copyright (C) 2017 Robin Lee Powell
8+ License : GPLv2
9+
10+ Maintainer : Robin Lee Powell <robinleepowell@gmail.com>
11+ Stability : alpha
12+ Portability : portable
13+
14+Conversion of TikiWiki text to 'Pandoc' document.
15+-}
16+
17+module Text.Pandoc.Readers.TikiWiki ( readTikiWiki
18+ ) where
19+
20+import Control.Monad
21+import Control.Monad.Except (throwError)
22+import Text.Pandoc.Definition
23+import qualified Text.Pandoc.Builder as B
24+import Text.Pandoc.Options
25+import Text.Pandoc.Parsing hiding (enclosed, nested)
26+import Text.Printf (printf)
27+import Text.Pandoc.XML (fromEntities)
28+import Text.Pandoc.Class (PandocMonad(..), CommonState(..))
29+import Text.Pandoc.Shared (crFilter)
30+import Text.Pandoc.Logging (Verbosity(..))
31+import Data.Maybe (fromMaybe)
32+import Data.List (intercalate)
33+import qualified Data.Foldable as F
34+import Data.Text (Text)
35+import qualified Data.Text as T
36+
37+-- | Read TikiWiki from an input string and return a Pandoc document.
38+readTikiWiki :: PandocMonad m
39+ => ReaderOptions
40+ -> Text
41+ -> m Pandoc
42+readTikiWiki opts s = do
43+ res <- readWithM parseTikiWiki def{ stateOptions = opts }
44+ (T.unpack (crFilter s) ++ "\n\n")
45+ case res of
46+ Left e -> throwError e
47+ Right d -> return d
48+
49+type TikiWikiParser = ParserT [Char] ParserState
50+
51+--
52+-- utility functions
53+--
54+
55+tryMsg :: PandocMonad m => String -> TikiWikiParser m a -> TikiWikiParser m a
56+tryMsg msg p = try p <?> msg
57+
58+skip :: PandocMonad m => TikiWikiParser m a -> TikiWikiParser m ()
59+skip parser = parser >> return ()
60+
61+nested :: PandocMonad m => TikiWikiParser m a -> TikiWikiParser m a
62+nested p = do
63+ nestlevel <- stateMaxNestingLevel <$> getState
64+ guard $ nestlevel > 0
65+ updateState $ \st -> st{ stateMaxNestingLevel = stateMaxNestingLevel st - 1 }
66+ res <- p
67+ updateState $ \st -> st{ stateMaxNestingLevel = nestlevel }
68+ return res
69+
70+--
71+-- main parser
72+--
73+
74+parseTikiWiki :: PandocMonad m => TikiWikiParser m Pandoc
75+parseTikiWiki = do
76+ bs <- mconcat <$> many block
77+ spaces
78+ eof
79+ return $ B.doc bs
80+
81+block :: PandocMonad m => TikiWikiParser m B.Blocks
82+block = do
83+ verbosity <- getsCommonState stVerbosity
84+ pos <- getPosition
85+ res <- mempty <$ skipMany1 blankline
86+ <|> blockElements
87+ <|> para
88+ skipMany blankline
89+ when (verbosity >= INFO) $ do
90+ trace (printf "line %d: %s" (sourceLine pos) (take 60 $ show $ B.toList res))
91+ return res
92+
93+blockElements :: PandocMonad m => TikiWikiParser m B.Blocks
94+blockElements = choice [ table
95+ , hr
96+ , header
97+ , mixedList
98+ , definitionList
99+ , codeMacro
100+ ]
101+
102+-- top
103+-- ----
104+-- bottom
105+--
106+-- ----
107+--
108+hr :: PandocMonad m => TikiWikiParser m B.Blocks
109+hr = try $ do
110+ string "----"
111+ many (char '-')
112+ newline
113+ return $ B.horizontalRule
114+
115+-- ! header
116+--
117+-- !! header level two
118+--
119+-- !!! header level 3
120+--
121+header :: PandocMonad m => TikiWikiParser m B.Blocks
122+header = tryMsg "header" $ do
123+ level <- many1 (char '!') >>= return . length
124+ guard $ level <= 6
125+ skipSpaces
126+ content <- B.trimInlines . mconcat <$> manyTill inline newline
127+ attr <- registerHeader nullAttr content
128+ return $ B.headerWith attr level $ content
129+
130+tableRow :: PandocMonad m => TikiWikiParser m [B.Blocks]
131+tableRow = try $ do
132+-- row <- sepBy1 (many1Till inline $ oneOf "\n|") (try $ string "|" <* notFollowedBy (oneOf "|\n"))
133+-- return $ map (B.plain . mconcat) row
134+ row <- sepBy1 ((many1 $ noneOf "\n|") >>= parseColumn) (try $ string "|" <* notFollowedBy (oneOf "|\n"))
135+ return $ map B.plain row
136+ where
137+ parseColumn x = do
138+ parsed <- parseFromString (many1 inline) x
139+ return $ mconcat parsed
140+
141+
142+
143+-- Tables:
144+--
145+-- ||foo||
146+--
147+-- ||row1-column1|row1-column2||row2-column1|row2-column2||
148+--
149+-- ||row1-column1|row1-column2
150+-- row2-column1|row2-column2||
151+--
152+-- ||row1-column1|row1-column2
153+-- row2-column1|row2-column2||row3-column1|row3-column2||
154+--
155+-- || Orange | Apple | more
156+-- Bread | Pie | more
157+-- Butter | Ice cream | and more ||
158+--
159+table :: PandocMonad m => TikiWikiParser m B.Blocks
160+table = try $ do
161+ string "||"
162+ rows <- sepBy1 tableRow (try $ string "\n" <|> (string "||" <* notFollowedBy (string "\n")))
163+ string "||"
164+ newline
165+ -- return $ B.simpleTable (headers rows) $ trace ("rows: " ++ (show rows)) rows
166+ return $ B.simpleTable (headers rows) $ rows
167+ where
168+ -- The headers are as many empty srings as the number of columns
169+ -- in the first row
170+ headers rows = map (B.plain . B.str) $ take (length $ rows !! 0) $ repeat ""
171+
172+para :: PandocMonad m => TikiWikiParser m B.Blocks
173+para = many1Till inline endOfParaElement >>= return . result . mconcat
174+ where
175+ endOfParaElement = lookAhead $ endOfInput <|> endOfPara <|> newBlockElement
176+ endOfInput = try $ skipMany blankline >> skipSpaces >> eof
177+ endOfPara = try $ blankline >> skipMany1 blankline
178+ newBlockElement = try $ blankline >> skip blockElements
179+ result content = if F.all (==Space) content
180+ then mempty
181+ else B.para $ B.trimInlines content
182+
183+-- ;item 1: definition 1
184+-- ;item 2: definition 2-1
185+-- + definition 2-2
186+-- ;item ''3'': definition ''3''
187+--
188+definitionList :: PandocMonad m => TikiWikiParser m B.Blocks
189+definitionList = tryMsg "definitionList" $ do
190+ elements <- many1 $ parseDefinitionListItem
191+ return $ B.definitionList elements
192+ where
193+ parseDefinitionListItem :: PandocMonad m => TikiWikiParser m (B.Inlines, [B.Blocks])
194+ parseDefinitionListItem = do
195+ skipSpaces >> char ';' <* skipSpaces
196+ term <- many1Till inline $ char ':' <* skipSpaces
197+ line <- listItemLine 1
198+ return $ (mconcat term, [B.plain line])
199+
200+data ListType = None | Numbered | Bullet deriving (Ord, Eq, Show)
201+
202+data ListNesting = LN { lntype :: ListType, lnnest :: Int } deriving (Ord, Eq, Show)
203+
204+-- The first argument is a stack (most recent == head) of our list
205+-- nesting status; the list type and the nesting level; if we're in
206+-- a number list in a bullet list it'd be
207+-- [LN Numbered 2, LN Bullet 1]
208+--
209+-- Mixed list example:
210+--
211+-- # one
212+-- # two
213+-- ** two point one
214+-- ** two point two
215+-- # three
216+-- # four
217+--
218+mixedList :: PandocMonad m => TikiWikiParser m B.Blocks
219+mixedList = try $ do
220+ items <- try $ many1 listItem
221+ return $ mconcat $ fixListNesting $ spanFoldUpList (LN None 0) items
222+
223+-- See the "Handling Lists" section of DESIGN-CODE for why this
224+-- function exists. It's to post-process the lists and do some
225+-- mappends.
226+--
227+-- We need to walk the tree two items at a time, so we can see what
228+-- we're going to join *to* before we get there.
229+--
230+-- Because of that, it seemed easier to do it by hand than to try to
231+-- figre out a fold or something.
232+fixListNesting :: [B.Blocks] -> [B.Blocks]
233+fixListNesting [] = []
234+fixListNesting (first:[]) = [recurseOnList first]
235+-- fixListNesting nestall | trace ("\n\nfixListNesting: " ++ (show nestall)) False = undefined
236+-- fixListNesting nestall@(first:second:rest) =
237+fixListNesting (first:second:rest) =
238+ let secondBlock = head $ B.toList second in
239+ case secondBlock of
240+ BulletList _ -> fixListNesting $ [(mappend (recurseOnList first) (recurseOnList second))] ++ rest
241+ OrderedList _ _ -> fixListNesting $ [(mappend (recurseOnList first) (recurseOnList second))] ++ rest
242+ _ -> [recurseOnList first] ++ fixListNesting (second:rest)
243+
244+-- This function walks the Block structure for fixListNesting,
245+-- because it's a bit complicated, what with converting to and from
246+-- lists and so on.
247+recurseOnList :: B.Blocks -> B.Blocks
248+-- recurseOnList item | trace ("rOL: " ++ (show $ length $ B.toList item) ++ ", " ++ (show $ B.toList item)) False = undefined
249+recurseOnList items
250+ | (length $ B.toList items) == 1 =
251+ let itemBlock = head $ B.toList items in
252+ case itemBlock of
253+ BulletList listItems -> B.bulletList $ fixListNesting $ map B.fromList listItems
254+ OrderedList _ listItems -> B.orderedList $ fixListNesting $ map B.fromList listItems
255+ _ -> items
256+
257+ -- The otherwise works because we constructed the blocks, and we
258+ -- know for a fact that no mappends have been run on them; each
259+ -- Blocks consists of exactly one Block.
260+ --
261+ -- Anything that's not like that has already been processed by
262+ -- fixListNesting; don't bother to process it again.
263+ | otherwise = items
264+
265+
266+-- Turn the list if list items into a tree by breaking off the first
267+-- item, splitting the remainder of the list into items that are in
268+-- the tree of the first item and those that aren't, wrapping the
269+-- tree of the first item in its list time, and recursing on both
270+-- sections.
271+spanFoldUpList :: ListNesting -> [(ListNesting, B.Blocks)] -> [B.Blocks]
272+spanFoldUpList _ [] = []
273+spanFoldUpList ln (first:[]) =
274+ listWrap ln (fst first) [snd first]
275+spanFoldUpList ln (first:rest) =
276+ let (span1, span2) = span (splitListNesting (fst first)) rest
277+ newTree1 = listWrap ln (fst first) $ [snd first] ++ spanFoldUpList (fst first) span1
278+ newTree2 = spanFoldUpList ln span2
279+ in
280+ newTree1 ++ newTree2
281+
282+-- Decide if the second item should be in the tree of the first
283+-- item, which is true if the second item is at a deeper nesting
284+-- level and of the same type.
285+splitListNesting :: ListNesting -> (ListNesting, B.Blocks) -> Bool
286+splitListNesting ln1 (ln2, _) =
287+ if (lnnest ln1) < (lnnest ln2) then
288+ True
289+ else
290+ if ln1 == ln2 then
291+ True
292+ else
293+ False
294+
295+-- If we've moved to a deeper nesting level, wrap the new level in
296+-- the appropriate type of list.
297+listWrap :: ListNesting -> ListNesting -> [B.Blocks] -> [B.Blocks]
298+listWrap upperLN curLN retTree =
299+ if upperLN == curLN then
300+ retTree
301+ else
302+ case lntype curLN of
303+ None -> []
304+ Bullet -> [B.bulletList retTree]
305+ Numbered -> [B.orderedList retTree]
306+
307+listItem :: PandocMonad m => TikiWikiParser m (ListNesting, B.Blocks)
308+listItem = choice [
309+ bulletItem
310+ , numberedItem
311+ ]
312+
313+
314+-- * Start each line
315+-- * with an asterisk (*).
316+-- ** More asterisks gives deeper
317+-- *** and deeper levels.
318+--
319+bulletItem :: PandocMonad m => TikiWikiParser m (ListNesting, B.Blocks)
320+bulletItem = try $ do
321+ prefix <- many1 $ char '*'
322+ many1 $ char ' '
323+ content <- listItemLine (length prefix)
324+ return $ (LN Bullet (length prefix), B.plain content)
325+
326+-- # Start each line
327+-- # with a number (1.).
328+-- ## More number signs gives deeper
329+-- ### and deeper
330+--
331+numberedItem :: PandocMonad m => TikiWikiParser m (ListNesting, B.Blocks)
332+numberedItem = try $ do
333+ prefix <- many1 $ char '#'
334+ many1 $ char ' '
335+ content <- listItemLine (length prefix)
336+ return $ (LN Numbered (length prefix), B.plain content)
337+
338+listItemLine :: PandocMonad m => Int -> TikiWikiParser m B.Inlines
339+listItemLine nest = lineContent >>= parseContent >>= return
340+ where
341+ lineContent = do
342+ content <- anyLine
343+ continuation <- optionMaybe listContinuation
344+ return $ filterSpaces content ++ "\n" ++ (maybe "" id continuation)
345+ filterSpaces = reverse . dropWhile (== ' ') . reverse
346+ listContinuation = string (take nest (repeat '+')) >> lineContent
347+ parseContent x = do
348+ parsed <- parseFromString (many1 inline) x
349+ return $ mconcat parsed
350+
351+-- Turn the CODE macro attributes into Pandoc code block attributes.
352+mungeAttrs :: [(String, String)] -> (String, [String], [(String, String)])
353+mungeAttrs rawAttrs = ("", classes, rawAttrs)
354+ where
355+ -- "colors" is TikiWiki CODE macro for "name of language to do
356+ -- highlighting for"; turn the value into a class
357+ color = fromMaybe "" $ lookup "colors" rawAttrs
358+ -- ln = 1 means line numbering. It's also the default. So we
359+ -- emit numberLines as a class unless ln = 0
360+ lnRaw = fromMaybe "1" $ lookup "ln" rawAttrs
361+ ln = if lnRaw == "0" then
362+ ""
363+ else
364+ "numberLines"
365+ classes = filter (/= "") [color, ln]
366+
367+codeMacro :: PandocMonad m => TikiWikiParser m B.Blocks
368+codeMacro = try $ do
369+ string "{CODE("
370+ rawAttrs <- macroAttrs
371+ string ")}"
372+ body <- manyTill anyChar (try (string "{CODE}"))
373+ newline
374+ if length rawAttrs > 0
375+ then
376+ return $ B.codeBlockWith (mungeAttrs rawAttrs) body
377+ else
378+ return $ B.codeBlock body
379+
380+
381+--
382+-- inline parsers
383+--
384+
385+inline :: PandocMonad m => TikiWikiParser m B.Inlines
386+inline = choice [ whitespace
387+ , noparse
388+ , strong
389+ , emph
390+ , nbsp
391+ , image
392+ , htmlComment
393+ , strikeout
394+ , code
395+ , wikiLink
396+ , notExternalLink
397+ , externalLink
398+ , superTag
399+ , superMacro
400+ , subTag
401+ , subMacro
402+ , escapedChar
403+ , colored
404+ , centered
405+ , underlined
406+ , boxed
407+ , breakChars
408+ , str
409+ , symbol
410+ ] <?> "inline"
411+
412+whitespace :: PandocMonad m => TikiWikiParser m B.Inlines
413+whitespace = (lb <|> regsp) >>= return
414+ where lb = try $ skipMany spaceChar >> linebreak >> return B.space
415+ regsp = try $ skipMany1 spaceChar >> return B.space
416+
417+-- UNSUPPORTED, as there doesn't seem to be any facility in calibre
418+-- for this
419+nbsp :: PandocMonad m => TikiWikiParser m B.Inlines
420+nbsp = try $ do
421+ string "~hs~"
422+ return $ B.str " NOT SUPPORTED BEGIN: ~hs~ (non-breaking space) :END "
423+
424+-- UNSUPPORTED, as the desired behaviour (that the data be
425+-- *retained* and stored as a comment) doesn't exist in calibre, and
426+-- silently throwing data out seemed bad.
427+htmlComment :: PandocMonad m => TikiWikiParser m B.Inlines
428+htmlComment = try $ do
429+ string "~hc~"
430+ inner <- many1 $ noneOf "~"
431+ string "~/hc~"
432+ return $ B.str $ " NOT SUPPORTED: ~hc~ (html comment opener) BEGIN: " ++ inner ++ " ~/hc~ :END "
433+
434+linebreak :: PandocMonad m => TikiWikiParser m B.Inlines
435+linebreak = newline >> notFollowedBy newline >> (lastNewline <|> innerNewline)
436+ where lastNewline = eof >> return mempty
437+ innerNewline = return B.space
438+
439+between :: (Monoid c, PandocMonad m, Show b) => TikiWikiParser m a -> TikiWikiParser m b -> (TikiWikiParser m b -> TikiWikiParser m c) -> TikiWikiParser m c
440+between start end p =
441+ mconcat <$> try (start >> notFollowedBy whitespace >> many1Till (p end) end)
442+
443+enclosed :: (Monoid b, PandocMonad m, Show a) => TikiWikiParser m a -> (TikiWikiParser m a -> TikiWikiParser m b) -> TikiWikiParser m b
444+enclosed sep p = between sep (try $ sep <* endMarker) p
445+ where
446+ endMarker = lookAhead $ skip endSpace <|> skip (oneOf ".,!?:)|'_") <|> eof
447+ endSpace = (spaceChar <|> newline) >> return B.space
448+
449+
450+nestedInlines :: (Show a, PandocMonad m) => TikiWikiParser m a -> TikiWikiParser m B.Inlines
451+nestedInlines end = innerSpace <|> nestedInline
452+ where
453+ innerSpace = try $ whitespace <* (notFollowedBy end)
454+ nestedInline = notFollowedBy whitespace >> nested inline
455+
456+-- {img attId="39" imalign="right" link="http://info.tikiwiki.org" alt="Panama Hat"}
457+--
458+-- {img attId="37", thumb="mouseover", styleimage="border", desc="150"}
459+--
460+-- {img src="img/wiki_up/393px-Pears.jpg" thumb="y" imalign="center" stylebox="border" button="y" desc="Pretty pears" max="200" rel="box"}
461+--
462+image :: PandocMonad m => TikiWikiParser m B.Inlines
463+image = try $ do
464+ string "{img "
465+ rawAttrs <- sepEndBy1 imageAttr spaces
466+ string "}"
467+ let src = fromMaybe "" $ lookup "src" rawAttrs
468+ let title = fromMaybe src $ lookup "desc" rawAttrs
469+ let alt = fromMaybe title $ lookup "alt" rawAttrs
470+ let classes = map fst $ filter (\(_,b) -> b == "" || b == "y") rawAttrs
471+ if length src > 0
472+ then
473+ return $ B.imageWith ("", classes, rawAttrs) src title (B.str alt)
474+ else
475+ return $ B.str $ " NOT SUPPORTED: image without src attribute BEGIN: {img " ++ (printAttrs rawAttrs) ++ "} :END "
476+ where
477+ printAttrs attrs = intercalate " " $ map (\(a, b) -> a ++ "=\"" ++ b ++ "\"") attrs
478+
479+imageAttr :: PandocMonad m => TikiWikiParser m (String, String)
480+imageAttr = try $ do
481+ key <- many1 (noneOf "=} \t\n")
482+ char '='
483+ optional $ char '"'
484+ value <- many1 (noneOf "}\"\n")
485+ optional $ char '"'
486+ optional $ char ','
487+ return (key, value)
488+
489+
490+-- __strong__
491+strong :: PandocMonad m => TikiWikiParser m B.Inlines
492+strong = try $ enclosed (string "__") nestedInlines >>= return . B.strong
493+
494+-- ''emph''
495+emph :: PandocMonad m => TikiWikiParser m B.Inlines
496+emph = try $ enclosed (string "''") nestedInlines >>= return . B.emph
497+
498+-- ~246~
499+escapedChar :: PandocMonad m => TikiWikiParser m B.Inlines
500+escapedChar = try $ do
501+ string "~"
502+ inner <- many1 $ oneOf "0123456789"
503+ string "~"
504+ return $ B.str $ [(toEnum ((read inner) :: Int)) :: Char]
505+
506+-- UNSUPPORTED, as there doesn't seem to be any facility in calibre
507+-- for this
508+centered :: PandocMonad m => TikiWikiParser m B.Inlines
509+centered = try $ do
510+ string "::"
511+ inner <- many1 $ noneOf ":\n"
512+ string "::"
513+ return $ B.str $ " NOT SUPPORTED: :: (centered) BEGIN: ::" ++ inner ++ ":: :END "
514+
515+-- UNSUPPORTED, as there doesn't seem to be any facility in calibre
516+-- for this
517+colored :: PandocMonad m => TikiWikiParser m B.Inlines
518+colored = try $ do
519+ string "~~"
520+ inner <- many1 $ noneOf "~\n"
521+ string "~~"
522+ return $ B.str $ " NOT SUPPORTED: ~~ (colored) BEGIN: ~~" ++ inner ++ "~~ :END "
523+
524+-- UNSUPPORTED, as there doesn't seem to be any facility in calibre
525+-- for this
526+underlined :: PandocMonad m => TikiWikiParser m B.Inlines
527+underlined = try $ do
528+ string "==="
529+ inner <- many1 $ noneOf "=\n"
530+ string "==="
531+ return $ B.str $ " NOT SUPPORTED: ==== (underlined) BEGIN: ===" ++ inner ++ "=== :END "
532+
533+-- UNSUPPORTED, as there doesn't seem to be any facility in calibre
534+-- for this
535+boxed :: PandocMonad m => TikiWikiParser m B.Inlines
536+boxed = try $ do
537+ string "^"
538+ inner <- many1 $ noneOf "^\n"
539+ string "^"
540+ return $ B.str $ " NOT SUPPORTED: ^ (boxed) BEGIN: ^" ++ inner ++ "^ :END "
541+
542+-- --text--
543+strikeout :: PandocMonad m => TikiWikiParser m B.Inlines
544+strikeout = try $ enclosed (string "--") nestedInlines >>= return . B.strikeout
545+
546+nestedString :: (Show a, PandocMonad m) => TikiWikiParser m a -> TikiWikiParser m String
547+nestedString end = innerSpace <|> (count 1 nonspaceChar)
548+ where
549+ innerSpace = try $ many1 spaceChar <* notFollowedBy end
550+
551+breakChars :: PandocMonad m => TikiWikiParser m B.Inlines
552+breakChars = try $ string "%%%" >> return B.linebreak
553+
554+-- superscript: foo{TAG(tag=>sup)}super{TAG}foo / bar{SUP()}super2{SUP}bar
555+superTag :: PandocMonad m => TikiWikiParser m B.Inlines
556+superTag = try $ between (string "{TAG(tag=>sup)}") (string "{TAG}") nestedString >>= return . B.superscript . B.text . fromEntities
557+
558+superMacro :: PandocMonad m => TikiWikiParser m B.Inlines
559+superMacro = try $ do
560+ string "{SUP("
561+ manyTill anyChar (string ")}")
562+ body <- manyTill anyChar (string "{SUP}")
563+ return $ B.superscript $ B.text body
564+
565+-- subscript: baz{TAG(tag=>sub)}sub{TAG}qux / qux{SUB()}sub2{SUB}qux
566+subTag :: PandocMonad m => TikiWikiParser m B.Inlines
567+subTag = try $ between (string "{TAG(tag=>sub)}") (string "{TAG}") nestedString >>= return . B.subscript . B.text . fromEntities
568+
569+subMacro :: PandocMonad m => TikiWikiParser m B.Inlines
570+subMacro = try $ do
571+ string "{SUB("
572+ manyTill anyChar (string ")}")
573+ body <- manyTill anyChar (string "{SUB}")
574+ return $ B.subscript $ B.text body
575+
576+-- -+text+-
577+code :: PandocMonad m => TikiWikiParser m B.Inlines
578+code = try $ between (string "-+") (string "+-") nestedString >>= return . B.code . fromEntities
579+
580+macroAttr :: PandocMonad m => TikiWikiParser m (String, String)
581+macroAttr = try $ do
582+ key <- many1 (noneOf "=)")
583+ char '='
584+ optional $ char '"'
585+ value <- many1 (noneOf " )\"")
586+ optional $ char '"'
587+ return (key, value)
588+
589+macroAttrs :: PandocMonad m => TikiWikiParser m [(String, String)]
590+macroAttrs = try $ do
591+ attrs <- sepEndBy macroAttr spaces
592+ return attrs
593+
594+-- ~np~ __not bold__ ~/np~
595+noparse :: PandocMonad m => TikiWikiParser m B.Inlines
596+noparse = try $ do
597+ string "~np~"
598+ body <- manyTill anyChar (string "~/np~")
599+ return $ B.str body
600+
601+str :: PandocMonad m => TikiWikiParser m B.Inlines
602+str = (many1 alphaNum <|> count 1 characterReference) >>= return . B.str
603+
604+symbol :: PandocMonad m => TikiWikiParser m B.Inlines
605+symbol = count 1 nonspaceChar >>= return . B.str
606+
607+-- [[not a link]
608+notExternalLink :: PandocMonad m => TikiWikiParser m B.Inlines
609+notExternalLink = try $ do
610+ start <- string "[["
611+ body <- many (noneOf "\n[]")
612+ end <- string "]"
613+ return $ B.text (start ++ body ++ end)
614+
615+-- [http://www.somesite.org url|Some Site title]
616+-- ((internal link))
617+--
618+-- The ((...)) wiki links and [...] external links are handled
619+-- exactly the same; this abstracts that out
620+makeLink :: PandocMonad m => String -> String -> String -> TikiWikiParser m B.Inlines
621+makeLink start middle end = try $ do
622+ st <- getState
623+ guard $ stateAllowLinks st
624+ setState $ st{ stateAllowLinks = False }
625+ (url, title, anchor) <- wikiLinkText start middle end
626+ parsedTitle <- parseFromString (many1 inline) title
627+ setState $ st{ stateAllowLinks = True }
628+ return $ B.link (url++anchor) "" $ mconcat $ parsedTitle
629+
630+wikiLinkText :: PandocMonad m => String -> String -> String -> TikiWikiParser m (String, String, String)
631+wikiLinkText start middle end = do
632+ string start
633+ url <- many1 (noneOf $ middle ++ "\n")
634+ seg1 <- option url linkContent
635+ seg2 <- option "" linkContent
636+ string end
637+ if seg2 /= ""
638+ then
639+ return (url, seg2, seg1)
640+ else
641+ return (url, seg1, "")
642+ where
643+ linkContent = do
644+ (char '|')
645+ mystr <- many (noneOf middle)
646+ return $ mystr
647+
648+externalLink :: PandocMonad m => TikiWikiParser m B.Inlines
649+externalLink = makeLink "[" "]|" "]"
650+
651+-- NB: this wiki linking is unlikely to work for anyone besides me
652+-- (rlpowell); it happens to work for me because my Hakyll code has
653+-- post-processing that treats pandoc .md titles as valid link
654+-- targets, so something like
655+-- [see also this other post](My Other Page) is perfectly valid.
656+wikiLink :: PandocMonad m => TikiWikiParser m B.Inlines
657+wikiLink = makeLink "((" ")|" "))"
658+