Merge pull request #1256 from tarleb/org-reader-improvements

Org reader improvements

5 files changed, 642 insertions, 253 deletions

diff --git a/COPYRIGHT b/COPYRIGHT
index 8bf62135e..cfec5a4bf 100644
--- a/COPYRIGHT
+++ b/COPYRIGHT
@@ -56,6 +56,13 @@ Copyright (C) 2010 Paul Rivier
 Released under the GPL.
 
 ----------------------------------------------------------------------
+src/Text/Pandoc/Readers/Org.hs
+tests/Tests/Readers/Org.hs
+Copyright (C) 2014 Albert Krewinkel
+
+Released under the GPL.
+
+----------------------------------------------------------------------
 src/Text/Pandoc/Biblio.hs
 Copyright (C) 2008-2010 Andrea Rossato
 
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 57e1ca560..053385d20 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -861,22 +861,6 @@ definitionList = do
   items <- fmap sequence $ many1 definitionListItem
   return $ B.definitionList <$> fmap compactify'DL items
 
-compactify'DL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
-compactify'DL items =
-  let defs = concatMap snd items
-      defBlocks = reverse $ concatMap B.toList defs
-      isPara (Para _) = True
-      isPara _        = False
-  in  case defBlocks of
-           (Para x:_) -> if not $ any isPara (drop 1 defBlocks)
-                            then let (t,ds) = last items
-                                     lastDef = B.toList $ last ds
-                                     ds' = init ds ++
-                                          [B.fromList $ init lastDef ++ [Plain x]]
-                                  in init items ++ [(t, ds')]
-                            else items
-           _          -> items
-
 --
 -- paragraph block
 --
@@ -1892,4 +1876,3 @@ doubleQuoted = try $ do
   (withQuoteContext InDoubleQuote $ doubleQuoteEnd >> return
        (fmap B.doubleQuoted . trimInlinesF $ contents))
    <|> (return $ return (B.str "\8220") <> contents)
-
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index bda0b0262..c71cc24be 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-
 Copyright (C) 2014 Albert Krewinkel <tarleb@moltkeplatz.de>
 
@@ -24,26 +25,32 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
    Maintainer  : Albert Krewinkel <tarleb@moltkeplatz.de>
 
-Conversion of Org-Mode to 'Pandoc' document.
+Conversion of org-mode formatted plain text to 'Pandoc' document.
 -}
 module Text.Pandoc.Readers.Org ( readOrg ) where
 
 import qualified Text.Pandoc.Builder as B
-import           Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>), HasMeta(..))
+import           Text.Pandoc.Builder ( Inlines, Blocks, HasMeta(..), (<>)
+                                     , trimInlines )
 import           Text.Pandoc.Definition
 import           Text.Pandoc.Options
 import qualified Text.Pandoc.Parsing as P
-import           Text.Pandoc.Parsing hiding (newline, orderedListMarker, updateLastStrPos)
-import           Text.Pandoc.Shared (compactify')
-
-import           Control.Applicative (pure, (<$>), (<$), (<*>), (<*), (*>), (<**>))
-import           Control.Arrow ((***))
-import           Control.Monad (guard, when)
+import           Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF
+                                            , newline, orderedListMarker
+                                            , parseFromString
+                                            , updateLastStrPos )
+import           Text.Pandoc.Shared (compactify', compactify'DL)
+
+import           Control.Applicative ( Applicative, pure
+                                     , (<$>), (<$), (<*>), (<*), (*>), (<**>) )
+import           Control.Monad (foldM, guard, liftM, liftM2, when)
+import           Control.Monad.Reader (Reader, runReader, ask, asks)
 import           Data.Char (toLower)
 import           Data.Default
