{-# LANGUAGE OverloadedStrings #-}
module Tests.Writers.Muse (tests) where
import Prelude hiding (unlines)
import Data.Text (Text, unlines)
import Test.Tasty
import Tests.Helpers
import Text.Pandoc
import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder
defopts :: WriterOptions
defopts = def{ writerWrapText = WrapPreserve,
writerExtensions = extensionsFromList [Ext_amuse,
Ext_auto_identifiers] }
muse :: (ToPandoc a) => a -> Text
muse = museWithOpts defopts
museWithOpts :: (ToPandoc a) => WriterOptions -> a -> Text
museWithOpts opts = purely (writeMuse opts) . toPandoc
infix 4 =:
(=:) :: (ToString a, ToPandoc a)
=> String -> (a, Text) -> TestTree
(=:) = test muse
noteLocationTestDoc :: Blocks
noteLocationTestDoc =
header 1 "First Header" <>
para ("This is a footnote." <>
note (para "First note.")) <>
blockQuote (para ("A note inside a block quote." <>
note (para "The second note.")) <>
para "A second paragraph.") <>
header 1 "Second Header" <>
para "Some more text."
noteLocationTests :: TestTree
noteLocationTests = testGroup "note location"
[ test (museWithOpts defopts {writerReferenceLocation=EndOfDocument})
"footnotes at the end of document" $
noteLocationTestDoc =?>
unlines [ "* First Header"
, ""
, "This is a footnote.[1]"
, ""
, ""
, "A note inside a block quote.[2]"
, ""
, "A second paragraph."
, "
"
, ""
, "* Second Header"
, ""
, "Some more text."
, ""
, "[1] First note."
, ""
, "[2] The second note."
]
, test (museWithOpts defopts {writerReferenceLocation=EndOfBlock})
"footnotes at the end of block" $
noteLocationTestDoc =?>
unlines [ "* First Header"
, ""
, "This is a footnote.[1]"
, ""
, "[1] First note."
, ""
, ""
, "A note inside a block quote.[2]"
, ""
, "[2] The second note."
, ""
, "A second paragraph."
, "
"
, ""
, "* Second Header"
, ""
, "Some more text."
]
, test (museWithOpts defopts {writerReferenceLocation=EndOfSection})
"footnotes at the end of section" $
noteLocationTestDoc =?>
unlines [ "* First Header"
, ""
, "This is a footnote.[1]"
, ""
, ""
, "A note inside a block quote.[2]"
, ""
, "A second paragraph."
, "
"
, ""
, "[1] First note."
, ""
, "[2] The second note."
, ""
, "* Second Header"
, ""
, "Some more text."
]
]
tests :: [TestTree]
tests = [ testGroup "block elements"
[ "plain" =: plain "Foo bar." =?> "Foo bar."
, testGroup "paragraphs"
[ "single paragraph" =: para "Sample paragraph."
=?> "Sample paragraph."
, "two paragraphs" =: para "First paragraph." <>
para "Second paragraph."
=?> unlines [ "First paragraph."
, ""
, "Second paragraph."
]
]
, "line block" =: lineBlock ["Foo", "bar", "baz"]
=?> unlines [ "> Foo"
, "> bar"
, "> baz"
]
, "code block" =: codeBlock "int main(void) {\n\treturn 0;\n}"
=?> unlines [ "
" , "Foo" , "" ] , testGroup "lists" [ testGroup "simple lists" [ "ordered list" =: orderedList [ plain "first" , plain "second" , plain "third" ] =?> unlines [ " 1. first" , " 2. second" , " 3. third" ] , "ordered list with Roman numerals" =: orderedListWith (1, UpperRoman, DefaultDelim) [ plain "first" , plain "second" , plain "third" ] =?> unlines [ " I. first" , " II. second" , " III. third" ] , "bullet list" =: bulletList [ plain "first" , plain "second" , plain "third" ] =?> unlines [ " - first" , " - second" , " - third" ] , "definition list" =: definitionList [ ("first definition", [plain "first description"]) , ("second definition", [plain "second description"]) , ("third definition", [plain "third description"]) ] =?> unlines [ " first definition :: first description" , " second definition :: second description" , " third definition :: third description" ] , "definition list with multiple descriptions" =: definitionList [ ("first definition", [ plain "first description" , plain "second description" ]) , ("second definition", [plain "third description"]) ] =?> unlines [ " first definition :: first description" , " :: second description" , " second definition :: third description" ] , "definition list with empty term" =: definitionList [ ("first definition", [plain "first description"]) , (mempty, [plain "second description"]) , (str "", [plain "third description"]) ] =?> unlines [ " first definition :: first description" , "
" , " 1. first" , " 2. second" , " 3. third" , "" ] ] , testGroup "headings" [ "normal heading" =: header 1 "foo" =?> "* foo" , "heading levels" =: header 1 "First level" <> header 3 "Third level" =?> unlines [ "* First level" , "" , "*** Third level" ] , "heading with ID" =: headerWith ("bar", [], []) 2 "Foo" =?> unlines [ "#bar" , "** Foo" ] , "empty heading" =: header 4 mempty =?> "****
"
, "space" =: code " " =?> "
"
, "space at the beginning" =: code " foo" =?> " foo
"
, "space at the end" =: code "foo " =?> "foo
"
, "use tags for =" =: code "foo = bar" =?> "foo = bar
"
, "escape tag" =: code "foo = bar
baz" =?> "foo = bar<
/code> baz
"
, "normalization with attributes" =: codeWith ("",["haskell"],[]) "foo" <> code "bar" =?> "=foobar="
, "code tag" =: code "foo
" =?> "=foo
="
, "normalization" =: code " code "de>" <> code "=" =?> "<
/code>=
"
, "normalization with empty string" =: code " str "" <> code "de>" <> code "=" =?> "<
/code>=
"
, "emphasized code" =: emph (code "foo") =?> "*=foo=*"
, "strong code" =: strong (code "foo") =?> "**=foo=**"
]
, testGroup "spaces"
[ "space" =: "a" <> space <> "b" =?> "a b"
, "soft break" =: "a" <> softbreak <> "b" =?> "a\nb"
, test (museWithOpts def{ writerWrapText = WrapNone })
"remove soft break" $ "a" <> softbreak <> "b"
=?> ("a b" :: String)
, "line break" =: "a" <> linebreak <> "b" =?> "a
\nb"
, "line break at the end" =: "a" <> linebreak =?> "a
"
, "no newline after line break in header" =: header 1 ("a" <> linebreak <> "b") =?> "* a
b"
, "no softbreak in header" =: header 1 ("a" <> softbreak <> "b") =?> "* a b"
]
, testGroup "math"
[ "inline math" =: math "2^3" =?> "23"
, "display math" =: displayMath "2^3" =?> "23"
, "multiple letters in inline math" =: math "abc" =?> "*abc*"
, "expand math before normalization" =: math "[" <> str "2]" =?> "[2] "
, "multiple math expressions inside one inline list" =: math "5_4" <> ", " <> displayMath "3^2" =?> "54, 32"
]
, "raw inline"
=: rawInline "html" "marked text"
=?> "marked text "
, testGroup "links"
[ "link with description" =: link "https://example.com" "" (str "Link 1")
=?> "[[https://example.com][Link 1]]"
, "link without description" =: link "https://example.com" "" (str "https://example.com")
=?> "[[https://example.com]]"
-- Internal links in Muse include '#'
, "link to anchor" =: link "#intro" "" (str "Introduction")
=?> "[[#intro][Introduction]]"
-- According to Emacs Muse manual, links to images should be prefixed with "URL:"
, "link to image with description" =: link "1.png" "" (str "Link to image")
=?> "[[URL:1.png][Link to image]]"
, "link to image without description" =: link "1.png" "" (str "1.png")
=?> "[[URL:1.png]]"
, testGroup "escape brackets in links"
[ "link with description"
=: link "https://example.com/foo].txt" "" (str "Description")
=?> "[[https://example.com/foo%5D.txt][Description]]"
, "link without description"
=: link "https://example.com/foo].txt" "" (str "https://example.com/foo].txt")
=?> "[[https://example.com/foo%5D.txt][https://example.com/foo].txt ]]"
, "image link with description"
=: link "foo]bar.png" "" (str "Image link")
=?> "[[URL:foo%5Dbar.png][Image link]]"
, "image link without description"
=: link "foo]bar.png" "" (str "foo]bar.png")
=?> "[[URL:foo%5Dbar.png][foo]bar.png ]]"
]
]
, "image" =: image "image.png" "Image 1" (str "") =?> "[[image.png][Image 1]]"
, "image with width" =:
imageWith ("", [], [("width", "60%")]) "image.png" "Image" (str "") =?>
"[[image.png 60][Image]]"
, "left-aligned image with width" =:
imageWith ("", ["align-left"], [("width", "60%")]) "image.png" "Image" (str "") =?>
"[[image.png 60 l][Image]]"
, "right-aligned image with width" =:
imageWith ("", ["align-right"], [("width", "60%")]) "image.png" "Image" (str "") =?>
"[[image.png 60 r][Image]]"
, "escape brackets in image title" =: image "image.png" "Foo]bar" (str "") =?> "[[image.png][Foo]bar ]]"
, "note" =: note (plain "Foo")
=?> unlines [ "[1]"
, ""
, "[1] Foo"
]
, noteLocationTests
, "span with class" =: spanWith ("",["foobar"],[]) "Some text"
=?> "Some text "
, "span without class" =: spanWith ("",[],[]) "Some text"
=?> "Some text "
, "span with anchor" =: spanWith ("anchor", [], []) mempty <> "Foo bar"
=?> "#anchor Foo bar"
, "empty span with anchor" =: spanWith ("anchor", [], []) mempty
=?> "#anchor"
, "empty span without class and anchor" =: spanWith ("", [], []) mempty
=?> " "
, "span with class and anchor" =: spanWith ("anchor", ["foo"], []) "bar"
=?> "#anchor bar "
, "adjacent spans" =: spanWith ("", ["syllable"], []) (str "wa") <>
spanWith ("", ["syllable"], []) (str "ter")
=?> "wa ter "
, testGroup "RTL"
[ "RTL span" =: spanWith ("",[],[("dir", "rtl")]) (text "foo bar") =?> "<<>>"
, "LTR span" =: spanWith ("",[],[("dir", "ltr")]) (text "foo bar") =?> ">>>foo bar<<<"
, "RTL span with a class" =: spanWith ("",["foobar"],[("dir", "rtl")]) (text "foo bar") =?> "<<>> "
, "LTR span with a class" =: spanWith ("",["foobar"],[("dir", "ltr")]) (text "foo bar") =?> ">>>foo bar<<< "
, "Escape <<< and >>>" =: plain (text "<<< foo bar >>>") =?> "<<< foo bar >>> "
]
, testGroup "combined"
[ "emph word before" =:
para ("foo" <> emph "bar") =?>
"foobar"
, "emph word after" =:
para (emph "foo" <> "bar") =?>
"foobar"
, "emph quoted" =:
para (doubleQuoted (emph "foo")) =?>
"“*foo*”"
, "strong word before" =:
para ("foo" <> strong "bar") =?>
"foobar"
, "strong word after" =:
para (strong "foo" <> "bar") =?>
"foobar"
, "strong quoted" =:
para (singleQuoted (strong "foo")) =?>
"‘**foo**’"
]
]
]