where
import Data.Maybe
-import Network.URI
+import Network.URI hiding (fragment)
import Rakka.Wiki
-import Text.ParserCombinators.Parsec
+import Text.ParserCombinators.Parsec hiding (label)
type CommandTypeOf = String -> Maybe CommandType
, horizontalLine
, listElement cmdTypeOf
, definitionList cmdTypeOf
- , pdata
+ , verbatim
, leadingSpaced cmdTypeOf
, paragraph cmdTypeOf
, blockCmd cmdTypeOf
listElement :: CommandTypeOf -> Parser BlockElement
-listElement cmdTypeOf = listElement' [] >>= return . List
+listElement cmdTypeOf = listElement' []
where
- listElement' :: [Char] -> Parser ListElement
+ listElement' :: [Char] -> Parser BlockElement
listElement' stack
= do t <- oneOf "*#"
ws
xs <- items (stack ++ [t])
- return (ListElement (toType t) xs)
+ return (List (toType t) xs)
- -- ListItem の終了條件は、
items :: [Char] -> Parser [ListItem]
items stack = do xs <- many1 $ inlineElement cmdTypeOf
nested <- option Nothing
string stack
listElement' stack >>= return . Just
rest <- items stack
- return $ (map Right xs ++ map Left (catMaybes [nested])) : rest
+ return $ (map Inline xs ++ map Block (catMaybes [nested])) : rest
<|>
(try $ do skipMany comment
newline
toType :: Char -> ListType
toType '*' = Bullet
toType '#' = Numbered
+ toType _ = undefined
definitionList :: CommandTypeOf -> Parser BlockElement
"description of term"
-pdata :: Parser BlockElement
-pdata = do try (string "<![PDATA[")
- many (oneOf " \t\n")
- x <- pdata'
- return (Preformatted [Text x])
+verbatim :: Parser BlockElement
+verbatim = do try (string "<!verbatim[")
+ many (oneOf " \t\n")
+ x <- verbatim'
+ return (Preformatted [Text x])
where
- pdata' :: Parser String
- pdata' = do try (many (oneOf " \t\n") >> string "]]>")
- return []
- <|>
- do x <- anyChar
- xs <- pdata'
- return (x:xs)
+ verbatim' :: Parser String
+ verbatim' = do try (many (oneOf " \t\n") >> string "]>")
+ return []
+ <|>
+ do x <- anyChar
+ xs <- verbatim'
+ return (x:xs)
leadingSpaced :: CommandTypeOf -> Parser BlockElement
return []
-blockCommand :: Parser BlockElement
-blockCommand = pzero -- not implemented
-
-
paragraph :: CommandTypeOf -> Parser BlockElement
paragraph cmdTypeOf = paragraph' >>= return . Paragraph
where
, bCmdAttributes = tagAttrs
, bCmdContents = xs
}
- _ -> pzero
+
+ Just InlineCommandType
+ -> pzero
+
+ _ -> return $ undefinedCmdErr tagName
)
<|>
(try $ do (tagName, tagAttrs) <- emptyTag
, bCmdAttributes = tagAttrs
, bCmdContents = []
}
- _ -> pzero
+
+ Just InlineCommandType
+ -> pzero
+
+ _ -> return $ undefinedCmdErr tagName
)
<?>
"block command"
<|>
return []
+ undefinedCmdErr :: String -> BlockElement
+ undefinedCmdErr name
+ = Div [("class", "error")]
+ [ Block (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
+ foldr (<|>) pzero [ nowiki
, apostrophes cmdTypeOf
, text
+ , objLink
, pageLink
, extLink
, inlineCmd cmdTypeOf
]
-cdata :: Parser InlineElement
-cdata = try (string "<![CDATA[") >> cdata' >>= return . Text
+nowiki :: Parser InlineElement
+nowiki = try (string "<!nowiki[") >> nowiki' >>= return . Text
where
- cdata' :: Parser String
- cdata' = do try (string "]]>")
- return []
- <|>
- do x <- anyChar
- xs <- cdata'
- return (x:xs)
+ nowiki' :: Parser String
+ nowiki' = do try (string "]>")
+ return []
+ <|>
+ do x <- anyChar
+ xs <- nowiki'
+ return (x:xs)
text :: Parser InlineElement
apos n = count n (char '\'') >> notFollowedBy (char '\'')
+objLink :: Parser InlineElement
+objLink = do try (string "[[[")
+ page <- many1 (noneOf "|]")
+ label <- option Nothing
+ (char '|' >> many1 (satisfy (/= ']')) >>= return . Just)
+ string "]]]"
+ return $ ObjectLink page label
+ <?>
+ "object link"
+
+
pageLink :: Parser InlineElement
pageLink = do try (string "[[")
page <- option Nothing
(many1 (noneOf "#|]") >>= return . Just)
fragment <- option Nothing
(char '#' >> many1 (noneOf "|]") >>= return . Just)
- text <- option Nothing
+ label <- option Nothing
(char '|' >> many1 (satisfy (/= ']')) >>= return . Just)
case (page, fragment) of
(_, _) -> return ()
string "]]"
- return $ PageLink page fragment text
+ return $ PageLink page fragment label
<?>
"page link"
extLink = do char '['
uriStr <- many1 (noneOf " \t]")
skipMany (oneOf " \t")
- text <- option Nothing
- (many1 (noneOf "]") >>= return . Just)
+ label <- option Nothing
+ (many1 (noneOf "]") >>= return . Just)
case parseURI uriStr of
- Just uri -> char ']' >> return (ExternalLink uri text)
+ Just uri -> char ']' >> return (ExternalLink uri label)
Nothing -> pzero <?> "absolute URI"
<?>
"external link"