-import           Data.List (foldl', isPrefixOf, isSuffixOf)
-import           Data.Maybe (listToMaybe, fromMaybe)
-import           Data.Monoid (mconcat, mempty, mappend)
+import           Data.List (intersperse, isPrefixOf, isSuffixOf)
+import qualified Data.Map as M
+import           Data.Maybe (listToMaybe, fromMaybe, isJust)
+import           Data.Monoid (Monoid, mconcat, mempty, mappend)
 
 -- | Parse org-mode string and return a Pandoc document.
 readOrg :: ReaderOptions -- ^ Reader options
@@ -53,27 +60,35 @@ readOrg opts s = readWith parseOrg def{ orgStateOptions = opts } (s ++ "\n\n")
 
 type OrgParser = Parser [Char] OrgParserState
 
-parseOrg:: OrgParser Pandoc
+parseOrg :: OrgParser Pandoc
 parseOrg = do
-  blocks' <- B.toList <$> parseBlocks
+  blocks' <- parseBlocks
   st <- getState
-  let meta = orgStateMeta st
-  return $ Pandoc meta $ filter (/= Null) blocks'
+  let meta = runF (orgStateMeta' st) st
+  return $ Pandoc meta $ filter (/= Null) (B.toList $ runF blocks' st)
 
 --
 -- Parser State for Org
 --
 
+type OrgNoteRecord = (String, F Blocks)
+type OrgNoteTable = [OrgNoteRecord]
+
+type OrgBlockAttributes = M.Map String String
+
 -- | Org-mode parser state
 data OrgParserState = OrgParserState
                       { orgStateOptions              :: ReaderOptions
+                      , orgStateBlockAttributes      :: OrgBlockAttributes
                       , orgStateEmphasisCharStack    :: [Char]
                       , orgStateEmphasisNewlines     :: Maybe Int
                       , orgStateLastForbiddenCharPos :: Maybe SourcePos
                       , orgStateLastPreCharPos       :: Maybe SourcePos
                       , orgStateLastStrPos           :: Maybe SourcePos
                       , orgStateMeta                 :: Meta
-                      } deriving (Show)
+                      , orgStateMeta'                :: F Meta
+                      , orgStateNotes'               :: OrgNoteTable
+                      }
 
 instance HasReaderOptions OrgParserState where
   extractReaderOptions = orgStateOptions
@@ -90,14 +105,30 @@ instance Default OrgParserState where
 defaultOrgParserState :: OrgParserState
 defaultOrgParserState = OrgParserState
                         { orgStateOptions = def
+                        , orgStateBlockAttributes = M.empty
                         , orgStateEmphasisCharStack = []
                         , orgStateEmphasisNewlines = Nothing
                         , orgStateLastForbiddenCharPos = Nothing
                         , orgStateLastPreCharPos = Nothing
                         , orgStateLastStrPos = Nothing
                         , orgStateMeta = nullMeta
+                        , orgStateMeta' = return nullMeta
+                        , orgStateNotes' = []
                         }
 
+addBlockAttribute :: String -> String -> OrgParser ()
+addBlockAttribute key val = updateState $ \s ->
+  let attrs = orgStateBlockAttributes s
+  in s{ orgStateBlockAttributes = M.insert key val attrs }
+
+lookupBlockAttribute :: String -> OrgParser (Maybe String)
+lookupBlockAttribute key =
+  M.lookup key . orgStateBlockAttributes <$> getState
+
+resetBlockAttributes :: OrgParser ()
+resetBlockAttributes = updateState $ \s ->
+  s{ orgStateBlockAttributes = orgStateBlockAttributes def }
+
 updateLastStrPos :: OrgParser ()
 updateLastStrPos = getPosition >>= \p ->
   updateState $ \s -> s{ orgStateLastStrPos = Just p }
@@ -111,19 +142,19 @@ updateLastPreCharPos = getPosition >>= \p ->
   updateState $ \s -> s{ orgStateLastPreCharPos = Just p}
 
 pushToInlineCharStack :: Char -> OrgParser ()
-pushToInlineCharStack c = updateState $ \st ->
-  st { orgStateEmphasisCharStack = c:orgStateEmphasisCharStack st }
+pushToInlineCharStack c = updateState $ \s ->
+  s{ orgStateEmphasisCharStack = c:orgStateEmphasisCharStack s }
 
 popInlineCharStack :: OrgParser ()
-popInlineCharStack = updateState $ \st ->
-  st { orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ st }
+popInlineCharStack = updateState $ \s ->
+  s{ orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ s }
 
 surroundingEmphasisChar :: OrgParser [Char]
 surroundingEmphasisChar = take 1 . drop 1 . orgStateEmphasisCharStack <$> getState
 
 startEmphasisNewlinesCounting :: Int -> OrgParser ()
 startEmphasisNewlinesCounting maxNewlines = updateState $ \s ->
-  s { orgStateEmphasisNewlines = Just maxNewlines }
+  s{ orgStateEmphasisNewlines = Just maxNewlines }
 
 decEmphasisNewlinesCount :: OrgParser ()
 decEmphasisNewlinesCount = updateState $ \s ->
@@ -138,6 +169,48 @@ resetEmphasisNewlines :: OrgParser ()
 resetEmphasisNewlines = updateState $ \s ->
   s{ orgStateEmphasisNewlines = Nothing }
 
+addToNotesTable :: OrgNoteRecord -> OrgParser ()
+addToNotesTable note = do
+  oldnotes <- orgStateNotes' <$> getState
+  updateState $ \s -> s{ orgStateNotes' = note:oldnotes }
+
+-- The version Text.Pandoc.Parsing cannot be used, as we need additional parts
+-- of the state saved and restored.
+parseFromString :: OrgParser a -> String -> OrgParser a
+parseFromString parser str' = do
+  oldLastPreCharPos <- orgStateLastPreCharPos <$> getState
+  updateState $ \s -> s{ orgStateLastPreCharPos = Nothing }
+  result <- P.parseFromString parser str'
+  updateState $ \s -> s{ orgStateLastPreCharPos = oldLastPreCharPos }
+  return result
+
+
+--
+-- Adaptions and specializations of parsing utilities
+--
+
+newtype F a = F { unF :: Reader OrgParserState a
+                } deriving (Monad, Applicative, Functor)
+
+runF :: F a -> OrgParserState -> a
+runF = runReader . unF
+
+askF :: F OrgParserState
+askF = F ask
+
+asksF :: (OrgParserState -> a) -> F a
+asksF f = F $ asks f
+
+instance Monoid a => Monoid (F a) where
+  mempty = return mempty
+  mappend = liftM2 mappend
+  mconcat = fmap mconcat . sequence
+
+trimInlinesF :: F Inlines -> F Inlines
+trimInlinesF = liftM trimInlines
+
+
+-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.
 newline :: OrgParser Char
 newline =
   P.newline
@@ -148,37 +221,83 @@ newline =
 -- parsing blocks
 --
 
-parseBlocks :: OrgParser Blocks
+parseBlocks :: OrgParser (F Blocks)
 parseBlocks = mconcat <$> manyTill block eof
 
-block :: OrgParser Blocks
+block :: OrgParser (F Blocks)
 block = choice [ mempty <$ blanklines
-               , orgBlock
+               , optionalAttributes $ choice
+                 [ orgBlock
+                 , figure
+                 , table
+                 ]
                , example
                , drawer
-               , figure
                , specialLine
                , header
-               , hline
+               , return <$> hline
                , list
-               , table
+               , latexFragment
+               , noteBlock
                , paraOrPlain
                ] <?> "block"
 
+optionalAttributes :: OrgParser (F Blocks) -> OrgParser (F Blocks)
+optionalAttributes parser = try $
+  resetBlockAttributes *> parseBlockAttributes *> parser
+
+parseBlockAttributes :: OrgParser ()
+parseBlockAttributes = do
+  attrs <- many attribute
+  () <$ mapM (uncurry parseAndAddAttribute) attrs
+ where
+   attribute :: OrgParser (String, String)
+   attribute = try $ do
+         key <- metaLineStart *> many1Till (noneOf "\n\r") (char ':')
+         val <- skipSpaces *> anyLine
+         return (map toLower key, val)
+
+parseAndAddAttribute :: String -> String -> OrgParser ()
+parseAndAddAttribute key value = do
+  let key' = map toLower key
+  () <$ addBlockAttribute key' value
+
+lookupInlinesAttr :: String -> OrgParser (Maybe (F Inlines))
+lookupInlinesAttr attr = try $ do
+  val <- lookupBlockAttribute attr
+  maybe (return Nothing)
+        (fmap Just . parseFromString parseInlines)
+        val
+
+
 --
 -- Org Blocks (#+BEGIN_... / #+END_...)
 --
 
-orgBlock :: OrgParser Blocks
+orgBlock :: OrgParser (F Blocks)
 orgBlock = try $ do
   (indent, blockType, args) <- blockHeader
-  blockStr <- rawBlockContent indent blockType
+  content <- rawBlockContent indent blockType
+  contentBlocks <- parseFromString parseBlocks (content ++ "\n")
   let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ]
   case blockType of
     "comment" -> return mempty
-    "src"     -> return $ B.codeBlockWith ("", classArgs, []) blockStr
-    _         -> B.divWith ("", [blockType], [])
-                 <$> parseFromString parseBlocks blockStr
+    "html"    -> returnF $ B.rawBlock "html" content
+    "latex"   -> returnF $ B.rawBlock "latex" content
+    "ascii"   -> returnF $ B.rawBlock "ascii" content
+    "example" -> returnF $ exampleCode content
+    "quote"   -> return  $ B.blockQuote <$> contentBlocks
+    "verse"   -> parseVerse content
+    "src"     -> codeBlockWithAttr classArgs content
+    _         -> return  $ B.divWith ("", [blockType], []) <$> contentBlocks
+ where
+   returnF :: a -> OrgParser (F a)
+   returnF = return . return
+
+   parseVerse :: String -> OrgParser (F Blocks)
+   parseVerse cs =
+       fmap B.para . mconcat . intersperse (pure B.linebreak)
+       <$> mapM (parseFromString parseInlines) (lines cs)
 
 blockHeader :: OrgParser (Int, String, [String])
 blockHeader = (,,) <$> blockIndent
@@ -188,6 +307,18 @@ blockHeader = (,,) <$> blockIndent
        blockType = map toLower <$> (stringAnyCase "#+begin_" *> many letter)
        blockArgs = manyTill (many nonspaceChar <* skipSpaces) newline
 
+codeBlockWithAttr :: [String] -> String -> OrgParser (F Blocks)
+codeBlockWithAttr classArgs content = do
+  identifier <- fromMaybe "" <$> lookupBlockAttribute "name"
+  caption <- lookupInlinesAttr "caption"
+  let codeBlck = B.codeBlockWith (identifier, classArgs, []) content
+  return $ maybe (pure codeBlck) (labelDiv codeBlck) caption
+ where
+   labelDiv blk value =
+       B.divWith nullAttr <$> (mappend <$> labelledBlock value
+                                       <*> pure blk)
+   labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], []))
+
 rawBlockContent :: Int -> String -> OrgParser String
 rawBlockContent indent blockType =
   unlines . map commaEscaped <$> manyTill indentedLine blockEnder
