diff --git a/pandoc.cabal b/pandoc.cabal
index c1d76785c..a9e561fa6 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -380,6 +380,7 @@ Library
Text.Pandoc.Readers.Docx,
Text.Pandoc.Readers.Odt,
Text.Pandoc.Readers.EPUB,
+ Text.Pandoc.Readers.Muse,
Text.Pandoc.Writers,
Text.Pandoc.Writers.Native,
Text.Pandoc.Writers.Docbook,
@@ -559,6 +560,7 @@ Test-Suite test-pandoc
Tests.Readers.Odt
Tests.Readers.Txt2Tags
Tests.Readers.EPUB
+ Tests.Readers.Muse
Tests.Writers.Native
Tests.Writers.ConTeXt
Tests.Writers.Docbook
diff --git a/src/Text/Pandoc/Readers.hs b/src/Text/Pandoc/Readers.hs
index 004fefe25..4c95d5d28 100644
--- a/src/Text/Pandoc/Readers.hs
+++ b/src/Text/Pandoc/Readers.hs
@@ -59,6 +59,7 @@ module Text.Pandoc.Readers
, readTWiki
, readTxt2Tags
, readEPUB
+ , readMuse
-- * Miscellaneous
, getReader
, getDefaultExtensions
@@ -81,6 +82,7 @@ import Text.Pandoc.Readers.HTML
import Text.Pandoc.Readers.LaTeX
import Text.Pandoc.Readers.Markdown
import Text.Pandoc.Readers.MediaWiki
+import Text.Pandoc.Readers.Muse
import Text.Pandoc.Readers.Native
import Text.Pandoc.Readers.Odt
import Text.Pandoc.Readers.OPML
@@ -125,6 +127,7 @@ readers = [ ("native" , TextReader readNative)
,("odt" , ByteStringReader readOdt)
,("t2t" , TextReader readTxt2Tags)
,("epub" , ByteStringReader readEPUB)
+ ,("muse" , TextReader readMuse)
]
-- | Retrieve reader based on formatSpec (format+extensions).
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
new file mode 100644
index 000000000..bc9da26cb
--- /dev/null
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -0,0 +1,577 @@
+{-
+ Copyright (C) 2017 Alexander Krotov <ilabdsf@gmail.com>
+
+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.Muse
+ Copyright : Copyright (C) 2017 Alexander Krotov
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Alexander Krotov <ilabdsf@gmail.com>
+ Stability : alpha
+ Portability : portable
+
+Conversion of Muse text to 'Pandoc' document.
+-}
+{-
+TODO:
+- {{{ }}} syntax for <example>
+- Page breaks (five "*")
+- Headings with anchors (make it round trip with Muse writer)
+- <verse> and ">"
+- Definition lists
+- Org tables
+- table.el tables
+- Images with attributes (floating and width)
+- Anchors
+- Citations and <biblio>
+- <play> environment
+- <verbatim> tag
+-}
+module Text.Pandoc.Readers.Muse (readMuse) where
+
+import Control.Monad
+import Control.Monad.Except (throwError)
+import qualified Data.Map as M
+import Data.Text (Text, unpack)
+import Data.List (stripPrefix)
+import Data.Maybe (fromMaybe)
+import Text.HTML.TagSoup
+import Text.Pandoc.Builder (Blocks, Inlines)
+import qualified Text.Pandoc.Builder as B
+import Text.Pandoc.Class (PandocMonad, report)
+import Text.Pandoc.Definition
+import Text.Pandoc.Logging
+import Text.Pandoc.Options
+import Text.Pandoc.Parsing hiding (macro, nested)
+import Text.Pandoc.Readers.HTML (htmlTag)
+import Text.Pandoc.XML (fromEntities)
+import System.FilePath (takeExtension)
+
+-- | Read Muse from an input string and return a Pandoc document.
+readMuse :: PandocMonad m
+ => ReaderOptions
+ -> Text
+ -> m Pandoc
+readMuse opts s = do
+ res <- readWithM parseMuse def{ stateOptions = opts } (unpack s)
+ case res of
+ Left e -> throwError e
+ Right d -> return d
+
+type MuseParser = ParserT String ParserState
+
+--
+-- main parser
+--
+
+parseMuse :: PandocMonad m => MuseParser m Pandoc
+parseMuse = do
+ many directive
+ blocks <- parseBlocks
+ st <- getState
+ let doc = runF (do Pandoc _ bs <- B.doc <$> blocks
+ meta <- stateMeta' st
+ return $ Pandoc meta bs) st
+ reportLogMessages
+ return doc
+
+parseBlocks :: PandocMonad m => MuseParser m (F Blocks)
+parseBlocks = do
+ res <- mconcat <$> many block
+ spaces
+ eof
+ return res
+
+--
+-- utility functions
+--
+
+nested :: PandocMonad m => MuseParser m a -> MuseParser m a
+nested p = do
+ nestlevel <- stateMaxNestingLevel <$> getState
+ guard $ nestlevel > 0
+ updateState $ \st -> st{ stateMaxNestingLevel = stateMaxNestingLevel st - 1 }
+ res <- p
+ updateState $ \st -> st{ stateMaxNestingLevel = nestlevel }
+ return res
+
+htmlElement :: PandocMonad m => String -> MuseParser m (Attr, String)
+htmlElement tag = try $ do
+ (TagOpen _ attr, _) <- htmlTag (~== TagOpen tag [])
+ content <- manyTill anyChar (endtag <|> endofinput)
+ return (htmlAttrToPandoc attr, trim content)
+ where
+ endtag = void $ htmlTag (~== TagClose tag)
+ endofinput = lookAhead $ try $ skipMany blankline >> skipSpaces >> eof
+ trim = dropWhile (=='\n') . reverse . dropWhile (=='\n') . reverse
+
+htmlAttrToPandoc :: [Attribute String] -> Attr
+htmlAttrToPandoc attrs = (ident, classes, keyvals)
+ where
+ ident = fromMaybe "" $ lookup "id" attrs
+ classes = maybe [] words $ lookup "class" attrs
+ keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]
+
+parseHtmlContentWithAttrs :: PandocMonad m
+ => String -> MuseParser m a -> MuseParser m (Attr, [a])
+parseHtmlContentWithAttrs tag parser = do
+ (attr, content) <- htmlElement tag
+ parsedContent <- try $ parseContent content
+ return (attr, parsedContent)
+ where
+ parseContent = parseFromString $ nested $ manyTill parser endOfContent
+ endOfContent = try $ skipMany blankline >> skipSpaces >> eof
+
+parseHtmlContent :: PandocMonad m => String -> MuseParser m a -> MuseParser m [a]
+parseHtmlContent tag p = liftM snd (parseHtmlContentWithAttrs tag p)
+
+--
+-- directive parsers
+--
+
+parseDirective :: PandocMonad m => MuseParser m (String, F Inlines)
+parseDirective = do
+ char '#'
+ key <- many letter
+ space
+ spaces
+ raw <- many $ noneOf "\n"
+ newline
+ value <- parseFromString (trimInlinesF . mconcat <$> many inline) raw
+ return (key, value)
+
+directive :: PandocMonad m => MuseParser m ()
+directive = do
+ (key, value) <- parseDirective
+ updateState $ \st -> st { stateMeta' = B.setMeta key <$> value <*> stateMeta' st }
+
+--
+-- block parsers
+--
+
+block :: PandocMonad m => MuseParser m (F Blocks)
+block = do
+ pos <- getPosition
+ res <- mempty <$ skipMany1 blankline
+ <|> blockElements
+ <|> para
+ skipMany blankline
+ report $ ParsingTrace (take 60 $ show $ B.toList $ runF res defaultParserState) pos
+ return res
+
+blockElements :: PandocMonad m => MuseParser m (F Blocks)
+blockElements = choice [ comment
+ , separator
+ , header
+ , exampleTag
+ , literal
+ , centerTag
+ , rightTag
+ , quoteTag
+ , bulletList
+ , orderedList
+ , table
+ , commentTag
+ , noteBlock
+ ]
+
+comment :: PandocMonad m => MuseParser m (F Blocks)
+comment = try $ do
+ char ';'
+ space
+ many $ noneOf "\n"
+ void newline <|> eof
+ return mempty
+
+separator :: PandocMonad m => MuseParser m (F Blocks)
+separator = try $ do
+ string "---"
+ newline
+ return $ return B.horizontalRule
+
+header :: PandocMonad m => MuseParser m (F Blocks)
+header = try $ do
+ level <- liftM length $ many1 $ char '*'
+ guard $ level <= 5
+ skipSpaces
+ content <- trimInlinesF . mconcat <$> manyTill inline newline
+ attr <- registerHeader ("", [], []) (runF content defaultParserState)
+ return $ B.headerWith attr level <$> content
+
+exampleTag :: PandocMonad m => MuseParser m (F Blocks)
+exampleTag = liftM (return . uncurry B.codeBlockWith) $ htmlElement "example"
+
+literal :: PandocMonad m => MuseParser m (F Blocks)
+literal = liftM (return . rawBlock) $ htmlElement "literal"
+ where
+ format (_, _, kvs) = fromMaybe "html" $ lookup "format" kvs
+ rawBlock (attrs, content) = B.rawBlock (format attrs) content
+
+blockTag :: PandocMonad m
+ => (Blocks -> Blocks)
+ -> String
+ -> MuseParser m (F Blocks)
+blockTag f s = do
+ res <- parseHtmlContent s block
+ return $ f <$> mconcat res
+
+-- <center> tag is ignored
+centerTag :: PandocMonad m => MuseParser m (F Blocks)
+centerTag = blockTag id "center"
+
+-- <right> tag is ignored
+rightTag :: PandocMonad m => MuseParser m (F Blocks)
+rightTag = blockTag id "right"
+
+quoteTag :: PandocMonad m => MuseParser m (F Blocks)
+quoteTag = blockTag B.blockQuote "quote"
+
+commentTag :: PandocMonad m => MuseParser m (F Blocks)
+commentTag = parseHtmlContent "comment" block >> return mempty
+
+para :: PandocMonad m => MuseParser m (F Blocks)
+para = do
+ res <- trimInlinesF . mconcat <$> many1Till inline endOfParaElement
+ return $ B.para <$> res
+ where
+ endOfParaElement = lookAhead $ endOfInput <|> endOfPara <|> newBlockElement
+ endOfInput = try $ skipMany blankline >> skipSpaces >> eof
+ endOfPara = try $ blankline >> skipMany1 blankline
+ newBlockElement = try $ blankline >> void blockElements
+
+noteMarker :: PandocMonad m => MuseParser m String
+noteMarker = try $ do
+ char '['
+ many1Till digit $ char ']'
+
+noteBlock :: PandocMonad m => MuseParser m (F Blocks)
+noteBlock = try $ do
+ pos <- getPosition
+ ref <- noteMarker <* skipSpaces
+ content <- mconcat <$> blocksTillNote
+ oldnotes <- stateNotes' <$> getState
+ case M.lookup ref oldnotes of
+ Just _ -> logMessage $ DuplicateNoteReference ref pos
+ Nothing -> return ()
+ updateState $ \s -> s{ stateNotes' = M.insert ref (pos, content) oldnotes }
+ return mempty
+ where
+ blocksTillNote =
+ many1Till block (eof <|> () <$ lookAhead noteMarker)
+
+--
+-- lists
+--
+
+listLine :: PandocMonad m => Int -> MuseParser m String
+listLine markerLength = try $ do
+ notFollowedBy blankline
+ indentWith markerLength
+ anyLineNewline
+
+withListContext :: PandocMonad m => MuseParser m a -> MuseParser m a
+withListContext p = do
+ state <- getState
+ let oldContext = stateParserContext state
+ setState $ state { stateParserContext = ListItemState }
+ parsed <- p
+ updateState (\st -> st {stateParserContext = oldContext})
+ return parsed
+
+listContinuation :: PandocMonad m => Int -> MuseParser m String
+listContinuation markerLength = try $ do
+ result <- many1 $ listLine markerLength
+ blanks <- many1 blankline
+ return $ concat result ++ blanks
+
+listStart :: PandocMonad m => MuseParser m Int -> MuseParser m Int
+listStart marker = try $ do
+ preWhitespace <- length <$> many spaceChar
+ st <- stateParserContext <$> getState
+ getPosition >>= \pos -> guard (st == ListItemState || sourceColumn pos /= 1)
+ markerLength <- marker
+ postWhitespace <- length <$> many1 spaceChar
+ return $ preWhitespace + markerLength + postWhitespace
+
+listItem :: PandocMonad m => MuseParser m Int -> MuseParser m (F Blocks)
+listItem start = try $ do
+ markerLength <- start
+ firstLine <- anyLineNewline
+ blank <- option "" ("\n" <$ blankline)
+ restLines <- many $ listLine markerLength
+ let first = firstLine ++ blank ++ concat restLines
+ rest <- many $ listContinuation markerLength
+ parseFromString (withListContext parseBlocks) $ concat (first:rest) ++ "\n"
+
+bulletListItems :: PandocMonad m => MuseParser m (F [Blocks])
+bulletListItems = sequence <$> many1 (listItem bulletListStart)
+
+bulletListStart :: PandocMonad m => MuseParser m Int
+bulletListStart = listStart (char '-' >> return 1)
+
+bulletList :: PandocMonad m => MuseParser m (F Blocks)
+bulletList = do
+ listItems <- bulletListItems
+ return $ B.bulletList <$> listItems
+
+orderedListStart :: PandocMonad m
+ => ListNumberStyle
+ -> ListNumberDelim
+ -> MuseParser m Int
+orderedListStart style delim = listStart (snd <$> withHorizDisplacement (orderedListMarker style delim))
+
+orderedList :: PandocMonad m => MuseParser m (F Blocks)
+orderedList = try $ do
+ p@(_, style, delim) <- lookAhead (many spaceChar *> anyOrderedListMarker <* spaceChar)
+ guard $ style `elem` [Decimal, LowerAlpha, UpperAlpha, LowerRoman, UpperRoman]
+ guard $ delim == Period
+ items <- sequence <$> many1 (listItem $ orderedListStart style delim)
+ return $ B.orderedListWith p <$> items
+
+--
+-- tables
+--
+
+data MuseTable = MuseTable
+ { museTableCaption :: Inlines
+ , museTableHeaders :: [[Blocks]]
+ , museTableRows :: [[Blocks]]
+ , museTableFooters :: [[Blocks]]
+ }
+
+data MuseTableElement = MuseHeaderRow (F [Blocks])
+ | MuseBodyRow (F [Blocks])
+ | MuseFooterRow (F [Blocks])
+ | MuseCaption (F Inlines)
+
+museToPandocTable :: MuseTable -> Blocks
+museToPandocTable (MuseTable caption headers body footers) =
+ B.table caption attrs headRow rows
+ where ncol = maximum (0 : map length (headers ++ body ++ footers))
+ attrs = replicate ncol (AlignDefault, 0.0)
+ headRow = if null headers then [] else head headers
+ rows = (if null headers then [] else tail headers) ++ body ++ footers
+
+museAppendElement :: MuseTable
+ -> MuseTableElement
+ -> F MuseTable
+museAppendElement tbl element =
+ case element of
+ MuseHeaderRow row -> do
+ row' <- row
+ return tbl{ museTableHeaders = museTableHeaders tbl ++ [row'] }
+ MuseBodyRow row -> do
+ row' <- row
+ return tbl{ museTableRows = museTableRows tbl ++ [row'] }
+ MuseFooterRow row-> do
+ row' <- row
+ return tbl{ museTableFooters = museTableFooters tbl ++ [row'] }
+ MuseCaption inlines -> do
+ inlines' <- inlines
+ return tbl{ museTableCaption = inlines' }
+
+tableCell :: PandocMonad m => MuseParser m (F Blocks)
+tableCell = try $ do
+ content <- trimInlinesF . mconcat <$> manyTill inline (lookAhead cellEnd)
+ return $ B.plain <$> content
+ where cellEnd = try $ void (many1 spaceChar >> char '|') <|> void newline <|> eof
+
+tableElements :: PandocMonad m => MuseParser m [MuseTableElement]
+tableElements = tableParseElement `sepEndBy1` (void newline <|> eof)
+
+elementsToTable :: [MuseTableElement] -> F MuseTable
+elementsToTable = foldM museAppendElement emptyTable
+ where emptyTable = MuseTable mempty mempty mempty mempty
+
+table :: PandocMonad m => MuseParser m (F Blocks)
+table = try $ do
+ rows <- tableElements
+ let tbl = elementsToTable rows
+ let pandocTbl = museToPandocTable <$> tbl :: F Blocks
+ return pandocTbl
+
+tableParseElement :: PandocMonad m => MuseParser m MuseTableElement
+tableParseElement = tableParseHeader
+ <|> tableParseBody
+ <|> tableParseFooter
+ <|> tableParseCaption
+
+tableParseRow :: PandocMonad m => Int -> MuseParser m (F [Blocks])
+tableParseRow n = try $ do
+ fields <- tableCell `sepBy2` fieldSep
+ return $ sequence fields
+ where p `sepBy2` sep = (:) <$> p <*> many1 (sep >> p)
+ fieldSep = many1 spaceChar >> count n (char '|') >> (void (many1 spaceChar) <|> void (lookAhead newline))
+
+tableParseHeader :: PandocMonad m => MuseParser m MuseTableElement
+tableParseHeader = MuseHeaderRow <$> tableParseRow 2
+
+tableParseBody :: PandocMonad m => MuseParser m MuseTableElement
+tableParseBody = MuseBodyRow <$> tableParseRow 1
+
+tableParseFooter :: PandocMonad m => MuseParser m MuseTableElement
+tableParseFooter = MuseFooterRow <$> tableParseRow 3
+
+tableParseCaption :: PandocMonad m => MuseParser m MuseTableElement
+tableParseCaption = try $ do
+ many spaceChar
+ string "|+"
+ contents <- trimInlinesF . mconcat <$> many1Till inline (lookAhead $ string "+|")
+ string "+|"
+ return $ MuseCaption contents
+
+--
+-- inline parsers
+--
+
+inline :: PandocMonad m => MuseParser m (F Inlines)
+inline = choice [ whitespace
+ , br
+ , footnote
+ , strong
+ , strongTag
+ , emph
+ , emphTag
+ , superscriptTag
+ , subscriptTag
+ , strikeoutTag
+ , link
+ , code
+ , codeTag
+ , str
+ , symbol
+ ] <?> "inline"
+
+footnote :: PandocMonad m => MuseParser m (F Inlines)
+footnote = try $ do
+ ref <- noteMarker
+ return $ do
+ notes <- asksF stateNotes'
+ case M.lookup ref notes of
+ Nothing -> return $ B.str $ "[" ++ ref ++ "]"
+ Just (_pos, contents) -> do
+ st <- askF
+ let contents' = runF contents st { stateNotes' = M.empty }
+ return $ B.note contents'
+
+whitespace :: PandocMonad m => MuseParser m (F Inlines)
+whitespace = liftM return (lb <|> regsp)
+ where lb = try $ skipMany spaceChar >> linebreak >> return B.space
+ regsp = try $ skipMany1 spaceChar >> return B.space
+
+br :: PandocMonad m => MuseParser m (F Inlines)
+br = try $ do
+ string "<br>"
+ return $ return B.linebreak
+
+linebreak :: PandocMonad m => MuseParser m (F Inlines)
+linebreak = newline >> notFollowedBy newline >> (lastNewline <|> innerNewline)
+ where lastNewline = do
+ eof
+ return $ return mempty
+ innerNewline = return $ return B.space
+
+emphasisBetween :: (PandocMonad m, Show a) => MuseParser m a -> MuseParser m (F Inlines)
+emphasisBetween c = try $ enclosedInlines c c
+
+enclosedInlines :: (PandocMonad m, Show a, Show b)
+ => MuseParser m a
+ -> MuseParser m b
+ -> MuseParser m (F Inlines)
+enclosedInlines start end = try $
+ trimInlinesF . mconcat <$> enclosed start end inline
+
+verbatimBetween :: PandocMonad m
+ => Char
+ -> MuseParser m String
+verbatimBetween c = try $ do
+ char c
+ many1Till anyChar $ char c
+
+inlineTag :: PandocMonad m
+ => (Inlines -> Inlines)
+ -> String
+ -> MuseParser m (F Inlines)
+inlineTag f s = do
+ res <- parseHtmlContent s inline
+ return $ f <$> mconcat res
+
+strongTag :: PandocMonad m => MuseParser m (F Inlines)
+strongTag = inlineTag B.strong "strong"
+
+strong :: PandocMonad m => MuseParser m (F Inlines)
+strong = fmap B.strong <$> emphasisBetween (string "**")
+
+emph :: PandocMonad m => MuseParser m (F Inlines)
+emph = fmap B.emph <$> emphasisBetween (char '*')
+
+emphTag :: PandocMonad m => MuseParser m (F Inlines)
+emphTag = inlineTag B.emph "em"
+
+superscriptTag :: PandocMonad m => MuseParser m (F Inlines)
+superscriptTag = inlineTag B.superscript "sup"
+
+subscriptTag :: PandocMonad m => MuseParser m (F Inlines)
+subscriptTag = inlineTag B.subscript "sub"
+
+strikeoutTag :: PandocMonad m => MuseParser m (F Inlines)
+strikeoutTag = inlineTag B.strikeout "del"
+
+code :: PandocMonad m => MuseParser m (F Inlines)
+code = return . B.code <$> verbatimBetween '='
+
+codeTag :: PandocMonad m => MuseParser m (F Inlines)
+codeTag = do
+ (attrs, content) <- parseHtmlContentWithAttrs "code" anyChar
+ return $ return $ B.codeWith attrs $ fromEntities content
+
+str :: PandocMonad m => MuseParser m (F Inlines)
+str = liftM (return . B.str) (many1 alphaNum <|> count 1 characterReference)
+
+symbol :: PandocMonad m => MuseParser m (F Inlines)
+symbol = liftM (return . B.str) $ count 1 nonspaceChar
+
+link :: PandocMonad m => MuseParser m (F Inlines)
+link = try $ do
+ st <- getState
+ guard $ stateAllowLinks st
+ setState $ st{ stateAllowLinks = False }
+ (url, title, content) <- linkText
+ setState $ st{ stateAllowLinks = True }
+ return $ case stripPrefix "URL:" url of
+ Nothing -> if isImageUrl url
+ then B.image url title <$> fromMaybe (return mempty) content
+ else B.link url title <$> fromMaybe (return $ B.str url) content
+ Just url' -> B.link url' title <$> fromMaybe (return $ B.str url') content
+ where -- Taken from muse-image-regexp defined in Emacs Muse file lisp/muse-regexps.el
+ imageExtensions = [".eps", ".gif", ".jpg", ".jpeg", ".pbm", ".png", ".tiff", ".xbm", ".xpm"]
+ isImageUrl = (`elem` imageExtensions) . takeExtension
+
+linkContent :: PandocMonad m => MuseParser m (F Inlines)
+linkContent = do
+ char '['
+ res <- many1Till anyChar $ char ']'
+ parseFromString (mconcat <$> many1 inline) res
+
+linkText :: PandocMonad m => MuseParser m (String, String, Maybe (F Inlines))
+linkText = do
+ string "[["
+ url <- many1Till anyChar $ char ']'
+ content <- optionMaybe linkContent
+ char ']'
+ return (url, "", content)
diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs
new file mode 100644
index 000000000..5a896da55
--- /dev/null
+++ b/test/Tests/Readers/Muse.hs
@@ -0,0 +1,264 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Tests.Readers.Muse (tests) where
+
+import Data.List (intersperse)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Test.Tasty
+import Tests.Helpers
+import Text.Pandoc
+import Text.Pandoc.Arbitrary ()
+import Text.Pandoc.Builder
+import Text.Pandoc.Class
+
+muse :: Text -> Pandoc
+muse = purely $ \s -> do
+ putCommonState
+ def { stInputFiles = Just ["in"]
+ , stOutputFile = Just "out"
+ }
+ readMuse def s
+
+infix 4 =:
+(=:) :: ToString c
+ => String -> (Text, c) -> TestTree
+(=:) = test muse
+
+spcSep :: [Inlines] -> Inlines
+spcSep = mconcat . intersperse space
+
+tests :: [TestTree]
+tests =
+ [ testGroup "Inlines"
+ [ "Plain String" =:
+ "Hello, World" =?>
+ para (spcSep [ "Hello,", "World" ])
+
+ , "Emphasis" =: "*Foo bar*" =?> para (emph . spcSep $ ["Foo", "bar"])
+
+ , "Emphasis tag" =: "<em>Foo bar</em>" =?> para (emph . spcSep $ ["Foo", "bar"])
+
+ , "Strong" =:
+ "**Cider**" =?>
+ para (strong "Cider")
+
+ , "Strong tag" =: "<strong>Strong</strong>" =?> para (strong "Strong")
+
+ , "Strong Emphasis" =:
+ "***strength***" =?>
+ para (strong . emph $ "strength")
+
+ , "Superscript tag" =: "<sup>Superscript</sup>" =?> para (superscript "Superscript")
+
+ , "Subscript tag" =: "<sub>Subscript</sub>" =?> para (subscript "Subscript")
+
+ , "Strikeout tag" =: "<del>Strikeout</del>" =?> para (strikeout "Strikeout")
+
+ , "Linebreak" =: "Line <br> break" =?> para ("Line" <> linebreak <> "break")
+
+ , "Code" =: "=foo(bar)=" =?> para (code "foo(bar)")
+
+ , "Code tag" =: "<code>foo(bar)</code>" =?> para (code "foo(bar)")
+
+ , testGroup "Links"
+ [ "Link without description" =:
+ "[[https://amusewiki.org/]]" =?>
+ para (link "https://amusewiki.org/" "" (str "https://amusewiki.org/"))
+ , "Link with description" =:
+ "[[https://amusewiki.org/][A Muse Wiki]]" =?>
+ para (link "https://amusewiki.org/" "" (text "A Muse Wiki"))
+ , "Image" =:
+ "[[image.jpg]]" =?>
+ para (image "image.jpg" "" mempty)
+ , "Image with description" =:
+ "[[image.jpg][Image]]" =?>
+ para (image "image.jpg" "" (text "Image"))
+ , "Image link" =:
+ "[[URL:image.jpg]]" =?>
+ para (link "image.jpg" "" (str "image.jpg"))
+ , "Image link with description" =:
+ "[[URL:image.jpg][Image]]" =?>
+ para (link "image.jpg" "" (text "Image"))
+ ]
+ ]
+
+ , testGroup "Blocks"
+ [ "Quote" =: "<quote>Hello, world</quote>" =?> blockQuote (para $ text "Hello, world")
+ , "Center" =: "<center>Hello, world</center>" =?> para (text "Hello, world")
+ , "Right" =: "<right>Hello, world</right>" =?> para (text "Hello, world")
+ , testGroup "Comments"
+ [ "Comment tag" =: "<comment>\nThis is a comment\n</comment>" =?> (mempty::Blocks)
+ , "Line comment" =: "; Comment" =?> (mempty::Blocks)
+ , "Not a comment (does not start with a semicolon)" =: " ; Not a comment" =?> para (text "; Not a comment")
+ , "Not a comment (has no space after semicolon)" =: ";Not a comment" =?> para (text ";Not a comment")
+ ]
+ , testGroup "Headers"
+ [ "Part" =:
+ "* First level\n" =?>
+ header 1 "First level"
+ , "Chapter" =:
+ "** Second level\n" =?>
+ header 2 "Second level"
+ , "Section" =:
+ "*** Third level\n" =?>
+ header 3 "Third level"
+ , "Subsection" =:
+ "**** Fourth level\n" =?>
+ header 4 "Fourth level"
+ , "Subsubsection" =:
+ "***** Fifth level\n" =?>
+ header 5 "Fifth level"
+ ]
+ , testGroup "Footnotes"
+ [ "Simple footnote" =:
+ T.unlines [ "Here is a footnote[1]."
+ , ""
+ , "[1] Footnote contents"
+ ] =?>
+ para (text "Here is a footnote" <>
+ note (para "Footnote contents") <>
+ str ".")
+ , "Recursive footnote" =:
+ T.unlines [ "Start recursion here[1]"
+ , ""
+ , "[1] Recursion continues here[1]"
+ ] =?>
+ para (text "Start recursion here" <>
+ note (para "Recursion continues here[1]"))
+ ]
+ ]
+ , testGroup "Tables"
+ [ "Two cell table" =:
+ "One | Two" =?>
+ table mempty [(AlignDefault, 0.0), (AlignDefault, 0.0)]
+ []
+ [[plain "One", plain "Two"]]
+ , "Table with multiple words" =:
+ "One two | three four" =?>
+ table mempty [(AlignDefault, 0.0), (AlignDefault, 0.0)]
+ []
+ [[plain "One two", plain "three four"]]
+ , "Not a table" =:
+ "One| Two" =?>
+ para (text "One| Two")
+ , "Not a table again" =:
+ "One |Two" =?>
+ para (text "One |Two")
+ , "Two line table" =:
+ T.unlines
+ [ "One | Two"
+ , "Three | Four"
+ ] =?>
+ table mempty [(AlignDefault, 0.0), (AlignDefault, 0.0)]
+ []
+ [[plain "One", plain "Two"],
+ [plain "Three", plain "Four"]]
+ , "Table with one header" =:
+ T.unlines
+ [ "First || Second"
+ , "Third | Fourth"
+ ] =?>
+ table mempty [(AlignDefault, 0.0), (AlignDefault, 0.0)]
+ [plain "First", plain "Second"]
+ [[plain "Third", plain "Fourth"]]
+ , "Table with two headers" =:
+ T.unlines
+ [ "First || header"
+ , "Second || header"
+ , "Foo | bar"
+ ] =?>
+ table mempty [(AlignDefault, 0.0), (AlignDefault, 0.0)]
+ [plain "First", plain "header"]
+ [[plain "Second", plain "header"],
+ [plain "Foo", plain "bar"]]
+ , "Header and footer reordering" =:
+ T.unlines
+ [ "Foo ||| bar"
+ , "Baz || foo"
+ , "Bar | baz"
+ ] =?>
+ table mempty [(AlignDefault, 0.0), (AlignDefault, 0.0)]
+ [plain "Baz", plain "foo"]
+ [[plain "Bar", plain "baz"],
+ [plain "Foo", plain "bar"]]
+ , "Table with caption" =:
+ T.unlines
+ [ "Foo || bar || baz"
+ , "First | row | here"
+ , "Second | row | there"
+ , "|+ Table caption +|"
+ ] =?>
+ table (text "Table caption") (replicate 3 (AlignDefault, 0.0))
+ [plain "Foo", plain "bar", plain "baz"]
+ [[plain "First", plain "row", plain "here"],
+ [plain "Second", plain "row", plain "there"]]
+ , "Caption without table" =:
+ "|+ Foo bar baz +|" =?>
+ table (text "Foo bar baz") [] [] []
+ , "Table indented with space" =:
+ T.unlines
+ [ " Foo | bar"
+ , " Baz | foo"
+ , " Bar | baz"
+ ] =?>
+ table mempty [(AlignDefault, 0.0), (AlignDefault, 0.0)]
+ []
+ [[plain "Foo", plain "bar"],
+ [plain "Baz", plain "foo"],
+ [plain "Bar", plain "baz"]]
+ , "Empty cells" =:
+ T.unlines
+ [ " | Foo"
+ , " |"
+ , " bar |"
+ , " || baz"
+ ] =?>
+ table mempty [(AlignDefault, 0.0), (AlignDefault, 0.0)]
+ [plain "", plain "baz"]
+ [[plain "", plain "Foo"],
+ [plain "", plain ""],
+ [plain "bar", plain ""]]
+ ]
+ , testGroup "Lists"
+ [ "Bullet list" =:
+ T.unlines
+ [ " - Item1"
+ , ""
+ , " - Item2"
+ ] =?>
+ bulletList [ para "Item1"
+ , para "Item2"
+ ]
+ , "Ordered list" =:
+ T.unlines
+ [ " 1. Item1"
+ , ""
+ , " 2. Item2"
+ ] =?>
+ orderedListWith (1, Decimal, Period) [ para "Item1"
+ , para "Item2"
+ ]
+ , "Nested list" =:
+ T.unlines
+ [ " - Item1"
+ , " - Item2"
+ , " - Item3"
+ , " - Item4"
+ , " 1. Nested"
+ , " 2. Ordered"
+ , " 3. List"
+ ] =?>
+ bulletList [ mconcat [ para "Item1"
+ , bulletList [ para "Item2"
+ , para "Item3"
+ ]
+ ]
+ , mconcat [ para "Item4"
+ , orderedListWith (1, Decimal, Period) [ para "Nested"
+ , para "Ordered"
+ , para "List"
+ ]
+ ]
+ ]
+ ]
+ ]
diff --git a/test/test-pandoc.hs b/test/test-pandoc.hs
index 97ad3183f..caa2b7c65 100644
--- a/test/test-pandoc.hs
+++ b/test/test-pandoc.hs
@@ -16,6 +16,7 @@ import qualified Tests.Readers.Odt
import qualified Tests.Readers.Org
import qualified Tests.Readers.RST
import qualified Tests.Readers.Txt2Tags
+import qualified Tests.Readers.Muse
import qualified Tests.Shared
import qualified Tests.Writers.AsciiDoc
import qualified Tests.Writers.ConTeXt
@@ -61,6 +62,7 @@ tests = testGroup "pandoc tests" [ Tests.Command.tests
, testGroup "Odt" Tests.Readers.Odt.tests
, testGroup "Txt2Tags" Tests.Readers.Txt2Tags.tests
, testGroup "EPUB" Tests.Readers.EPUB.tests
+ , testGroup "Muse" Tests.Readers.Muse.tests
]
, testGroup "Lua filters" Tests.Lua.tests
]
diff --git a/trypandoc/index.html b/trypandoc/index.html
index 26a373112..9b84e14b7 100644
--- a/trypandoc/index.html
+++ b/trypandoc/index.html
@@ -88,6 +88,7 @@ $(document).ready(function() {
<option value="markdown_github">Markdown (GitHub)</option>
<option value="mediawiki">MediaWiki</option>
<option value="markdown_mmd">MultiMarkdown</option>
+ <option value="muse">Muse</option>
<option value="opml">OPML</option>
<option value="org">Org Mode</option>
<option value="rst">reStructuredText</option>