)
where
+import Data.Maybe
import Rakka.Wiki
import Text.ParserCombinators.Parsec
wikiPage :: Parser WikiPage
-wikiPage = do xs <- many wikiElement
+wikiPage = do xs <- many (try blockElement)
+ skipMany ( comment
+ <|>
+ (newline >> return ())
+ )
eof
return xs
-wikiElement :: Parser WikiElement
-wikiElement = ( try (blockElement >>= return . Block)
- <|>
- try (inlineElement >>= return . Inline)
- )
-
-
blockElement :: Parser BlockElement
-blockElement = ( try header
+blockElement = skipMany ( comment
+ <|>
+ (newline >> return ())
+ )
+ >>
+ ( heading
+ <|>
+ horizontalLine
+ <|>
+ listElement
<|>
- try emptyLine
+ leadingSpaced
+ <|>
+ paragraph
)
-header :: Parser BlockElement
-header = foldr (<|>) pzero (map (try . header') [1..5])
+heading :: Parser BlockElement
+heading = foldr (<|>) pzero (map 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 '=')))
+ heading' :: Int -> Parser BlockElement
+ heading' n = do try $ do count n (char '=')
+ notFollowedBy (char '=')
+ ws
+ x <- notFollowedBy (char '=') >> anyChar
+ xs <- manyTill anyChar (try $ ws >> ( count n (char '=')
+ <?>
+ ("trailing " ++ take n (repeat '='))
+ )
+ )
+ ws
+ eol
+ return (Heading n (x:xs))
+
+
+horizontalLine :: Parser BlockElement
+horizontalLine = try $ do count 4 (char '-')
+ many (char '-')
+ ws
+ eol
+ return HorizontalLine
+
+
+listElement :: Parser BlockElement
+listElement = listElement' [] >>= return . List
+ where
+ listElement' :: [Char] -> Parser ListElement
+ listElement' stack
+ = try $ do t <- oneOf "*#"
ws
- eol
- return (Header n (x:xs))
-
-
-emptyLine :: Parser BlockElement
-emptyLine = newline >> return EmptyLine
+ xs <- items (stack ++ [t])
+ return (ListElement (toType t) xs)
+
+ -- ListItem の終了條件は、
+ items :: [Char] -> Parser [ListItem]
+ items stack = do xs <- many1 inlineElement
+ nested <- option Nothing
+ $ try $ do newline
+ string stack
+ listElement' stack >>= return . Just
+ rest <- items stack
+ return $ (map Right xs ++ map Left (catMaybes [nested])) : rest
+ <|>
+ (try $ do newline
+ string stack
+ ws
+ items stack
+ )
+ <|>
+ return []
+{-
+ items stack = do nested <- listElement' stack
+ rest <- items stack
+ return (Left nested : rest)
+ <|>
+ do xs <- many1 inlineElement
+ rest <- items stack
+ return (Right xs : rest)
+ <|>
+ try ( newline
+ >>
+ string stack
+ >>
+ items stack
+ )
+ <|>
+ return []
+-}
+
+ toType :: Char -> ListType
+ toType '*' = Bullet
+ toType '#' = Numbered
+
+
+leadingSpaced :: Parser BlockElement
+leadingSpaced = char ' ' >> leadingSpaced' >>= return . LeadingSpaced
+ where
+ leadingSpaced' :: Parser [InlineElement]
+ leadingSpaced' = do x <- inlineElement
+ xs <- leadingSpaced'
+ return (x:xs)
+ <|>
+ try ( newline
+ >>
+ char ' '
+ >>
+ leadingSpaced'
+ >>=
+ return . (Text "\n" :)
+ )
+ <|>
+ return []
+
+
+blockTag :: Parser BlockElement
+blockTag = pzero -- not implemented
+
+
+paragraph :: Parser BlockElement
+paragraph = paragraph' >>= return . Paragraph
+ where
+ paragraph' :: Parser [InlineElement]
+ paragraph' = do x <- inlineElement
+ xs <- try ( do newline
+ eof
+ return []
+ -- \n で文字列が終はってゐたら、ここ
+ -- で終了。
+ )
+ <|>
+ try ( do newline
+ ((oneOf ('\n':blockSymbols) >> pzero) <|> return ())
+ ((blockTag >> pzero) <|> return ())
+ ys <- (paragraph' <|> return [])
+ return (Text "\n" : ys)
+ -- \n があり、その次に \n、ブロックタ
+ -- グまたは blockSymbols があれば、
+ -- fail して 最初の newline を讀んだ
+ -- 所まで卷き戻す。
+ )
+ <|>
+ try paragraph'
+ -- それ以外の場合は次の inlineElement から
+ -- を讀んで見る。但し一つも無くても良い。
+ <|>
+ return [] -- 全部失敗したらここで終了。
+ return (x:xs)
inlineElement :: Parser InlineElement
-inlineElement = text
+inlineElement = skipMany comment
+ >>
+ ( try text
+ <|>
+ try pageLink
+ )
text :: Parser InlineElement
-text = do xs <- many1 (noneOf symbols)
- nl <- option "" (count 1 newline)
- return $ Text (xs ++ nl)
+text = many1 (noneOf ('\n':inlineSymbols)) >>= return . Text
+
+
+pageLink :: Parser InlineElement
+pageLink = do string "[["
+ page <- option Nothing
+ (many1 (noneOf "#|]") >>= return . Just)
+ fragment <- option Nothing
+ (char '#' >> many1 (noneOf "|]") >>= return . Just)
+ text <- option Nothing
+ (char '|' >> many1 (noneOf "]") >>= return . Just)
+ case (page, fragment) of
+ (Nothing, Nothing) -> pzero
+ (_, _) -> return ()
-symbols :: [Char]
-symbols = "\n"
+ 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)
+ )
+blockSymbols :: [Char]
+blockSymbols = " =-*#"
+
+
+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 ()
projects / Rakka.git / blobdiff