@@ -222,15 +353,18 @@ commaEscaped (',':cs@('*':_))     = cs
 commaEscaped (',':cs@('#':'+':_)) = cs
 commaEscaped cs                   = cs
 
-example :: OrgParser Blocks
-example = try $
-  B.codeBlockWith ("", ["example"], []) . unlines <$> many1 exampleLine
+example :: OrgParser (F Blocks)
+example = try $ do
+  return . return . exampleCode =<< unlines <$> many1 exampleLine
+
+exampleCode :: String -> Blocks
+exampleCode = B.codeBlockWith ("", ["example"], [])
 
 exampleLine :: OrgParser String
 exampleLine = try $ string ": " *> anyLine
 
 -- Drawers for properties or a logbook
-drawer :: OrgParser Blocks
+drawer :: OrgParser (F Blocks)
 drawer = try $ do
   drawerStart
   manyTill drawerLine (try drawerEnd)
@@ -256,41 +390,31 @@ drawerEnd = try $
 --
 
 -- Figures (Image on a line by itself, preceded by name and/or caption)
-figure :: OrgParser Blocks
+figure :: OrgParser (F Blocks)
 figure = try $ do
-  (tit, cap) <- (maybe mempty withFigPrefix *** fromMaybe mempty)
-                <$> nameAndOrCaption
+  (cap, nam) <- nameAndCaption
   src <- skipSpaces *> selfTarget <* skipSpaces <* newline
   guard (isImageFilename src)
-  return . B.para $ B.image src tit cap
- where withFigPrefix cs = if "fig:" `isPrefixOf` cs
-                          then cs
-                          else "fig:" ++ cs
-
-nameAndOrCaption :: OrgParser (Maybe String, Maybe Inlines)
-nameAndOrCaption = try $ nameFirst <|> captionFirst
+  return $ do
+    cap' <- cap
+    return $ B.para $ B.image src nam cap'
  where
-   nameFirst = try $ do
-                 n <- name
-                 c <- optionMaybe caption
-                 return (Just n, c)
-   captionFirst = try $ do
-                 c <- caption
-                 n <- optionMaybe name
-                 return (n, Just c)
-
-caption :: OrgParser Inlines
-caption = try $ annotation "CAPTION" *> inlinesTillNewline
-
-name :: OrgParser String
-name = try $ annotation "NAME" *> skipSpaces *> manyTill anyChar newline
-
-annotation :: String -> OrgParser String
-annotation ann = try $ metaLineStart *> stringAnyCase ann <* char ':'
+   nameAndCaption =
+       do
+         maybeCap <- lookupInlinesAttr "caption"
+         maybeNam <- lookupBlockAttribute "name"
+         guard $ isJust maybeCap || isJust maybeNam
+         return ( fromMaybe mempty maybeCap
+                , maybe mempty withFigPrefix maybeNam )
+   withFigPrefix cs =
+       if "fig:" `isPrefixOf` cs
+       then cs
+       else "fig:" ++ cs
 
+--
 -- Comments, Options and Metadata
-specialLine :: OrgParser Blocks
-specialLine = try $ metaLine <|> commentLine
+specialLine :: OrgParser (F Blocks)
+specialLine = fmap return . try $ metaLine <|> commentLine
 
 metaLine :: OrgParser Blocks
 metaLine = try $ metaLineStart *> declarationLine
@@ -308,29 +432,41 @@ commentLineStart = try $ mappend <$> many spaceChar <*> string "# "
 
 declarationLine :: OrgParser Blocks
 declarationLine = try $ do
-  meta' <- B.setMeta <$> metaKey <*> metaValue <*> pure nullMeta
-  updateState $ \st -> st { orgStateMeta  = orgStateMeta st <> meta' }
+  key <- metaKey
+  inlinesF <- metaInlines
+  updateState $ \st ->
+    let meta' = B.setMeta <$> pure key <*> inlinesF <*> pure nullMeta
+    in st { orgStateMeta' = orgStateMeta' st <> meta' }
   return mempty
 
-metaValue :: OrgParser MetaValue
-metaValue = MetaInlines . B.toList <$> inlinesTillNewline
+metaInlines :: OrgParser (F MetaValue)
+metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
 
 metaKey :: OrgParser String
 metaKey = map toLower <$> many1 (noneOf ": \n\r")
                       <*  char ':'
                       <*  skipSpaces
 
+--
+-- Headers
+--
+
 -- | Headers
-header :: OrgParser Blocks
-header = try $
-  B.header <$> headerStart
-           <*> inlinesTillNewline
+header :: OrgParser (F Blocks)
+header = try $ do
+  level <- headerStart
+  title <- inlinesTillNewline
+  return $ B.header level <$> title
 
 headerStart :: OrgParser Int
 headerStart = try $
   (length <$> many1 (char '*')) <* many1 (char ' ')
 
--- Horizontal Line (five dashes or more)
+
+-- Don't use (or need) the reader wrapper here, we want hline to be
+-- @show@able.  Otherwise we can't use it with @notFollowedBy'@.
+
+-- | Horizontal Line (five -- dashes or more)
 hline :: OrgParser Blocks
 hline = try $ do
   skipSpaces
@@ -344,27 +480,30 @@ hline = try $ do
 -- Tables
 --
 
-data OrgTableRow = OrgContentRow [Blocks]
+data OrgTableRow = OrgContentRow (F [Blocks])
                  | OrgAlignRow [Alignment]
                  | OrgHlineRow
- deriving (Eq, Show)
 
 data OrgTable = OrgTable
   { orgTableColumns    :: Int
   , orgTableAlignments :: [Alignment]
   , orgTableHeader     :: [Blocks]
   , orgTableRows       :: [[Blocks]]
-  } deriving (Eq, Show)
+  }
 
-table :: OrgParser Blocks
+table :: OrgParser (F Blocks)
 table = try $ do
   lookAhead tableStart
-  orgToPandocTable . normalizeTable . rowsToTable <$> tableRows
+  do
+    rows <- tableRows
+    cptn <- fromMaybe (pure "") <$> lookupInlinesAttr "caption"
+    return $ (<$> cptn) . orgToPandocTable . normalizeTable =<< rowsToTable rows
 
 orgToPandocTable :: OrgTable
+                 -> Inlines
                  -> Blocks
-orgToPandocTable (OrgTable _ aligns heads lns) =
-  B.table "" (zip aligns $ repeat 0) heads lns
+orgToPandocTable (OrgTable _ aligns heads lns) caption =
+  B.table caption (zip aligns $ repeat 0) heads lns
 
 tableStart :: OrgParser Char
 tableStart = try $ skipSpaces *> char '|'
@@ -374,11 +513,11 @@ tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)
 
 tableContentRow :: OrgParser OrgTableRow
 tableContentRow = try $
