markdown-0.1.7/ 0000755 0000000 0000000 00000000000 12215245431 011526 5 ustar 00 0000000 0000000 markdown-0.1.7/Setup.hs 0000644 0000000 0000000 00000000056 12215245431 013163 0 ustar 00 0000000 0000000 import Distribution.Simple main = defaultMain markdown-0.1.7/LICENSE 0000644 0000000 0000000 00000002767 12215245431 012547 0 ustar 00 0000000 0000000 Copyright (c)2011, Michael Snoyman All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Michael Snoyman nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. markdown-0.1.7/markdown.cabal 0000644 0000000 0000000 00000003764 12215245431 014346 0 ustar 00 0000000 0000000 Name: markdown Version: 0.1.7 Synopsis: Convert Markdown to HTML, with XSS protection Description: This library leverages existing high-performance libraries (attoparsec, blaze-html, text, and conduit), and should integrate well with existing codebases. Homepage: https://github.com/snoyberg/markdown License: BSD3 License-file: LICENSE Author: Michael Snoyman Maintainer: michael@snoyman.com Category: Web Build-type: Simple Extra-source-files: test/examples/*.html , test/examples/*.md , test/Tests/*.html , test/Tests/*.text Cabal-version: >=1.8 Library Exposed-modules: Text.Markdown Text.Markdown.Block Text.Markdown.Inline other-modules: Text.Markdown.Types Build-depends: base >= 4 && < 5 , blaze-html >= 0.4 , attoparsec >= 0.10 , attoparsec-conduit >= 0.5 , transformers >= 0.2.2 , conduit >= 0.5.2.1 , text , data-default >= 0.3 , xss-sanitize >= 0.3.3 , containers ghc-options: -Wall test-suite test hs-source-dirs: test main-is: main.hs other-modules: Block Inline type: exitcode-stdio-1.0 ghc-options: -Wall build-depends: markdown , base >= 4 && < 5 , hspec >= 1.3 , blaze-html , text , system-fileio , system-filepath , transformers , conduit , containers source-repository head type: git location: git://github.com/snoyberg/markdown.git markdown-0.1.7/Text/ 0000755 0000000 0000000 00000000000 12215245431 012452 5 ustar 00 0000000 0000000 markdown-0.1.7/Text/Markdown.hs 0000644 0000000 0000000 00000013643 12215245431 014577 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} module Text.Markdown ( -- * Functions markdown -- * Settings , MarkdownSettings , msXssProtect , msStandaloneHtml , msFencedHandlers , msBlockCodeRenderer , msLinkNewTab , msBlankBeforeBlockquote , msBlockFilter -- * Newtype , Markdown (..) -- * Fenced handlers , FencedHandler (..) , codeFencedHandler , htmlFencedHandler -- * Convenience re-exports , def ) where import Control.Arrow ((&&&)) import Text.Markdown.Inline import Text.Markdown.Block import Text.Markdown.Types import Prelude hiding (sequence, takeWhile) import Data.Default (Default (..)) import Data.Text (Text) import qualified Data.Text.Lazy as TL import Text.Blaze.Html (ToMarkup (..), Html) import Text.Blaze.Html.Renderer.Text (renderHtml) import Data.Conduit import qualified Data.Conduit.List as CL import Data.Monoid (Monoid (mappend, mempty, mconcat)) import Data.Functor.Identity (runIdentity) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as HA import Text.HTML.SanitizeXSS (sanitizeBalance) import qualified Data.Map as Map import Data.String (IsString) -- | A newtype wrapper providing a @ToHtml@ instance. newtype Markdown = Markdown TL.Text deriving(Monoid, IsString) instance ToMarkup Markdown where toMarkup (Markdown t) = markdown def t -- | Convert the given textual markdown content to HTML. -- -- >>> :set -XOverloadedStrings -- >>> import Text.Blaze.Html.Renderer.Text -- >>> renderHtml $ markdown def "# Hello World!" -- "
main = putStrLn "Hello world!"
--
-- Since: 0.1.2.1
, msLinkNewTab :: Bool
-- ^ If @True@, all generated links have the attribute target=_blank set,
-- causing them to be opened in a new tab or window.
--
-- Default: @False@
--
-- Since 0.1.4
, msBlankBeforeBlockquote :: Bool
-- ^ If @True@, a blank line is required before the start of a blockquote. Standard
-- markdown syntax does not require a blank line before a blockquote, but it is all
-- too easy for a > to end up at the beginning of a line by accident.
--
-- Default: @True@
--
-- Since 0.1.5
, msBlockFilter :: [Block [Inline]] -> [Block [Inline]]
-- ^ A function to filter and/or modify parsed blocks before they are
-- written to Html
--
-- Default: @id@
--
-- Since 0.1.7
}
-- | See 'msFencedHandlers.
--
-- Since 0.1.2
data FencedHandler = FHRaw (Text -> [Block Text])
-- ^ Wrap up the given raw content.
| FHParsed ([Block Text] -> [Block Text])
-- ^ Wrap up the given parsed content.
instance Default MarkdownSettings where
def = MarkdownSettings
{ msXssProtect = True
, msStandaloneHtml = empty
, msFencedHandlers = codeFencedHandler "```" `mappend` codeFencedHandler "~~~"
, msBlockCodeRenderer =
\lang (_,rendered) -> case lang of
Just l -> H.pre $ H.code H.! HA.class_ (H.toValue l) $ rendered
Nothing -> H.pre $ H.code $ rendered
, msLinkNewTab = False
, msBlankBeforeBlockquote = True
, msBlockFilter = id
}
-- | Helper for creating a 'FHRaw'.
--
-- Since 0.1.2
codeFencedHandler :: Text -- ^ Delimiter
-> Map Text (Text -> FencedHandler)
codeFencedHandler key = singleton key $ \lang -> FHRaw $
return . BlockCode (if T.null lang then Nothing else Just lang)
-- | Helper for creating a 'FHParsed'.
--
-- Note that the start and end parameters take a @Text@ parameter; this is the
-- text following the delimiter. For example, with the markdown:
--
-- > @@@ foo
--
-- @foo@ would be passed to start and end.
--
-- Since 0.1.2
htmlFencedHandler :: Text -- ^ Delimiter
-> (Text -> Text) -- ^ start HTML
-> (Text -> Text) -- ^ end HTML
-> Map Text (Text -> FencedHandler)
htmlFencedHandler key start end = singleton key $ \lang -> FHParsed $ \blocks ->
BlockHtml (start lang)
: blocks
++ [BlockHtml $ end lang]
data ListType = Ordered | Unordered
deriving (Show, Eq)
data Block inline
= BlockPara inline
| BlockList ListType (Either inline [Block inline])
| BlockCode (Maybe Text) Text
| BlockQuote [Block inline]
| BlockHtml Text
| BlockRule
| BlockHeading Int inline
| BlockReference Text Text
| BlockPlainText inline
deriving (Show, Eq)
instance Functor Block where
fmap f (BlockPara i) = BlockPara (f i)
fmap f (BlockList lt (Left i)) = BlockList lt $ Left $ f i
fmap f (BlockList lt (Right bs)) = BlockList lt $ Right $ map (fmap f) bs
fmap _ (BlockCode a b) = BlockCode a b
fmap f (BlockQuote bs) = BlockQuote $ map (fmap f) bs
fmap _ (BlockHtml t) = BlockHtml t
fmap _ BlockRule = BlockRule
fmap f (BlockHeading level i) = BlockHeading level (f i)
fmap _ (BlockReference x y) = BlockReference x y
fmap f (BlockPlainText x) = BlockPlainText (f x)
data Inline = InlineText Text
| InlineItalic [Inline]
| InlineBold [Inline]
| InlineCode Text
| InlineHtml Text
| InlineLink Text (Maybe Text) [Inline] -- ^ URL, title, content
| InlineImage Text (Maybe Text) Text -- ^ URL, title, content
| InlineFootnoteRef Integer -- ^ The footnote reference in the body
| InlineFootnote Integer
deriving (Show, Eq)
markdown-0.1.7/Text/Markdown/Block.hs 0000644 0000000 0000000 00000026661 12215245431 015635 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK hide #-}
module Text.Markdown.Block
( Block (..)
, ListType (..)
, toBlocks
) where
import Prelude
#if MIN_VERSION_conduit(1, 0, 0)
import Data.Conduit
#else
import Data.Conduit hiding ((=$=))
import Data.Conduit.Internal (pipeL)
#endif
import qualified Data.Conduit.Text as CT
import qualified Data.Conduit.List as CL
import Data.Text (Text)
import qualified Data.Text as T
import Data.Functor.Identity (runIdentity)
import Data.Char (isDigit)
import Text.Markdown.Types
import qualified Data.Set as Set
import qualified Data.Map as Map
#if !MIN_VERSION_conduit(1, 0, 0)
(=$=) :: Monad m => Pipe a a b x m y -> Pipe b b c y m z -> Pipe a a c x m z
(=$=) = pipeL
#endif
toBlocks :: Monad m => MarkdownSettings -> Conduit Text m (Block Text)
toBlocks ms =
mapOutput fixWS CT.lines =$= toBlocksLines ms
where
fixWS = T.pack . go 0 . T.unpack
go _ [] = []
go i ('\r':cs) = go i cs
go i ('\t':cs) =
(replicate j ' ') ++ go (i + j) cs
where
j = 4 - (i `mod` 4)
go i (c:cs) = c : go (i + 1) cs
toBlocksLines :: Monad m => MarkdownSettings -> Conduit Text m (Block Text)
toBlocksLines ms = awaitForever (start ms) =$= tightenLists
tightenLists :: Monad m => Conduit (Either Blank (Block Text)) m (Block Text)
tightenLists =
go Nothing
where
go mTightList =
await >>= maybe (return ()) go'
where
go' (Left Blank) = go mTightList
go' (Right (BlockList ltNew contents)) =
case mTightList of
Just (ltOld, isTight) | ltOld == ltNew -> do
yield $ BlockList ltNew $ (if isTight then tighten else untighten) contents
go mTightList
_ -> do
isTight <- checkTight ltNew False
yield $ BlockList ltNew $ (if isTight then tighten else untighten) contents
go $ Just (ltNew, isTight)
go' (Right b) = yield b >> go Nothing
tighten (Right [BlockPara t]) = Left t
tighten (Right []) = Left T.empty
tighten x = x
untighten (Left t) = Right [BlockPara t]
untighten x = x
checkTight lt sawBlank = do
await >>= maybe (return $ not sawBlank) go'
where
go' (Left Blank) = checkTight lt True
go' b@(Right (BlockList ltNext _)) | ltNext == lt = do
leftover b
return $ not sawBlank
go' b = leftover b >> return False
data Blank = Blank
data LineType = LineList ListType Text
| LineCode Text
| LineFenced Text FencedHandler -- ^ terminator, language
| LineBlockQuote Text
| LineHeading Int Text
| LineBlank
| LineText Text
| LineRule
| LineHtml Text
| LineReference Text Text -- ^ name, destination
lineType :: MarkdownSettings -> Text -> LineType
lineType ms t
| T.null $ T.strip t = LineBlank
| Just (term, fh) <- getFenced (Map.toList $ msFencedHandlers ms) t = LineFenced term fh
| Just t' <- T.stripPrefix "> " t = LineBlockQuote t'
| Just (level, t') <- stripHeading t = LineHeading level t'
| Just t' <- T.stripPrefix " " t = LineCode t'
| isRule t = LineRule
| isHtmlStart t = LineHtml t
| Just (ltype, t') <- listStart t = LineList ltype t'
| Just (name, dest) <- getReference t = LineReference name dest
| otherwise = LineText t
where
getFenced [] _ = Nothing
getFenced ((x, fh):xs) t'
| Just rest <- T.stripPrefix x t' = Just (x, fh $ T.strip rest)
| otherwise = getFenced xs t'
isRule :: Text -> Bool
isRule =
go . T.strip
where
go "* * *" = True
go "***" = True
go "*****" = True
go "- - -" = True
go "---" = True
go "___" = True
go "_ _ _" = True
go t' = T.length (T.takeWhile (== '-') t') >= 5
stripHeading :: Text -> Maybe (Int, Text)
stripHeading t'
| T.null x = Nothing
| otherwise = Just (T.length x, T.strip $ T.dropWhileEnd (== '#') y)
where
(x, y) = T.span (== '#') t'
getReference :: Text -> Maybe (Text, Text)
getReference a = do
b <- T.stripPrefix "[" $ T.dropWhile (== ' ') a
let (name, c) = T.break (== ']') b
d <- T.stripPrefix "]:" c
Just (name, T.strip d)
start :: Monad m => MarkdownSettings -> Text -> Conduit Text m (Either Blank (Block Text))
start ms t =
go $ lineType ms t
where
go LineBlank = yield $ Left Blank
go (LineFenced term fh) = do
(finished, ls) <- takeTillConsume (== term)
case finished of
Just _ -> do
let block =
case fh of
FHRaw fh' -> fh' $ T.intercalate "\n" ls
FHParsed fh' -> fh' $ runIdentity $ mapM_ yield ls $$ toBlocksLines ms =$ CL.consume
mapM_ (yield . Right) block
Nothing -> mapM_ leftover (reverse $ T.cons ' ' t : ls)
go (LineBlockQuote t') = do
ls <- takeQuotes =$= CL.consume
let blocks = runIdentity $ mapM_ yield (t' : ls) $$ toBlocksLines ms =$ CL.consume
yield $ Right $ BlockQuote blocks
go (LineHeading level t') = yield $ Right $ BlockHeading level t'
go (LineCode t') = do
ls <- getIndented 4 =$= CL.consume
yield $ Right $ BlockCode Nothing $ T.intercalate "\n" $ t' : ls
go LineRule = yield $ Right BlockRule
go (LineHtml t') = do
if t' `Set.member` msStandaloneHtml ms
then yield $ Right $ BlockHtml t'
else do
ls <- takeTill (T.null . T.strip) =$= CL.consume
yield $ Right $ BlockHtml $ T.intercalate "\n" $ t' : ls
go (LineList ltype t') = do
t2 <- CL.peek
case fmap (lineType ms) t2 of
-- If the next line is a non-indented text line, then we have a
-- lazy list.
Just (LineText t2') | T.null (T.takeWhile (== ' ') t2') -> do
CL.drop 1
-- Get all of the non-indented lines.
let loop front = do
x <- await
case x of
Nothing -> return $ front []
Just y ->
case lineType ms y of
LineText z -> loop (front . (z:))
_ -> leftover y >> return (front [])
ls <- loop (\rest -> T.dropWhile (== ' ') t' : t2' : rest)
yield $ Right $ BlockList ltype $ Right [BlockPara $ T.intercalate "\n" ls]
-- If the next line is an indented list, then we have a sublist. I
-- disagree with this interpretation of Markdown, but it's the way
-- that Github implements things, so we will too.
_ | Just t2' <- t2
, Just t2'' <- T.stripPrefix " " t2'
, LineList _ltype' _t2''' <- lineType ms t2'' -> do
ls <- getIndented 4 =$= CL.consume
let blocks = runIdentity $ mapM_ yield ls $$ toBlocksLines ms =$ CL.consume
let addPlainText
| T.null $ T.strip t' = id
| otherwise = (BlockPlainText (T.strip t'):)
yield $ Right $ BlockList ltype $ Right $ addPlainText blocks
_ -> do
let t'' = T.dropWhile (== ' ') t'
let leader = T.length t - T.length t''
ls <- getIndented leader =$= CL.consume
let blocks = runIdentity $ mapM_ yield (t'' : ls) $$ toBlocksLines ms =$ CL.consume
yield $ Right $ BlockList ltype $ Right blocks
go (LineReference x y) = yield $ Right $ BlockReference x y
go (LineText t') = do
-- Check for underline headings
let getUnderline :: Text -> Maybe Int
getUnderline s
| T.length s < 2 = Nothing
| T.all (== '=') s = Just 1
| T.all (== '-') s = Just 2
| otherwise = Nothing
t2 <- CL.peek
case t2 >>= getUnderline of
Just level -> do
CL.drop 1
yield $ Right $ BlockHeading level t'
Nothing -> do
let listStartIndent x =
case listStart x of
Just (_, y) -> T.take 2 y == " "
Nothing -> False
isNonPara LineBlank = True
isNonPara LineFenced{} = True
isNonPara LineBlockQuote{} = not $ msBlankBeforeBlockquote ms
isNonPara _ = False
(mfinal, ls) <- takeTillConsume (\x -> isNonPara (lineType ms x) || listStartIndent x)
maybe (return ()) leftover mfinal
yield $ Right $ BlockPara $ T.intercalate "\n" $ t' : ls
isHtmlStart :: T.Text -> Bool
isHtmlStart t =
case T.stripPrefix "<" t of
Nothing -> False
Just t' ->
let (name, rest) = T.break (\c -> c `elem` " >") t'
in T.all isValidTagName name &&
not (T.null name) &&
(not ("/" `T.isPrefixOf` rest) || ("/>" `T.isPrefixOf` rest))
where
isValidTagName :: Char -> Bool
isValidTagName c =
('A' <= c && c <= 'Z') ||
('a' <= c && c <= 'z') ||
('0' <= c && c <= '9') ||
(c == '-') ||
(c == '_') ||
(c == '/') ||
(c == '!')
takeTill :: Monad m => (i -> Bool) -> Conduit i m i
takeTill f =
loop
where
loop = await >>= maybe (return ()) (\x -> if f x then return () else yield x >> loop)
--takeTillConsume :: Monad m => (i -> Bool) -> Consumer i m (Maybe i, [i])
takeTillConsume f =
loop id
where
loop front = await >>= maybe
(return (Nothing, front []))
(\x ->
if f x
then return (Just x, front [])
else loop (front . (x:))
)
listStart :: Text -> Maybe (ListType, Text)
listStart t0
| Just t' <- T.stripPrefix "* " t = Just (Unordered, t')
| Just t' <- T.stripPrefix "+ " t = Just (Unordered, t')
| Just t' <- T.stripPrefix "- " t = Just (Unordered, t')
| Just t' <- stripNumber t, Just t'' <- stripSeparator t' = Just (Ordered, t'')
| otherwise = Nothing
where
t = T.stripStart t0
stripNumber :: Text -> Maybe Text
stripNumber x
| T.null y = Nothing
| otherwise = Just z
where
(y, z) = T.span isDigit x
stripSeparator :: Text -> Maybe Text
stripSeparator x =
case T.uncons x of
Nothing -> Nothing
Just ('.', y) -> Just y
Just (')', y) -> Just y
_ -> Nothing
getIndented :: Monad m => Int -> Conduit Text m Text
getIndented leader =
go []
where
go blanks = await >>= maybe (mapM_ leftover blanks) (go' blanks)
go' blanks t
| T.null $ T.strip t = go (T.drop leader t : blanks)
| T.length x == leader && T.null (T.strip x) = do
mapM_ yield $ reverse blanks
yield y
go []
| otherwise = mapM_ leftover (t:blanks)
where
(x, y) = T.splitAt leader t
takeQuotes :: Monad m => Conduit Text m Text
takeQuotes =
await >>= maybe (return ()) go
where
go "" = return ()
go ">" = yield "" >> takeQuotes
go t
| Just t' <- T.stripPrefix "> " t = yield t' >> takeQuotes
| otherwise = yield t >> takeQuotes
markdown-0.1.7/Text/Markdown/Inline.hs 0000644 0000000 0000000 00000016361 12215245431 016015 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK hide #-}
module Text.Markdown.Inline
( Inline (..)
, inlineParser
, toInline
) where
import Prelude hiding (takeWhile)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Attoparsec.Text
import Control.Applicative
import Data.Monoid (Monoid, mappend)
import qualified Data.Map as Map
import Text.Markdown.Types (Inline(..))
type RefMap = Map.Map Text Text
toInline :: RefMap -> Text -> [Inline]
toInline refmap t =
case parseOnly (inlineParser refmap) t of
Left s -> [InlineText $ T.pack s]
Right is -> is
(<>) :: Monoid m => m -> m -> m
(<>) = mappend
inlineParser :: RefMap -> Parser [Inline]
inlineParser = fmap combine . many . inlineAny
combine :: [Inline] -> [Inline]
combine [] = []
combine (InlineText x:InlineText y:rest) = combine (InlineText (x <> y):rest)
combine (InlineText x:rest) = InlineText x : combine rest
combine (InlineItalic x:InlineItalic y:rest) = combine (InlineItalic (x <> y):rest)
combine (InlineItalic x:rest) = InlineItalic (combine x) : combine rest
combine (InlineBold x:InlineBold y:rest) = combine (InlineBold (x <> y):rest)
combine (InlineBold x:rest) = InlineBold (combine x) : combine rest
combine (InlineCode x:InlineCode y:rest) = combine (InlineCode (x <> y):rest)
combine (InlineCode x:rest) = InlineCode x : combine rest
combine (InlineLink u t c:rest) = InlineLink u t (combine c) : combine rest
combine (InlineImage u t c:rest) = InlineImage u t c : combine rest
combine (InlineHtml t:rest) = InlineHtml t : combine rest
combine (InlineFootnote x:rest) = InlineFootnote x : combine rest
combine (InlineFootnoteRef x:rest) = InlineFootnoteRef x : combine rest
specials :: [Char]
specials = "*_`\\[]!<&{}"
inlineAny :: RefMap -> Parser Inline
inlineAny refs =
inline refs <|> special
where
special = InlineText . T.singleton <$> satisfy (`elem` specials)
inline :: RefMap -> Parser Inline
inline refs =
text
<|> escape
<|> footnote
<|> footnoteRef
<|> paired "**" InlineBold <|> paired "__" InlineBold
<|> paired "*" InlineItalic <|> paired "_" InlineItalic
<|> doubleCodeSpace <|> doubleCode <|> code
<|> link
<|> image
<|> autoLink
<|> html
<|> entity
where
inlinesTill :: Text -> Parser [Inline]
inlinesTill end =
go id
where
go front =
(string end *> pure (front []))
<|> (do
x <- inlineAny refs
go $ front . (x:))
text = InlineText <$> takeWhile1 (`notElem` specials)
paired t wrap = wrap <$> do
_ <- string t
is <- inlinesTill t
if null is then fail "wrapped around something missing" else return is
doubleCodeSpace = InlineCode . T.pack <$> (string "`` " *> manyTill anyChar (string " ``"))
doubleCode = InlineCode . T.pack <$> (string "``" *> manyTill anyChar (string "``"))
code = InlineCode <$> (char '`' *> takeWhile1 (/= '`') <* char '`')
footnoteRef = InlineFootnoteRef <$> (char '{' *> decimal <* char '}')
footnote = InlineFootnote <$> (string "{^" *> decimal <* char '}')
escape = InlineText . T.singleton <$> (char '\\' *> satisfy (`elem` "\\`*_{}[]()#+-.!>"))
takeBalancedBrackets =
T.pack <$> go (0 :: Int)
where
go i = do
c <- anyChar
case c of
'[' -> (c:) <$> go (i + 1)
']'
| i == 0 -> return []
| otherwise -> (c:) <$> go (i - 1)
_ -> (c:) <$> go i
parseUrl = fixUrl . T.pack <$> parseUrl' (0 :: Int)
parseUrl' level
| level > 0 = do
c <- anyChar
let level'
| c == ')' = level - 1
| otherwise = level
c' <-
if c == '\\'
then anyChar
else return c
cs <- parseUrl' level'
return $ c' : cs
| otherwise = (do
c <- hrefChar
if c == '('
then (c:) <$> parseUrl' 1
else (c:) <$> parseUrl' 0) <|> return []
parseUrlTitle defRef = parseUrlTitleInline <|> parseUrlTitleRef defRef
parseUrlTitleInside endTitle = do
url <- parseUrl
mtitle <- (Just <$> title) <|> (skipSpace >> endTitle >> pure Nothing)
return (url, mtitle)
where
title = do
_ <- space
skipSpace
_ <- char '"'
t <- T.stripEnd . T.pack <$> go
return $
if not (T.null t) && T.last t == '"'
then T.init t
else t
where
go = (char '\\' *> anyChar >>= \c -> (c:) <$> go)
<|> (endTitle *> return [])
<|> (anyChar >>= \c -> (c:) <$> go)
parseUrlTitleInline = char '(' *> parseUrlTitleInside (char ')')
parseUrlTitleRef defRef = do
ref' <- (skipSpace *> char '[' *> takeWhile (/= ']') <* char ']') <|> return ""
let ref = if T.null ref' then defRef else ref'
case Map.lookup (T.unwords $ T.words ref) refs of
Nothing -> fail "ref not found"
Just t -> either fail return $ parseOnly (parseUrlTitleInside endOfInput) t
link = do
_ <- char '['
rawContent <- takeBalancedBrackets
content <- either fail return $ parseOnly (inlineParser refs) rawContent
(url, mtitle) <- parseUrlTitle rawContent
return $ InlineLink url mtitle content
image = do
_ <- string "!["
content <- takeBalancedBrackets
(url, mtitle) <- parseUrlTitle content
return $ InlineImage url mtitle content
fixUrl t
| T.length t > 2 && T.head t == '<' && T.last t == '>' = T.init $ T.tail t
| otherwise = t
autoLink = do
_ <- char '<'
a <- string "http:" <|> string "https:"
b <- takeWhile1 (/= '>')
_ <- char '>'
let url = a `T.append` b
return $ InlineLink url Nothing [InlineText url]
html = do
c <- char '<'
t <- takeWhile1 (\x -> ('A' <= x && x <= 'Z') || ('a' <= x && x <= 'z') || x == '/')
if T.null t
then fail "invalid tag"
else do
t2 <- takeWhile (/= '>')
c2 <- char '>'
return $ InlineHtml $ T.concat
[ T.singleton c
, t
, t2
, T.singleton c2
]
entity =
rawent "<"
<|> rawent ">"
<|> rawent "&"
<|> rawent """
<|> rawent "'"
<|> decEnt
<|> hexEnt
rawent t = InlineHtml <$> string t
decEnt = do
s <- string ""
t <- takeWhile1 $ \x -> ('0' <= x && x <= '9')
c <- char ';'
return $ InlineHtml $ T.concat
[ s
, t
, T.singleton c
]
hexEnt = do
s <- string "" <|> string ""
t <- takeWhile1 $ \x -> ('0' <= x && x <= '9') || ('A' <= x && x <= 'F') || ('a' <= x && x <= 'f')
c <- char ';'
return $ InlineHtml $ T.concat
[ s
, t
, T.singleton c
]
hrefChar :: Parser Char
hrefChar = (char '\\' *> anyChar) <|> satisfy (notInClass " )")
markdown-0.1.7/test/ 0000755 0000000 0000000 00000000000 12215245431 012505 5 ustar 00 0000000 0000000 markdown-0.1.7/test/Block.hs 0000644 0000000 0000000 00000006124 12215245431 014076 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
module Block
( blockSpecs
) where
import Test.Hspec
import Data.Text (Text)
import Data.Conduit
import qualified Data.Conduit.List as CL
import Text.Markdown (def, MarkdownSettings(..))
import Text.Markdown.Block
import Data.Functor.Identity (runIdentity)
checkWith :: MarkdownSettings -> Text -> [Block Text] -> Expectation
checkWith ms md blocks = runIdentity (yield md $$ toBlocks ms =$ CL.consume) `shouldBe` blocks
check :: Text -> [Block Text] -> Expectation
check = checkWith def
blockSpecs :: Spec
blockSpecs = do
describe "tilde code" $ do
it "simple" $ check
"~~~haskell\nfoo\n\nbar\n~~~"
[BlockCode (Just "haskell") "foo\n\nbar"]
it "no lang" $ check
"~~~\nfoo\n\nbar\n~~~"
[BlockCode Nothing "foo\n\nbar"]
it "no close" $ check
"~~~\nfoo\n\nbar\n"
[BlockPara " ~~~\nfoo", BlockPara "bar"]
describe "list" $ do
it "simple" $ check
"* foo\n\n* bar\n\n"
[ BlockList Unordered (Right [BlockPara "foo"])
, BlockList Unordered (Right [BlockPara "bar"])
]
it "nested" $ check
"* foo\n* \n 1. bar\n 2. baz"
[ BlockList Unordered (Left "foo")
, BlockList Unordered (Right
[ BlockList Ordered $ Left "bar"
, BlockList Ordered $ Left "baz"
])
]
it "with blank" $ check
"* foo\n\n bar\n\n* baz"
[ BlockList Unordered $ Right
[ BlockPara "foo"
, BlockPara "bar"
]
, BlockList Unordered $ Right
[ BlockPara "baz"
]
]
describe "blockquote" $ do
it "simple" $ check
"> foo\n>\n> * bar"
[ BlockQuote
[ BlockPara "foo"
, BlockList Unordered $ Left "bar"
]
]
it "blank" $ check
"> foo\n\n> * bar"
[ BlockQuote [BlockPara "foo"]
, BlockQuote [BlockList Unordered $ Left "bar"]
]
it "require blank before blockquote" $ check
"foo\n> bar"
[ BlockPara "foo\n> bar" ]
it "no blank before blockquote" $ checkWith def { msBlankBeforeBlockquote = False }
"foo\n> bar"
[ BlockPara "foo", BlockQuote [BlockPara "bar"]]
describe "indented code" $ do
it "simple" $ check
" foo\n bar\n"
[ BlockCode Nothing "foo\nbar"
]
it "blank" $ check
" foo\n\n bar\n"
[ BlockCode Nothing "foo\n\nbar"
]
it "extra space" $ check
" foo\n\n bar\n"
[ BlockCode Nothing "foo\n\n bar"
]
describe "html" $ do
it "simple" $ check
"Hello world!
" [ BlockHtml "Hello world!
" ] it "multiline" $ check "Hello world!\n
" [ BlockHtml "Hello world!\n
" ] markdown-0.1.7/test/main.hs 0000644 0000000 0000000 00000022277 12215245431 013777 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-} import Text.Blaze.Html (toHtml) import Text.Blaze.Html5 (figure) import Test.Hspec import Text.Markdown import Data.Text.Lazy (Text, unpack, snoc, fromStrict) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Text.Blaze.Html.Renderer.Text (renderHtml) import Control.Monad (forM_) import qualified Data.Set as Set import qualified Data.Map as Map import qualified Filesystem.Path.CurrentOS as F import qualified Filesystem as F import Block import Inline check :: Text -> Text -> Expectation check html md = renderHtml (markdown def md) `shouldBe` html checkSet :: MarkdownSettings -> Text -> Text -> Expectation checkSet set html md = renderHtml (markdown set md) `shouldBe` html check' :: Text -> Text -> Expectation check' html md = renderHtml (markdown def { msXssProtect = False } md) `shouldBe` html checkNoNL :: Text -> Text -> Expectation checkNoNL html md = f (renderHtml $ markdown def { msXssProtect = False } md) `shouldBe` f html where f = TL.filter (/= '\n') -- FIXME add quickcheck: all input is valid main :: IO () main = do examples <- getExamples gruber <- getGruber hspec $ do describe "block" blockSpecs describe "inline" inlineSpecs describe "paragraphs" $ do it "simple" $ check "Hello World!
" "Hello World!" it "multiline" $ check "Hello\nWorld!
" "Hello\nWorld!" it "multiple" $ check "Hello
World!
" "Hello\n\nWorld!" describe "italics" $ do it "simple" $ check "foo
" "*foo*" it "hanging" $ check "foo *
" "*foo* *" it "two" $ check "foo bar
" "*foo* *bar*" describe "italics under" $ do it "simple" $ check "foo
" "_foo_" it "hanging" $ check "foo _
" "_foo_ _" it "two" $ check "foo bar
" "_foo_ _bar_" describe "bold" $ do it "simple" $ check "foo
" "**foo**" it "hanging" $ check "foo **
" "**foo** **" it "two" $ check "foo bar
" "**foo** **bar**" describe "bold under" $ do it "simple" $ check "foo
" "__foo__" it "hanging" $ check "foo __
" "__foo__ __" it "two" $ check "foo bar
" "__foo__ __bar__" describe "html" $ do it "simple" $ check "paragraph
foo bar
baz
foo\n bar\nbaz
"
" foo\n bar\n baz"
it "custom renderer"
$ checkSet
def { msBlockCodeRenderer = (\_ (u,_) -> figure (toHtml u)) }
"*foo_barbaz\\`bin
" "\\*foo\\_bar_baz_\\\\\\`bin" describe "bullets" $ do it "simple" $ check "" "> foo\n>\n> bar" describe "links" $ do it "simple" $ check "" "[bar](foo)" it "title" $ check "" "[bar](foo \"baz\")" it "escaped href" $ check "" "[bar](foo\\) \"baz\")" it "escaped title" $ check "" "[bar](foo\\) \"baz\\\"\")" it "inside a paragraph" $ check "foo
bar
Hello bar World
" "Hello [bar](foo) World" it "not a link" $ check "Not a [ link
" "Not a [ link" it "new tab" $ checkSet def { msLinkNewTab = True } "" "[bar](foo)" {- describe "github links" $ do it "simple" $ check "" "[[bar|foo]]" it "no link text" $ check "" "[[foo]]" it "escaping" $ check "" "[[bar|foo/baz bin]]" it "inside a list" $ check "" "* [[foo]]" -} describe "images" $ do it "simple" $ check "Hello World
Not an ![ image
" "Not an ![ image" describe "rules" $ do let options = concatMap (\t -> [t, snoc t '\n']) [ "* * *" , "***" , "*****" , "- - -" , "---------------------------------------" , "----------------------------------" ] forM_ options $ \o -> it (unpack o) $ check "foo
bar
foo
bar
1 < 2
" "1 < 2" it "standalone" $ checkSet def { msStandaloneHtml = Set.fromList ["foo\nbar
foo
bar
[1]hello
" "{1}hello" it "references" $ check "[1]hello
" "{^1}hello" describe "examples" $ sequence_ examples describe "John Gruber's test suite" $ sequence_ gruber getExamples :: IO [Spec] getExamples = do files <- F.listDirectory "test/examples" mapM go $ filter (flip F.hasExtension "md") files where go fp = do input <- F.readTextFile fp output <- F.readTextFile $ F.replaceExtension fp "html" return $ it (F.encodeString $ F.basename fp) $ check (fromStrict $ T.strip output) (fromStrict input) getGruber :: IO [Spec] getGruber = do files <- F.listDirectory "test/Tests" mapM go $ filter (flip F.hasExtension "text") files where go fp = do input <- F.readTextFile fp output <- F.readTextFile $ F.replaceExtension fp "html" return $ it (F.encodeString $ F.basename fp) $ checkNoNL (fromStrict $ T.strip output) (fromStrict input) markdown-0.1.7/test/Inline.hs 0000644 0000000 0000000 00000006022 12215245431 014257 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-} module Inline ( inlineSpecs ) where import Test.Hspec import Text.Markdown.Inline import Data.Text (Text) import Data.Monoid (mempty) check :: Text -> [Inline] -> Expectation check md ins = toInline mempty md `shouldBe` ins inlineSpecs :: Spec inlineSpecs = do describe "raw text" $ do it "simple" $ check "raw text" [InlineText "raw text"] it "multiline" $ check "raw\ntext" [InlineText "raw\ntext"] describe "italic" $ do it "asterisk" $ check "raw *text*" [InlineText "raw ", InlineItalic [InlineText "text"]] it "underline" $ check "raw _text_" [InlineText "raw ", InlineItalic [InlineText "text"]] it "multiline" $ check "*raw\ntext*" [InlineItalic [InlineText "raw\ntext"]] it "mismatched" $ check "*foo* *bar" [InlineItalic [InlineText "foo"], InlineText " *bar"] describe "bold" $ do it "asterisk" $ check "raw **text**" [InlineText "raw ", InlineBold [InlineText "text"]] it "underline" $ check "raw __text__" [InlineText "raw ", InlineBold [InlineText "text"]] it "multiline" $ check "**raw\ntext**" [InlineBold [InlineText "raw\ntext"]] it "mismatched" $ check "**foo** *bar" [InlineBold [InlineText "foo"], InlineText " *bar"] describe "nested" $ do it "bold inside italic" $ check "*i __ib__ i*" [InlineItalic [InlineText "i ", InlineBold [InlineText "ib"], InlineText " i"]] it "bold inside italic swap" $ check "_i **ib** i_" [InlineItalic [InlineText "i ", InlineBold [InlineText "ib"], InlineText " i"]] it "italic inside bold" $ check "**b _ib_ b**" [InlineBold [InlineText "b ", InlineItalic [InlineText "ib"], InlineText " b"]] it "italic inside bold swap" $ check "__b *ib* b__" [InlineBold [InlineText "b ", InlineItalic [InlineText "ib"], InlineText " b"]] describe "code" $ do it "takes all characters" $ check "`foo*__*bar` baz`" [ InlineCode "foo*__*bar" , InlineText " baz`" ] describe "escaping" $ do it "asterisk" $ check "\\*foo*\\\\" [InlineText "*foo*\\"] describe "links" $ do it "simple" $ check "[bar](foo)" [InlineLink "foo" Nothing [InlineText "bar"]] it "title" $ check "[bar](foo \"baz\")" [InlineLink "foo" (Just "baz") [InlineText "bar"]] {- it "escaped href" $ check "" "[bar](foo\\) \"baz\")" it "escaped title" $ check "" "[bar](foo\\) \"baz\\\"\")" it "inside a paragraph" $ check "Hello bar World
" "Hello [bar](foo) World" it "not a link" $ check "Not a [ link
" "Not a [ link" -} markdown-0.1.7/test/Tests/ 0000755 0000000 0000000 00000000000 12215245432 013610 5 ustar 00 0000000 0000000 markdown-0.1.7/test/Tests/Nested blockquotes.html 0000644 0000000 0000000 00000000131 12215245431 020226 0 ustar 00 0000000 0000000markdown-0.1.7/test/Tests/Inline HTML (Simple).html 0000644 0000000 0000000 00000001430 12215245431 017771 0 ustar 00 0000000 0000000foo
bar
foo
Here's a simple block:
This should be a code block, though:
<div>
foo
</div>
As should this:
<div>foo</div>
Now, nested:
This should just be an HTML comment:
Multiline:
Code block:
<!-- Comment -->
Just plain comment, with trailing spaces on the line:
Code:
<hr />
Hr's:
This is strong and em.
So is this word.
This is strong and em.
So is this word.
markdown-0.1.7/test/Tests/Links, shortcut references.html 0000755 0000000 0000000 00000000400 12215245431 021564 0 ustar 00 0000000 0000000This is the simple case.
This one has a line break.
This one has a line break with a line-ending space.
markdown-0.1.7/test/Tests/Ordered and unordered lists.html 0000644 0000000 0000000 00000003267 12215245432 021704 0 ustar 00 0000000 0000000Asterisks tight:
Asterisks loose:
asterisk 1
asterisk 2
asterisk 3
Pluses tight:
Pluses loose:
Plus 1
Plus 2
Plus 3
Minuses tight:
Minuses loose:
Minus 1
Minus 2
Minus 3
Tight:
and:
Loose using tabs:
First
Second
Third
and using spaces:
One
Two
Three
Multiple paragraphs:
Item 1, graf one.
Item 2. graf two. The quick brown fox jumped over the lazy dog's back.
Item 2.
Item 3.
Tab
Tab
Here's another:
Same thing but with paragraphs:
First
Second:
Third
This was an error in Markdown 1.0.1:
this
that
Just a URL.
URL wrapped in angle brackets.
URL w/ angle brackets + title.
(With outer parens and parens in url)
(With outer parens and parens in url)
markdown-0.1.7/test/Tests/Literal quotes in titles.text 0000644 0000000 0000000 00000000154 12215245432 021267 0 ustar 00 0000000 0000000 Foo [bar][]. Foo [bar](/url/ "Title with "quotes" inside"). [bar]: /url/ "Title with "quotes" inside" markdown-0.1.7/test/Tests/Code Blocks.text 0000644 0000000 0000000 00000000307 12215245432 016566 0 ustar 00 0000000 0000000 code block on the first line Regular text. code block indented by spaces Regular text. the lines in this block all contain trailing spaces Regular Text. code block on the last line markdown-0.1.7/test/Tests/Backslash escapes.text 0000644 0000000 0000000 00000002342 12215245432 020016 0 ustar 00 0000000 0000000 These should all get escaped: Backslash: \\ Backtick: \` Asterisk: \* Underscore: \_ Left brace: \{ Right brace: \} Left bracket: \[ Right bracket: \] Left paren: \( Right paren: \) Greater-than: \> Hash: \# Period: \. Bang: \! Plus: \+ Minus: \- These should not, because they occur within a code block: Backslash: \\ Backtick: \` Asterisk: \* Underscore: \_ Left brace: \{ Right brace: \} Left bracket: \[ Right bracket: \] Left paren: \( Right paren: \) Greater-than: \> Hash: \# Period: \. Bang: \! Plus: \+ Minus: \- Nor should these, which occur in code spans: Backslash: `\\` Backtick: `` \` `` Asterisk: `\*` Underscore: `\_` Left brace: `\{` Right brace: `\}` Left bracket: `\[` Right bracket: `\]` Left paren: `\(` Right paren: `\)` Greater-than: `\>` Hash: `\#` Period: `\.` Bang: `\!` Plus: `\+` Minus: `\-` These should get escaped, even though they're matching pairs for other Markdown constructs: \*asterisks\* \_underscores\_ \`backticks\` This is a code span with a literal backslash-backtick sequence: `` \` `` This is a tag with unescaped backticks bar. This is a tag with backslashes bar. markdown-0.1.7/test/Tests/Code Spans.text 0000644 0000000 0000000 00000000245 12215245432 016436 0 ustar 00 0000000 0000000 `AT&T has an ampersand in their name.
AT&T is another way to write it.
This & that.
4 < 5.
6 > 5.
Here's a link with an ampersand in the URL.
Here's a link with an amersand in the link text: AT&T.
Here's an inline link.
Here's an inline link.
markdown-0.1.7/test/Tests/Links, reference style.html 0000644 0000000 0000000 00000002151 12215245432 020671 0 ustar 00 0000000 0000000Foo bar.
Foo bar.
Foo bar.
With embedded [brackets].
Indented once.
Indented twice.
Indented thrice.
Indented [four][] times.
[four]: /url
this should work
So should this.
And this.
And this.
And this.
But not [that] [].
Nor [that][].
Nor [that].
[Something in brackets like this should work]
[Same with this.]
In this case, this points to something else.
Backslashing should suppress [this] and [this].
Here's one where the link breaks across lines.
Here's another where the link breaks across lines, but with a line-ending space.
markdown-0.1.7/test/Tests/Horizontal rules.text 0000644 0000000 0000000 00000000416 12215245432 017763 0 ustar 00 0000000 0000000 Dashes: --- --- --- --- --- - - - - - - - - - - - - - - - Asterisks: *** *** *** *** *** * * * * * * * * * * * * * * * Underscores: ___ ___ ___ ___ ___ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ markdown-0.1.7/test/Tests/Links, reference style.text 0000644 0000000 0000000 00000001427 12215245432 020716 0 ustar 00 0000000 0000000 Foo [bar] [1]. Foo [bar][1]. Foo [bar] [1]. [1]: /url/ "Title" With [embedded [brackets]] [b]. Indented [once][]. Indented [twice][]. Indented [thrice][]. Indented [four][] times. [once]: /url [twice]: /url [thrice]: /url [four]: /url [b]: /url/ * * * [this] [this] should work So should [this][this]. And [this] []. And [this][]. And [this]. But not [that] []. Nor [that][]. Nor [that]. [Something in brackets like [this][] should work] [Same with [this].] In this case, [this](/somethingelse/) points to something else. Backslashing should suppress \[this] and [this\]. [this]: foo * * * Here's one where the [link breaks] across lines. Here's another where the [link breaks] across lines, but with a line-ending space. [link breaks]: /url/ markdown-0.1.7/test/Tests/Tabs.text 0000644 0000000 0000000 00000000467 12215245432 015416 0 ustar 00 0000000 0000000 + this is a list item indented with tabs + this is a list item indented with spaces Code: this code block is indented by one tab And: this code block is indented by two tabs And: + this is an example list item indented with tabs + this is an example list item indented with spaces markdown-0.1.7/test/Tests/Nested blockquotes.text 0000644 0000000 0000000 00000000030 12215245432 020245 0 ustar 00 0000000 0000000 > foo > > > bar > > foo markdown-0.1.7/test/Tests/Inline HTML comments.text 0000644 0000000 0000000 00000000244 12215245432 020267 0 ustar 00 0000000 0000000 Paragraph one. Paragraph two. The end. markdown-0.1.7/test/Tests/Strong and em together.text 0000644 0000000 0000000 00000000153 12215245432 020700 0 ustar 00 0000000 0000000 ***This is strong and em.*** So is ***this*** word. ___This is strong and em.___ So is ___this___ word. markdown-0.1.7/test/Tests/Code Blocks.html 0000644 0000000 0000000 00000000470 12215245432 016547 0 ustar 00 0000000 0000000code block on the first line
Regular text.
code block indented by spaces
Regular text.
the lines in this block
all contain trailing spaces
Regular Text.
code block on the last line
markdown-0.1.7/test/Tests/Hard-wrapped paragraphs with list-like lines.html 0000644 0000000 0000000 00000000327 12215245432 025034 0 ustar 00 0000000 0000000 In Markdown 1.0.0 and earlier. Version 8. This line turns into a list item. Because a hard-wrapped line in the middle of a paragraph looked like a list item.
Here's one with a bullet. * criminey.
markdown-0.1.7/test/Tests/Markdown Documentation - Basics.html 0000644 0000000 0000000 00000022250 12215245432 022355 0 ustar 00 0000000 0000000This page offers a brief overview of what it's like to use Markdown. The syntax page provides complete, detailed documentation for every feature, but Markdown should be very easy to pick up simply by looking at a few examples of it in action. The examples on this page are written in a before/after style, showing example syntax and the HTML output produced by Markdown.
It's also helpful to simply try Markdown out; the Dingus is a web application that allows you type your own Markdown-formatted text and translate it to XHTML.
Note: This document is itself written using Markdown; you can see the source for it by adding '.text' to the URL.
A paragraph is simply one or more consecutive lines of text, separated by one or more blank lines. (A blank line is any line that looks like a blank line -- a line containing nothing spaces or tabs is considered blank.) Normal paragraphs should not be intended with spaces or tabs.
Markdown offers two styles of headers: Setext and atx.
Setext-style headers for <h1>
and <h2>
are created by
"underlining" with equal signs (=
) and hyphens (-
), respectively.
To create an atx-style header, you put 1-6 hash marks (#
) at the
beginning of the line -- the number of hashes equals the resulting
HTML header level.
Blockquotes are indicated using email-style '>
' angle brackets.
Markdown:
A First Level Header
====================
A Second Level Header
---------------------
Now is the time for all good men to come to
the aid of their country. This is just a
regular paragraph.
The quick brown fox jumped over the lazy
dog's back.
### Header 3
> This is a blockquote.
>
> This is the second paragraph in the blockquote.
>
> ## This is an H2 in a blockquote
Output:
<h1>A First Level Header</h1>
<h2>A Second Level Header</h2>
<p>Now is the time for all good men to come to
the aid of their country. This is just a
regular paragraph.</p>
<p>The quick brown fox jumped over the lazy
dog's back.</p>
<h3>Header 3</h3>
<blockquote>
<p>This is a blockquote.</p>
<p>This is the second paragraph in the blockquote.</p>
<h2>This is an H2 in a blockquote</h2>
</blockquote>
Markdown uses asterisks and underscores to indicate spans of emphasis.
Markdown:
Some of these words *are emphasized*.
Some of these words _are emphasized also_.
Use two asterisks for **strong emphasis**.
Or, if you prefer, __use two underscores instead__.
Output:
<p>Some of these words <em>are emphasized</em>.
Some of these words <em>are emphasized also</em>.</p>
<p>Use two asterisks for <strong>strong emphasis</strong>.
Or, if you prefer, <strong>use two underscores instead</strong>.</p>
Unordered (bulleted) lists use asterisks, pluses, and hyphens (*
,
+
, and -
) as list markers. These three markers are
interchangable; this:
* Candy.
* Gum.
* Booze.
this:
+ Candy.
+ Gum.
+ Booze.
and this:
- Candy.
- Gum.
- Booze.
all produce the same output:
<ul>
<li>Candy.</li>
<li>Gum.</li>
<li>Booze.</li>
</ul>
Ordered (numbered) lists use regular numbers, followed by periods, as list markers:
1. Red
2. Green
3. Blue
Output:
<ol>
<li>Red</li>
<li>Green</li>
<li>Blue</li>
</ol>
If you put blank lines between items, you'll get <p>
tags for the
list item text. You can create multi-paragraph list items by indenting
the paragraphs by 4 spaces or 1 tab:
* A list item.
With multiple paragraphs.
* Another item in the list.
Output:
<ul>
<li><p>A list item.</p>
<p>With multiple paragraphs.</p></li>
<li><p>Another item in the list.</p></li>
</ul>
Markdown supports two styles for creating links: inline and reference. With both styles, you use square brackets to delimit the text you want to turn into a link.
Inline-style links use parentheses immediately after the link text. For example:
This is an [example link](http://example.com/).
Output:
<p>This is an <a href="http://example.com/">
example link</a>.</p>
Optionally, you may include a title attribute in the parentheses:
This is an [example link](http://example.com/ "With a Title").
Output:
<p>This is an <a href="http://example.com/" title="With a Title">
example link</a>.</p>
Reference-style links allow you to refer to your links by names, which you define elsewhere in your document:
I get 10 times more traffic from [Google][1] than from
[Yahoo][2] or [MSN][3].
[1]: http://google.com/ "Google"
[2]: http://search.yahoo.com/ "Yahoo Search"
[3]: http://search.msn.com/ "MSN Search"
Output:
<p>I get 10 times more traffic from <a href="http://google.com/"
title="Google">Google</a> than from <a href="http://search.yahoo.com/"
title="Yahoo Search">Yahoo</a> or <a href="http://search.msn.com/"
title="MSN Search">MSN</a>.</p>
The title attribute is optional. Link names may contain letters, numbers and spaces, but are not case sensitive:
I start my morning with a cup of coffee and
[The New York Times][NY Times].
[ny times]: http://www.nytimes.com/
Output:
<p>I start my morning with a cup of coffee and
<a href="http://www.nytimes.com/">The New York Times</a>.</p>
Image syntax is very much like link syntax.
Inline (titles are optional):

Reference-style:
![alt text][id]
[id]: /path/to/img.jpg "Title"
Both of the above examples produce the same output:
<img src="/path/to/img.jpg" alt="alt text" title="Title" />
In a regular paragraph, you can create code span by wrapping text in
backtick quotes. Any ampersands (&
) and angle brackets (<
or
>
) will automatically be translated into HTML entities. This makes
it easy to use Markdown to write about HTML example code:
I strongly recommend against using any `<blink>` tags.
I wish SmartyPants used named entities like `—`
instead of decimal-encoded entites like `—`.
Output:
<p>I strongly recommend against using any
<code><blink></code> tags.</p>
<p>I wish SmartyPants used named entities like
<code>&mdash;</code> instead of decimal-encoded
entites like <code>&#8212;</code>.</p>
To specify an entire block of pre-formatted code, indent every line of
the block by 4 spaces or 1 tab. Just like with code spans, &
, <
,
and >
characters will be escaped automatically.
Markdown:
If you want your page to validate under XHTML 1.0 Strict,
you've got to put paragraph tags in your blockquotes:
<blockquote>
<p>For example.</p>
</blockquote>
Output:
<p>If you want your page to validate under XHTML 1.0 Strict,
you've got to put paragraph tags in your blockquotes:</p>
<pre><code><blockquote>
<p>For example.</p>
</blockquote>
</code></pre>
markdown-0.1.7/test/Tests/Tabs.html 0000644 0000000 0000000 00000000667 12215245432 015400 0 ustar 00 0000000 0000000 this is a list item indented with tabs
this is a list item indented with spaces
Code:
this code block is indented by one tab
And:
this code block is indented by two tabs
And:
+ this is an example list item
indented with tabs
+ this is an example list item
indented with spaces
markdown-0.1.7/test/Tests/Blockquotes with code blocks.html 0000644 0000000 0000000 00000000310 12215245432 022050 0 ustar 00 0000000 0000000 markdown-0.1.7/test/Tests/Blockquotes with code blocks.text 0000644 0000000 0000000 00000000207 12215245432 022075 0 ustar 00 0000000 0000000 > Example: > > sub status { > print "working"; > } > > Or: > > sub status { > return "working"; > } markdown-0.1.7/test/Tests/Inline HTML (Advanced).html 0000644 0000000 0000000 00000000532 12215245432 020250 0 ustar 00 0000000 0000000Example:
sub status { print "working"; }
Or:
sub status { return "working"; }
Simple block on one line:
And nested without indentation:
And with attributes:
This was broken in 1.0.2b7:
Foo bar.
Foo bar.
markdown-0.1.7/test/Tests/Images.html 0000644 0000000 0000000 00000001226 12215245432 015704 0 ustar 00 0000000 0000000Inline within a paragraph: alt text.
.