Add a simple Emacs Org-mode reader

The basic structure of org-mode documents is recognized; however,
org-mode features like todo markers, tags etc. are not supported yet.

pandoc.cabal

@@ -263,6 +263,7 @@ Library
                    Text.Pandoc.Readers.Markdown,
                    Text.Pandoc.Readers.MediaWiki,
                    Text.Pandoc.Readers.RST,
+                   Text.Pandoc.Readers.Org,
                    Text.Pandoc.Readers.DocBook,
                    Text.Pandoc.Readers.OPML,
                    Text.Pandoc.Readers.TeXMath,
@@ -381,6 +382,7 @@ Test-Suite test-pandoc
                   Tests.Walk
                   Tests.Readers.LaTeX
                   Tests.Readers.Markdown
+                  Tests.Readers.Org
                   Tests.Readers.RST
                   Tests.Writers.Native
                   Tests.Writers.ConTeXt

pandoc.hs

@@ -834,6 +834,7 @@ defaultReaderName fallback (x:xs) =
     ".latex"    -> "latex"
     ".ltx"      -> "latex"
     ".rst"      -> "rst"
+    ".org"      -> "org"
     ".lhs"      -> "markdown+lhs"
     ".db"       -> "docbook"
     ".opml"     -> "opml"

src/Text/Pandoc.hs

@@ -65,6 +65,7 @@ module Text.Pandoc
                , readMarkdown
                , readMediaWiki
                , readRST
+               , readOrg
                , readLaTeX
                , readHtml
                , readTextile
@@ -115,6 +116,7 @@ import Text.Pandoc.JSON
 import Text.Pandoc.Readers.Markdown
 import Text.Pandoc.Readers.MediaWiki
 import Text.Pandoc.Readers.RST
+import Text.Pandoc.Readers.Org
 import Text.Pandoc.Readers.DocBook
 import Text.Pandoc.Readers.OPML
 import Text.Pandoc.Readers.LaTeX
