Below, an example of a simple markdown parser (using the parsec library).
module Syntax (
Syntax (..)
, Text
, parseSyntax
, ParseError
) where
import Data.Text
import Data.String
import Text.Parsec
import Text.Parsec.Text
import Control.Monad (join)
{- Syntax Table
Italic: /.../
Bold: *...*
Language switch: $...$
Quote: {...}
Link: <...|...>
Image: [...]
Paragraph: |...|
Big: ^...^
-}
data Syntax =
Raw Text
| Italic Syntax
| Bold Syntax
| Lang Syntax
| Quote Syntax
| Link Text Text
| Image Text
| Par Syntax
| Big Syntax
| Seq Syntax Syntax
deriving Show -- For debugging
reschars :: [Char]
reschars = "/*${}<>[]|^"
p_Syntax :: Parser Syntax
p_Syntax = fmap (Prelude.foldr1 Seq) $ many1 $ choice $ fmap try [
p_Raw
, p_Chars Italic '/' '/'
, p_Chars Bold '*' '*'
, p_Chars Lang '$' '$'
, p_Chars Quote '{' '}'
, p_CharsT2 Link '<' '|' '>'
, p_CharsT Image '[' ']'
, p_Chars Par '|' '|'
, p_Chars Big '^' '^'
]
parseSyntax :: Text -> Either ParseError Syntax
parseSyntax = parse (withEOF p_Syntax) "SyntaxSource"
----------------------------------------------------
p_Chars :: (Syntax -> a) -> Char -> Char -> Parser a
p_Chars f c1 c2 = fmap f $ between (char c1) (char c2) $ p_Syntax
p_CharsT :: (Text -> a) -> Char -> Char -> Parser a
p_CharsT f c1 c2 = char c1 >> (fmap (f . fromString) $ many1 $ noneOf [c2])
>>= (char c2 >>) . return
p_CharsT2 :: (Text -> Text -> a) -> Char -> Char -> Char -> Parser a
p_CharsT2 f c1 c c2 = do
char c1
l <- many1 $ noneOf [c]
char c
s <- many1 $ noneOf [c2]
char c2
return $ f (fromString l) (fromString s)
p_Raw :: Parser Syntax
p_Raw = fmap (Raw . fromString) $ many1 $
try (char '\\' >> choice (fmap char reschars))
<|> noneOf reschars
withEOF :: (Stream s m t, Show t) => ParsecT s u m b -> ParsecT s u m b
withEOF = (>>= (eof >>) . return)
|
No comments:
Post a Comment