-  OrgContentRow <$> (tableStart *> manyTill tableContentCell newline)
+  OrgContentRow . sequence <$> (tableStart *> manyTill tableContentCell newline)
 
-tableContentCell :: OrgParser Blocks
+tableContentCell :: OrgParser (F Blocks)
 tableContentCell = try $
-  B.plain . trimInlines . mconcat <$> many1Till inline endOfCell
+  fmap B.plain . trimInlinesF . mconcat <$> many1Till inline endOfCell
 
 endOfCell :: OrgParser Char
 endOfCell = try $ char '|' <|> lookAhead newline
@@ -410,8 +549,8 @@ tableHline = try $
   OrgHlineRow <$ (tableStart *> char '-' *> anyLine)
 
 rowsToTable :: [OrgTableRow]
-            -> OrgTable
-rowsToTable = foldl' (flip rowToContent) zeroTable
+            -> F OrgTable
+rowsToTable = foldM (flip rowToContent) zeroTable
   where zeroTable = OrgTable 0 mempty mempty mempty
 
 normalizeTable :: OrgTable
@@ -430,57 +569,113 @@ normalizeTable (OrgTable cols aligns heads lns) =
 -- line as a header.  All other horizontal lines are discarded.
 rowToContent :: OrgTableRow
              -> OrgTable
-             -> OrgTable
-rowToContent OrgHlineRow        = maybeBodyToHeader
-rowToContent (OrgContentRow rs) = setLongestRow rs . appendToBody rs
-rowToContent (OrgAlignRow as)   = setLongestRow as . setAligns as
+             -> F OrgTable
+rowToContent OrgHlineRow        t = maybeBodyToHeader t
+rowToContent (OrgAlignRow as)   t = setLongestRow as =<< setAligns as t
+rowToContent (OrgContentRow rf) t = do
+  rs <- rf
+  setLongestRow rs =<< appendToBody rs t
 
 setLongestRow :: [a]
               -> OrgTable
-              -> OrgTable
-setLongestRow rs t = t{ orgTableColumns = max (length rs) (orgTableColumns t) }
+              -> F OrgTable
+setLongestRow rs t =
+  return t{ orgTableColumns = max (length rs) (orgTableColumns t) }
 
 maybeBodyToHeader :: OrgTable
-                  -> OrgTable
+                  -> F OrgTable
 maybeBodyToHeader t = case t of
   OrgTable{ orgTableHeader = [], orgTableRows = b:[] } ->
-         t{ orgTableHeader = b , orgTableRows = [] }
-  _   -> t
+         return t{ orgTableHeader = b , orgTableRows = [] }
+  _   -> return t
 
 appendToBody :: [Blocks]
              -> OrgTable
-             -> OrgTable
-appendToBody r t = t{ orgTableRows = orgTableRows t ++ [r] }
+             -> F OrgTable
+appendToBody r t = return t{ orgTableRows = orgTableRows t ++ [r] }
 
 setAligns :: [Alignment]
           -> OrgTable
-          -> OrgTable
-setAligns aligns t = t{ orgTableAlignments = aligns }
+          -> F OrgTable
+setAligns aligns t = return $ t{ orgTableAlignments = aligns }
+
+
+--
+-- LaTeX fragments
+--
+latexFragment :: OrgParser (F Blocks)
+latexFragment = try $ do
+  envName <- latexEnvStart
+  content <- mconcat <$> manyTill anyLineNewline (latexEnd envName)
+  return . return $ B.rawBlock "latex" (content `inLatexEnv` envName)
+ where
+   c `inLatexEnv` e = mconcat [ "\\begin{", e, "}\n"
+                              , c
+                              , "\\end{", e, "}\n"
+                              ]
+
+latexEnvStart :: OrgParser String
+latexEnvStart = try $ do
+  skipSpaces *> string "\\begin{"
+             *> latexEnvName
+             <* string "}"
+             <* blankline
+
+latexEnd :: String -> OrgParser ()
+latexEnd envName = try $
+  () <$ skipSpaces
+     <* string ("\\end{" ++ envName ++ "}")
+     <* blankline
+
+-- | Parses a LaTeX environment name.
+latexEnvName :: OrgParser String
+latexEnvName = try $ do
+  mappend <$> many1 alphaNum
+          <*> option "" (string "*")
+
+
+--
+-- Footnote defintions
+--
+noteBlock :: OrgParser (F Blocks)
+noteBlock = try $ do
+  ref <- noteMarker <* skipSpaces
+  content <- mconcat <$> blocksTillHeaderOrNote
+  addToNotesTable (ref, content)
+  return mempty
+ where
+   blocksTillHeaderOrNote =
+     many1Till block (eof <|> () <$ lookAhead noteMarker
+                          <|> () <$ lookAhead headerStart)
 
 -- Paragraphs or Plain text
-paraOrPlain :: OrgParser Blocks
+paraOrPlain :: OrgParser (F Blocks)
 paraOrPlain = try $
-  parseInlines <**> option B.plain (try $ newline *> pure B.para)
+  parseInlines <**> (fmap <$> option B.plain (try $ newline *> pure B.para))
 
-inlinesTillNewline :: OrgParser Inlines
-inlinesTillNewline = trimInlines . mconcat <$> manyTill inline newline
+inlinesTillNewline :: OrgParser (F Inlines)
+inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline
 
 
 --
 -- list blocks
 --
 
-list :: OrgParser Blocks
+list :: OrgParser (F Blocks)
 list = choice [ definitionList, bulletList, orderedList ] <?> "list"
 
-definitionList :: OrgParser Blocks
-definitionList = B.definitionList <$> many1 (definitionListItem bulletListStart)
+definitionList :: OrgParser (F Blocks)
+definitionList = fmap B.definitionList . fmap compactify'DL . sequence
+                 <$> many1 (definitionListItem bulletListStart)
 