@@ -201,6 +203,7 @@ readers = [ ("native"       , \_ s -> return $ readNative s)
            ,("mediawiki"    , \o s -> return $ readMediaWiki o s)
            ,("docbook"      , \o s -> return $ readDocBook o s)
            ,("opml"         , \o s -> return $ readOPML o s)
+           ,("org"          , \o s -> return $ readOrg o s)
            ,("textile"      , \o s -> return $ readTextile o s) -- TODO : textile+lhs
            ,("html"         , \o s -> return $ readHtml o s)
            ,("latex"        , \o s -> return $ readLaTeX o s)

src/Text/Pandoc/Readers/Org.hs

@@ -0,0 +1,552 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-
+Copyright (C) 2014 Albert Krewinkel <tarleb@moltkeplatz.de>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+-}
+
+{- |
+   Module      : Text.Pandoc.Readers.Org
+   Copyright   : Copyright (C) 2014 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : Albert Krewinkel <tarleb@moltkeplatz.de>
+
+Conversion of Org-Mode to 'Pandoc' document.
+-}
+module Text.Pandoc.Readers.Org ( readOrg ) where
+
+import qualified Text.Pandoc.Builder as B
+import           Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>))
+import           Text.Pandoc.Definition
+import           Text.Pandoc.Options
+import           Text.Pandoc.Parsing hiding (orderedListMarker)
+import           Text.Pandoc.Shared (compactify')
+
+import           Control.Applicative (pure, (<$>), (<$), (<*>), (<*), (*>), (<**>))
+import           Control.Monad (guard, mzero)
+import           Data.Char (toLower)
+import           Data.List (foldl')
+import           Data.Maybe (listToMaybe, fromMaybe)
+import           Data.Monoid (mconcat, mempty, mappend)
+
+-- | Parse org-mode string and return a Pandoc document.
+readOrg :: ReaderOptions -- ^ Reader options
+        -> String        -- ^ String to parse (assuming @'\n'@ line endings)
+        -> Pandoc
+readOrg opts s = (readWith parseOrg) def{ stateOptions = opts } (s ++ "\n\n")
+
+type OrgParser = Parser [Char] ParserState
+
+parseOrg:: OrgParser Pandoc
+parseOrg = do
+  blocks' <- B.toList <$> parseBlocks
+  st <- getState
+  let meta = stateMeta st
+  return $ Pandoc meta $ filter (/= Null) blocks'
+
+--
+-- parsing blocks
+--
+
+parseBlocks :: OrgParser Blocks
+parseBlocks = mconcat <$> manyTill block eof
+
+block :: OrgParser Blocks
+block = choice [ mempty <$ blanklines
+               , orgBlock
+               , example
+               , drawer
+               , specialLine
+               , header
+               , hline
+               , list
+               , table
+               , paraOrPlain
+               ] <?> "block"
+
+--
+-- Org Blocks (#+BEGIN_... / #+END_...)
+--
+
+orgBlock :: OrgParser Blocks
+orgBlock = try $ do
+  (indent, blockType, args) <- blockHeader
+  blockStr <- rawBlockContent indent blockType
+  let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ]
+  case blockType of
+    "comment" -> return mempty
+    "src"     -> return $ B.codeBlockWith ("", classArgs, []) blockStr
+    _         -> B.divWith ("", [blockType], [])
+                            <$> (parseFromString parseBlocks blockStr)
+
+blockHeader :: OrgParser (Int, String, [String])
+blockHeader = (,,) <$> blockIndent
+                   <*> blockType
+                   <*> (skipSpaces *> blockArgs)
+ where blockIndent = length <$> many spaceChar
+       blockType = map toLower <$> (stringAnyCase "#+begin_" *> many letter)
+       blockArgs = manyTill (many nonspaceChar <* skipSpaces) newline
+
+rawBlockContent :: Int -> String -> OrgParser String
+rawBlockContent indent blockType =
+  unlines . map commaEscaped <$> manyTill indentedLine blockEnder
+ where
+   indentedLine = try $ choice [ blankline         *> pure "\n"
+                               , indentWith indent *> anyLine
+                               ]
+   blockEnder = try $ indentWith indent *> stringAnyCase ("#+end_" <> blockType)
+
+-- indent by specified number of spaces (or equiv. tabs)
+indentWith :: Int -> OrgParser String
+indentWith num = do
+  tabStop <- getOption readerTabStop
+  if (num < tabStop)
+     then count num (char ' ')
+     else choice [ try (count num (char ' '))
+                 , try (char '\t' >> count (num - tabStop) (char ' ')) ]
+
+translateLang :: String -> String
+translateLang "sh" = "bash"
+translateLang cs = cs
+
+commaEscaped :: String -> String
+commaEscaped (',':cs@('*':_))     = cs
+commaEscaped (',':cs@('#':'+':_)) = cs
+commaEscaped cs                   = cs
+
+example :: OrgParser Blocks
+example = try $
+  B.codeBlockWith ("", ["example"], []) . unlines <$> many1 exampleLine
+
+exampleLine :: OrgParser String
+exampleLine = try $ string ": " *> anyLine
+
+-- Drawers for properties or a logbook
+drawer :: OrgParser Blocks
+drawer = try $ do
+  drawerStart
+  manyTill drawerLine (try drawerEnd)
+  return mempty
+
+drawerStart :: OrgParser String
+drawerStart = try $
+  skipSpaces *> drawerName <* skipSpaces <* newline
+ where drawerName = try $  char ':' *> validDrawerName <* char ':'
+       validDrawerName =  stringAnyCase "PROPERTIES"
+                          <|> stringAnyCase "LOGBOOK"
+
+drawerLine :: OrgParser String
+drawerLine = try $ anyLine
+
+drawerEnd :: OrgParser String
+drawerEnd = try $
+  skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* newline
+
+
+-- Comments, Options and Metadata
+specialLine :: OrgParser Blocks
+specialLine = try $ metaLine <|> commentLine
+
+metaLine :: OrgParser Blocks
+metaLine = try $ metaLineStart *> declarationLine
+
+commentLine :: OrgParser Blocks
+commentLine = try $ commentLineStart *> anyLine *> pure mempty
+
+-- The order, in which blocks are tried, makes sure that we're not looking at
+-- the beginning of a block, so we don't need to check for it
+metaLineStart :: OrgParser String
+metaLineStart = try $ mappend <$> many spaceChar <*> string "#+"
+
+commentLineStart :: OrgParser String
+commentLineStart = try $ mappend <$> many spaceChar <*> string "# "
+
+declarationLine :: OrgParser Blocks
+declarationLine = try $ do
+  meta' <- B.setMeta <$> metaKey <*> metaValue <*> pure nullMeta
+  updateState $ \st -> st { stateMeta = stateMeta st <> meta' }
+  return mempty
+
+metaValue :: OrgParser MetaValue
+metaValue = MetaInlines . B.toList . trimInlines <$> restOfLine
+
+metaKey :: OrgParser [Char]
+metaKey = map toLower <$> many1 (noneOf ": \n\r")
+                      <*  char ':'
+                      <*  skipSpaces
+
+-- | Headers
+header :: OrgParser Blocks
+header = try $
+  B.header <$> headerStart
+           <*> (trimInlines <$> restOfLine)
+
+headerStart :: OrgParser Int
+headerStart = try $
+  (length <$> many1 (char '*')) <* many1 (char ' ')
+
+-- Horizontal Line (five dashes or more)
+hline :: OrgParser Blocks
+hline = try $ do
+  skipSpaces
+  string "-----"
+  many (char '-')
+  skipSpaces
+  newline
+  return B.horizontalRule
+
+--
+-- Tables
+--
+
+data OrgTableRow = OrgContentRow [Blocks]
+                 | OrgAlignRow [Alignment]
+                 | OrgHlineRow
+ deriving (Eq, Show)
+
+type OrgTableContent = (Int, [Alignment], [Double], [Blocks], [[Blocks]])
+
+table :: OrgParser Blocks
+table = try $ do
+  lookAhead tableStart
+  (_, aligns, widths, heads, lns) <- normalizeTable . tableContent <$> tableRows
+  return $ B.table "" (zip aligns widths) heads lns
+
+tableStart :: OrgParser Char
+tableStart = try $ skipSpaces *> char '|'
+
+tableRows :: OrgParser [OrgTableRow]
+tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)
+
+tableContentRow :: OrgParser OrgTableRow
+tableContentRow = try $
+  OrgContentRow <$> (tableStart *> manyTill tableContentCell newline)
+
+tableContentCell :: OrgParser Blocks
+tableContentCell = try $
+  B.plain . trimInlines . mconcat <$> many1Till inline (try endOfCell)
+
+endOfCell :: OrgParser Char
+-- endOfCell =  char '|' <|> newline
+endOfCell = try $ char '|' <|> lookAhead newline
+
+tableAlignRow :: OrgParser OrgTableRow
+tableAlignRow = try $
+  OrgAlignRow <$> (tableStart *> manyTill tableAlignCell newline)
+
+tableAlignCell :: OrgParser Alignment
+tableAlignCell =
+  choice [ try $ emptyCell *> return (AlignDefault)
+         , try $ skipSpaces
+                   *> char '<'
+                   *> tableAlignFromChar
+                   <* many digit
+                   <* char '>'
+                   <* emptyCell
+         ] <?> "alignment info"
+    where emptyCell = try $ skipSpaces *> endOfCell
+
+tableAlignFromChar :: OrgParser Alignment
+tableAlignFromChar = try $ choice [ char 'l' *> return AlignLeft
+                                  , char 'c' *> return AlignCenter
+                                  , char 'r' *> return AlignRight
+                                  ]
+
+tableHline :: OrgParser OrgTableRow
+tableHline = try $
+  OrgHlineRow <$ (tableStart *> char '-' *> anyLine)
+
+tableContent :: [OrgTableRow]
+             -> OrgTableContent
+tableContent = foldl' (flip rowToContent) (0, mempty, repeat 0, mempty, mempty)
+
+normalizeTable :: OrgTableContent
+               -> OrgTableContent
+normalizeTable (cols, aligns, widths, heads, lns) =
+  let aligns' = fillColumns aligns AlignDefault
+      widths' = fillColumns widths 0.0
+      heads'  = if heads == mempty
+                then heads
+                else fillColumns heads  (B.plain mempty)
+      lns'    = map (flip fillColumns (B.plain mempty)) lns
+      fillColumns base padding = take cols $ base ++ repeat padding
+  in (cols, aligns', widths', heads', lns')
+
+
+-- One or more horizontal rules after the first content line mark the previous
+-- line as a header.  All other horizontal lines are discarded.
+rowToContent :: OrgTableRow
+             -> OrgTableContent
+             -> OrgTableContent
+rowToContent OrgHlineRow        = maybeBodyToHeader
+rowToContent (OrgContentRow rs) = setLongestRow rs . appendToBody rs
+rowToContent (OrgAlignRow as)   = setLongestRow as . setAligns as
+
+setLongestRow :: [a]
+              -> OrgTableContent
+              -> OrgTableContent
+setLongestRow r (cols, aligns, widths, heads, lns) =
+  (max cols (length r), aligns, widths, heads, lns)
+
+maybeBodyToHeader :: OrgTableContent
+                  -> OrgTableContent
+maybeBodyToHeader (cols, aligns, widths, [], b:[]) = (cols, aligns, widths, b, [])
+maybeBodyToHeader content                          = content
+
+appendToBody :: [Blocks]
+             -> OrgTableContent
+             -> OrgTableContent
+appendToBody r (cols, aligns, widths, heads, lns) =
+  (cols, aligns, widths, heads, lns ++ [r])
+
+setAligns :: [Alignment]
+          -> OrgTableContent
+          -> OrgTableContent
+setAligns aligns (cols, _, widths, heads, lns) =
+   (cols, aligns, widths, heads, lns)
+
+-- Paragraphs or Plain text
+paraOrPlain :: OrgParser Blocks
+paraOrPlain = try $
+  trimInlines . mconcat
+    <$> many1 inline
+    <**> option B.plain
+                (try $ newline *> pure B.para)
+
+restOfLine :: OrgParser Inlines
+restOfLine = mconcat <$> manyTill inline newline
+
+
+--
+-- list blocks
+--
+
+list :: OrgParser Blocks
+list = choice [ bulletList, orderedList ] <?> "list"
+
+bulletList :: OrgParser Blocks
+bulletList = B.bulletList . compactify' <$> many1 (listItem bulletListStart)
+
+orderedList :: OrgParser Blocks
+orderedList = B.orderedList . compactify' <$> many1 (listItem orderedListStart)
+
+genericListStart :: OrgParser String
+                 -> OrgParser Int
+genericListStart listMarker = try $
+  (+) <$> (length <$> many spaceChar)
+      <*> (length <$> listMarker <* many1 spaceChar)
+
+-- parses bullet list start and returns its length (excl. following whitespace)
+bulletListStart :: OrgParser Int
+bulletListStart = genericListStart bulletListMarker
+  where bulletListMarker = pure <$> oneOf "*-+"
+
+orderedListStart :: OrgParser Int
+orderedListStart = genericListStart orderedListMarker
+  -- Ordered list markers allowed in org-mode
+  where orderedListMarker = mappend <$> many1 digit <*> (pure <$> oneOf ".)")
+
+listItem :: OrgParser Int
+         -> OrgParser Blocks
+listItem start = try $ do
+  (markerLength, first) <- try (start >>= rawListItem)
+  rest <- many (listContinuation markerLength)
+  parseFromString parseBlocks $ concat (first:rest)
+
+-- parse raw text for one list item, excluding start marker and continuations
+rawListItem :: Int
+            -> OrgParser (Int, String)
+rawListItem markerLength = try $ do
+  firstLine <- anyLine
+  restLines <- many (listLine markerLength)
+  return (markerLength, (firstLine ++ "\n" ++ (concat restLines)))
+
+-- 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 markerLength))
+
+-- parse a line of a list item
+listLine :: Int
+         -> OrgParser String
+listLine markerLength = try $
+  indentWith markerLength *> anyLine
+    <**> pure (++ "\n")
+
+
+--
+-- inline
+--
+
+inline :: OrgParser Inlines
+inline = choice inlineParsers <?> "inline"
+  where inlineParsers = [ whitespace
+                        , link
+                        , str
+                        , endline
+                        , emph
+                        , strong
+                        , strikeout
+                        , underline
+                        , code
+                        , verbatim
+                        , subscript
+                        , superscript
+                        , symbol
+                        ]
+
+-- treat these as potentially non-text when parsing inline:
+specialChars :: [Char]
+specialChars = "\"$'()*+-./:<=>[\\]^_{|}~"
+
+
+whitespace :: OrgParser Inlines
+whitespace = B.space <$ skipMany1 spaceChar <?> "whitespace"
+
+str :: OrgParser Inlines
+str = 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
+endline = try $ do
+  newline
+  notFollowedBy blankline
+  notFollowedBy' exampleLine
+  notFollowedBy' hline
+  notFollowedBy' tableStart
+  notFollowedBy' drawerStart
+  notFollowedBy' headerStart
+  notFollowedBy' metaLineStart
+  notFollowedBy' commentLineStart
+  notFollowedBy' bulletListStart
+  notFollowedBy' orderedListStart
+  return B.space
+
+link :: OrgParser Inlines
+link = explicitLink <|> selfLink <?> "link"
+
+explicitLink :: OrgParser Inlines
+explicitLink = try $ do
+  char '['
+  src   <- enclosedRaw     (char '[') (char ']')
+  title <- enclosedInlines (char '[') (char ']')
+  char ']'
+  return $ B.link src "" title
+
+selfLink :: OrgParser Inlines
+selfLink = try $ do
+  src <- enclosedRaw (string "[[") (string "]]")
+  return $ B.link src "" (B.str src)
+
+emph      :: OrgParser Inlines
+emph      = B.emph         <$> inlinesEnclosedBy '/'
+
+strong    :: OrgParser Inlines
+strong    = B.strong       <$> inlinesEnclosedBy '*'
+
+strikeout :: OrgParser Inlines
+strikeout = B.strikeout    <$> inlinesEnclosedBy '+'
+
+-- There is no underline, so we use strong instead.
+underline :: OrgParser Inlines
+underline = B.strong       <$> inlinesEnclosedBy '_'
+
+code      :: OrgParser Inlines
+code      = B.code         <$> rawEnclosedBy '='
+
+verbatim  ::  OrgParser Inlines
+verbatim  = B.rawInline "" <$> rawEnclosedBy '~'
+
+subscript ::  OrgParser Inlines
+subscript = B.subscript    <$> (try $ char '_' *> maybeGroupedByBraces)
+
+superscript ::  OrgParser Inlines
+superscript = B.superscript <$> (try $ char '^' *> maybeGroupedByBraces)
+
+maybeGroupedByBraces :: OrgParser Inlines
+maybeGroupedByBraces = try $
+  choice [ try $ enclosedInlines (char '{') (char '}')
+         , B.str . (:"") <$> anyChar
+         ]
+
+symbol :: OrgParser Inlines
+symbol = B.str . (: "") <$> oneOf specialChars
+
+enclosedInlines :: OrgParser a
+                -> OrgParser b
+                -> OrgParser Inlines
+enclosedInlines start end = try $
+  trimInlines . mconcat <$> enclosed start end inline
+
+-- FIXME: This is a hack
+inlinesEnclosedBy :: Char
+                  -> OrgParser Inlines
+inlinesEnclosedBy c = enclosedInlines (atStart (char c) <* endsOnThisOrNextLine c)
+                                      (atEnd $ char c)
+
+enclosedRaw :: OrgParser a
+            -> OrgParser b
+            -> OrgParser String
+enclosedRaw start end = try $
+  start *> (onSingleLine <|> spanningTwoLines)
+ where onSingleLine = try $ many1Till (noneOf "\n\r") end
+       spanningTwoLines = try $
+         anyLine >>= \f -> mappend (f <> " ") <$> onSingleLine
+
+rawEnclosedBy :: Char
+              -> OrgParser String
+rawEnclosedBy c = enclosedRaw (atStart $ char c) (atEnd $ char c)
+
+-- succeeds only if we're not right after a str (ie. in middle of word)
+atStart :: OrgParser a -> OrgParser a
+atStart p = do
+  pos <- getPosition
+  st <- getState
+  guard $ stateLastStrPos st /= Just pos
+  p
+
+-- | succeeds only if we're at the end of a word
+atEnd :: OrgParser a -> OrgParser a
+atEnd p = try $ p <* lookingAtEndOfWord
+ where lookingAtEndOfWord = lookAhead . oneOf $ postWordChars
+
+postWordChars :: [Char]
+postWordChars = "\t\n\r !\"'),-.:?}"
+
+-- FIXME: These functions are hacks and should be replaced
+endsOnThisOrNextLine :: Char
+                     -> OrgParser ()
+endsOnThisOrNextLine c = do
+  inp <- getInput
+  let doOtherwise = \rest -> endsOnThisLine rest c (const mzero)
+  endsOnThisLine inp c doOtherwise
+
+endsOnThisLine :: [Char]
+               -> Char
+               -> ([Char] -> OrgParser ())
+               -> OrgParser ()
+endsOnThisLine input c doOnOtherLines = do
+  case break (`elem` c:"\n") input of
+    (_,'\n':rest)    -> doOnOtherLines rest
+    (_,_:rest@(n:_)) -> if n `elem` postWordChars
+                        then return ()
+                        else endsOnThisLine rest c doOnOtherLines
+    _                -> mzero
+

