where
import Data.Maybe
+import Network.URI
import Rakka.Wiki
import Text.ParserCombinators.Parsec
wikiPage :: CommandTypeOf -> Parser WikiPage
wikiPage cmdTypeOf
- = do xs <- many $ try (blockElement cmdTypeOf)
+ = do xs <- many (blockElement cmdTypeOf)
skipMany ( comment
<|>
(newline >> return ())
blockElement :: CommandTypeOf -> Parser BlockElement
blockElement cmdTypeOf
- = skipMany ( comment
- <|>
- (newline >> return ())
- )
- >>
- ( foldr (<|>) pzero [ heading
- , horizontalLine
- , listElement cmdTypeOf
- , definitionList cmdTypeOf
- , pdata
- , leadingSpaced cmdTypeOf
- , paragraph cmdTypeOf
- ]
- )
+ = try $ do skipMany ( comment
+ <|>
+ (newline >> return ())
+ )
+ foldr (<|>) pzero [ heading
+ , horizontalLine
+ , listElement cmdTypeOf
+ , definitionList cmdTypeOf
+ , pdata
+ , leadingSpaced cmdTypeOf
+ , paragraph cmdTypeOf
+ , blockCmd cmdTypeOf
+ ]
heading :: Parser BlockElement
<|>
try ( do newline
((oneOf ('\n':blockSymbols) >> pzero) <|> return ())
- ((blockCommand >> pzero) <|> return ())
ys <- (paragraph' <|> return [])
return (Text "\n" : ys)
- -- \n があり、その次に \n、ブロックタ
- -- グまたは blockSymbols があれば、
- -- fail して 最初の newline を讀んだ
- -- æ\89\80ã\81¾ã\81§å\8d·ã\81\8dæ\88»ã\81\99ã\80\82
+ -- \n があり、その次に \n または
+ -- blockSymbols があれば、fail して
+ -- 最初の newline を讀んだ所まで卷き
+ -- 戻す。
)
<|>
- try paragraph'
+ paragraph'
-- それ以外の場合は次の inlineElement から
-- を讀んで見る。但し一つも無くても良い。
<|>
return (x:xs)
+blockCmd :: CommandTypeOf -> Parser BlockElement
+blockCmd cmdTypeOf
+ = (try $ do (tagName, tagAttrs) <- openTag
+ case cmdTypeOf tagName of
+ Just BlockCommandType
+ -> do xs <- contents
+ closeTag tagName
+ return $ BlockCmd $ BlockCommand {
+ bCmdName = tagName
+ , bCmdAttributes = tagAttrs
+ , bCmdContents = xs
+ }
+
+ Just InlineCommandType
+ -> pzero
+
+ _ -> return $ undefinedCmdErr tagName
+ )
+ <|>
+ (try $ do (tagName, tagAttrs) <- emptyTag
+ case cmdTypeOf tagName of
+ Just BlockCommandType
+ -> return $ BlockCmd $ BlockCommand {
+ bCmdName = tagName
+ , bCmdAttributes = tagAttrs
+ , bCmdContents = []
+ }
+
+ Just InlineCommandType
+ -> pzero
+
+ _ -> return $ undefinedCmdErr tagName
+ )
+ <?>
+ "block command"
+ where
+ contents :: Parser [BlockElement]
+ contents = do x <- blockElement cmdTypeOf
+ xs <- contents
+ return (x:xs)
+ <|>
+ (newline >> contents)
+ <|>
+ (comment >> contents)
+ <|>
+ return []
+
+ undefinedCmdErr :: String -> BlockElement
+ undefinedCmdErr name
+ = Div [("class", "error")]
+ [ Paragraph [Text ("The command `" ++ name ++ "' is not defined. " ++
+ "Make sure you haven't mistyped.")
+ ]
+ ]
+
+
inlineElement :: CommandTypeOf -> Parser InlineElement
inlineElement cmdTypeOf
= try $ do skipMany comment
foldr (<|>) pzero [ cdata
, apostrophes cmdTypeOf
, text
+ , objLink
, pageLink
+ , extLink
, inlineCmd cmdTypeOf
]
apos n = count n (char '\'') >> notFollowedBy (char '\'')
+objLink :: Parser InlineElement
+objLink = do try (string "[[[")
+ page <- many1 (noneOf "|]")
+ text <- option Nothing
+ (char '|' >> many1 (satisfy (/= ']')) >>= return . Just)
+ string "]]]"
+ return $ ObjectLink page text
+ <?>
+ "object link"
+
+
pageLink :: Parser InlineElement
pageLink = do try (string "[[")
page <- option Nothing
"page link"
+extLink :: Parser InlineElement
+extLink = do char '['
+ uriStr <- many1 (noneOf " \t]")
+ skipMany (oneOf " \t")
+ text <- option Nothing
+ (many1 (noneOf "]") >>= return . Just)
+
+ case parseURI uriStr of
+ Just uri -> char ']' >> return (ExternalLink uri text)
+ Nothing -> pzero <?> "absolute URI"
+ <?>
+ "external link"
+
+
inlineCmd :: CommandTypeOf -> Parser InlineElement
inlineCmd cmdTypeOf
= (try $ do (tagName, tagAttrs) <- openTag
return $ InlineCmd $ InlineCommand {
iCmdName = tagName
, iCmdAttributes = tagAttrs
- , iCmdContents = xs
+ , iCmdContents = xs
}
_ -> pzero
)
}
_ -> pzero
)
+ <?>
+ "inline command"
where
contents :: Parser [InlineElement]
contents = do x <- inlineElement cmdTypeOf
blockSymbols :: [Char]
-blockSymbols = " =-*#;"
+blockSymbols = " =-*#;<"
inlineSymbols :: [Char]