-bulletList :: OrgParser Blocks
-bulletList = B.bulletList . compactify' <$> many1 (listItem bulletListStart)
+bulletList :: OrgParser (F Blocks)
+bulletList = fmap B.bulletList . fmap compactify' . sequence
+             <$> many1 (listItem bulletListStart)
 
-orderedList :: OrgParser Blocks
-orderedList = B.orderedList . compactify' <$> many1 (listItem orderedListStart)
+orderedList :: OrgParser (F Blocks)
+-- orderedList = B.orderedList . compactify' <$> many1 (listItem orderedListStart)
+orderedList = fmap B.orderedList . fmap compactify' . sequence
+              <$> many1 (listItem orderedListStart)
 
 genericListStart :: OrgParser String
                  -> OrgParser Int
@@ -499,33 +694,36 @@ orderedListStart = genericListStart orderedListMarker
   where orderedListMarker = mappend <$> many1 digit <*> (pure <$> oneOf ".)")
 
 definitionListItem :: OrgParser Int
-                   -> OrgParser (Inlines, [Blocks])
+                   -> OrgParser (F (Inlines, [Blocks]))
 definitionListItem parseMarkerGetLength = try $ do
   markerLength <- parseMarkerGetLength
   term <- manyTill (noneOf "\n\r") (try $ string "::")
   first <- anyLineNewline
+  blank <- option "" ("\n" <$ blankline)
   cont <- concat <$> many (listContinuation markerLength)
   term' <- parseFromString inline term
-  contents' <- parseFromString parseBlocks $ first ++ cont
-  return (term', [contents'])
+  contents' <- parseFromString parseBlocks $ first ++ blank ++ cont
+  return $ (,) <$> term' <*> fmap (:[]) contents'
 
 
 -- parse raw text for one list item, excluding start marker and continuations
 listItem :: OrgParser Int
-         -> OrgParser Blocks
+         -> OrgParser (F Blocks)
 listItem start = try $ do
   markerLength <- try start
   firstLine <- anyLineNewline
+  blank <- option "" ("\n" <$ blankline)
   rest <- concat <$> many (listContinuation markerLength)
-  parseFromString parseBlocks $ firstLine ++ rest
+  parseFromString parseBlocks $ firstLine ++ blank ++ rest
 
 -- continuation of a list item - indented and separated by blankline or endline.
 -- Note: nested lists are parsed as continuations.
 listContinuation :: Int
                  -> OrgParser String
 listContinuation markerLength = try $
-  mappend <$> many blankline
-          <*> (concat <$> many1 listLine)
+  notFollowedBy' blankline
+  *> (mappend <$> (concat <$> many1 listLine)
+              <*> many blankline)
  where listLine = try $ indentWith markerLength *> anyLineNewline
 
 anyLineNewline :: OrgParser String
@@ -536,11 +734,12 @@ anyLineNewline = (++ "\n") <$> anyLine
 -- inline
 --
 
-inline :: OrgParser Inlines
+inline :: OrgParser (F Inlines)
 inline =
   choice [ whitespace
          , linebreak
-         , link
+         , footnote
+         , linkOrImage
          , str
          , endline
          , emph
@@ -557,67 +756,104 @@ inline =
          ] <* (guard =<< newlinesCountWithinLimits)
   <?> "inline"
 
-parseInlines :: OrgParser Inlines
-parseInlines = trimInlines . mconcat <$> many1 inline
+parseInlines :: OrgParser (F Inlines)
+parseInlines = trimInlinesF . mconcat <$> many1 inline
 
 -- treat these as potentially non-text when parsing inline:
 specialChars :: [Char]
 specialChars = "\"$'()*+-./:<=>[\\]^_{|}~"
 
 
-whitespace :: OrgParser Inlines
-whitespace = B.space <$ skipMany1 spaceChar
-                     <* updateLastPreCharPos
-                     <* updateLastForbiddenCharPos
+whitespace :: OrgParser (F Inlines)
+whitespace = pure B.space <$ skipMany1 spaceChar
+                          <* updateLastPreCharPos
+                          <* updateLastForbiddenCharPos
              <?> "whitespace"
 
-linebreak :: OrgParser Inlines
-linebreak = try $ B.linebreak <$ string "\\\\" <* skipSpaces <* newline
+linebreak :: OrgParser (F Inlines)
+linebreak = try $ pure B.linebreak <$ string "\\\\" <* skipSpaces <* newline
 
-str :: OrgParser Inlines
-str = B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")
-            <* updateLastStrPos
+str :: OrgParser (F Inlines)
+str = return . B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")
+      <* updateLastStrPos
 
--- an endline character that can be treated as a space, not a structural break
-endline :: OrgParser Inlines
+-- | An endline character that can be treated as a space, not a structural
+-- break.  This should reflect the values of the Emacs variable
+-- @org-element-pagaraph-separate@.
+endline :: OrgParser (F Inlines)
 endline = try $ do
   newline
   notFollowedBy blankline
   notFollowedBy' exampleLine
   notFollowedBy' hline
+  notFollowedBy' noteMarker
   notFollowedBy' tableStart
   notFollowedBy' drawerStart
   notFollowedBy' headerStart
   notFollowedBy' metaLineStart
+  notFollowedBy' latexEnvStart
   notFollowedBy' commentLineStart
   notFollowedBy' bulletListStart
   notFollowedBy' orderedListStart
   decEmphasisNewlinesCount
   guard =<< newlinesCountWithinLimits
   updateLastPreCharPos
-  return B.space
+  return . return $ B.space
+
+footnote :: OrgParser (F Inlines)
+footnote = try $ inlineNote <|> referencedNote
+
+inlineNote :: OrgParser (F Inlines)
+inlineNote = try $ do
+  string "[fn:"
+  ref <- many alphaNum
+  char ':'
+  note <- fmap B.para . trimInlinesF . mconcat <$> many1Till inline (char ']')
+  when (not $ null ref) $
+       addToNotesTable ("fn:" ++ ref, note)
+  return $ B.note <$> note
+
+referencedNote :: OrgParser (F Inlines)
+referencedNote = try $ do
+  ref <- noteMarker
+  return $ do
+    notes <- asksF orgStateNotes'
+    case lookup ref notes of
+      Nothing   -> return $ B.str $ "[" ++ ref ++ "]"
+      Just contents  -> do
+        st <- askF
+        let contents' = runF contents st{ orgStateNotes' = [] }
+        return $ B.note contents'
+
+noteMarker :: OrgParser String
+noteMarker = try $ do
+  char '['
+  choice [ many1Till digit (char ']')
+         , (++) <$> string "fn:"
+                <*> many1Till (noneOf "\n\r\t ") (char ']')
+         ]
 
-link :: OrgParser Inlines
-link = explicitOrImageLink <|> selflinkOrImage <?> "link"
+linkOrImage :: OrgParser (F Inlines)
+linkOrImage = explicitOrImageLink <|> selflinkOrImage <?> "link or image"
 
