{-# 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 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
                                                  =?> "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**’"
            ]
         ]
       ]