module Text.GentleMark.Parsec
( text
, bold, italic, underlined, striked, spoiler
, latex, monospace
, quote, reference, hyperlink
, ulist, olist
, tag
, paragraph, style, textualTerm, toplevelTerm
) where
import Text.GentleMark.Term
import Control.Applicative hiding ( (<|>), many )
import Data.Function
import Data.List
import Text.Parsec hiding ( newline, parse )
import qualified Text.Parsec as P
(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(f .: g) x y = f (g x y)
manyTill1 :: Stream s m Char => ParsecT s u m r -> ParsecT s u m e -> ParsecT s u m [r]
manyTill1 p end = (:) <$> p <*> p `manyTill` end
block :: Stream s m Char => ParsecT s u m r -> String -> ParsecT s u m [r]
block p sep = (string sep) *> p `manyTill` try (string sep)
eofOr :: Stream s m Char => ParsecT s u m a -> ParsecT s u m ()
eofOr p = () <$ p <|> eof
whitespaces :: Stream s m Char => ParsecT s u m [Char]
whitespaces = many (char ' ')
newline :: Stream s m Char => ParsecT s u m ()
newline = () <$ many1 P.newline <* whitespaces
hyperlinkPrefixes :: [String]
hyperlinkPrefixes = ["http:", "https:", "ftp:", "mailto:", "news:", "irc:"]
text, bold, italic, underlined, striked, spoiler, latex, monospace, reference, hyperlink, tag, style, textualTerm :: Stream s m Char => ParsecT s u m (Term Textual)
bold = Bold <$> block textualTerm "**"
italic = Italic <$> block textualTerm "~~"
underlined = Underlined <$> block textualTerm "__"
striked = Striked <$> block textualTerm "!!"
spoiler = Spoiler <$> block textualTerm "%%"
latex = Latex <$> block anyChar "$$"
monospace = Monospace <$> block anyChar "``"
reference = Reference <$> (string ">>" *> many1 digit)
hyperlink = Hyperlink .: (++)
<$> choice (map string hyperlinkPrefixes)
<*> anyChar `manyTill` lookAhead (eofOr space)
tag = do name <- char '[' *> many1 (noneOf "|]")
Tag name
<$> (many (char '|' *> many (noneOf "|]")) <* char ']')
<*> (anyChar `manyTill` eofOr (string ("[/" ++ name ++ "]")))
text = Text .: (:)
<$> (noneOf "\n " <|> (char ' ' <* whitespaces))
<*> many ((char ' ' <* whitespaces) <|> noneOf (linkChars ++ styleChars ++ ">[\n") <|> nonLink <|> nonStyle)
where
linkChars = map head hyperlinkPrefixes
nonLink = choice nonLinkParsers
where nonLinkParsers = map tryNonLink (groupBy ((==) `on` head) hyperlinkPrefixes)
tryNonLink ws@((c:_):_) = try $ char c <* notFollowedBy (choice $ map (string . tail) ws)
tryNonLink _ = error "tryNonLink received unsuitable list!"
styleChars = "*~_!%$`"
nonStyle = choice $ map (\c -> try $ char c <* notFollowedBy (char c)) styleChars
style = choice $ map try [bold, italic, underlined, striked, spoiler, latex, monospace]
textualTerm = choice [ try reference, try hyperlink, style, try tag, try text ]
quote, ulist, olist, paragraph, toplevelTerm :: Stream s m Char => ParsecT s u m (Term Toplevel)
quote = Quote <$> (char '>' *> anyChar `manyTill` newline)
ulist = UList <$> many1 (char '-' *> whitespaces *> textualTerm `manyTill` eofOr newline)
olist = OList <$> many1 ((,) <$> (read <$> (many1 digit <* char '.'))
<*> (whitespaces *> textualTerm `manyTill` eofOr newline))
paragraph = Paragraph <$> (textualTerm `manyTill1` eofOr newline)
toplevelTerm = choice $ map try [ ulist, olist, quote, paragraph ]