-explicitOrImageLink :: OrgParser Inlines
+explicitOrImageLink :: OrgParser (F Inlines)
 explicitOrImageLink = try $ do
   char '['
   src    <- linkTarget
   title  <- enclosedRaw (char '[') (char ']')
   title' <- parseFromString (mconcat <$> many inline) title
   char ']'
-  return . B.link src ""
-         $ if isImageFilename src && isImageFilename title
-           then B.image title "" ""
-           else title'
+  return $ B.link src ""  <$>
+         if isImageFilename src && isImageFilename title
+            then return $ B.image title mempty mempty
+            else title'
 
-selflinkOrImage :: OrgParser Inlines
+selflinkOrImage :: OrgParser (F Inlines)
 selflinkOrImage = try $ do
   src <- char '[' *> linkTarget <* char ']'
-  return $ if isImageFilename src
-           then B.image src "" ""
-           else B.link src "" (B.str src)
+  return . return $ if isImageFilename src
+                    then B.image src "" ""
+                    else B.link src "" (B.str src)
 
 selfTarget :: OrgParser String
 selfTarget = try $ char '[' *> linkTarget <* char ']'
@@ -628,57 +864,56 @@ linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r]")
 isImageFilename :: String -> Bool
 isImageFilename filename =
   any (\x -> ('.':x)  `isSuffixOf` filename) imageExtensions &&
-  any (\x -> (x++":") `isPrefixOf` filename) protocols ||
-  ':' `notElem` filename
+  (any (\x -> (x++":") `isPrefixOf` filename) protocols ||
+   ':' `notElem` filename)
  where
    imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]
    protocols = [ "file", "http", "https" ]
 
-emph      :: OrgParser Inlines
-emph      = B.emph         <$> emphasisBetween '/'
+emph      :: OrgParser (F Inlines)
+emph      = fmap B.emph         <$> emphasisBetween '/'
 
-strong    :: OrgParser Inlines
-strong    = B.strong       <$> emphasisBetween '*'
+strong    :: OrgParser (F Inlines)
+strong    = fmap B.strong       <$> emphasisBetween '*'
 
-strikeout :: OrgParser Inlines
-strikeout = B.strikeout    <$> emphasisBetween '+'
+strikeout :: OrgParser (F Inlines)
+strikeout = fmap B.strikeout    <$> emphasisBetween '+'
 
 -- There is no underline, so we use strong instead.
-underline :: OrgParser Inlines
-underline = B.strong       <$> emphasisBetween '_'
-
-code      :: OrgParser Inlines
-code      = B.code         <$> verbatimBetween '='
+underline :: OrgParser (F Inlines)
+underline = fmap B.strong       <$> emphasisBetween '_'
 
-verbatim  :: OrgParser Inlines
-verbatim  = B.rawInline "" <$> verbatimBetween '~'
+code      :: OrgParser (F Inlines)
+code      = return . B.code         <$> verbatimBetween '='
 
-math      :: OrgParser Inlines
-math      = B.math         <$> choice [ math1CharBetween '$'
-                                      , mathStringBetween '$'
-                                      , rawMathBetween "\\(" "\\)"
-                                      ]
+verbatim  :: OrgParser (F Inlines)
+verbatim  = return . B.rawInline "" <$> verbatimBetween '~'
 
-displayMath :: OrgParser Inlines
-displayMath = B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"
-                                       , rawMathBetween "$$"  "$$"
-                                       ]
+subscript   :: OrgParser (F Inlines)
+subscript   = fmap B.subscript   <$> try (char '_' *> subOrSuperExpr)
 
-subscript   :: OrgParser Inlines
-subscript   = B.subscript   <$> try (char '_' *> subOrSuperExpr)
+superscript :: OrgParser (F Inlines)
+superscript = fmap B.superscript <$> try (char '^' *> subOrSuperExpr)
 
-superscript :: OrgParser Inlines
-superscript = B.superscript <$> try (char '^' *> subOrSuperExpr)
+math      :: OrgParser (F Inlines)
+math      = return . B.math      <$> choice [ math1CharBetween '$'
+                                            , mathStringBetween '$'
+                                            , rawMathBetween "\\(" "\\)"
+                                            ]
 
-symbol :: OrgParser Inlines
-symbol = B.str . (: "") <$> (oneOf specialChars >>= updatePositions)
+displayMath :: OrgParser (F Inlines)
+displayMath = return . B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"
+                                                , rawMathBetween "$$"  "$$"
+                                                ]
+symbol :: OrgParser (F Inlines)
+symbol = return . B.str . (: "") <$> (oneOf specialChars >>= updatePositions)
  where updatePositions c
            | c `elem` emphasisPreChars = c <$ updateLastPreCharPos
            | c `elem` emphasisForbiddenBorderChars = c <$ updateLastForbiddenCharPos
            | otherwise = return c
 
 emphasisBetween :: Char
-                -> OrgParser Inlines
+                -> OrgParser (F Inlines)
 emphasisBetween c = try $ do
   startEmphasisNewlinesCounting emphasisAllowedNewlines
   res <- enclosedInlines (emphasisStart c) (emphasisEnd c)
@@ -711,7 +946,7 @@ math1CharBetween c = try $ do
   char c
   res <- noneOf $ c:mathForbiddenBorderChars
   char c
-  eof <|> lookAhead (oneOf mathPostChars) *> return ()
+  eof <|> () <$ lookAhead (oneOf mathPostChars)
   return [res]
 
 rawMathBetween :: String
@@ -734,12 +969,12 @@ emphasisEnd :: Char -> OrgParser Char
 emphasisEnd c = try $ do
   guard =<< notAfterForbiddenBorderChar
   char c
-  eof <|> lookAhead (surroundingEmphasisChar >>= \x ->
-                         oneOf (x ++ emphasisPostChars))
-          *> return ()
+  eof <|> () <$ lookAhead acceptablePostChars
   updateLastStrPos
   popInlineCharStack
   return c
+ where acceptablePostChars =
+           surroundingEmphasisChar >>= \x -> oneOf (x ++ emphasisPostChars)
 
 mathStart :: Char -> OrgParser Char
 mathStart c = try $
@@ -749,15 +984,15 @@ mathEnd :: Char -> OrgParser Char
 mathEnd c = try $ do
   res <- noneOf (c:mathForbiddenBorderChars)
   char c
-  eof <|> lookAhead (oneOf mathPostChars *> pure ())
+  eof <|> () <$ lookAhead (oneOf mathPostChars)
   return res
 
 
 enclosedInlines :: OrgParser a
                 -> OrgParser b
-                -> OrgParser Inlines
+                -> OrgParser (F Inlines)
 enclosedInlines start end = try $
-  trimInlines . mconcat <$> enclosed start end inline
+  trimInlinesF . mconcat <$> enclosed start end inline
 
 enclosedRaw :: OrgParser a
             -> OrgParser b
@@ -843,25 +1078,13 @@ notAfterForbiddenBorderChar = do
   return $ lastFBCPos /= Just pos
 
 -- | Read a sub- or superscript expression
