diff options
| -rw-r--r-- | pandoc.cabal | 2 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers.hs | 3 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 577 | ||||
| -rw-r--r-- | test/Tests/Readers/Muse.hs | 264 | ||||
| -rw-r--r-- | test/test-pandoc.hs | 2 | ||||
| -rw-r--r-- | trypandoc/index.html | 1 |
6 files changed, 849 insertions, 0 deletions
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> |