tests/Tests/Readers/Org.hs

@@ -0,0 +1,533 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Tests.Readers.Org (tests) where
+
+import Text.Pandoc.Definition
+import Test.Framework
+import Tests.Helpers
+import Tests.Arbitrary()
+import Text.Pandoc.Builder
+import Text.Pandoc
+import Data.List (intersperse)
+import Data.Monoid (mempty, mconcat)
+
+org :: String -> Pandoc
+org = readOrg def
+
+infix 4 =:
+(=:) :: ToString c
+     => String -> (String, c) -> Test
+(=:) = test org
+
+spcSep :: [Inlines] -> Inlines
+spcSep = mconcat . intersperse space
+
+simpleTable' :: Int
+             -> [Blocks]
+             -> [[Blocks]]
+             -> Blocks
+simpleTable' n = table "" (take n $ repeat (AlignDefault, 0.0))
+
+tests :: [Test]
+tests =
+  [ testGroup "Inlines" $
+      [ "Plain String" =:
+          "Hello, World" =?>
+          para (spcSep [ "Hello,", "World" ])
+
+      , "Emphasis" =:
+          "/Planet Punk/" =?>
+          para (emph . spcSep $ ["Planet", "Punk"])
+
+      , "Strong" =:
+          "*Cider*" =?>
+          para (strong "Cider")
+
+      , "Strikeout" =:
+          "+Kill Bill+" =?>
+          para (strikeout . spcSep $ [ "Kill", "Bill" ])
+
+      , "Code" =:
+          "=Robot.rock()=" =?>
+          para (code "Robot.rock()")
+
+      , "Verbatim" =:
+          "~word for word~" =?>
+          para (rawInline "" "word for word")
+
+      , "Symbol" =:
+          "A * symbol" =?>
+          para (str "A" <> space <> str "*" <> space <> "symbol")
+
+      , "Superscript single char" =:
+          "2^n" =?>
+          para (str "2" <> superscript "n")
+
+      , "Superscript multi char" =:
+          "2^{n-1}" =?>
+          para (str "2" <> superscript "n-1")
+
+      , "Subscript single char" =:
+          "a_n" =?>
+          para (str "a" <> subscript "n")
+
+      , "Subscript multi char" =:
+          "a_{n+1}" =?>
+          para (str "a" <> subscript "n+1")
+
+      , "Markup-chars not occuring on word break are symbols" =:
+          unlines [ "this+that+ +so+on"
+                  , "seven*eight* nine*"
+                  , "+not+funny+"
+                  ] =?>
+          para (spcSep [ "this+that+", "+so+on"
+                       , "seven*eight*", "nine*"
+                       , strikeout "not+funny"
+                       ])
+
+      , "Markup may not span more than two lines" =:
+          unlines [ "/this *is", "not*", "emph/" ] =?>
+          para (spcSep [ "/this"
+                       , (strong ("is" <> space <> "not"))
+                       , "emph/" ])
+
+      , "Explicit link" =:
+          "[[http://zeitlens.com/][pseudo-random nonsense]]" =?>
+          (para $ link "http://zeitlens.com/" ""
+                       ("pseudo-random" <> space <> "nonsense"))
+
+      , "Self-link" =:
+          "[[http://zeitlens.com/]]" =?>
+          (para $ link "http://zeitlens.com/" "" "http://zeitlens.com/")
+      ]
+
+  , testGroup "Meta Information" $
+      [ "Comment" =:
+          "# Nothing to see here" =?>
+          (mempty::Blocks)
+
+      , "Not a comment" =:
+          "#-tag" =?>
+          para "#-tag"
+
+      , "Comment surrounded by Text" =:
+          unlines [ "Before"
+                  , "# Comment"
+                  , "After"
+                  ] =?>
+          mconcat [ para "Before"
+                  , para "After"
+                  ]
+
+      , "Title" =:
+        "#+TITLE: Hello, World" =?>
+        let titleInline = toList $ "Hello," <> space <> "World"
+            meta = setMeta "title" (MetaInlines titleInline) $ nullMeta
+        in Pandoc meta mempty
+
+      , "Author" =:
+        "#+author: Albert /Emacs-Fanboy/ Krewinkel" =?>
+        let author = toList . spcSep $ [ "Albert", emph "Emacs-Fanboy", "Krewinkel" ]
+            meta = setMeta "author" (MetaInlines author) $ nullMeta
+        in Pandoc meta mempty
+
+      , "Date" =:
+        "#+Date: Feb. *28*, 2014" =?>
+        let date = toList . spcSep $ [ "Feb.", (strong "28") <> ",", "2014" ]
+            meta = setMeta "date" (MetaInlines date) $ nullMeta
+        in Pandoc meta mempty
+
+      , "Description" =:
+        "#+DESCRIPTION: Explanatory text" =?>
+        let description = toList . spcSep $ [ "Explanatory", "text" ]
+            meta = setMeta "description" (MetaInlines description) $ nullMeta
+        in Pandoc meta mempty
+
+      , "Properties drawer" =:
+          unlines [ "  :PROPERTIES:"
+                  , "  :setting: foo"
+                  , "  :END:"
+                  ] =?>
+          (mempty::Blocks)
+
+      , "Logbook drawer" =:
+          unlines [ "  :LogBook:"
+                  , "  - State \"DONE\"       from \"TODO\"       [2014-03-03 Mon 11:00]"
+                  , "  :END:"
+                  ] =?>
+          (mempty::Blocks)
+
+      , "Drawer surrounded by text" =:
+          unlines [ "Before"
+                  , ":PROPERTIES:"
+                  , ":END:"
+                  , "After"
+                  ] =?>
+          para "Before" <> para "After"
+
+      , "Drawer start is the only text in first line of a drawer" =:
+          unlines [ "  :LOGBOOK: foo"
+                  , "  :END:"
+                  ] =?>
+          para (spcSep [ ":LOGBOOK:", "foo", ":END:" ])
+
+      , "Drawers with unknown names are just text" =:
+          unlines [ ":FOO:"
+                  , ":END:"
+                  ] =?>
+          para (":FOO:" <> space <> ":END:")
+      ]
+
+  , testGroup "Basic Blocks" $
+      [ "Paragraph" =:
+          "Paragraph\n" =?>
+          para "Paragraph"
+
+      , "First Level Header" =:
+          "* Headline\n" =?>
+          header 1 "Headline"
+
+      , "Third Level Header" =:
+          "*** Third Level Headline\n" =?>
+          header 3 ("Third" <> space <>
+                    "Level" <> space <>
+                    "Headline")
+
+      , "Compact Headers with Paragraph" =:
+          unlines [ "* First Level"
+                  , "** Second Level"
+                  , "   Text"
+                  ] =?>
+          mconcat [ header 1 ("First" <> space <> "Level")
+                  , header 2 ("Second" <> space <> "Level")
+                  , para "Text"
+                  ]
+
+      , "Separated Headers with Paragraph" =:
+          unlines [ "* First Level"
+                  , ""
+                  , "** Second Level"
+                  , ""
+                  , "   Text"
+                  ] =?>
+          mconcat [ header 1 ("First" <> space <> "Level")
+                  , header 2 ("Second" <> space <> "Level")
+                  , para "Text"
+                  ]
+
+      , "Headers not preceded by a blank line" =:
+          unlines [ "** eat dinner"
+                  , "Spaghetti and meatballs tonight."
+                  , "** walk dog"
+                  ] =?>
+          mconcat [ header 2 ("eat" <> space <> "dinner")
+                  , para $ spcSep [ "Spaghetti", "and", "meatballs", "tonight." ]
+                  , header 2 ("walk" <> space <> "dog")
+                  ]
+
+      , "Paragraph starting with an asterisk" =:
+          "*five" =?>
+          para "*five"
+
+      , "Paragraph containing asterisk at beginning of line" =:
+          unlines [ "lucky"
+                  , "*star"
+                  ] =?>
+          para ("lucky" <> space <> "*star")
+
+      , "Example block" =:
+          unlines [ ": echo hello"
+                  , ": echo dear tester"
+                  ] =?>
+          codeBlockWith ("", ["example"], []) "echo hello\necho dear tester\n"
+
+      , "Example block surrounded by text" =:
+          unlines [ "Greetings"
+                  , ": echo hello"
+                  , ": echo dear tester"
+                  , "Bye"
+                  ] =?>
+          mconcat [ para "Greetings"
+                  , codeBlockWith ("", ["example"], [])
+                                  "echo hello\necho dear tester\n"
+                  , para "Bye"
+                  ]
+
+      , "Horizontal Rule" =:
+          unlines [ "before"
+                  , "-----"
+                  , "after"
+                  ] =?>
+          mconcat [ para "before"
+                  , horizontalRule
+                  , para "after"
+                  ]
+
+      , "Not a Horizontal Rule" =:
+          "----- five dashes" =?>
+          (para $ spcSep [ "-----", "five", "dashes" ])
+
+      , "Comment Block" =:
+          unlines [ "#+BEGIN_COMMENT"
+                  , "stuff"
+                  , "bla"
+                  , "#+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'
+      ]
+
+  , testGroup "Lists" $
+      [ "Simple Bullet Lists" =:
+          ("- Item1\n" ++
+           "- Item2\n") =?>
+          bulletList [ plain "Item1"
+                     , plain "Item2"
+                     ]
+
+      , "Indented Bullet Lists" =:
+          ("   - Item1\n" ++
+           "   - Item2\n") =?>
+          bulletList [ plain "Item1"
+                     , plain "Item2"
+                     ]
+
+      , "Multi-line Bullet Lists" =:
+          ("- *Fat\n" ++
+           "  Tony*\n" ++
+           "- /Sideshow\n" ++
+           " Bob/") =?>
+          bulletList [ plain $ strong ("Fat" <> space <> "Tony")
+                     , plain $ emph ("Sideshow" <> space <> "Bob")
+                     ]
+
+      , "Nested Bullet Lists" =:
+          ("- Discovery\n" ++
+           "  + One More Time\n" ++
+           "  + Harder, Better, Faster, Stronger\n" ++
+           "- Homework\n" ++
+           "  + Around the World\n"++
+           "- Human After All\n" ++
+           "  + Technologic\n" ++
+           "  + Robot Rock\n") =?>
+          bulletList [ mconcat
+                       [ para "Discovery"
+                       , bulletList [ plain ("One" <> space <>
+                                             "More" <> space <>
+                                             "Time")
+                                    , plain ("Harder," <> space <>
+                                             "Better," <> space <>
+                                             "Faster," <> space <>
+                                             "Stronger")
+                                    ]
+                       ]
+                     , mconcat
+                       [ para "Homework"
+                       , bulletList [ plain ("Around" <> space <>
+                                             "the" <> space <>
+                                             "World")
+                                    ]
+                       ]
+                     , mconcat
+                       [ para ("Human" <> space <> "After" <> space <> "All")
+                       , bulletList [ plain "Technologic"
+                                    , plain ("Robot" <> space <> "Rock")
+                                    ]
+                       ]
+                     ]
+
+      , "Simple Ordered List" =:
+          ("1. Item1\n" ++
+           "2. Item2\n") =?>
+          let listStyle = (1, DefaultStyle, DefaultDelim)
+              listStructure = [ plain "Item1"
+                              , plain "Item2"
+                              ]
+          in orderedListWith listStyle listStructure
+
+      , "Simple Ordered List with Parens" =:
+          ("1) Item1\n" ++
+           "2) Item2\n") =?>
+          let listStyle = (1, DefaultStyle, DefaultDelim)
+              listStructure = [ plain "Item1"
+                              , plain "Item2"
+                              ]
+          in orderedListWith listStyle listStructure
+
+      , "Indented Ordered List" =:
+          (" 1. Item1\n" ++
+           " 2. Item2\n") =?>
+          let listStyle = (1, DefaultStyle, DefaultDelim)
+              listStructure = [ plain "Item1"
+                              , plain "Item2"
+                              ]
+          in orderedListWith listStyle listStructure
+
+      , "Nested Ordered Lists" =:
+          ("1. One\n" ++
+           "   1. One-One\n" ++
+           "   2. One-Two\n" ++
+           "2. Two\n" ++
+           "   1. Two-One\n"++
+           "   2. Two-Two\n") =?>
+          let listStyle = (1, DefaultStyle, DefaultDelim)
+              listStructure = [ mconcat
+                                [ para "One"
+                                , orderedList [ plain "One-One"
+                                              , plain "One-Two"
+                                              ]
+                                ]
+                              , mconcat
+                                [ para "Two"
+                                , orderedList [ plain "Two-One"
+                                              , plain "Two-Two"
+                                              ]
+                                ]
+                              ]
+          in orderedListWith listStyle listStructure
+
+      , "Ordered List in Bullet List" =:
+          ("- Emacs\n" ++
+           "  1. Org\n") =?>
+          bulletList [ (para "Emacs") <>
+                       (orderedList [ plain "Org"])
+                     ]
+
+      , "Bullet List in Ordered List" =:
+          ("1. GNU\n" ++
+           "   - Freedom\n") =?>
+            orderedList [ (para "GNU") <> bulletList [ (plain "Freedom") ] ]
+      ]
+
+  , testGroup "Tables"
+      [ "Single cell table" =:
+          "|Test|" =?>
+          simpleTable' 1 mempty [[plain "Test"]]
+
+      , "Multi cell table" =:
+          "| One | Two |" =?>
+           simpleTable' 2 mempty [ [ plain "One", plain "Two" ] ]
+
+      , "Multi line table" =:
+          unlines [ "| One   |"
+                  , "| Two   |"
+                  , "| Three |"
+                  ] =?>
+           simpleTable' 1 mempty
+                        [ [ plain "One" ]
+                        , [ plain "Two" ]
+                        , [ plain "Three" ]
+                        ]
+
+      , "Empty table" =:
+          "||" =?>
+          simpleTable' 1 mempty mempty
+
+      , "Glider Table" =:
+          unlines [ "| 1 | 0 | 0 |"
+                  , "| 0 | 1 | 1 |"
+                  , "| 1 | 1 | 0 |"
+                  ] =?>
+          simpleTable' 3 mempty
+                       [ [ plain "1", plain "0", plain "0" ]
+                       , [ plain "0", plain "1", plain "1" ]
+                       , [ plain "1", plain "1", plain "0" ]
+                       ]
+
+      , "Table between Paragraphs" =:
+          unlines [ "Before"
+                  , "| One | Two |"
+                  , "After"
+                  ] =?>
+          mconcat [ para "Before"
+                  , simpleTable' 2 mempty [ [ plain "One", plain "Two" ] ]
+                  , para "After"
+                  ]
+
+      , "Table with Header" =:
+          unlines [ "| Species      | Status       |"
+                  , "|--------------+--------------|"
+                  , "| cervisiae    | domesticated |"
+                  , "| paradoxus    | wild         |"
+                  ] =?>
+          simpleTable [ plain "Species", plain "Status" ]
+                      [ [ plain "cervisiae", plain "domesticated" ]
+                      , [ plain "paradoxus", plain "wild" ]
+                      ]
+
+      , "Table with final hline" =:
+          unlines [ "| cervisiae    | domesticated |"
+                  , "| paradoxus    | wild         |"
+                  , "|--------------+--------------|"
+                  ] =?>
+          simpleTable' 2 mempty
+                [ [ plain "cervisiae", plain "domesticated" ]
+                 , [ plain "paradoxus", plain "wild" ]
+                ]
+
+      , "Table in a box" =:
+          unlines [ "|---------|---------|"
+                  , "| static  | Haskell |"
+                  , "| dynamic | Lisp    |"
+                  , "|---------+---------|"
+                  ] =?>
+          simpleTable' 2 mempty
+                [ [ plain "static", plain "Haskell" ]
+                , [ plain "dynamic", plain "Lisp" ]
+                ]
+
+      , "Table with alignment row" =:
+          unlines [ "| Numbers | Text | More |"
+                  , "| <c>     | <r>  |      |"
+                  , "| 1       | One  | foo  |"
+                  , "| 2       | Two  | bar  |"
+                  ] =?>
+          table "" (zip [AlignCenter, AlignRight, AlignDefault] [0, 0, 0])
+                []
+                [ [ plain "Numbers", plain "Text", plain "More" ]
+                , [ plain "1"      , plain "One" , plain "foo"  ]
+                , [ plain "2"      , plain "Two" , plain "bar"  ]
+                ]
+
+      , "Pipe within text doesn't start a table" =:
+          "Ceci n'est pas une | pipe " =?>
+          para (spcSep [ "Ceci", "n'est", "pas", "une", "|", "pipe" ])
+
+      , "Missing pipe at end of row" =:
+          "|incomplete-but-valid" =?>
+          simpleTable' 1 mempty [ [ plain "incomplete-but-valid" ] ]
+
+      , "Table with differing row lengths" =:
+          unlines [ "| Numbers | Text "
+                  , "|-"
+                  , "| <c>     | <r>  |"
+                  , "| 1       | One  | foo  |"
+                  , "| 2"
+                  ] =?>
+          table "" (zip [AlignCenter, AlignRight, AlignDefault] [0, 0, 0])
+                [ plain "Numbers", plain "Text" , plain mempty ]
+                [ [ plain "1"      , plain "One"  , plain "foo"  ]
+                , [ plain "2"      , plain mempty , plain mempty  ]
+                ]
+      ]
+  ]

tests/test-pandoc.hs

@@ -7,6 +7,7 @@ import GHC.IO.Encoding
 import qualified Tests.Old
 import qualified Tests.Readers.LaTeX
 import qualified Tests.Readers.Markdown
+import qualified Tests.Readers.Org
 import qualified Tests.Readers.RST
 import qualified Tests.Writers.ConTeXt
 import qualified Tests.Writers.LaTeX
@@ -31,6 +32,7 @@ tests = [ testGroup "Old" Tests.Old.tests
         , testGroup "Readers"
           [ testGroup "LaTeX" Tests.Readers.LaTeX.tests
           , testGroup "Markdown" Tests.Readers.Markdown.tests
+          , testGroup "Org" Tests.Readers.Org.tests
           , testGroup "RST" Tests.Readers.RST.tests
           ]
         ]