-subOrSuperExpr :: OrgParser Inlines
-subOrSuperExpr = try $ do
-  choice [ balancedSexp '{' '}'
-         , balancedSexp '(' ')' >>= return . enclosing ('(', ')')
+subOrSuperExpr :: OrgParser (F Inlines)
+subOrSuperExpr = try $
+  choice [ id                   <$> charsInBalanced '{' '}' (noneOf "\n\r")
+         , enclosing ('(', ')') <$> charsInBalanced '(' ')' (noneOf "\n\r")
          , simpleSubOrSuperString
          ] >>= parseFromString (mconcat <$> many inline)
-
--- | Read a balanced sexp
-balancedSexp :: Char
-             -> Char
-             -> OrgParser String
-balancedSexp l r = try $ do
-  char l
-  res <- concat <$> many (  many1 (noneOf ([l, r] ++ "\n\r"))
-                        <|> try (string [l, r])
-                        <|> enclosing (l, r) <$> balancedSexp l r
-                         )
-  char r
-  return res
+ where enclosing (left, right) s = left : s ++ [right]
 
 simpleSubOrSuperString :: OrgParser String
 simpleSubOrSuperString = try $
@@ -869,8 +1092,3 @@ simpleSubOrSuperString = try $
          , mappend <$> option [] ((:[]) <$> oneOf "+-")
                    <*> many1 alphaNum
          ]
-
-enclosing :: (a, a)
-          -> [a]
-          -> [a]
-enclosing (left, right) s = left : s ++ [right]
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 27ef6a579..6f0629ea2 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -56,6 +56,7 @@ module Text.Pandoc.Shared (
                      stringify,
                      compactify,
                      compactify',
+                     compactify'DL,
                      Element (..),
                      hierarchicalize,
                      uniqueIdent,
@@ -82,7 +83,7 @@ module Text.Pandoc.Shared (
 import Text.Pandoc.Definition
 import Text.Pandoc.Walk
 import Text.Pandoc.Generic
-import Text.Pandoc.Builder (Blocks, ToMetaValue(..))
+import Text.Pandoc.Builder (Inlines, Blocks, ToMetaValue(..))
 import qualified Text.Pandoc.Builder as B
 import qualified Text.Pandoc.UTF8 as UTF8
 import System.Environment (getProgName)
@@ -435,6 +436,21 @@ compactify' items =
                             _   -> items
            _      -> items
 
+-- | Like @compactify'@, but akts on items of definition lists.
+compactify'DL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
+compactify'DL items =
+  let defs = concatMap snd items
+      defBlocks = reverse $ concatMap B.toList defs
+  in  case defBlocks of
+           (Para x:_) -> if not $ any isPara (drop 1 defBlocks)
+                            then let (t,ds) = last items
+                                     lastDef = B.toList $ last ds
+                                     ds' = init ds ++
+                                          [B.fromList $ init lastDef ++ [Plain x]]
+                                  in init items ++ [(t, ds')]
+                            else items
+           _          -> items
+
 isPara :: Block -> Bool
 isPara (Para _) = True
 isPara _        = False
@@ -698,5 +714,3 @@ safeRead s = case reads s of
                   (d,x):_
                     | all isSpace x -> return d
                   _                 -> fail $ "Could not read `" ++ s ++ "'"
-
-
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index f39bd7992..f62b73ce4 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -8,7 +8,7 @@ import Tests.Arbitrary()
 import Text.Pandoc.Builder
 import Text.Pandoc
 import Data.List (intersperse)
-import Data.Monoid (mempty, mconcat)
+import Data.Monoid (mempty, mappend, mconcat)
 
 org :: String -> Pandoc
 org = readOrg def
@@ -98,6 +98,10 @@ tests =
           "line \\\\ \nbreak" =?>
           para ("line" <> linebreak <> "break")
 
+      , "Inline note" =:
+          "[fn::Schreib mir eine E-Mail]" =?>
+          para (note $ para "Schreib mir eine E-Mail")
+
       , "Markup-chars not occuring on word break are symbols" =:
           unlines [ "this+that+ +so+on"
                   , "seven*eight* nine*"
@@ -359,29 +363,6 @@ tests =
                   , "#+END_COMMENT"] =?>
           (mempty::Blocks)
 
-      , "Source Block in Text" =:
-          unlines [ "Low German greeting"
-                  , "  #+BEGIN_SRC haskell"
-                  , "  main = putStrLn greeting"
-                  , "    where greeting = \"moin\""
-                  , "  #+END_SRC" ] =?>
-          let attr' = ("", ["haskell"], [])
-              code' = "main = putStrLn greeting\n" ++
-                       "  where greeting = \"moin\"\n"
-          in mconcat [ para $ spcSep [ "Low", "German", "greeting"  ]
-                     , codeBlockWith attr' code'
-                     ]
-
-      , "Source Block" =:
-          unlines [ "  #+BEGIN_SRC haskell"
-                  , "  main = putStrLn greeting"
-                  , "    where greeting = \"moin\""
-                  , "  #+END_SRC" ] =?>
-          let attr' = ("", ["haskell"], [])
-              code' = "main = putStrLn greeting\n" ++
-                       "  where greeting = \"moin\"\n"
-          in codeBlockWith attr' code'
-
       , "Figure" =:
           unlines [ "#+caption: A very courageous man."
                   , "#+name: goodguy"
@@ -402,6 +383,48 @@ tests =
                   ] =?>
           para (image "the-red-queen.jpg" "fig:redqueen"
                       "Used as a metapher in evolutionary biology.")
+
+      , "Footnote" =:
+          unlines [ "A footnote[1]"
+                  , ""
+                  , "[1] First paragraph"
+                  , ""
+                  , "second paragraph"
+                  ] =?>
+          para (mconcat
+                [ "A", space, "footnote"
+                , note $ mconcat [ para ("First" <> space <> "paragraph")
+                                 , para ("second" <> space <> "paragraph")
+                                 ]
+                ])
+
+      , "Two footnotes" =:
+          unlines [ "Footnotes[fn:1][fn:2]"
+                  , ""
+                  , "[fn:1] First note."
+                  , ""
+                  , "[fn:2] Second note."
+                  ] =?>
+          para (mconcat
+                [ "Footnotes"
+                , note $ para ("First" <> space <> "note.")
+                , note $ para ("Second" <> space <> "note.")
+                ])
+
+      , "Footnote followed by header" =:
+          unlines [ "Another note[fn:yay]"
+                  , ""
+                  , "[fn:yay] This is great!"
+                  , ""
+                  , "** Headline"
+                  ] =?>
+          mconcat
+          [ para (mconcat
+                  [ "Another", space, "note"
+                  , note $ para ("This" <> space <> "is" <> space <> "great!")
+                  ])
+          , header 2 "Headline"
+          ]
       ]
 
   , testGroup "Lists" $
@@ -537,13 +560,36 @@ tests =
                          , ("TTL", [ plain $ "transistor-transistor" <> space <>
                                                "logic" ])
                          , ("PSK", [ mconcat
-                                     [ para  $ "phase-shift" <> space <> "keying"
-                                     , plain $ spcSep [ "a", "digital"
-                                                      , "modulation", "scheme" ]
+                                     [ para $ "phase-shift" <> space <> "keying"
+                                     , para $ spcSep [ "a", "digital"
+                                                     , "modulation", "scheme" ]
                                      ]
-                                   ]
-                                   )
+                                   ])
                          ]
+
+      , "Compact definition list" =:
+          unlines [ "- ATP :: adenosine 5' triphosphate"
+                  , "- DNA :: deoxyribonucleic acid"
+                  , "- PCR :: polymerase chain reaction"
+                  , ""
+                  ] =?>
+          definitionList
+          [ ("ATP", [ plain $ spcSep [ "adenosine", "5'", "triphosphate" ] ])
+          , ("DNA", [ plain $ spcSep [ "deoxyribonucleic", "acid" ] ])
+          , ("PCR", [ plain $ spcSep [ "polymerase", "chain", "reaction" ] ])
+          ]
+
+      , "Loose bullet list" =:
+          unlines [ "- apple"
+                  , ""
+                  , "- orange"
+                  , ""
+                  , "- peach"
+                  ] =?>
+          bulletList [ para "apple"
+                     , para "orange"
+                     , para "peach"
+                     ]
       ]
 
   , testGroup "Tables"
