Permalink
Browse files

Definition lists - rough draft

  • Loading branch information...
1 parent 7a7733d commit 660ba656565c353b0e4676dabbac3432bdb9d13a @jgm committed May 31, 2011
Showing with 24 additions and 1 deletion.
  1. +3 −0 Text/Pandoc/Builder.hs
  2. +15 −1 Text/Pandoc/Reader/Markdown.hs
  3. +6 −0 Text/Pandoc/Writer/HTML.hs
@@ -89,6 +89,9 @@ bulletListLoose :: [Blocks] -> Blocks
bulletListLoose =
single . List ListAttr{ listTight = False, listStyle = Bullet }
+definitions :: [(Inlines, [Blocks])] -> Blocks
+definitions = single . Definitions
+
header :: Int -> Inlines -> Blocks
header n = single . Header n
@@ -269,7 +269,7 @@ pInlineNote = note . para
pBlock :: PMonad m => MP m (PR Blocks)
pBlock = choice [pQuote, pCode, pHrule, pList, pNote, pReference,
- pHeader, pHtmlBlock, pPara]
+ pHeader, pHtmlBlock, pDefinitions, pPara]
pBlocks :: PMonad m => MP m (PR Blocks)
pBlocks = option mempty $ mconcat <$> (pBlock `sepBy` pNewlines)
@@ -307,6 +307,20 @@ pHeaderATX = try $ do
let closeATX = try $ skipMany (sym '#') *> eol
header level . trimInlines <$$> mconcat <$> many1Till pInline closeATX
+pDefinitions :: PMonad m => MP m (PR Blocks)
+pDefinitions = do
+ items <- pDefinition `sepBy` (pNewlines *> notFollowedBy spnl)
+ return $ Future $ \s -> definitions (map (evalResult s) items)
+
+pDefinition :: PMonad m => MP m (PR (Inlines, [Blocks]))
+pDefinition = try $ do
+ term <- withEndline mzero pInlines
+ let sep = try $ nonindentSpace *> (sym '~' <|> sym ':') *> sps
+ -- maybe : let el = indentSpace
+ defs <- withBlockSep sep $ {- withEndline el $ -} pNewline *>
+ many1 (mconcat <$> (pBlock `sepBy` pNewlines))
+ return $ Future $ \s -> (evalResult s term, map (evalResult s) defs)
+
pList :: PMonad m => MP m (PR Blocks)
pList = do
marker <- lookAhead listStart
@@ -73,6 +73,12 @@ blockToHtml (List attr bs) =
Bullet -> H.ul <$> nl <> items
Ordered start sty _ -> ol <$> nl <> items
where ol = addStart start $ addStyle sty $ H.ol
+blockToHtml (Definitions items) = do
+ let toTerm ils = inlinesToHtml ils
+ let toDefs bs = mconcat $ map (\b -> nl <> blocksToHtml b) bs
+ let toItem (term, defs) = (H.dt <$> toTerm term)
+ <> nl <> (H.dd <$> toDefs defs)
+ H.dl <$> nl <> mconcat (map toItem items) <> nl
blockToHtml (Code attr t) = return $ addAttributes attr
$ H.pre $ H.code $ toHtml t
blockToHtml (RawBlock (Format "html") t) = return $ preEscapedText t

0 comments on commit 660ba65

Please sign in to comment.