)
where
+import Data.Char
import Rakka.Wiki
import Text.ParserCombinators.Parsec
wikiPage :: Parser WikiPage
-wikiPage = do xs <- many wikiElement
+wikiPage = do xs <- many (try wikiElement)
+ skipMany comment
eof
return xs
wikiElement :: Parser WikiElement
-wikiElement = ( try (blockElement >>= return . Block)
+wikiElement = skipMany comment >>
+ ( try (blockElement >>= return . Block)
<|>
try (inlineElement >>= return . Inline)
)
blockElement :: Parser BlockElement
-blockElement = ( try header
+blockElement = ( try heading
<|>
try emptyLine
)
-header :: Parser BlockElement
-header = foldr (<|>) pzero (map (try . header') [1..5])
+heading :: Parser BlockElement
+heading = foldr (<|>) pzero (map (try . heading') [1..5])
+ <?>
+ "heading"
where
- header' :: Int -> Parser BlockElement
- header' n = do count n (char '=')
- notFollowedBy (char '=')
- ws
- x <- notFollowedBy (char '=') >> anyChar
- xs <- manyTill anyChar (try $ ws >> (count n (char '=')))
- ws
- eol
- return (Header n (x:xs))
+ heading' :: Int -> Parser BlockElement
+ heading' n = do count n (char '=')
+ notFollowedBy (char '=')
+ ws
+ x <- notFollowedBy (char '=') >> anyChar
+ xs <- manyTill anyChar (try $ ws >> (count n (char '=')))
+ ws
+ eol
+ return (Heading n (x:xs))
emptyLine :: Parser BlockElement
-emptyLine = newline >> return EmptyLine
+emptyLine = count 2 newline >> many newline >> return EmptyLine
+ <?>
+ "empty line"
inlineElement :: Parser InlineElement
-inlineElement = text
+inlineElement = ( try text
+ <|>
+ try pageLink
+ )
text :: Parser InlineElement
-text = do xs <- many1 (noneOf symbols)
- nl <- option "" (count 1 newline)
- return $ Text (xs ++ nl)
-
+text = text' >>= return . Text
+ where
+ text' :: Parser String
+ text' = do x <- noneOf inlineSymbols
+ case x of
+ -- 單獨の \n は受け入れる。
+ '\n' -> return [x]
+ -- それ以外では \n を受け入れない。
+ _ -> many (noneOf ('\n':inlineSymbols)) >>= return . (x:)
+
+
+pageLink :: Parser InlineElement
+pageLink = do string "[["
+ page <- option Nothing $
+ do x <- satisfy (\ c -> not (elem c "#|]" || isLower c))
+ xs <- many (noneOf "#|]")
+ return $ Just (x:xs)
+ fragment <- option Nothing
+ (char '#' >> many1 (noneOf "|]") >>= return . Just)
+ text <- option Nothing
+ (char '|' >> many1 (noneOf "]") >>= return . Just)
+
+ case (page, fragment) of
+ (Nothing, Nothing) -> pzero
+ (_, _) -> return ()
+
+ string "]]"
+ return $ PageLink page fragment text
+ <?>
+ "page link"
+
+
+comment :: Parser ()
+comment = (try (string "<!--") >> skipTillEnd 1)
+ <?>
+ "comment"
+ where
+ skipTillEnd :: Int -> Parser ()
+ skipTillEnd level = ( (try (string "<!--") >> skipTillEnd (level + 1))
+ <|>
+ (try (string "-->") >> case level of
+ 1 -> return ()
+ n -> skipTillEnd (n - 1))
+ <|>
+ (anyChar >> skipTillEnd level)
+ )
-symbols :: [Char]
-symbols = "\n"
+inlineSymbols :: [Char]
+inlineSymbols = "<["
-- white space
-ws :: Parser String
-ws = many (oneOf " \t")
+ws :: Parser ()
+ws = skipMany ( (oneOf " \t" >> return ())
+ <|>
+ comment
+ )
-- end of line
eol :: Parser ()
-eol = ( (newline >> return ())
+eol = ( (many1 newline >> return ())
<|>
eof
)