@@ -656,5 +702,126 @@ tests =
                 [ [ plain "1"      , plain "One"  , plain "foo"  ]
                 , [ plain "2"      , plain mempty , plain mempty  ]
                 ]
+
+      , "Table with caption" =:
+          unlines [ "#+CAPTION: Hitchhiker's Multiplication Table"
+                  , "| x |  6 |"
+                  , "| 9 | 42 |"
+                  ] =?>
+          table "Hitchhiker's Multiplication Table"
+                [(AlignDefault, 0), (AlignDefault, 0)]
+                []
+                [ [ plain "x", plain "6" ]
+                , [ plain "9", plain "42" ]
+                ]
+      ]
+
+    , testGroup "Blocks and fragments"
+      [ "Source block" =:
+           unlines [ "  #+BEGIN_SRC haskell"
+                   , "  main = putStrLn greeting"
+                   , "    where greeting = \"moin\""
+                   , "  #+END_SRC" ] =?>
+           let attr' = ("", ["haskell"], [])
+               code' = "main = putStrLn greeting\n" ++
+                       "  where greeting = \"moin\"\n"
+           in codeBlockWith attr' code'
+
+      , "Source block between paragraphs" =:
+           unlines [ "Low German greeting"
+                   , "  #+BEGIN_SRC haskell"
+                   , "  main = putStrLn greeting"
+                   , "    where greeting = \"Moin!\""
+                   , "  #+END_SRC" ] =?>
+           let attr' = ("", ["haskell"], [])
+               code' = "main = putStrLn greeting\n" ++
+                        "  where greeting = \"Moin!\"\n"
+           in mconcat [ para $ spcSep [ "Low", "German", "greeting"  ]
+                      , codeBlockWith attr' code'
+                      ]
+
+      , "Example block" =:
+           unlines [ "#+begin_example"
+                   , "A chosen representation of"
+                   , "a rule."
+                   , "#+eND_exAMPle"
+                   ] =?>
+           codeBlockWith ("", ["example"], [])
+                         "A chosen representation of\na rule.\n"
+
+      , "HTML block" =:
+           unlines [ "#+BEGIN_HTML"
+                   , "<aside>HTML5 is pretty nice.</aside>"
+                   , "#+END_HTML"
+                   ] =?>
+           rawBlock "html" "<aside>HTML5 is pretty nice.</aside>\n"
+
+      , "Quote block" =:
+           unlines [ "#+BEGIN_QUOTE"
+                   , "/Niemand/ hat die Absicht, eine Mauer zu errichten!"
+                   , "#+END_QUOTE"
+                   ] =?>
+           blockQuote (para (spcSep [ emph "Niemand", "hat", "die", "Absicht,"
+                                    , "eine", "Mauer", "zu", "errichten!"
+                                    ]))
+
+      , "Verse block" =:
+          unlines [ "The first lines of Goethe's /Faust/:"
+                  , "#+begin_verse"
+                  , "Habe nun, ach! Philosophie,"
+                  , "Juristerei und Medizin,"
+                  , "Und leider auch Theologie!"
+                  , "Durchaus studiert, mit heißem Bemühn."
+                  , "#+end_verse"
+                  ] =?>
+          mconcat
+          [ para $ spcSep [ "The", "first", "lines", "of"
+                          , "Goethe's", emph "Faust" <> ":"]
+          , para $ mconcat
+              [ spcSep [ "Habe", "nun,", "ach!", "Philosophie," ]
+              , linebreak
+              , spcSep [ "Juristerei", "und", "Medizin," ]
+              , linebreak
+              , spcSep [ "Und", "leider", "auch", "Theologie!" ]
+              , linebreak
+              , spcSep [ "Durchaus", "studiert,", "mit", "heißem", "Bemühn." ]
+              ]
+          ]
+
+      , "LaTeX fragment" =:
+          unlines [ "\\begin{equation}"
+                  , "X_i = \\begin{cases}"
+                  , "      G_{\\alpha(i)} & \\text{if }\\alpha(i-1) = \\alpha(i)\\\\"
+                  , "      C_{\\alpha(i)} & \\text{otherwise}"
+                  , "      \\end{cases}"
+                  , "\\end{equation}"
+                  ] =?>
+          rawBlock "latex"
+                   (unlines [ "\\begin{equation}"
+                            , "X_i = \\begin{cases}"
+                            , "      G_{\\alpha(i)} & \\text{if }\\alpha(i-1) =" ++
+                              " \\alpha(i)\\\\"
+                            , "      C_{\\alpha(i)} & \\text{otherwise}"
+                            , "      \\end{cases}"
+                            , "\\end{equation}"
+                            ])
+
+      , "Code block with caption" =:
+          unlines [ "#+CAPTION: Functor laws in Haskell"
+                  , "#+NAME: functor-laws"
+                  , "#+BEGIN_SRC haskell"
+                  , "fmap id = id"
+                  , "fmap (p . q) = (fmap p) . (fmap q)"
+                  , "#+END_SRC"
+                  ] =?>
+          divWith
+             nullAttr
+             (mappend
+              (plain $ spanWith ("", ["label"], [])
+                                (spcSep [ "Functor", "laws", "in", "Haskell" ]))
+              (codeBlockWith ("functor-laws", ["haskell"], [])
+                             (unlines [ "fmap id = id"
+                                      , "fmap (p . q) = (fmap p) . (fmap q)"
+                                      ])))
       ]
   ]