module Rakka.Wiki.Parser
- ( wikiPage
+ ( CommandTypeOf
+ , wikiPage
)
where
import Text.ParserCombinators.Parsec
-wikiPage :: Parser WikiPage
-wikiPage = do xs <- many (try blockElement)
- skipMany ( comment
- <|>
- (newline >> return ())
- )
- eof
- return xs
+type CommandTypeOf = String -> Maybe CommandType
-blockElement :: Parser BlockElement
-blockElement = skipMany ( comment
- <|>
- (newline >> return ())
- )
- >>
- ( heading
- <|>
- horizontalLine
- <|>
- listElement
- <|>
- definitionList
- <|>
- pdata
- <|>
- leadingSpaced
+wikiPage :: CommandTypeOf -> Parser WikiPage
+wikiPage cmdTypeOf
+ = do xs <- many $ try (blockElement cmdTypeOf)
+ skipMany ( comment
+ <|>
+ (newline >> return ())
+ )
+ eof
+ return xs
+
+
+blockElement :: CommandTypeOf -> Parser BlockElement
+blockElement cmdTypeOf
+ = skipMany ( comment
<|>
- paragraph
+ (newline >> return ())
)
+ >>
+ ( foldr (<|>) pzero [ heading
+ , horizontalLine
+ , listElement cmdTypeOf
+ , definitionList cmdTypeOf
+ , pdata
+ , leadingSpaced cmdTypeOf
+ , paragraph cmdTypeOf
+ ]
+ )
heading :: Parser BlockElement
"horizontal line"
-listElement :: Parser BlockElement
-listElement = listElement' [] >>= return . List
+listElement :: CommandTypeOf -> Parser BlockElement
+listElement cmdTypeOf = listElement' [] >>= return . List
where
listElement' :: [Char] -> Parser ListElement
listElement' stack
- = try $ do t <- oneOf "*#"
- ws
- xs <- items (stack ++ [t])
- return (ListElement (toType t) xs)
+ = do t <- oneOf "*#"
+ ws
+ xs <- items (stack ++ [t])
+ return (ListElement (toType t) xs)
-- ListItem の終了條件は、
items :: [Char] -> Parser [ListItem]
- items stack = do xs <- many1 inlineElement
+ items stack = do xs <- many1 $ inlineElement cmdTypeOf
nested <- option Nothing
- $ try $ do newline
+ $ try $ do skipMany comment
+ newline
string stack
listElement' stack >>= return . Just
rest <- items stack
return $ (map Right xs ++ map Left (catMaybes [nested])) : rest
<|>
- (try $ do newline
+ (try $ do skipMany comment
+ newline
string stack
ws
items stack
toType '#' = Numbered
-definitionList :: Parser BlockElement
-definitionList = many1 definition >>= return . DefinitionList
+definitionList :: CommandTypeOf -> Parser BlockElement
+definitionList cmdTypeOf = many1 definition >>= return . DefinitionList
where
definition :: Parser Definition
definition = do char ';'
ws
- tHead <- inlineElement
+ tHead <- inlineElement cmdTypeOf
tRest <- term
d <- description
return (Definition (tHead:tRest) d)
<|>
(newline >> char ':' >> ws >> return [])
<|>
- do x <- inlineElement
+ do x <- inlineElement cmdTypeOf
xs <- term
return (x:xs)
<?>
"term to be defined"
description :: Parser [InlineElement]
- description = do x <- inlineElement
+ description = do x <- inlineElement cmdTypeOf
xs <- description
return (x:xs)
<|>
return (x:xs)
-leadingSpaced :: Parser BlockElement
-leadingSpaced = (char ' ' >> leadingSpaced' >>= return . Preformatted)
- <?>
- "leading space"
+leadingSpaced :: CommandTypeOf -> Parser BlockElement
+leadingSpaced cmdTypeOf = (char ' ' >> leadingSpaced' >>= return . Preformatted)
+ <?>
+ "leading space"
where
leadingSpaced' :: Parser [InlineElement]
- leadingSpaced' = do x <- inlineElement
+ leadingSpaced' = do x <- inlineElement cmdTypeOf
xs <- leadingSpaced'
return (x:xs)
<|>
return []
-blockTag :: Parser BlockElement
-blockTag = pzero -- not implemented
+blockCommand :: Parser BlockElement
+blockCommand = pzero -- not implemented
-paragraph :: Parser BlockElement
-paragraph = paragraph' >>= return . Paragraph
+paragraph :: CommandTypeOf -> Parser BlockElement
+paragraph cmdTypeOf = paragraph' >>= return . Paragraph
where
paragraph' :: Parser [InlineElement]
- paragraph' = do x <- inlineElement
+ paragraph' = do x <- inlineElement cmdTypeOf
xs <- try ( do newline
eof
return []
<|>
try ( do newline
((oneOf ('\n':blockSymbols) >> pzero) <|> return ())
- ((blockTag >> pzero) <|> return ())
+ ((blockCommand >> pzero) <|> return ())
ys <- (paragraph' <|> return [])
return (Text "\n" : ys)
-- \n があり、その次に \n、ブロックタ
return (x:xs)
-inlineElement :: Parser InlineElement
-inlineElement = skipMany comment
- >>
- ( cdata
- <|>
- apostrophes
- <|>
- text
- <|>
- pageLink
- )
+inlineElement :: CommandTypeOf -> Parser InlineElement
+inlineElement cmdTypeOf
+ = try $ do skipMany comment
+ foldr (<|>) pzero [ cdata
+ , apostrophes cmdTypeOf
+ , text
+ , pageLink
+ , inlineCmd cmdTypeOf
+ ]
cdata :: Parser InlineElement
"text"
-apostrophes :: Parser InlineElement
-apostrophes = foldr (<|>) pzero (map try [apos1, apos2, apos3, apos4, apos5])
+apostrophes :: CommandTypeOf -> Parser InlineElement
+apostrophes cmdTypeOf = foldr (<|>) pzero (map try [apos1, apos2, apos3, apos4, apos5])
where
apos1 = apos 1 >> return (Text "'")
apos2 = do apos 2
- xs <- many1 inlineElement
+ xs <- many1 $ inlineElement cmdTypeOf
apos 2
return (Italic xs)
apos3 = do apos 3
- xs <- many1 inlineElement
+ xs <- many1 $ inlineElement cmdTypeOf
apos 3
return (Bold xs)
apos4 = apos 4 >> return (Text "'")
apos5 = do apos 5
- xs <- many1 inlineElement
+ xs <- many1 $ inlineElement cmdTypeOf
apos 5
return (Italic [Bold xs])
fragment <- option Nothing
(char '#' >> many1 (noneOf "|]") >>= return . Just)
text <- option Nothing
- (char '|' >> many1 (noneOf "]") >>= return . Just)
+ (char '|' >> many1 (satisfy (/= ']')) >>= return . Just)
case (page, fragment) of
(Nothing, Nothing) -> pzero
"page link"
+inlineCmd :: CommandTypeOf -> Parser InlineElement
+inlineCmd cmdTypeOf
+ = (try $ do (tagName, tagAttrs) <- openTag
+ case cmdTypeOf tagName of
+ Just InlineCommandType
+ -> do xs <- contents
+ closeTag tagName
+ return $ InlineCmd $ InlineCommand {
+ iCmdName = tagName
+ , iCmdAttributes = tagAttrs
+ , iCmdContents = xs
+ }
+ _ -> pzero
+ )
+ <|>
+ (try $ do (tagName, tagAttrs) <- emptyTag
+ case cmdTypeOf tagName of
+ Just InlineCommandType
+ -> return $ InlineCmd $ InlineCommand {
+ iCmdName = tagName
+ , iCmdAttributes = tagAttrs
+ , iCmdContents = []
+ }
+ _ -> pzero
+ )
+ where
+ contents :: Parser [InlineElement]
+ contents = do x <- inlineElement cmdTypeOf
+ xs <- contents
+ return (x:xs)
+ <|>
+ (comment >> contents)
+ <|>
+ (newline >> contents >>= return . (Text "\n" :))
+ <|>
+ return []
+
+
+openTag :: Parser (String, [Attribute])
+openTag = try $ do char '<'
+ many space
+ name <- many1 letter
+ many space
+ attrs <- many $ do attr <- tagAttr
+ many space
+ return attr
+ char '>'
+ return (name, attrs)
+
+
+emptyTag :: Parser (String, [Attribute])
+emptyTag = try $ do char '<'
+ many space
+ name <- many1 letter
+ many space
+ attrs <- many $ do attr <- tagAttr
+ many space
+ return attr
+ char '/'
+ many space
+ char '>'
+ return (name, attrs)
+
+
+closeTag :: String -> Parser ()
+closeTag name = try $ do char '<'
+ many space
+ char '/'
+ many space
+ string name
+ many space
+ char '>'
+ return ()
+
+
+tagAttr :: Parser (String, String)
+tagAttr = do name <- many1 letter
+ char '='
+ char '"'
+ value <- many (satisfy (/= '"'))
+ char '"'
+ return (name, value)
+
+
comment :: Parser ()
comment = (try (string "<!--") >> skipTillEnd 1)
<?>
projects / Rakka.git / blobdiff