From d819bd5f3a308eb068ee4b51ae4290b62ad9952a Mon Sep 17 00:00:00 2001 From: Clint Adams Date: Tue, 6 Nov 2012 22:49:28 -0500 Subject: Imported Upstream version 1.9.4.5 --- INSTALL | 4 +- MakeManPage.hs | 87 ----------------- Setup.hs | 89 ++++------------- changelog | 27 ++++++ man/make-pandoc-man-pages.hs | 99 +++++++++++++++++++ pandoc.cabal | 138 +++++++++++--------------- src/Tests/Arbitrary.hs | 190 ------------------------------------ src/Tests/Helpers.hs | 114 ---------------------- src/Tests/Old.hs | 202 --------------------------------------- src/Tests/Readers/LaTeX.hs | 169 -------------------------------- src/Tests/Readers/Markdown.hs | 107 --------------------- src/Tests/Readers/RST.hs | 60 ------------ src/Tests/Shared.hs | 26 ----- src/Tests/Writers/ConTeXt.hs | 70 -------------- src/Tests/Writers/HTML.hs | 46 --------- src/Tests/Writers/LaTeX.hs | 35 ------- src/Tests/Writers/Markdown.hs | 34 ------- src/Tests/Writers/Native.hs | 21 ---- src/Text/Pandoc/Readers/LaTeX.hs | 6 +- src/Text/Pandoc/Writers/EPUB.hs | 2 + src/Text/Pandoc/Writers/ODT.hs | 6 +- src/Text/Pandoc/Writers/RTF.hs | 4 +- src/pandoc.hs | 16 ++-- src/test-pandoc.hs | 36 ------- tests/Tests/Arbitrary.hs | 190 ++++++++++++++++++++++++++++++++++++ tests/Tests/Helpers.hs | 114 ++++++++++++++++++++++ tests/Tests/Old.hs | 202 +++++++++++++++++++++++++++++++++++++++ tests/Tests/Readers/LaTeX.hs | 169 ++++++++++++++++++++++++++++++++ tests/Tests/Readers/Markdown.hs | 107 +++++++++++++++++++++ tests/Tests/Readers/RST.hs | 60 ++++++++++++ tests/Tests/Shared.hs | 26 +++++ tests/Tests/Writers/ConTeXt.hs | 70 ++++++++++++++ tests/Tests/Writers/HTML.hs | 46 +++++++++ tests/Tests/Writers/LaTeX.hs | 35 +++++++ tests/Tests/Writers/Markdown.hs | 34 +++++++ tests/Tests/Writers/Native.hs | 21 ++++ tests/lhs-test.latex | 2 +- tests/test-pandoc.hs | 37 +++++++ 38 files changed, 1336 insertions(+), 1365 deletions(-) delete mode 100644 MakeManPage.hs create mode 100644 man/make-pandoc-man-pages.hs delete mode 100644 src/Tests/Arbitrary.hs delete mode 100644 src/Tests/Helpers.hs delete mode 100644 src/Tests/Old.hs delete mode 100644 src/Tests/Readers/LaTeX.hs delete mode 100644 src/Tests/Readers/Markdown.hs delete mode 100644 src/Tests/Readers/RST.hs delete mode 100644 src/Tests/Shared.hs delete mode 100644 src/Tests/Writers/ConTeXt.hs delete mode 100644 src/Tests/Writers/HTML.hs delete mode 100644 src/Tests/Writers/LaTeX.hs delete mode 100644 src/Tests/Writers/Markdown.hs delete mode 100644 src/Tests/Writers/Native.hs delete mode 100644 src/test-pandoc.hs create mode 100644 tests/Tests/Arbitrary.hs create mode 100644 tests/Tests/Helpers.hs create mode 100644 tests/Tests/Old.hs create mode 100644 tests/Tests/Readers/LaTeX.hs create mode 100644 tests/Tests/Readers/Markdown.hs create mode 100644 tests/Tests/Readers/RST.hs create mode 100644 tests/Tests/Shared.hs create mode 100644 tests/Tests/Writers/ConTeXt.hs create mode 100644 tests/Tests/Writers/HTML.hs create mode 100644 tests/Tests/Writers/LaTeX.hs create mode 100644 tests/Tests/Writers/Markdown.hs create mode 100644 tests/Tests/Writers/Native.hs create mode 100644 tests/test-pandoc.hs diff --git a/INSTALL b/INSTALL index 8c4a07e2b..ac142ecc8 100644 --- a/INSTALL +++ b/INSTALL @@ -136,9 +136,9 @@ Running tests ------------- Pandoc comes with an automated test suite integrated to cabal. -To enable the tests, compile pandoc with the `tests` flag: +To enable the tests, compile pandoc with the `--enable-tests` option: - cabal install -ftests + cabal install --enable-tests Note: If you obtained the source via git, you should first do diff --git a/MakeManPage.hs b/MakeManPage.hs deleted file mode 100644 index 8405df70b..000000000 --- a/MakeManPage.hs +++ /dev/null @@ -1,87 +0,0 @@ --- Create pandoc.1 man and pandoc_markdown.5 man pages from README -import Text.Pandoc -import Data.ByteString.UTF8 (toString, fromString) -import Data.Char (toUpper) -import qualified Data.ByteString as B -import Control.Monad -import System.FilePath -import System.Environment (getArgs) -import Text.Pandoc.Shared (normalize) -import System.Directory (getModificationTime) -import System.IO.Error (isDoesNotExistError) -import System.Time (ClockTime(..)) -import Data.Maybe (catMaybes) - -main = do - rmContents <- liftM toString $ B.readFile "README" - let (Pandoc meta blocks) = readMarkdown defaultParserState rmContents - let manBlocks = removeSect [Str "Wrappers"] - $ removeSect [Str "Pandoc's",Space,Str "markdown"] blocks - let syntaxBlocks = extractSect [Str "Pandoc's",Space,Str "markdown"] blocks - args <- getArgs - let verbose = "--verbose" `elem` args - makeManPage verbose ("man" "man1" "pandoc.1") - meta manBlocks - makeManPage verbose ("man" "man5" "pandoc_markdown.5") - meta syntaxBlocks - -makeManPage :: Bool -> FilePath -> Meta -> [Block] -> IO () -makeManPage verbose page meta blocks = do - let templ = page <.> "template" - modDeps <- modifiedDependencies page ["README", templ] - unless (null modDeps) $ do - manTemplate <- liftM toString $ B.readFile templ - writeManPage page manTemplate (Pandoc meta blocks) - when verbose $ - putStrLn $ "Created " ++ page - -writeManPage :: FilePath -> String -> Pandoc -> IO () -writeManPage page templ doc = do - let opts = defaultWriterOptions{ writerStandalone = True - , writerTemplate = templ } - let manPage = writeMan opts $ - bottomUp (concatMap removeLinks) $ - bottomUp capitalizeHeaders doc - B.writeFile page $ fromString manPage - --- | Returns a list of 'dependencies' that have been modified after 'file'. -modifiedDependencies :: FilePath -> [FilePath] -> IO [FilePath] -modifiedDependencies file dependencies = do - fileModTime <- catch (getModificationTime file) $ - \e -> if isDoesNotExistError e - then return (TOD 0 0) -- the minimum ClockTime - else ioError e - depModTimes <- mapM getModificationTime dependencies - let modified = zipWith (\dep time -> if time > fileModTime then Just dep else Nothing) dependencies depModTimes - return $ catMaybes modified - -removeLinks :: Inline -> [Inline] -removeLinks (Link l _) = l -removeLinks x = [x] - -capitalizeHeaders :: Block -> Block -capitalizeHeaders (Header 1 xs) = Header 1 $ bottomUp capitalize xs -capitalizeHeaders x = x - -capitalize :: Inline -> Inline -capitalize (Str xs) = Str $ map toUpper xs -capitalize x = x - -removeSect :: [Inline] -> [Block] -> [Block] -removeSect ils (Header 1 x:xs) | normalize x == normalize ils = - dropWhile (not . isHeader1) xs -removeSect ils (x:xs) = x : removeSect ils xs -removeSect _ [] = [] - -extractSect :: [Inline] -> [Block] -> [Block] -extractSect ils (Header 1 z:xs) | normalize z == normalize ils = - bottomUp promoteHeader $ takeWhile (not . isHeader1) xs - where promoteHeader (Header n x) = Header (n-1) x - promoteHeader x = x -extractSect ils (x:xs) = extractSect ils xs -extractSect _ [] = [] - -isHeader1 :: Block -> Bool -isHeader1 (Header 1 _) = True -isHeader1 _ = False - diff --git a/Setup.hs b/Setup.hs index 56df0045d..420c617db 100644 --- a/Setup.hs +++ b/Setup.hs @@ -1,80 +1,43 @@ +{-# LANGUAGE ScopedTypeVariables #-} import Distribution.Simple import Distribution.Simple.Setup (copyDest, copyVerbosity, fromFlag, installVerbosity, BuildFlags(..)) -import Distribution.PackageDescription - (PackageDescription(..), Executable(..), BuildInfo(..)) +import Distribution.PackageDescription (PackageDescription(..), Executable(..)) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), absoluteInstallDirs) import Distribution.Verbosity ( Verbosity, silent ) -import Distribution.Simple.GHC (ghcPackageDbOptions) -import Distribution.Simple.InstallDirs (mandir, bindir, CopyDest (NoCopyDest)) +import Distribution.Simple.InstallDirs (mandir, CopyDest (NoCopyDest)) import Distribution.Simple.Utils (installOrdinaryFiles) -import Control.Exception ( bracket_ ) -import Control.Monad ( unless ) -import System.Process ( rawSystem, runCommand, waitForProcess ) +import Prelude hiding (catch) +import System.Process ( rawSystem ) import System.FilePath ( () ) -import System.Directory import System.Exit -import System.Time -import System.IO.Error ( isDoesNotExistError ) -import Data.Maybe ( catMaybes ) -import Data.List ( (\\) ) main :: IO () main = do defaultMainWithHooks $ simpleUserHooks { - runTests = runTestSuite - , postBuild = makeManPages + postBuild = makeManPages , postCopy = \ _ flags pkg lbi -> installManpages pkg lbi (fromFlag $ copyVerbosity flags) (fromFlag $ copyDest flags) , postInst = \ _ flags pkg lbi -> installManpages pkg lbi (fromFlag $ installVerbosity flags) NoCopyDest + , copyHook = \pkgdescr -> + (copyHook simpleUserHooks) pkgdescr{ executables = + [x | x <- executables pkgdescr, exeName x /= "make-pandoc-man-pages"] } + , instHook = \pkgdescr -> + (instHook simpleUserHooks) pkgdescr{ executables = + [x | x <- executables pkgdescr, exeName x /= "make-pandoc-man-pages"] } } exitWith ExitSuccess --- | Run test suite. -runTestSuite :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO a -runTestSuite args _ pkg lbi = do - let testDir = buildDir lbi "test-pandoc" - testDir' <- canonicalizePath testDir - let testArgs = "--timeout=5" : concatMap (\arg -> ["-t",arg]) args - if any id [buildable (buildInfo exe) | exe <- executables pkg, exeName exe == "test-pandoc"] - then inDirectory "tests" $ rawSystem (testDir' "test-pandoc") testArgs >>= exitWith - else do - putStrLn "Build pandoc with the 'tests' flag to run tests" - exitWith $ ExitFailure 3 - -- | Build man pages from markdown sources in man/ makeManPages :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () -makeManPages _ flags _ lbi = do - ds1 <- modifiedDependencies (manDir "man1" "pandoc.1") - ["README", manDir "man1" "pandoc.1.template"] - ds2 <- modifiedDependencies (manDir "man5" "pandoc_markdown.5") - ["README", manDir "man5" "pandoc_markdown.5.template"] - - let distPref = fromFlag (buildDistPref flags) - packageDB = - withPackageDB lbi - ++ [SpecificPackageDB $ distPref "package.conf.inplace"] - - verbosity = fromFlag $ buildVerbosity flags - - args = makeGhcArgs (ghcPackageDbOptions packageDB) - ++ ["MakeManPage.hs"] - args' = if verbosity == silent - then args - else args ++ ["--verbose"] - -- Don't run MakeManPage.hs unless we have to - unless (null ds1 && null ds2) $ do - rawSystem "runghc" args' >>= exitWith - --- format arguments to runghc that we wish to pass to ghc --- normally runghc gets it right, unless the argument does --- not begin with a '-' charecter, so we need to give clear --- directions. -makeGhcArgs :: [String] -> [String] -makeGhcArgs = map ("--ghc-arg="++) +makeManPages _ flags _ _ = do + let verbosity = fromFlag $ buildVerbosity flags + let args = ["--verbose" | verbosity /= silent] + rawSystem ("dist" "build" "make-pandoc-man-pages" "make-pandoc-man-pages") + args >>= exitWith manpages :: [FilePath] manpages = ["man1" "pandoc.1" @@ -88,21 +51,3 @@ installManpages :: PackageDescription -> LocalBuildInfo installManpages pkg lbi verbosity copy = installOrdinaryFiles verbosity (mandir (absoluteInstallDirs pkg lbi copy)) (zip (repeat manDir) manpages) - --- | Returns a list of 'dependencies' that have been modified after 'file'. -modifiedDependencies :: FilePath -> [FilePath] -> IO [FilePath] -modifiedDependencies file dependencies = do - fileModTime <- catch (getModificationTime file) $ - \e -> if isDoesNotExistError e - then return (TOD 0 0) -- the minimum ClockTime - else ioError e - depModTimes <- mapM getModificationTime dependencies - let modified = zipWith (\dep time -> if time > fileModTime then Just dep else Nothing) dependencies depModTimes - return $ catMaybes modified - --- | Perform an IO action in a directory. -inDirectory :: FilePath -> IO a -> IO a -inDirectory dir action = do - oldDir <- getCurrentDirectory - bracket_ (setCurrentDirectory dir) (setCurrentDirectory oldDir) action - diff --git a/changelog b/changelog index d8ec82ce5..50fe6694b 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,30 @@ +pandoc (1.9.4.5) + + * Raised version bounds on network, base64-bytestring, json, + and template-haskell. + +pandoc (1.9.4.4) + + * Removed `tests` flag and made test suite into a proper cabal + test suite, which can now be enabled using `--enable-tests` + and run with `cabal test`. + + * Moved man page creation out of `Setup.hs` and into an + executable built by Cabal, but never installed. This + allows dependencies to be specified, and solves a problem + with 1.9.4.3, which could only be installed if `data-default` + had already been installed. + + * Updated `lhs-latex.tex` test for latest highlighting-kate + representation of backticks. + +pandoc (1.9.4.3) + + * Removed `-threaded` from default compile flags. + + * Modified modules to compile with GHC 7.6 and latest version of time + package. + pandoc (1.9.4.2) * Don't encode/decode file paths if base >= 4.4. diff --git a/man/make-pandoc-man-pages.hs b/man/make-pandoc-man-pages.hs new file mode 100644 index 000000000..cfefa7aa3 --- /dev/null +++ b/man/make-pandoc-man-pages.hs @@ -0,0 +1,99 @@ +-- Create pandoc.1 man and pandoc_markdown.5 man pages from README +import Text.Pandoc +import qualified Text.Pandoc.UTF8 as UTF8 +import Data.Char (toUpper) +import Control.Monad +import System.FilePath +import System.Environment (getArgs) +import Text.Pandoc.Shared (normalize) +import Data.Maybe ( catMaybes ) +import Data.Time.Clock (UTCTime(..)) +import Prelude hiding (catch) +import Control.Exception ( catch ) +import System.IO.Error ( isDoesNotExistError ) +import System.Time (ClockTime(..)) +import System.Directory + +main :: IO () +main = do + ds1 <- modifiedDependencies ("man" "man1" "pandoc.1") + ["README", "man" "man1" "pandoc.1.template"] + ds2 <- modifiedDependencies ("man" "man5" "pandoc_markdown.5") + ["README", "man" "man5" "pandoc_markdown.5.template"] + + unless (null ds1 && null ds2) $ do + rmContents <- UTF8.readFile "README" + let (Pandoc meta blocks) = readMarkdown defaultParserState rmContents + let manBlocks = removeSect [Str "Wrappers"] + $ removeSect [Str "Pandoc's",Space,Str "markdown"] blocks + let syntaxBlocks = extractSect [Str "Pandoc's",Space,Str "markdown"] blocks + args <- getArgs + let verbose = "--verbose" `elem` args + unless (null ds1) $ + makeManPage verbose ("man" "man1" "pandoc.1") meta manBlocks + unless (null ds2) $ + makeManPage verbose ("man" "man5" "pandoc_markdown.5") meta syntaxBlocks + +makeManPage :: Bool -> FilePath -> Meta -> [Block] -> IO () +makeManPage verbose page meta blocks = do + let templ = page <.> "template" + manTemplate <- UTF8.readFile templ + writeManPage page manTemplate (Pandoc meta blocks) + when verbose $ putStrLn $ "Created " ++ page + +writeManPage :: FilePath -> String -> Pandoc -> IO () +writeManPage page templ doc = do + let opts = defaultWriterOptions{ + writerStandalone = True + , writerTemplate = templ } + let manPage = writeMan opts $ + bottomUp (concatMap removeLinks) $ + bottomUp capitalizeHeaders doc + UTF8.writeFile page manPage + +removeLinks :: Inline -> [Inline] +removeLinks (Link l _) = l +removeLinks x = [x] + +capitalizeHeaders :: Block -> Block +capitalizeHeaders (Header 1 xs) = Header 1 $ bottomUp capitalize xs +capitalizeHeaders x = x + +capitalize :: Inline -> Inline +capitalize (Str xs) = Str $ map toUpper xs +capitalize x = x + +removeSect :: [Inline] -> [Block] -> [Block] +removeSect ils (Header 1 x:xs) | normalize x == normalize ils = + dropWhile (not . isHeader1) xs +removeSect ils (x:xs) = x : removeSect ils xs +removeSect _ [] = [] + +extractSect :: [Inline] -> [Block] -> [Block] +extractSect ils (Header 1 z:xs) | normalize z == normalize ils = + bottomUp promoteHeader $ takeWhile (not . isHeader1) xs + where promoteHeader (Header n x) = Header (n-1) x + promoteHeader x = x +extractSect ils (x:xs) = extractSect ils xs +extractSect _ [] = [] + +isHeader1 :: Block -> Bool +isHeader1 (Header 1 _) = True +isHeader1 _ = False + + +-- | Returns a list of 'dependencies' that have been modified after 'file'. +modifiedDependencies :: FilePath -> [FilePath] -> IO [FilePath] +modifiedDependencies file dependencies = do + fileModTime <- catch (getModificationTime file) $ + \e -> if isDoesNotExistError e +#if MIN_VERSION_directory(1,2,0) + then return (UTCTime (toEnum 0) 0) -- the minimum ClockTime +#else + then return (TOD 0 0) -- the minimum ClockTime +#endif + else ioError e + depModTimes <- mapM getModificationTime dependencies + let modified = zipWith (\dep time -> if time > fileModTime then Just dep else Nothing) dependencies depModTimes + return $ catMaybes modified + diff --git a/pandoc.cabal b/pandoc.cabal index b4c74125f..101a040bf 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -1,5 +1,5 @@ Name: pandoc -Version: 1.9.4.2 +Version: 1.9.4.5 Cabal-Version: >= 1.10 Build-Type: Custom License: GPL @@ -90,7 +90,6 @@ Data-Files: README, INSTALL, COPYRIGHT, BUGS, changelog Extra-Source-Files: -- code to create pandoc.1 man page - MakeManPage.hs, man/man1/pandoc.1.template, man/man5/pandoc_markdown.5.template, -- generated man pages (produced post-build) @@ -188,9 +187,6 @@ Flag executable Flag library Description: Build the pandoc library. Default: True -Flag tests - Description: Build test-pandoc. - Default: False Flag blaze_html_0_5 Description: Use blaze-html 0.5 and blaze-markup 0.5 Default: False @@ -199,13 +195,13 @@ Library -- Note: the following is duplicated in all stanzas. -- It needs to be duplicated because of the library & executable flags. -- BEGIN DUPLICATED SECTION - Build-Depends: containers >= 0.1 && < 0.5, + Build-Depends: containers >= 0.1 && < 0.6, parsec >= 3.1 && < 3.2, mtl >= 1.1 && < 2.2, - network >= 2 && < 2.4, + network >= 2 && < 2.5, filepath >= 1.1 && < 1.4, process >= 1 && < 1.2, - directory >= 1 && < 1.2, + directory >= 1 && < 1.3, bytestring >= 0.9 && < 1.0, zip-archive >= 0.1.1.7 && < 0.2, utf8-string >= 0.3 && < 0.4, @@ -218,9 +214,9 @@ Library extensible-exceptions >= 0.1 && < 0.2, citeproc-hs >= 0.3.4 && < 0.4, pandoc-types >= 1.9.0.2 && < 1.10, - json >= 0.4 && < 0.6, + json >= 0.4 && < 0.8, tagsoup >= 0.12.5 && < 0.13, - base64-bytestring >= 0.1 && < 0.2, + base64-bytestring >= 0.1 && < 1.1, zlib >= 0.5 && < 0.6, highlighting-kate >= 0.5.1 && < 0.6, temporary >= 1.1 && < 1.2 @@ -289,9 +285,9 @@ Library Text.Pandoc.PDF, Text.Pandoc.Templates, Text.Pandoc.Biblio, + Text.Pandoc.UTF8, Text.Pandoc.SelfContained Other-Modules: Text.Pandoc.XML, - Text.Pandoc.UTF8, Text.Pandoc.MIME, Text.Pandoc.UUID, Text.Pandoc.ImageSize, @@ -307,13 +303,13 @@ Executable pandoc -- Note: the following is duplicated in all stanzas. -- It needs to be duplicated because of the library & executable flags. -- BEGIN DUPLICATED SECTION - Build-Depends: containers >= 0.1 && < 0.5, + Build-Depends: containers >= 0.1 && < 0.6, parsec >= 3.1 && < 3.2, mtl >= 1.1 && < 2.2, - network >= 2 && < 2.4, + network >= 2 && < 2.5, filepath >= 1.1 && < 1.4, process >= 1 && < 1.2, - directory >= 1 && < 1.2, + directory >= 1 && < 1.3, bytestring >= 0.9 && < 1.0, zip-archive >= 0.1.1.7 && < 0.2, utf8-string >= 0.3 && < 0.4, @@ -326,9 +322,9 @@ Executable pandoc extensible-exceptions >= 0.1 && < 0.2, citeproc-hs >= 0.3.4 && < 0.4, pandoc-types >= 1.9.0.2 && < 1.10, - json >= 0.4 && < 0.6, + json >= 0.4 && < 0.8, tagsoup >= 0.12.5 && < 0.13, - base64-bytestring >= 0.1 && < 0.2, + base64-bytestring >= 0.1 && < 1.1, zlib >= 0.5 && < 0.6, highlighting-kate >= 0.5.1 && < 0.6, temporary >= 1.1 && < 1.2 @@ -369,43 +365,23 @@ Executable pandoc else Buildable: False -Executable test-pandoc - Main-Is: test-pandoc.hs - -- Note: the following is duplicated in all stanzas. - -- It needs to be duplicated because of the library & executable flags. - -- BEGIN DUPLICATED SECTION - Build-Depends: containers >= 0.1 && < 0.5, - parsec >= 3.1 && < 3.2, - mtl >= 1.1 && < 2.2, - network >= 2 && < 2.4, +-- NOTE: A trick in Setup.hs makes sure this won't be installed: +Executable make-pandoc-man-pages + Main-Is: make-pandoc-man-pages.hs + Hs-Source-Dirs: man + Build-Depends: base >= 4.2 && < 5, + pandoc, + directory >= 1 && < 1.3, filepath >= 1.1 && < 1.4, - process >= 1 && < 1.2, - directory >= 1 && < 1.2, - bytestring >= 0.9 && < 1.0, - zip-archive >= 0.1.1.7 && < 0.2, - utf8-string >= 0.3 && < 0.4, - old-locale >= 1 && < 1.1, - time >= 1.2 && < 1.5, - HTTP >= 4000.0.5 && < 4000.3, - texmath >= 0.6.0.2 && < 0.7, - xml >= 1.3.12 && < 1.4, - random >= 1 && < 1.1, - extensible-exceptions >= 0.1 && < 0.2, - citeproc-hs >= 0.3.4 && < 0.4, - pandoc-types >= 1.9.0.2 && < 1.10, - json >= 0.4 && < 0.6, - tagsoup >= 0.12.5 && < 0.13, - base64-bytestring >= 0.1 && < 0.2, - zlib >= 0.5 && < 0.6, - highlighting-kate >= 0.5.1 && < 0.6, - temporary >= 1.1 && < 1.2 - if flag(blaze_html_0_5) - build-depends: - blaze-html >= 0.5 && < 0.6, - blaze-markup >= 0.5.1 && < 0.6 - else - build-depends: - blaze-html >= 0.4.3.0 && < 0.5 + old-time >= 1.1 && < 1.2, + time >= 1.2 && < 1.5 + Default-Language: Haskell98 + Default-Extensions: CPP + +Test-Suite test-pandoc + Type: exitcode-stdio-1.0 + Main-Is: test-pandoc.hs + Hs-Source-Dirs: tests if impl(ghc >= 6.10) Build-depends: base >= 4 && < 5, syb >= 0.1 && < 0.4 else @@ -427,33 +403,33 @@ Executable test-pandoc ScopedTypeVariables, GeneralizedNewtypeDeriving, RelaxedPolyRec, DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances - Hs-Source-Dirs: src - -- END DUPLICATED SECTION - if !flag(tests) - Buildable: False + if impl(ghc >= 7) + cpp-options: -D_LIT=lit else - Buildable: True - if impl(ghc >= 7) - cpp-options: -D_LIT=lit - else - cpp-options: -D_LIT=$lit - Other-Extensions: TemplateHaskell, QuasiQuotes - Build-Depends: Diff, test-framework >= 0.3 && < 0.7, - test-framework-hunit >= 0.2 && < 0.3, - test-framework-quickcheck2 >= 0.2.9 && < 0.3, - QuickCheck >= 2.4 && < 2.6, - HUnit >= 1.2 && < 1.3, - template-haskell >= 2.4 && < 2.8, - ansi-terminal == 0.5.* - Other-Modules: Tests.Old - Tests.Helpers - Tests.Arbitrary - Tests.Shared - Tests.Readers.LaTeX - Tests.Readers.Markdown - Tests.Readers.RST - Tests.Writers.Native - Tests.Writers.ConTeXt - Tests.Writers.HTML - Tests.Writers.Markdown - Tests.Writers.LaTeX + cpp-options: -D_LIT=$lit + Other-Extensions: TemplateHaskell, QuasiQuotes + Build-Depends: pandoc, Diff, test-framework >= 0.3 && < 0.7, + pandoc-types >= 1.9.0.2 && < 1.10, + test-framework-hunit >= 0.2 && < 0.3, + test-framework-quickcheck2 >= 0.2.9 && < 0.3, + process >= 1 && < 1.2, + filepath >= 1.1 && < 1.4, + directory >= 1 && < 1.3, + bytestring >= 0.9 && < 1.0, + utf8-string >= 0.3 && < 0.4, + QuickCheck >= 2.4 && < 2.6, + HUnit >= 1.2 && < 1.3, + template-haskell >= 2.4 && < 2.9, + ansi-terminal == 0.5.* + Other-Modules: Tests.Old + Tests.Helpers + Tests.Arbitrary + Tests.Shared + Tests.Readers.LaTeX + Tests.Readers.Markdown + Tests.Readers.RST + Tests.Writers.Native + Tests.Writers.ConTeXt + Tests.Writers.HTML + Tests.Writers.Markdown + Tests.Writers.LaTeX diff --git a/src/Tests/Arbitrary.hs b/src/Tests/Arbitrary.hs deleted file mode 100644 index 9d65e1f1f..000000000 --- a/src/Tests/Arbitrary.hs +++ /dev/null @@ -1,190 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables #-} --- provides Arbitrary instance for Pandoc types -module Tests.Arbitrary () -where -import Test.QuickCheck.Gen -import Test.QuickCheck.Arbitrary -import Control.Monad (liftM, liftM2) -import Text.Pandoc.Definition -import Text.Pandoc.Shared (normalize, escapeURI) -import Text.Pandoc.Builder - -realString :: Gen String -realString = resize 8 $ listOf $ frequency [ (9, elements [' '..'\127']) - , (1, elements ['\128'..'\9999']) ] - -arbAttr :: Gen Attr -arbAttr = do - id' <- elements ["","loc"] - classes <- elements [[],["haskell"],["c","numberLines"]] - keyvals <- elements [[],[("start","22")],[("a","11"),("b_2","a b c")]] - return (id',classes,keyvals) - -instance Arbitrary Inlines where - arbitrary = liftM (fromList :: [Inline] -> Inlines) arbitrary - -instance Arbitrary Blocks where - arbitrary = liftM (fromList :: [Block] -> Blocks) arbitrary - -instance Arbitrary Inline where - arbitrary = resize 3 $ arbInline 2 - -arbInlines :: Int -> Gen [Inline] -arbInlines n = listOf1 (arbInline n) `suchThat` (not . startsWithSpace) - where startsWithSpace (Space:_) = True - startsWithSpace _ = False - --- restrict to 3 levels of nesting max; otherwise we get --- bogged down in indefinitely large structures -arbInline :: Int -> Gen Inline -arbInline n = frequency $ [ (60, liftM Str realString) - , (60, return Space) - , (10, liftM2 Code arbAttr realString) - , (5, elements [ RawInline "html" "" - , RawInline "latex" "\\my{command}" ]) - ] ++ [ x | x <- nesters, n > 1] - where nesters = [ (10, liftM Emph $ arbInlines (n-1)) - , (10, liftM Strong $ arbInlines (n-1)) - , (10, liftM Strikeout $ arbInlines (n-1)) - , (10, liftM Superscript $ arbInlines (n-1)) - , (10, liftM Subscript $ arbInlines (n-1)) --- , (10, liftM SmallCaps $ arbInlines (n-1)) - , (10, do x1 <- arbitrary - x2 <- arbInlines (n-1) - return $ Quoted x1 x2) - , (10, do x1 <- arbitrary - x2 <- realString - return $ Math x1 x2) - , (10, do x1 <- arbInlines (n-1) - x3 <- realString - x2 <- liftM escapeURI realString - return $ Link x1 (x2,x3)) - , (10, do x1 <- arbInlines (n-1) - x3 <- realString - x2 <- liftM escapeURI realString - return $ Image x1 (x2,x3)) - , (2, liftM Note $ resize 3 $ listOf1 $ arbBlock (n-1)) - ] - -instance Arbitrary Block where - arbitrary = resize 3 $ arbBlock 2 - -arbBlock :: Int -> Gen Block -arbBlock n = frequency $ [ (10, liftM Plain $ arbInlines (n-1)) - , (15, liftM Para $ arbInlines (n-1)) - , (5, liftM2 CodeBlock arbAttr realString) - , (2, elements [ RawBlock "html" - "
\n*&*\n
" - , RawBlock "latex" - "\\begin[opt]{env}\nhi\n{\\end{env}" - ]) - , (5, do x1 <- choose (1 :: Int, 6) - x2 <- arbInlines (n-1) - return (Header x1 x2)) - , (2, return HorizontalRule) - ] ++ [x | x <- nesters, n > 0] - where nesters = [ (5, liftM BlockQuote $ listOf1 $ arbBlock (n-1)) - , (5, do x2 <- arbitrary - x3 <- arbitrary - x1 <- arbitrary `suchThat` (> 0) - x4 <- listOf1 $ listOf1 $ arbBlock (n-1) - return $ OrderedList (x1,x2,x3) x4 ) - , (5, liftM BulletList $ (listOf1 $ listOf1 $ arbBlock (n-1))) - , (5, do items <- listOf1 $ do - x1 <- listOf1 $ listOf1 $ arbBlock (n-1) - x2 <- arbInlines (n-1) - return (x2,x1) - return $ DefinitionList items) - , (2, do rs <- choose (1 :: Int, 4) - cs <- choose (1 :: Int, 4) - x1 <- arbInlines (n-1) - x2 <- vector cs - x3 <- vectorOf cs $ elements [0, 0.25] - x4 <- vectorOf cs $ listOf $ arbBlock (n-1) - x5 <- vectorOf rs $ vectorOf cs - $ listOf $ arbBlock (n-1) - return (Table x1 x2 x3 x4 x5)) - ] - -instance Arbitrary Pandoc where - arbitrary = resize 8 $ liftM normalize - $ liftM2 Pandoc arbitrary arbitrary - -{- -instance Arbitrary CitationMode where - arbitrary - = do x <- choose (0 :: Int, 2) - case x of - 0 -> return AuthorInText - 1 -> return SuppressAuthor - 2 -> return NormalCitation - _ -> error "FATAL ERROR: Arbitrary instance, logic bug" - -instance Arbitrary Citation where - arbitrary - = do x1 <- liftM (filter (`notElem` ",;]@ \t\n")) arbitrary - x2 <- arbitrary - x3 <- arbitrary - x4 <- arbitrary - x5 <- arbitrary - x6 <- arbitrary - return (Citation x1 x2 x3 x4 x5 x6) --} - -instance Arbitrary MathType where - arbitrary - = do x <- choose (0 :: Int, 1) - case x of - 0 -> return DisplayMath - 1 -> return InlineMath - _ -> error "FATAL ERROR: Arbitrary instance, logic bug" - -instance Arbitrary QuoteType where - arbitrary - = do x <- choose (0 :: Int, 1) - case x of - 0 -> return SingleQuote - 1 -> return DoubleQuote - _ -> error "FATAL ERROR: Arbitrary instance, logic bug" - -instance Arbitrary Meta where - arbitrary - = do x1 <- arbitrary - x2 <- liftM (filter (not . null)) arbitrary - x3 <- arbitrary - return (Meta x1 x2 x3) - -instance Arbitrary Alignment where - arbitrary - = do x <- choose (0 :: Int, 3) - case x of - 0 -> return AlignLeft - 1 -> return AlignRight - 2 -> return AlignCenter - 3 -> return AlignDefault - _ -> error "FATAL ERROR: Arbitrary instance, logic bug" - -instance Arbitrary ListNumberStyle where - arbitrary - = do x <- choose (0 :: Int, 6) - case x of - 0 -> return DefaultStyle - 1 -> return Example - 2 -> return Decimal - 3 -> return LowerRoman - 4 -> return UpperRoman - 5 -> return LowerAlpha - 6 -> return UpperAlpha - _ -> error "FATAL ERROR: Arbitrary instance, logic bug" - -instance Arbitrary ListNumberDelim where - arbitrary - = do x <- choose (0 :: Int, 3) - case x of - 0 -> return DefaultDelim - 1 -> return Period - 2 -> return OneParen - 3 -> return TwoParens - _ -> error "FATAL ERROR: Arbitrary instance, logic bug" - diff --git a/src/Tests/Helpers.hs b/src/Tests/Helpers.hs deleted file mode 100644 index 66879efed..000000000 --- a/src/Tests/Helpers.hs +++ /dev/null @@ -1,114 +0,0 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, TemplateHaskell #-} --- Utility functions for the test suite. - -module Tests.Helpers ( lit - , file - , test - , (=?>) - , property - , ToString(..) - , ToPandoc(..) - ) - where - -import Text.Pandoc.Definition -import Text.Pandoc.Builder (Inlines, Blocks, doc, plain) -import Test.Framework -import Test.Framework.Providers.HUnit -import Test.Framework.Providers.QuickCheck2 -import Test.HUnit (assertBool) -import Text.Pandoc.Shared (normalize, defaultWriterOptions, - WriterOptions(..), removeTrailingSpace) -import Text.Pandoc.Writers.Native (writeNative) -import Language.Haskell.TH.Quote (QuasiQuoter(..)) -import Language.Haskell.TH.Syntax (Q, runIO) -import qualified Test.QuickCheck.Property as QP -import System.Console.ANSI -import Data.Algorithm.Diff - -lit :: QuasiQuoter -lit = QuasiQuoter { - quoteExp = (\a -> let b = rnl a in [|b|]) . filter (/= '\r') - , quotePat = error "Cannot use lit as a pattern" - } - where rnl ('\n':xs) = xs - rnl xs = xs - -file :: QuasiQuoter -file = quoteFile lit - --- adapted from TH 2.5 code -quoteFile :: QuasiQuoter -> QuasiQuoter -quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp }) = - QuasiQuoter { quoteExp = get qe, quotePat = get qp } - where - get :: (String -> Q a) -> String -> Q a - get old_quoter file_name = do { file_cts <- runIO (readFile file_name) - ; old_quoter file_cts } - -test :: (ToString a, ToString b, ToString c) - => (a -> b) -- ^ function to test - -> String -- ^ name of test case - -> (a, c) -- ^ (input, expected value) - -> Test -test fn name (input, expected) = - testCase name $ assertBool msg (actual' == expected') - where msg = nl ++ dashes "input" ++ nl ++ input' ++ nl ++ - dashes "expected" ++ nl ++ expected'' ++ - dashes "got" ++ nl ++ actual'' ++ - dashes "" - nl = "\n" - input' = toString input - actual' = toString $ fn input - expected' = toString expected - diff = getDiff (lines expected') (lines actual') - expected'' = unlines $ map vividize $ filter (\(d,_) -> d /= S) diff - actual'' = unlines $ map vividize $ filter (\(d,_) -> d /= F) diff - dashes "" = replicate 72 '-' - dashes x = replicate (72 - length x - 5) '-' ++ " " ++ x ++ " ---" - -vividize :: (DI,String) -> String -vividize (B,s) = s -vividize (F,s) = s -vividize (S,s) = setSGRCode [SetColor Background Dull Red - , SetColor Foreground Vivid White] ++ s - ++ setSGRCode [Reset] - -property :: QP.Testable a => TestName -> a -> Test -property = testProperty - -infix 5 =?> -(=?>) :: a -> b -> (a,b) -x =?> y = (x, y) - -class ToString a where - toString :: a -> String - -instance ToString Pandoc where - toString d = writeNative defaultWriterOptions{ writerStandalone = s } - $ toPandoc d - where s = case d of - (Pandoc (Meta [] [] []) _) -> False - _ -> True - -instance ToString Blocks where - toString = writeNative defaultWriterOptions . toPandoc - -instance ToString Inlines where - toString = removeTrailingSpace . writeNative defaultWriterOptions . - toPandoc - -instance ToString String where - toString = id - -class ToPandoc a where - toPandoc :: a -> Pandoc - -instance ToPandoc Pandoc where - toPandoc = normalize - -instance ToPandoc Blocks where - toPandoc = normalize . doc - -instance ToPandoc Inlines where - toPandoc = normalize . doc . plain diff --git a/src/Tests/Old.hs b/src/Tests/Old.hs deleted file mode 100644 index 67eb51573..000000000 --- a/src/Tests/Old.hs +++ /dev/null @@ -1,202 +0,0 @@ -module Tests.Old (tests) where - -import Test.Framework (testGroup, Test ) -import Test.Framework.Providers.HUnit -import Test.HUnit ( assertBool ) - -import System.IO ( openTempFile, stderr ) -import System.Process ( runProcess, waitForProcess ) -import System.FilePath ( (), (<.>) ) -import System.Directory -import System.Exit -import Data.Algorithm.Diff -import Text.Pandoc.Shared ( normalize, defaultWriterOptions ) -import Text.Pandoc.Writers.Native ( writeNative ) -import Text.Pandoc.Readers.Native ( readNative ) -import Prelude hiding ( readFile ) -import qualified Data.ByteString.Lazy as B -import Data.ByteString.Lazy.UTF8 (toString) -import Text.Printf - -readFileUTF8 :: FilePath -> IO String -readFileUTF8 f = B.readFile f >>= return . toString - -pandocPath :: FilePath -pandocPath = ".." "dist" "build" "pandoc" "pandoc" - -data TestResult = TestPassed - | TestError ExitCode - | TestFailed String FilePath [(DI, String)] - deriving (Eq) - -instance Show TestResult where - show TestPassed = "PASSED" - show (TestError ec) = "ERROR " ++ show ec - show (TestFailed cmd file d) = '\n' : dash ++ - "\n--- " ++ file ++ - "\n+++ " ++ cmd ++ "\n" ++ showDiff (1,1) d ++ - dash - where dash = replicate 72 '-' - -showDiff :: (Int,Int) -> [(DI, String)] -> String -showDiff _ [] = "" -showDiff (l,r) ((F, ln) : ds) = - printf "+%4d " l ++ ln ++ "\n" ++ showDiff (l+1,r) ds -showDiff (l,r) ((S, ln) : ds) = - printf "-%4d " r ++ ln ++ "\n" ++ showDiff (l,r+1) ds -showDiff (l,r) ((B, _ ) : ds) = - showDiff (l+1,r+1) ds - -tests :: [Test] -tests = [ testGroup "markdown" - [ testGroup "writer" - $ writerTests "markdown" ++ lhsWriterTests "markdown" - , testGroup "reader" - [ test "basic" ["-r", "markdown", "-w", "native", "-s", "-S"] - "testsuite.txt" "testsuite.native" - , test "tables" ["-r", "markdown", "-w", "native", "--columns=80"] - "tables.txt" "tables.native" - , test "more" ["-r", "markdown", "-w", "native", "-S"] - "markdown-reader-more.txt" "markdown-reader-more.native" - , lhsReaderTest "markdown+lhs" - ] - , testGroup "citations" markdownCitationTests - ] - , testGroup "rst" - [ testGroup "writer" (writerTests "rst" ++ lhsWriterTests "rst") - , testGroup "reader" - [ test "basic" ["-r", "rst", "-w", "native", - "-s", "-S", "--columns=80"] "rst-reader.rst" "rst-reader.native" - , test "tables" ["-r", "rst", "-w", "native", "--columns=80"] - "tables.rst" "tables-rstsubset.native" - , lhsReaderTest "rst+lhs" - ] - ] - , testGroup "latex" - [ testGroup "writer" (writerTests "latex" ++ lhsWriterTests "latex") - , testGroup "reader" - [ test "basic" ["-r", "latex", "-w", "native", "-s", "-R"] - "latex-reader.latex" "latex-reader.native" - , lhsReaderTest "latex+lhs" - ] - ] - , testGroup "html" - [ testGroup "writer" (writerTests "html" ++ lhsWriterTests "html") - , test "reader" ["-r", "html", "-w", "native", "-s"] - "html-reader.html" "html-reader.native" - ] - , testGroup "s5" - [ s5WriterTest "basic" ["-s"] "s5" - , s5WriterTest "fancy" ["-s","-m","-i"] "s5" - , s5WriterTest "fragment" [] "html" - , s5WriterTest "inserts" ["-s", "-H", "insert", - "-B", "insert", "-A", "insert", "-c", "main.css"] "html" - ] - , testGroup "textile" - [ testGroup "writer" $ writerTests "textile" - , test "reader" ["-r", "textile", "-w", "native", "-s"] - "textile-reader.textile" "textile-reader.native" - ] - , testGroup "docbook" - [ testGroup "writer" $ writerTests "docbook" - , test "reader" ["-r", "docbook", "-w", "native", "-s"] - "docbook-reader.docbook" "docbook-reader.native" - ] - , testGroup "native" - [ testGroup "writer" $ writerTests "native" - , test "reader" ["-r", "native", "-w", "native", "-s"] - "testsuite.native" "testsuite.native" - ] - , testGroup "other writers" $ map (\f -> testGroup f $ writerTests f) - [ "opendocument" , "context" , "texinfo" - , "man" , "plain" , "mediawiki", "rtf", "org", "asciidoc" - ] - ] - --- makes sure file is fully closed after reading -readFile' :: FilePath -> IO String -readFile' f = do s <- readFileUTF8 f - return $! (length s `seq` s) - -lhsWriterTests :: String -> [Test] -lhsWriterTests format - = [ t "lhs to normal" format - , t "lhs to lhs" (format ++ "+lhs") - ] - where - t n f = test n ["--columns=78", "-r", "native", "-s", "-w", f] - "lhs-test.native" ("lhs-test" <.> f) - -lhsReaderTest :: String -> Test -lhsReaderTest format = - testWithNormalize normalizer "lhs" ["-r", format, "-w", "native"] - ("lhs-test" <.> format) "lhs-test.native" - where normalizer = writeNative defaultWriterOptions . normalize . readNative - -writerTests :: String -> [Test] -writerTests format - = [ test "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format) - , test "tables" opts "tables.native" ("tables" <.> format) - ] - where - opts = ["-r", "native", "-w", format, "--columns=78"] - -s5WriterTest :: String -> [String] -> String -> Test -s5WriterTest modifier opts format - = test (format ++ " writer (" ++ modifier ++ ")") - (["-r", "native", "-w", format] ++ opts) - "s5.native" ("s5." ++ modifier <.> "html") - -markdownCitationTests :: [Test] -markdownCitationTests - = map styleToTest ["chicago-author-date","ieee","mhra"] - ++ [test "natbib" wopts "markdown-citations.txt" - "markdown-citations.txt"] - where - ropts = ["-r", "markdown", "-w", "markdown", "--bibliography", - "biblio.bib", "--no-wrap"] - wopts = ropts ++ ["--natbib"] - styleToTest style = test style (ropts ++ ["--csl", style ++ ".csl"]) - "markdown-citations.txt" - ("markdown-citations." ++ style ++ ".txt") - --- | Run a test without normalize function, return True if test passed. -test :: String -- ^ Title of test - -> [String] -- ^ Options to pass to pandoc - -> String -- ^ Input filepath - -> FilePath -- ^ Norm (for test results) filepath - -> Test -test = testWithNormalize id - --- | Run a test with normalize function, return True if test passed. -testWithNormalize :: (String -> String) -- ^ Normalize function for output - -> String -- ^ Title of test - -> [String] -- ^ Options to pass to pandoc - -> String -- ^ Input filepath - -> FilePath -- ^ Norm (for test results) filepath - -> Test -testWithNormalize normalizer testname opts inp norm = testCase testname $ do - (outputPath, hOut) <- openTempFile "" "pandoc-test" - let inpPath = inp - let normPath = norm - let options = ["--data-dir", ".."] ++ [inpPath] ++ opts - let cmd = pandocPath ++ " " ++ unwords options - ph <- runProcess pandocPath options Nothing - (Just [("LANG","en_US.UTF-8"),("HOME", "./")]) Nothing (Just hOut) - (Just stderr) - ec <- waitForProcess ph - result <- if ec == ExitSuccess - then do - -- filter \r so the tests will work on Windows machines - outputContents <- readFile' outputPath >>= - return . filter (/='\r') . normalizer - normContents <- readFile' normPath >>= - return . filter (/='\r') . normalizer - if outputContents == normContents - then return TestPassed - else return - $ TestFailed cmd normPath - $ getDiff (lines outputContents) (lines normContents) - else return $ TestError ec - removeFile outputPath - assertBool (show result) (result == TestPassed) diff --git a/src/Tests/Readers/LaTeX.hs b/src/Tests/Readers/LaTeX.hs deleted file mode 100644 index d60026b20..000000000 --- a/src/Tests/Readers/LaTeX.hs +++ /dev/null @@ -1,169 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Tests.Readers.LaTeX (tests) where - -import Text.Pandoc.Definition -import Test.Framework -import Tests.Helpers -import Tests.Arbitrary() -import Text.Pandoc.Builder -import Text.Pandoc - -latex :: String -> Pandoc -latex = readLaTeX defaultParserState - -infix 4 =: -(=:) :: ToString c - => String -> (String, c) -> Test -(=:) = test latex - -tests :: [Test] -tests = [ testGroup "basic" - [ "simple" =: - "word" =?> para "word" - , "space" =: - "some text" =?> para ("some text") - , "emphasized" =: - "\\emph{emphasized}" =?> para (emph "emphasized") - ] - - , testGroup "headers" - [ "level 1" =: - "\\section{header}" =?> header 1 "header" - , "level 2" =: - "\\subsection{header}" =?> header 2 "header" - , "level 3" =: - "\\subsubsection{header}" =?> header 3 "header" - , "emph" =: - "\\section{text \\emph{emph}}" =?> - header 1 ("text" <> space <> emph "emph") - , "link" =: - "\\section{text \\href{/url}{link}}" =?> - header 1 ("text" <> space <> link "/url" "" "link") - ] - - , testGroup "math" - [ "escaped $" =: - "$x=\\$4$" =?> para (math "x=\\$4") - ] - - , testGroup "space and comments" - [ "blank lines + space at beginning" =: - "\n \n hi" =?> para "hi" - , "blank lines + space + comments" =: - "% my comment\n\n \n % another\n\nhi" =?> para "hi" - , "comment in paragraph" =: - "hi % this is a comment\nthere\n" =?> para "hi there" - ] - - , testGroup "citations" - [ natbibCitations - , biblatexCitations - ] - ] - -baseCitation :: Citation -baseCitation = Citation{ citationId = "item1" - , citationPrefix = [] - , citationSuffix = [] - , citationMode = AuthorInText - , citationNoteNum = 0 - , citationHash = 0 } - -rt :: String -> Inlines -rt = rawInline "latex" - -natbibCitations :: Test -natbibCitations = testGroup "natbib" - [ "citet" =: "\\citet{item1}" - =?> para (cite [baseCitation] (rt "\\citet{item1}")) - , "suffix" =: "\\citet[p.~30]{item1}" - =?> para - (cite [baseCitation{ citationSuffix = toList $ text ", p.\160\&30" }] (rt "\\citet[p.~30]{item1}")) - , "suffix long" =: "\\citet[p.~30, with suffix]{item1}" - =?> para (cite [baseCitation{ citationSuffix = - toList $ text ", p.\160\&30, with suffix" }] (rt "\\citet[p.~30, with suffix]{item1}")) - , "multiple" =: "\\citeauthor{item1} \\citetext{\\citeyear{item1}; \\citeyear[p.~30]{item2}; \\citealp[see also][]{item3}}" - =?> para (cite [baseCitation{ citationMode = AuthorInText } - ,baseCitation{ citationMode = SuppressAuthor - , citationSuffix = [Str ",",Space,Str "p.\160\&30"] - , citationId = "item2" } - ,baseCitation{ citationId = "item3" - , citationPrefix = [Str "see",Space,Str "also"] - , citationMode = NormalCitation } - ] (rt "\\citetext{\\citeyear{item1}; \\citeyear[p.~30]{item2}; \\citealp[see also][]{item3}}")) - , "group" =: "\\citetext{\\citealp[see][p.~34--35]{item1}; \\citealp[also][chap. 3]{item3}}" - =?> para (cite [baseCitation{ citationMode = NormalCitation - , citationPrefix = [Str "see"] - , citationSuffix = [Str ",",Space,Str "p.\160\&34\8211\&35"] } - ,baseCitation{ citationMode = NormalCitation - , citationId = "item3" - , citationPrefix = [Str "also"] - , citationSuffix = [Str ",",Space,Str "chap.",Space,Str "3"] } - ] (rt "\\citetext{\\citealp[see][p.~34--35]{item1}; \\citealp[also][chap. 3]{item3}}")) - , "suffix and locator" =: "\\citep[pp.~33, 35--37, and nowhere else]{item1}" - =?> para (cite [baseCitation{ citationMode = NormalCitation - , citationSuffix = [Str ",",Space,Str "pp.\160\&33,",Space,Str "35\8211\&37,",Space,Str "and",Space,Str "nowhere",Space, Str "else"] }] (rt "\\citep[pp.~33, 35--37, and nowhere else]{item1}")) - , "suffix only" =: "\\citep[and nowhere else]{item1}" - =?> para (cite [baseCitation{ citationMode = NormalCitation - , citationSuffix = toList $ text ", and nowhere else" }] (rt "\\citep[and nowhere else]{item1}")) - , "no author" =: "\\citeyearpar{item1}, and now Doe with a locator \\citeyearpar[p.~44]{item2}" - =?> para (cite [baseCitation{ citationMode = SuppressAuthor }] (rt "\\citeyearpar{item1}") <> - text ", and now Doe with a locator " <> - cite [baseCitation{ citationMode = SuppressAuthor - , citationSuffix = [Str ",",Space,Str "p.\160\&44"] - , citationId = "item2" }] (rt "\\citeyearpar[p.~44]{item2}")) - , "markup" =: "\\citep[\\emph{see}][p. \\textbf{32}]{item1}" - =?> para (cite [baseCitation{ citationMode = NormalCitation - , citationPrefix = [Emph [Str "see"]] - , citationSuffix = [Str ",",Space,Str "p.",Space, - Strong [Str "32"]] }] (rt "\\citep[\\emph{see}][p. \\textbf{32}]{item1}")) - ] - -biblatexCitations :: Test -biblatexCitations = testGroup "biblatex" - [ "textcite" =: "\\textcite{item1}" - =?> para (cite [baseCitation] (rt "\\textcite{item1}")) - , "suffix" =: "\\textcite[p.~30]{item1}" - =?> para - (cite [baseCitation{ citationSuffix = toList $ text ", p.\160\&30" }] (rt "\\textcite[p.~30]{item1}")) - , "suffix long" =: "\\textcite[p.~30, with suffix]{item1}" - =?> para (cite [baseCitation{ citationSuffix = - toList $ text ", p.\160\&30, with suffix" }] (rt "\\textcite[p.~30, with suffix]{item1}")) - , "multiple" =: "\\textcites{item1}[p.~30]{item2}[see also][]{item3}" - =?> para (cite [baseCitation{ citationMode = AuthorInText } - ,baseCitation{ citationMode = NormalCitation - , citationSuffix = [Str ",",Space,Str "p.\160\&30"] - , citationId = "item2" } - ,baseCitation{ citationId = "item3" - , citationPrefix = [Str "see",Space,Str "also"] - , citationMode = NormalCitation } - ] (rt "\\textcites{item1}[p.~30]{item2}[see also][]{item3}")) - , "group" =: "\\autocites[see][p.~34--35]{item1}[also][chap. 3]{item3}" - =?> para (cite [baseCitation{ citationMode = NormalCitation - , citationPrefix = [Str "see"] - , citationSuffix = [Str ",",Space,Str "p.\160\&34\8211\&35"] } - ,baseCitation{ citationMode = NormalCitation - , citationId = "item3" - , citationPrefix = [Str "also"] - , citationSuffix = [Str ",",Space,Str "chap.",Space,Str "3"] } - ] (rt "\\autocites[see][p.~34--35]{item1}[also][chap. 3]{item3}")) - , "suffix and locator" =: "\\autocite[pp.~33, 35--37, and nowhere else]{item1}" - =?> para (cite [baseCitation{ citationMode = NormalCitation - , citationSuffix = [Str ",",Space,Str "pp.\160\&33,",Space,Str "35\8211\&37,",Space,Str "and",Space,Str "nowhere",Space, Str "else"] }] (rt "\\autocite[pp.~33, 35--37, and nowhere else]{item1}")) - , "suffix only" =: "\\autocite[and nowhere else]{item1}" - =?> para (cite [baseCitation{ citationMode = NormalCitation - , citationSuffix = toList $ text ", and nowhere else" }] (rt "\\autocite[and nowhere else]{item1}")) - , "no author" =: "\\autocite*{item1}, and now Doe with a locator \\autocite*[p.~44]{item2}" - =?> para (cite [baseCitation{ citationMode = SuppressAuthor }] (rt "\\autocite*{item1}") <> - text ", and now Doe with a locator " <> - cite [baseCitation{ citationMode = SuppressAuthor - , citationSuffix = [Str ",",Space,Str "p.\160\&44"] - , citationId = "item2" }] (rt "\\autocite*[p.~44]{item2}")) - , "markup" =: "\\autocite[\\emph{see}][p. \\textbf{32}]{item1}" - =?> para (cite [baseCitation{ citationMode = NormalCitation - , citationPrefix = [Emph [Str "see"]] - , citationSuffix = [Str ",",Space,Str "p.",Space, - Strong [Str "32"]] }] (rt "\\autocite[\\emph{see}][p. \\textbf{32}]{item1}")) - , "parencite" =: "\\parencite{item1}" - =?> para (cite [baseCitation{ citationMode = NormalCitation }] (rt "\\parencite{item1}")) - ] diff --git a/src/Tests/Readers/Markdown.hs b/src/Tests/Readers/Markdown.hs deleted file mode 100644 index 5ad974adf..000000000 --- a/src/Tests/Readers/Markdown.hs +++ /dev/null @@ -1,107 +0,0 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} -module Tests.Readers.Markdown (tests) where - -import Text.Pandoc.Definition -import Test.Framework -import Tests.Helpers -import Tests.Arbitrary() -import Text.Pandoc.Builder --- import Text.Pandoc.Shared ( normalize ) -import Text.Pandoc - -markdown :: String -> Pandoc -markdown = readMarkdown defaultParserState{ stateStandalone = True } - -markdownSmart :: String -> Pandoc -markdownSmart = readMarkdown defaultParserState{ stateSmart = True } - -infix 4 =: -(=:) :: ToString c - => String -> (String, c) -> Test -(=:) = test markdown - -{- -p_markdown_round_trip :: Block -> Bool -p_markdown_round_trip b = matches d' d'' - where d' = normalize $ Pandoc (Meta [] [] []) [b] - d'' = normalize - $ readMarkdown defaultParserState{ stateSmart = True } - $ writeMarkdown defaultWriterOptions d' - matches (Pandoc _ [Plain []]) (Pandoc _ []) = True - matches (Pandoc _ [Para []]) (Pandoc _ []) = True - matches (Pandoc _ [Plain xs]) (Pandoc _ [Para xs']) = xs == xs' - matches x y = x == y --} - -tests :: [Test] -tests = [ testGroup "inline code" - [ "with attribute" =: - "`document.write(\"Hello\");`{.javascript}" - =?> para - (codeWith ("",["javascript"],[]) "document.write(\"Hello\");") - , "with attribute space" =: - "`*` {.haskell .special x=\"7\"}" - =?> para (codeWith ("",["haskell","special"],[("x","7")]) "*") - ] - , testGroup "backslash escapes" - [ "in URL" =: - "[hi](/there\\))" - =?> para (link "/there)" "" "hi") - , "in title" =: - "[hi](/there \"a\\\"a\")" - =?> para (link "/there" "a\"a" "hi") - , "in reference link title" =: - "[hi]\n\n[hi]: /there (a\\)a)" - =?> para (link "/there" "a)a" "hi") - , "in reference link URL" =: - "[hi]\n\n[hi]: /there\\.0" - =?> para (link "/there.0" "" "hi") - ] - , testGroup "smart punctuation" - [ test markdownSmart "quote before ellipses" - ("'...hi'" - =?> para (singleQuoted ("…hi"))) - , test markdownSmart "apostrophe before emph" - ("D'oh! A l'*aide*!" - =?> para ("D’oh! A l’" <> emph "aide" <> "!")) - , test markdownSmart "apostrophe in French" - ("À l'arrivée de la guerre, le thème de l'«impossibilité du socialisme»" - =?> para ("À l’arrivée de la guerre, le thème de l’«impossibilité du socialisme»")) - ] - , testGroup "mixed emphasis and strong" - [ "emph and strong emph alternating" =: - "*xxx* ***xxx*** xxx\n*xxx* ***xxx*** xxx" - =?> para (emph "xxx" <> space <> strong (emph "xxx") <> - space <> "xxx" <> space <> - emph "xxx" <> space <> strong (emph "xxx") <> - space <> "xxx") - , "emph with spaced strong" =: - "*x **xx** x*" - =?> para (emph ("x" <> space <> strong "xx" <> space <> "x")) - ] - , testGroup "footnotes" - [ "indent followed by newline and flush-left text" =: - "[^1]\n\n[^1]: my note\n\n \nnot in note\n" - =?> para (note (para "my note")) <> para "not in note" - , "indent followed by newline and indented text" =: - "[^1]\n\n[^1]: my note\n \n in note\n" - =?> para (note (para "my note" <> para "in note")) - , "recursive note" =: - "[^1]\n\n[^1]: See [^1]\n" - =?> para (note (para "See [^1]")) - ] - , testGroup "lhs" - [ test (readMarkdown defaultParserState{stateLiterateHaskell = True}) - "inverse bird tracks and html" $ - "> a\n\n< b\n\n
\n" - =?> codeBlockWith ("",["sourceCode","literate","haskell"],[]) "a" - <> - codeBlockWith ("",["sourceCode","haskell"],[]) "b" - <> - rawBlock "html" "
\n\n" - ] --- the round-trip properties frequently fail --- , testGroup "round trip" --- [ property "p_markdown_round_trip" p_markdown_round_trip --- ] - ] diff --git a/src/Tests/Readers/RST.hs b/src/Tests/Readers/RST.hs deleted file mode 100644 index 3269092a6..000000000 --- a/src/Tests/Readers/RST.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} -module Tests.Readers.RST (tests) where - -import Text.Pandoc.Definition -import Test.Framework -import Tests.Helpers -import Tests.Arbitrary() -import Text.Pandoc.Builder -import Text.Pandoc - -rst :: String -> Pandoc -rst = readRST defaultParserState{ stateStandalone = True } - -infix 4 =: -(=:) :: ToString c - => String -> (String, c) -> Test -(=:) = test rst - -tests :: [Test] -tests = [ "line block with blank line" =: - "| a\n|\n| b" =?> para (str "a" <> linebreak <> - linebreak <> str " " <> str "b") - , "field list" =: - [_LIT| -:Hostname: media08 -:IP address: 10.0.0.19 -:Size: 3ru -:Date: 2001-08-16 -:Version: 1 -:Authors: - Me - - Myself - - I -:Indentation: Since the field marker may be quite long, the second - and subsequent lines of the field body do not have to line up - with the first line, but they must be indented relative to the - field name marker, and they must line up with each other. -:Parameter i: integer -:Final: item - on two lines -|] =?> ( setAuthors ["Me","Myself","I"] - $ setDate "2001-08-16" - $ doc - $ definitionList [ (str "Hostname", [para "media08"]) - , (str "IP address", [para "10.0.0.19"]) - , (str "Size", [para "3ru"]) - , (str "Version", [para "1"]) - , (str "Indentation", [para "Since the field marker may be quite long, the second and subsequent lines of the field body do not have to line up with the first line, but they must be indented relative to the field name marker, and they must line up with each other."]) - , (str "Parameter i", [para "integer"]) - , (str "Final", [para "item on two lines"]) - ]) - , "URLs with following punctuation" =: - ("http://google.com, http://yahoo.com; http://foo.bar.baz.\n" ++ - "http://foo.bar/baz_(bam) (http://foo.bar)") =?> - para (link "http://google.com" "" "http://google.com" <> ", " <> - link "http://yahoo.com" "" "http://yahoo.com" <> "; " <> - link "http://foo.bar.baz" "" "http://foo.bar.baz" <> ". " <> - link "http://foo.bar/baz_(bam)" "" "http://foo.bar/baz_(bam)" - <> " (" <> link "http://foo.bar" "" "http://foo.bar" <> ")") - ] - diff --git a/src/Tests/Shared.hs b/src/Tests/Shared.hs deleted file mode 100644 index f4bf13da4..000000000 --- a/src/Tests/Shared.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Tests.Shared (tests) where - -import Text.Pandoc.Definition -import Text.Pandoc.Shared -import Test.Framework -import Tests.Helpers -import Tests.Arbitrary() - -tests :: [Test] -tests = [ testGroup "normalize" - [ property "p_normalize_blocks_rt" p_normalize_blocks_rt - , property "p_normalize_inlines_rt" p_normalize_inlines_rt - , property "p_normalize_no_trailing_spaces" - p_normalize_no_trailing_spaces - ] - ] - -p_normalize_blocks_rt :: [Block] -> Bool -p_normalize_blocks_rt bs = normalize bs == normalize (normalize bs) - -p_normalize_inlines_rt :: [Inline] -> Bool -p_normalize_inlines_rt ils = normalize ils == normalize (normalize ils) - -p_normalize_no_trailing_spaces :: [Inline] -> Bool -p_normalize_no_trailing_spaces ils = null ils' || last ils' /= Space - where ils' = normalize $ ils ++ [Space] diff --git a/src/Tests/Writers/ConTeXt.hs b/src/Tests/Writers/ConTeXt.hs deleted file mode 100644 index beb6411f0..000000000 --- a/src/Tests/Writers/ConTeXt.hs +++ /dev/null @@ -1,70 +0,0 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} -module Tests.Writers.ConTeXt (tests) where - -import Test.Framework -import Text.Pandoc.Builder -import Text.Pandoc -import Tests.Helpers -import Tests.Arbitrary() - -context :: (ToString a, ToPandoc a) => a -> String -context = writeConTeXt defaultWriterOptions . toPandoc - -context' :: (ToString a, ToPandoc a) => a -> String -context' = writeConTeXt defaultWriterOptions{ writerWrapText = False } - . toPandoc - -{- - "my test" =: X =?> Y - -is shorthand for - - test context "my test" $ X =?> Y - -which is in turn shorthand for - - test context "my test" (X,Y) --} - -infix 4 =: -(=:) :: (ToString a, ToPandoc a) - => String -> (a, String) -> Test -(=:) = test context - -tests :: [Test] -tests = [ testGroup "inline code" - [ "with '}'" =: code "}" =?> "\\mono{\\}}" - , "without '}'" =: code "]" =?> "\\type{]}" - , property "code property" $ \s -> null s || - if '{' `elem` s || '}' `elem` s - then (context' $ code s) == "\\mono{" ++ - (context' $ str s) ++ "}" - else (context' $ code s) == "\\type{" ++ s ++ "}" - ] - , testGroup "headers" - [ "level 1" =: - header 1 "My header" =?> "\\section[my-header]{My header}" - ] - , testGroup "bullet lists" - [ "nested" =: - bulletList [plain (text "top") - ,bulletList [plain (text "next") - ,bulletList [plain (text "bot")]]] - =?> [_LIT| -\startitemize -\item - top -\item - \startitemize - \item - next - \item - \startitemize - \item - bot - \stopitemize - \stopitemize -\stopitemize|] - ] - ] - diff --git a/src/Tests/Writers/HTML.hs b/src/Tests/Writers/HTML.hs deleted file mode 100644 index 8561aa421..000000000 --- a/src/Tests/Writers/HTML.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} -module Tests.Writers.HTML (tests) where - -import Test.Framework -import Text.Pandoc.Builder -import Text.Pandoc -import Tests.Helpers -import Tests.Arbitrary() -import Text.Pandoc.Highlighting (languages) -- null if no hl support - -html :: (ToString a, ToPandoc a) => a -> String -html = writeHtmlString defaultWriterOptions{ writerWrapText = False } . toPandoc - -{- - "my test" =: X =?> Y - -is shorthand for - - test html "my test" $ X =?> Y - -which is in turn shorthand for - - test html "my test" (X,Y) --} - -infix 4 =: -(=:) :: (ToString a, ToPandoc a) - => String -> (a, String) -> Test -(=:) = test html - -tests :: [Test] -tests = [ testGroup "inline code" - [ "basic" =: code "@&" =?> "@&" - , "haskell" =: codeWith ("",["haskell"],[]) ">>=" - =?> if null languages - then ">>=" - else ">>=" - , "nolanguage" =: codeWith ("",["nolanguage"],[]) ">>=" - =?> ">>=" - ] - , testGroup "images" - [ "alt with formatting" =: - image "/url" "title" ("my " <> emph "image") - =?> "\"my" - ] - ] diff --git a/src/Tests/Writers/LaTeX.hs b/src/Tests/Writers/LaTeX.hs deleted file mode 100644 index 7987716f3..000000000 --- a/src/Tests/Writers/LaTeX.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} -module Tests.Writers.LaTeX (tests) where - -import Test.Framework -import Text.Pandoc.Builder -import Text.Pandoc -import Tests.Helpers -import Tests.Arbitrary() - -latex :: (ToString a, ToPandoc a) => a -> String -latex = writeLaTeX defaultWriterOptions . toPandoc - -{- - "my test" =: X =?> Y - -is shorthand for - - test latex "my test" $ X =?> Y - -which is in turn shorthand for - - test latex "my test" (X,Y) --} - -infix 4 =: -(=:) :: (ToString a, ToPandoc a) - => String -> (a, String) -> Test -(=:) = test latex - -tests :: [Test] -tests = [ testGroup "code blocks" - [ "in footnotes" =: note (para "hi" <> codeBlock "hi") =?> - "\\footnote{hi\n\n\\begin{Verbatim}\nhi\n\\end{Verbatim}\n}" - ] - ] diff --git a/src/Tests/Writers/Markdown.hs b/src/Tests/Writers/Markdown.hs deleted file mode 100644 index d90dc83b1..000000000 --- a/src/Tests/Writers/Markdown.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} -module Tests.Writers.Markdown (tests) where - -import Test.Framework -import Text.Pandoc.Builder -import Text.Pandoc -import Tests.Helpers -import Tests.Arbitrary() - -markdown :: (ToString a, ToPandoc a) => a -> String -markdown = writeMarkdown defaultWriterOptions . toPandoc - -{- - "my test" =: X =?> Y - -is shorthand for - - test markdown "my test" $ X =?> Y - -which is in turn shorthand for - - test markdown "my test" (X,Y) --} - -infix 4 =: -(=:) :: (ToString a, ToPandoc a) - => String -> (a, String) -> Test -(=:) = test markdown - -tests :: [Test] -tests = [ "indented code after list" - =: (orderedList [ para "one" <> para "two" ] <> codeBlock "test") - =?> "1. one\n\n two\n\n\n\n test" - ] diff --git a/src/Tests/Writers/Native.hs b/src/Tests/Writers/Native.hs deleted file mode 100644 index 19740e0f4..000000000 --- a/src/Tests/Writers/Native.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Tests.Writers.Native (tests) where - -import Test.Framework -import Text.Pandoc.Builder -import Text.Pandoc -import Tests.Helpers -import Tests.Arbitrary() - -p_write_rt :: Pandoc -> Bool -p_write_rt d = - read (writeNative defaultWriterOptions{ writerStandalone = True } d) == d - -p_write_blocks_rt :: [Block] -> Bool -p_write_blocks_rt bs = length bs > 20 || - read (writeNative defaultWriterOptions (Pandoc (Meta [] [] []) bs)) == - bs - -tests :: [Test] -tests = [ property "p_write_rt" p_write_rt - , property "p_write_blocks_rt" p_write_blocks_rt - ] diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 3178945e4..37f34e853 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -27,6 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of LaTeX to 'Pandoc' document. -} +{-# LANGUAGE ScopedTypeVariables #-} module Text.Pandoc.Readers.LaTeX ( readLaTeX, rawLaTeXInline, rawLaTeXBlock, @@ -47,6 +48,7 @@ import Data.Monoid import System.FilePath (replaceExtension) import Data.List (intercalate) import qualified Data.Map as M +import qualified Control.Exception as E (catch, IOException) -- | Parse LaTeX from string and return 'Pandoc' document. readLaTeX :: ParserState -- ^ Parser state, including options for parser @@ -671,8 +673,8 @@ handleIncludes :: String -> IO String handleIncludes [] = return [] handleIncludes ('\\':xs) = case runParser include defaultParserState "input" ('\\':xs) of - Right (fs, rest) -> do let getfile f = catch (UTF8.readFile f) - (\_ -> return "") + Right (fs, rest) -> do let getfile f = E.catch (UTF8.readFile f) + (\(_::E.IOException) -> return "") yss <- mapM getfile fs (intercalate "\n" yss ++) `fmap` handleIncludes rest diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index b423f136f..d1cd67c68 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -48,7 +48,9 @@ import Text.Pandoc.Writers.Markdown ( writePlain ) import Data.Char ( toLower ) import Network.URI ( unEscapeString ) import Text.Pandoc.MIME (getMimeType) +#if ! MIN_VERSION_base(4,6,0) import Prelude hiding (catch) +#endif import Control.Exception (catch, SomeException) -- | Produce an EPUB file from a Pandoc document. diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index f8f22494f..6f5387691 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -27,6 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to ODT. -} +{-# LANGUAGE ScopedTypeVariables #-} module Text.Pandoc.Writers.ODT ( writeODT ) where import Data.IORef import Data.List ( isPrefixOf ) @@ -47,6 +48,7 @@ import Control.Monad (liftM) import Network.URI ( unEscapeString ) import Text.Pandoc.XML import Text.Pandoc.Pretty +import qualified Control.Exception as E (catch, IOException) -- | Produce an ODT file from a Pandoc document. writeODT :: Maybe FilePath -- ^ Path specified by --reference-odt @@ -110,9 +112,9 @@ transformPic sourceDir entriesRef (Image lab (src,tit)) = do Nothing -> tit entries <- readIORef entriesRef let newsrc = "Pictures/" ++ show (length entries) ++ takeExtension src' - catch (readEntry [] (sourceDir src') >>= \entry -> + E.catch (readEntry [] (sourceDir src') >>= \entry -> modifyIORef entriesRef (entry{ eRelativePath = newsrc } :) >> return (Image lab (newsrc, tit'))) - (\_ -> return (Emph lab)) + (\(_::E.IOException) -> return (Emph lab)) transformPic _ _ x = return x diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 4e7c2a7cd..91df240af 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -27,6 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to RTF (rich text format). -} +{-# LANGUAGE ScopedTypeVariables #-} module Text.Pandoc.Writers.RTF ( writeRTF, rtfEmbedImage ) where import Text.Pandoc.Definition import Text.Pandoc.Shared @@ -38,6 +39,7 @@ import System.FilePath ( takeExtension ) import qualified Data.ByteString as B import Text.Printf ( printf ) import Network.URI ( isAbsoluteURI, unEscapeString ) +import qualified Control.Exception as E (catch, IOException) -- | Convert Image inlines into a raw RTF embedded image, read from a file. -- If file not found or filetype not jpeg or png, leave the inline unchanged. @@ -47,7 +49,7 @@ rtfEmbedImage x@(Image _ (src,_)) = do if ext `elem` [".jpg",".jpeg",".png"] && not (isAbsoluteURI src) then do let src' = unEscapeString src - imgdata <- catch (B.readFile src') (\_ -> return B.empty) + imgdata <- E.catch (B.readFile src') (\(_::E.IOException) -> return B.empty) let bytes = map (printf "%02x") $ B.unpack imgdata let filetype = case ext of ".jpg" -> "\\jpegblip" diff --git a/src/pandoc.hs b/src/pandoc.hs index 0eb64c9ba..77510c906 100644 --- a/src/pandoc.hs +++ b/src/pandoc.hs @@ -29,6 +29,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Parses command-line options and calls the appropriate readers and writers. -} +{-# LANGUAGE ScopedTypeVariables #-} module Main where import Text.Pandoc import Text.Pandoc.PDF (tex2pdf) @@ -62,6 +63,7 @@ import Text.CSL.Reference (Reference(..)) #else import Codec.Binary.UTF8.String (decodeString, encodeString) #endif +import qualified Control.Exception as E (catch, IOException) encodePath, decodeArg :: FilePath -> FilePath #if MIN_VERSION_base(4,4,0) @@ -837,9 +839,9 @@ main = do let sources = if ignoreArgs then [] else args datadir <- case mbDataDir of - Nothing -> catch + Nothing -> E.catch (liftM Just $ getAppUserDataDirectory "pandoc") - (const $ return Nothing) + (\(_::E.IOException) -> return Nothing) Just _ -> return mbDataDir -- assign reader and writer based on options and filenames @@ -890,12 +892,12 @@ main = do let tp' = case takeExtension tp of "" -> tp <.> format _ -> tp - catch (UTF8.readFile tp') - (\e -> if isDoesNotExistError e - then catch + E.catch (UTF8.readFile tp') + (\(e::E.IOException) -> if isDoesNotExistError e + then E.catch (readDataFile datadir $ "templates" tp') - (\_ -> throwIO e) + (\(_::E.IOException) -> throwIO e) else throwIO e) let slideVariant = case writerName' of @@ -926,7 +928,7 @@ main = do -- that we can do lookups with regular string equality let unescapeRefId ref = ref{ refId = fromEntities (refId ref) } - refs <- mapM (\f -> catch (CSL.readBiblioFile f) $ \e -> + refs <- mapM (\f -> E.catch (CSL.readBiblioFile f) $ \(e::E.IOException) -> err 23 $ "Error reading bibliography `" ++ f ++ "'" ++ "\n" ++ show e) reffiles >>= return . map unescapeRefId . concat diff --git a/src/test-pandoc.hs b/src/test-pandoc.hs deleted file mode 100644 index 1a8c05e14..000000000 --- a/src/test-pandoc.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} - -module Main where - -import Test.Framework - -import qualified Tests.Old -import qualified Tests.Readers.LaTeX -import qualified Tests.Readers.Markdown -import qualified Tests.Readers.RST -import qualified Tests.Writers.ConTeXt -import qualified Tests.Writers.LaTeX -import qualified Tests.Writers.HTML -import qualified Tests.Writers.Native -import qualified Tests.Writers.Markdown -import qualified Tests.Shared - -tests :: [Test] -tests = [ testGroup "Old" Tests.Old.tests - , testGroup "Shared" Tests.Shared.tests - , testGroup "Writers" - [ testGroup "Native" Tests.Writers.Native.tests - , testGroup "ConTeXt" Tests.Writers.ConTeXt.tests - , testGroup "LaTeX" Tests.Writers.LaTeX.tests - , testGroup "HTML" Tests.Writers.HTML.tests - , testGroup "Markdown" Tests.Writers.Markdown.tests - ] - , testGroup "Readers" - [ testGroup "LaTeX" Tests.Readers.LaTeX.tests - , testGroup "Markdown" Tests.Readers.Markdown.tests - , testGroup "RST" Tests.Readers.RST.tests - ] - ] - -main :: IO () -main = defaultMain tests diff --git a/tests/Tests/Arbitrary.hs b/tests/Tests/Arbitrary.hs new file mode 100644 index 000000000..9d65e1f1f --- /dev/null +++ b/tests/Tests/Arbitrary.hs @@ -0,0 +1,190 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables #-} +-- provides Arbitrary instance for Pandoc types +module Tests.Arbitrary () +where +import Test.QuickCheck.Gen +import Test.QuickCheck.Arbitrary +import Control.Monad (liftM, liftM2) +import Text.Pandoc.Definition +import Text.Pandoc.Shared (normalize, escapeURI) +import Text.Pandoc.Builder + +realString :: Gen String +realString = resize 8 $ listOf $ frequency [ (9, elements [' '..'\127']) + , (1, elements ['\128'..'\9999']) ] + +arbAttr :: Gen Attr +arbAttr = do + id' <- elements ["","loc"] + classes <- elements [[],["haskell"],["c","numberLines"]] + keyvals <- elements [[],[("start","22")],[("a","11"),("b_2","a b c")]] + return (id',classes,keyvals) + +instance Arbitrary Inlines where + arbitrary = liftM (fromList :: [Inline] -> Inlines) arbitrary + +instance Arbitrary Blocks where + arbitrary = liftM (fromList :: [Block] -> Blocks) arbitrary + +instance Arbitrary Inline where + arbitrary = resize 3 $ arbInline 2 + +arbInlines :: Int -> Gen [Inline] +arbInlines n = listOf1 (arbInline n) `suchThat` (not . startsWithSpace) + where startsWithSpace (Space:_) = True + startsWithSpace _ = False + +-- restrict to 3 levels of nesting max; otherwise we get +-- bogged down in indefinitely large structures +arbInline :: Int -> Gen Inline +arbInline n = frequency $ [ (60, liftM Str realString) + , (60, return Space) + , (10, liftM2 Code arbAttr realString) + , (5, elements [ RawInline "html" "" + , RawInline "latex" "\\my{command}" ]) + ] ++ [ x | x <- nesters, n > 1] + where nesters = [ (10, liftM Emph $ arbInlines (n-1)) + , (10, liftM Strong $ arbInlines (n-1)) + , (10, liftM Strikeout $ arbInlines (n-1)) + , (10, liftM Superscript $ arbInlines (n-1)) + , (10, liftM Subscript $ arbInlines (n-1)) +-- , (10, liftM SmallCaps $ arbInlines (n-1)) + , (10, do x1 <- arbitrary + x2 <- arbInlines (n-1) + return $ Quoted x1 x2) + , (10, do x1 <- arbitrary + x2 <- realString + return $ Math x1 x2) + , (10, do x1 <- arbInlines (n-1) + x3 <- realString + x2 <- liftM escapeURI realString + return $ Link x1 (x2,x3)) + , (10, do x1 <- arbInlines (n-1) + x3 <- realString + x2 <- liftM escapeURI realString + return $ Image x1 (x2,x3)) + , (2, liftM Note $ resize 3 $ listOf1 $ arbBlock (n-1)) + ] + +instance Arbitrary Block where + arbitrary = resize 3 $ arbBlock 2 + +arbBlock :: Int -> Gen Block +arbBlock n = frequency $ [ (10, liftM Plain $ arbInlines (n-1)) + , (15, liftM Para $ arbInlines (n-1)) + , (5, liftM2 CodeBlock arbAttr realString) + , (2, elements [ RawBlock "html" + "
\n*&*\n
" + , RawBlock "latex" + "\\begin[opt]{env}\nhi\n{\\end{env}" + ]) + , (5, do x1 <- choose (1 :: Int, 6) + x2 <- arbInlines (n-1) + return (Header x1 x2)) + , (2, return HorizontalRule) + ] ++ [x | x <- nesters, n > 0] + where nesters = [ (5, liftM BlockQuote $ listOf1 $ arbBlock (n-1)) + , (5, do x2 <- arbitrary + x3 <- arbitrary + x1 <- arbitrary `suchThat` (> 0) + x4 <- listOf1 $ listOf1 $ arbBlock (n-1) + return $ OrderedList (x1,x2,x3) x4 ) + , (5, liftM BulletList $ (listOf1 $ listOf1 $ arbBlock (n-1))) + , (5, do items <- listOf1 $ do + x1 <- listOf1 $ listOf1 $ arbBlock (n-1) + x2 <- arbInlines (n-1) + return (x2,x1) + return $ DefinitionList items) + , (2, do rs <- choose (1 :: Int, 4) + cs <- choose (1 :: Int, 4) + x1 <- arbInlines (n-1) + x2 <- vector cs + x3 <- vectorOf cs $ elements [0, 0.25] + x4 <- vectorOf cs $ listOf $ arbBlock (n-1) + x5 <- vectorOf rs $ vectorOf cs + $ listOf $ arbBlock (n-1) + return (Table x1 x2 x3 x4 x5)) + ] + +instance Arbitrary Pandoc where + arbitrary = resize 8 $ liftM normalize + $ liftM2 Pandoc arbitrary arbitrary + +{- +instance Arbitrary CitationMode where + arbitrary + = do x <- choose (0 :: Int, 2) + case x of + 0 -> return AuthorInText + 1 -> return SuppressAuthor + 2 -> return NormalCitation + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance Arbitrary Citation where + arbitrary + = do x1 <- liftM (filter (`notElem` ",;]@ \t\n")) arbitrary + x2 <- arbitrary + x3 <- arbitrary + x4 <- arbitrary + x5 <- arbitrary + x6 <- arbitrary + return (Citation x1 x2 x3 x4 x5 x6) +-} + +instance Arbitrary MathType where + arbitrary + = do x <- choose (0 :: Int, 1) + case x of + 0 -> return DisplayMath + 1 -> return InlineMath + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance Arbitrary QuoteType where + arbitrary + = do x <- choose (0 :: Int, 1) + case x of + 0 -> return SingleQuote + 1 -> return DoubleQuote + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance Arbitrary Meta where + arbitrary + = do x1 <- arbitrary + x2 <- liftM (filter (not . null)) arbitrary + x3 <- arbitrary + return (Meta x1 x2 x3) + +instance Arbitrary Alignment where + arbitrary + = do x <- choose (0 :: Int, 3) + case x of + 0 -> return AlignLeft + 1 -> return AlignRight + 2 -> return AlignCenter + 3 -> return AlignDefault + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance Arbitrary ListNumberStyle where + arbitrary + = do x <- choose (0 :: Int, 6) + case x of + 0 -> return DefaultStyle + 1 -> return Example + 2 -> return Decimal + 3 -> return LowerRoman + 4 -> return UpperRoman + 5 -> return LowerAlpha + 6 -> return UpperAlpha + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance Arbitrary ListNumberDelim where + arbitrary + = do x <- choose (0 :: Int, 3) + case x of + 0 -> return DefaultDelim + 1 -> return Period + 2 -> return OneParen + 3 -> return TwoParens + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + diff --git a/tests/Tests/Helpers.hs b/tests/Tests/Helpers.hs new file mode 100644 index 000000000..66879efed --- /dev/null +++ b/tests/Tests/Helpers.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, TemplateHaskell #-} +-- Utility functions for the test suite. + +module Tests.Helpers ( lit + , file + , test + , (=?>) + , property + , ToString(..) + , ToPandoc(..) + ) + where + +import Text.Pandoc.Definition +import Text.Pandoc.Builder (Inlines, Blocks, doc, plain) +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.Framework.Providers.QuickCheck2 +import Test.HUnit (assertBool) +import Text.Pandoc.Shared (normalize, defaultWriterOptions, + WriterOptions(..), removeTrailingSpace) +import Text.Pandoc.Writers.Native (writeNative) +import Language.Haskell.TH.Quote (QuasiQuoter(..)) +import Language.Haskell.TH.Syntax (Q, runIO) +import qualified Test.QuickCheck.Property as QP +import System.Console.ANSI +import Data.Algorithm.Diff + +lit :: QuasiQuoter +lit = QuasiQuoter { + quoteExp = (\a -> let b = rnl a in [|b|]) . filter (/= '\r') + , quotePat = error "Cannot use lit as a pattern" + } + where rnl ('\n':xs) = xs + rnl xs = xs + +file :: QuasiQuoter +file = quoteFile lit + +-- adapted from TH 2.5 code +quoteFile :: QuasiQuoter -> QuasiQuoter +quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp }) = + QuasiQuoter { quoteExp = get qe, quotePat = get qp } + where + get :: (String -> Q a) -> String -> Q a + get old_quoter file_name = do { file_cts <- runIO (readFile file_name) + ; old_quoter file_cts } + +test :: (ToString a, ToString b, ToString c) + => (a -> b) -- ^ function to test + -> String -- ^ name of test case + -> (a, c) -- ^ (input, expected value) + -> Test +test fn name (input, expected) = + testCase name $ assertBool msg (actual' == expected') + where msg = nl ++ dashes "input" ++ nl ++ input' ++ nl ++ + dashes "expected" ++ nl ++ expected'' ++ + dashes "got" ++ nl ++ actual'' ++ + dashes "" + nl = "\n" + input' = toString input + actual' = toString $ fn input + expected' = toString expected + diff = getDiff (lines expected') (lines actual') + expected'' = unlines $ map vividize $ filter (\(d,_) -> d /= S) diff + actual'' = unlines $ map vividize $ filter (\(d,_) -> d /= F) diff + dashes "" = replicate 72 '-' + dashes x = replicate (72 - length x - 5) '-' ++ " " ++ x ++ " ---" + +vividize :: (DI,String) -> String +vividize (B,s) = s +vividize (F,s) = s +vividize (S,s) = setSGRCode [SetColor Background Dull Red + , SetColor Foreground Vivid White] ++ s + ++ setSGRCode [Reset] + +property :: QP.Testable a => TestName -> a -> Test +property = testProperty + +infix 5 =?> +(=?>) :: a -> b -> (a,b) +x =?> y = (x, y) + +class ToString a where + toString :: a -> String + +instance ToString Pandoc where + toString d = writeNative defaultWriterOptions{ writerStandalone = s } + $ toPandoc d + where s = case d of + (Pandoc (Meta [] [] []) _) -> False + _ -> True + +instance ToString Blocks where + toString = writeNative defaultWriterOptions . toPandoc + +instance ToString Inlines where + toString = removeTrailingSpace . writeNative defaultWriterOptions . + toPandoc + +instance ToString String where + toString = id + +class ToPandoc a where + toPandoc :: a -> Pandoc + +instance ToPandoc Pandoc where + toPandoc = normalize + +instance ToPandoc Blocks where + toPandoc = normalize . doc + +instance ToPandoc Inlines where + toPandoc = normalize . doc . plain diff --git a/tests/Tests/Old.hs b/tests/Tests/Old.hs new file mode 100644 index 000000000..67eb51573 --- /dev/null +++ b/tests/Tests/Old.hs @@ -0,0 +1,202 @@ +module Tests.Old (tests) where + +import Test.Framework (testGroup, Test ) +import Test.Framework.Providers.HUnit +import Test.HUnit ( assertBool ) + +import System.IO ( openTempFile, stderr ) +import System.Process ( runProcess, waitForProcess ) +import System.FilePath ( (), (<.>) ) +import System.Directory +import System.Exit +import Data.Algorithm.Diff +import Text.Pandoc.Shared ( normalize, defaultWriterOptions ) +import Text.Pandoc.Writers.Native ( writeNative ) +import Text.Pandoc.Readers.Native ( readNative ) +import Prelude hiding ( readFile ) +import qualified Data.ByteString.Lazy as B +import Data.ByteString.Lazy.UTF8 (toString) +import Text.Printf + +readFileUTF8 :: FilePath -> IO String +readFileUTF8 f = B.readFile f >>= return . toString + +pandocPath :: FilePath +pandocPath = ".." "dist" "build" "pandoc" "pandoc" + +data TestResult = TestPassed + | TestError ExitCode + | TestFailed String FilePath [(DI, String)] + deriving (Eq) + +instance Show TestResult where + show TestPassed = "PASSED" + show (TestError ec) = "ERROR " ++ show ec + show (TestFailed cmd file d) = '\n' : dash ++ + "\n--- " ++ file ++ + "\n+++ " ++ cmd ++ "\n" ++ showDiff (1,1) d ++ + dash + where dash = replicate 72 '-' + +showDiff :: (Int,Int) -> [(DI, String)] -> String +showDiff _ [] = "" +showDiff (l,r) ((F, ln) : ds) = + printf "+%4d " l ++ ln ++ "\n" ++ showDiff (l+1,r) ds +showDiff (l,r) ((S, ln) : ds) = + printf "-%4d " r ++ ln ++ "\n" ++ showDiff (l,r+1) ds +showDiff (l,r) ((B, _ ) : ds) = + showDiff (l+1,r+1) ds + +tests :: [Test] +tests = [ testGroup "markdown" + [ testGroup "writer" + $ writerTests "markdown" ++ lhsWriterTests "markdown" + , testGroup "reader" + [ test "basic" ["-r", "markdown", "-w", "native", "-s", "-S"] + "testsuite.txt" "testsuite.native" + , test "tables" ["-r", "markdown", "-w", "native", "--columns=80"] + "tables.txt" "tables.native" + , test "more" ["-r", "markdown", "-w", "native", "-S"] + "markdown-reader-more.txt" "markdown-reader-more.native" + , lhsReaderTest "markdown+lhs" + ] + , testGroup "citations" markdownCitationTests + ] + , testGroup "rst" + [ testGroup "writer" (writerTests "rst" ++ lhsWriterTests "rst") + , testGroup "reader" + [ test "basic" ["-r", "rst", "-w", "native", + "-s", "-S", "--columns=80"] "rst-reader.rst" "rst-reader.native" + , test "tables" ["-r", "rst", "-w", "native", "--columns=80"] + "tables.rst" "tables-rstsubset.native" + , lhsReaderTest "rst+lhs" + ] + ] + , testGroup "latex" + [ testGroup "writer" (writerTests "latex" ++ lhsWriterTests "latex") + , testGroup "reader" + [ test "basic" ["-r", "latex", "-w", "native", "-s", "-R"] + "latex-reader.latex" "latex-reader.native" + , lhsReaderTest "latex+lhs" + ] + ] + , testGroup "html" + [ testGroup "writer" (writerTests "html" ++ lhsWriterTests "html") + , test "reader" ["-r", "html", "-w", "native", "-s"] + "html-reader.html" "html-reader.native" + ] + , testGroup "s5" + [ s5WriterTest "basic" ["-s"] "s5" + , s5WriterTest "fancy" ["-s","-m","-i"] "s5" + , s5WriterTest "fragment" [] "html" + , s5WriterTest "inserts" ["-s", "-H", "insert", + "-B", "insert", "-A", "insert", "-c", "main.css"] "html" + ] + , testGroup "textile" + [ testGroup "writer" $ writerTests "textile" + , test "reader" ["-r", "textile", "-w", "native", "-s"] + "textile-reader.textile" "textile-reader.native" + ] + , testGroup "docbook" + [ testGroup "writer" $ writerTests "docbook" + , test "reader" ["-r", "docbook", "-w", "native", "-s"] + "docbook-reader.docbook" "docbook-reader.native" + ] + , testGroup "native" + [ testGroup "writer" $ writerTests "native" + , test "reader" ["-r", "native", "-w", "native", "-s"] + "testsuite.native" "testsuite.native" + ] + , testGroup "other writers" $ map (\f -> testGroup f $ writerTests f) + [ "opendocument" , "context" , "texinfo" + , "man" , "plain" , "mediawiki", "rtf", "org", "asciidoc" + ] + ] + +-- makes sure file is fully closed after reading +readFile' :: FilePath -> IO String +readFile' f = do s <- readFileUTF8 f + return $! (length s `seq` s) + +lhsWriterTests :: String -> [Test] +lhsWriterTests format + = [ t "lhs to normal" format + , t "lhs to lhs" (format ++ "+lhs") + ] + where + t n f = test n ["--columns=78", "-r", "native", "-s", "-w", f] + "lhs-test.native" ("lhs-test" <.> f) + +lhsReaderTest :: String -> Test +lhsReaderTest format = + testWithNormalize normalizer "lhs" ["-r", format, "-w", "native"] + ("lhs-test" <.> format) "lhs-test.native" + where normalizer = writeNative defaultWriterOptions . normalize . readNative + +writerTests :: String -> [Test] +writerTests format + = [ test "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format) + , test "tables" opts "tables.native" ("tables" <.> format) + ] + where + opts = ["-r", "native", "-w", format, "--columns=78"] + +s5WriterTest :: String -> [String] -> String -> Test +s5WriterTest modifier opts format + = test (format ++ " writer (" ++ modifier ++ ")") + (["-r", "native", "-w", format] ++ opts) + "s5.native" ("s5." ++ modifier <.> "html") + +markdownCitationTests :: [Test] +markdownCitationTests + = map styleToTest ["chicago-author-date","ieee","mhra"] + ++ [test "natbib" wopts "markdown-citations.txt" + "markdown-citations.txt"] + where + ropts = ["-r", "markdown", "-w", "markdown", "--bibliography", + "biblio.bib", "--no-wrap"] + wopts = ropts ++ ["--natbib"] + styleToTest style = test style (ropts ++ ["--csl", style ++ ".csl"]) + "markdown-citations.txt" + ("markdown-citations." ++ style ++ ".txt") + +-- | Run a test without normalize function, return True if test passed. +test :: String -- ^ Title of test + -> [String] -- ^ Options to pass to pandoc + -> String -- ^ Input filepath + -> FilePath -- ^ Norm (for test results) filepath + -> Test +test = testWithNormalize id + +-- | Run a test with normalize function, return True if test passed. +testWithNormalize :: (String -> String) -- ^ Normalize function for output + -> String -- ^ Title of test + -> [String] -- ^ Options to pass to pandoc + -> String -- ^ Input filepath + -> FilePath -- ^ Norm (for test results) filepath + -> Test +testWithNormalize normalizer testname opts inp norm = testCase testname $ do + (outputPath, hOut) <- openTempFile "" "pandoc-test" + let inpPath = inp + let normPath = norm + let options = ["--data-dir", ".."] ++ [inpPath] ++ opts + let cmd = pandocPath ++ " " ++ unwords options + ph <- runProcess pandocPath options Nothing + (Just [("LANG","en_US.UTF-8"),("HOME", "./")]) Nothing (Just hOut) + (Just stderr) + ec <- waitForProcess ph + result <- if ec == ExitSuccess + then do + -- filter \r so the tests will work on Windows machines + outputContents <- readFile' outputPath >>= + return . filter (/='\r') . normalizer + normContents <- readFile' normPath >>= + return . filter (/='\r') . normalizer + if outputContents == normContents + then return TestPassed + else return + $ TestFailed cmd normPath + $ getDiff (lines outputContents) (lines normContents) + else return $ TestError ec + removeFile outputPath + assertBool (show result) (result == TestPassed) diff --git a/tests/Tests/Readers/LaTeX.hs b/tests/Tests/Readers/LaTeX.hs new file mode 100644 index 000000000..d60026b20 --- /dev/null +++ b/tests/Tests/Readers/LaTeX.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tests.Readers.LaTeX (tests) where + +import Text.Pandoc.Definition +import Test.Framework +import Tests.Helpers +import Tests.Arbitrary() +import Text.Pandoc.Builder +import Text.Pandoc + +latex :: String -> Pandoc +latex = readLaTeX defaultParserState + +infix 4 =: +(=:) :: ToString c + => String -> (String, c) -> Test +(=:) = test latex + +tests :: [Test] +tests = [ testGroup "basic" + [ "simple" =: + "word" =?> para "word" + , "space" =: + "some text" =?> para ("some text") + , "emphasized" =: + "\\emph{emphasized}" =?> para (emph "emphasized") + ] + + , testGroup "headers" + [ "level 1" =: + "\\section{header}" =?> header 1 "header" + , "level 2" =: + "\\subsection{header}" =?> header 2 "header" + , "level 3" =: + "\\subsubsection{header}" =?> header 3 "header" + , "emph" =: + "\\section{text \\emph{emph}}" =?> + header 1 ("text" <> space <> emph "emph") + , "link" =: + "\\section{text \\href{/url}{link}}" =?> + header 1 ("text" <> space <> link "/url" "" "link") + ] + + , testGroup "math" + [ "escaped $" =: + "$x=\\$4$" =?> para (math "x=\\$4") + ] + + , testGroup "space and comments" + [ "blank lines + space at beginning" =: + "\n \n hi" =?> para "hi" + , "blank lines + space + comments" =: + "% my comment\n\n \n % another\n\nhi" =?> para "hi" + , "comment in paragraph" =: + "hi % this is a comment\nthere\n" =?> para "hi there" + ] + + , testGroup "citations" + [ natbibCitations + , biblatexCitations + ] + ] + +baseCitation :: Citation +baseCitation = Citation{ citationId = "item1" + , citationPrefix = [] + , citationSuffix = [] + , citationMode = AuthorInText + , citationNoteNum = 0 + , citationHash = 0 } + +rt :: String -> Inlines +rt = rawInline "latex" + +natbibCitations :: Test +natbibCitations = testGroup "natbib" + [ "citet" =: "\\citet{item1}" + =?> para (cite [baseCitation] (rt "\\citet{item1}")) + , "suffix" =: "\\citet[p.~30]{item1}" + =?> para + (cite [baseCitation{ citationSuffix = toList $ text ", p.\160\&30" }] (rt "\\citet[p.~30]{item1}")) + , "suffix long" =: "\\citet[p.~30, with suffix]{item1}" + =?> para (cite [baseCitation{ citationSuffix = + toList $ text ", p.\160\&30, with suffix" }] (rt "\\citet[p.~30, with suffix]{item1}")) + , "multiple" =: "\\citeauthor{item1} \\citetext{\\citeyear{item1}; \\citeyear[p.~30]{item2}; \\citealp[see also][]{item3}}" + =?> para (cite [baseCitation{ citationMode = AuthorInText } + ,baseCitation{ citationMode = SuppressAuthor + , citationSuffix = [Str ",",Space,Str "p.\160\&30"] + , citationId = "item2" } + ,baseCitation{ citationId = "item3" + , citationPrefix = [Str "see",Space,Str "also"] + , citationMode = NormalCitation } + ] (rt "\\citetext{\\citeyear{item1}; \\citeyear[p.~30]{item2}; \\citealp[see also][]{item3}}")) + , "group" =: "\\citetext{\\citealp[see][p.~34--35]{item1}; \\citealp[also][chap. 3]{item3}}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationPrefix = [Str "see"] + , citationSuffix = [Str ",",Space,Str "p.\160\&34\8211\&35"] } + ,baseCitation{ citationMode = NormalCitation + , citationId = "item3" + , citationPrefix = [Str "also"] + , citationSuffix = [Str ",",Space,Str "chap.",Space,Str "3"] } + ] (rt "\\citetext{\\citealp[see][p.~34--35]{item1}; \\citealp[also][chap. 3]{item3}}")) + , "suffix and locator" =: "\\citep[pp.~33, 35--37, and nowhere else]{item1}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationSuffix = [Str ",",Space,Str "pp.\160\&33,",Space,Str "35\8211\&37,",Space,Str "and",Space,Str "nowhere",Space, Str "else"] }] (rt "\\citep[pp.~33, 35--37, and nowhere else]{item1}")) + , "suffix only" =: "\\citep[and nowhere else]{item1}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationSuffix = toList $ text ", and nowhere else" }] (rt "\\citep[and nowhere else]{item1}")) + , "no author" =: "\\citeyearpar{item1}, and now Doe with a locator \\citeyearpar[p.~44]{item2}" + =?> para (cite [baseCitation{ citationMode = SuppressAuthor }] (rt "\\citeyearpar{item1}") <> + text ", and now Doe with a locator " <> + cite [baseCitation{ citationMode = SuppressAuthor + , citationSuffix = [Str ",",Space,Str "p.\160\&44"] + , citationId = "item2" }] (rt "\\citeyearpar[p.~44]{item2}")) + , "markup" =: "\\citep[\\emph{see}][p. \\textbf{32}]{item1}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationPrefix = [Emph [Str "see"]] + , citationSuffix = [Str ",",Space,Str "p.",Space, + Strong [Str "32"]] }] (rt "\\citep[\\emph{see}][p. \\textbf{32}]{item1}")) + ] + +biblatexCitations :: Test +biblatexCitations = testGroup "biblatex" + [ "textcite" =: "\\textcite{item1}" + =?> para (cite [baseCitation] (rt "\\textcite{item1}")) + , "suffix" =: "\\textcite[p.~30]{item1}" + =?> para + (cite [baseCitation{ citationSuffix = toList $ text ", p.\160\&30" }] (rt "\\textcite[p.~30]{item1}")) + , "suffix long" =: "\\textcite[p.~30, with suffix]{item1}" + =?> para (cite [baseCitation{ citationSuffix = + toList $ text ", p.\160\&30, with suffix" }] (rt "\\textcite[p.~30, with suffix]{item1}")) + , "multiple" =: "\\textcites{item1}[p.~30]{item2}[see also][]{item3}" + =?> para (cite [baseCitation{ citationMode = AuthorInText } + ,baseCitation{ citationMode = NormalCitation + , citationSuffix = [Str ",",Space,Str "p.\160\&30"] + , citationId = "item2" } + ,baseCitation{ citationId = "item3" + , citationPrefix = [Str "see",Space,Str "also"] + , citationMode = NormalCitation } + ] (rt "\\textcites{item1}[p.~30]{item2}[see also][]{item3}")) + , "group" =: "\\autocites[see][p.~34--35]{item1}[also][chap. 3]{item3}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationPrefix = [Str "see"] + , citationSuffix = [Str ",",Space,Str "p.\160\&34\8211\&35"] } + ,baseCitation{ citationMode = NormalCitation + , citationId = "item3" + , citationPrefix = [Str "also"] + , citationSuffix = [Str ",",Space,Str "chap.",Space,Str "3"] } + ] (rt "\\autocites[see][p.~34--35]{item1}[also][chap. 3]{item3}")) + , "suffix and locator" =: "\\autocite[pp.~33, 35--37, and nowhere else]{item1}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationSuffix = [Str ",",Space,Str "pp.\160\&33,",Space,Str "35\8211\&37,",Space,Str "and",Space,Str "nowhere",Space, Str "else"] }] (rt "\\autocite[pp.~33, 35--37, and nowhere else]{item1}")) + , "suffix only" =: "\\autocite[and nowhere else]{item1}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationSuffix = toList $ text ", and nowhere else" }] (rt "\\autocite[and nowhere else]{item1}")) + , "no author" =: "\\autocite*{item1}, and now Doe with a locator \\autocite*[p.~44]{item2}" + =?> para (cite [baseCitation{ citationMode = SuppressAuthor }] (rt "\\autocite*{item1}") <> + text ", and now Doe with a locator " <> + cite [baseCitation{ citationMode = SuppressAuthor + , citationSuffix = [Str ",",Space,Str "p.\160\&44"] + , citationId = "item2" }] (rt "\\autocite*[p.~44]{item2}")) + , "markup" =: "\\autocite[\\emph{see}][p. \\textbf{32}]{item1}" + =?> para (cite [baseCitation{ citationMode = NormalCitation + , citationPrefix = [Emph [Str "see"]] + , citationSuffix = [Str ",",Space,Str "p.",Space, + Strong [Str "32"]] }] (rt "\\autocite[\\emph{see}][p. \\textbf{32}]{item1}")) + , "parencite" =: "\\parencite{item1}" + =?> para (cite [baseCitation{ citationMode = NormalCitation }] (rt "\\parencite{item1}")) + ] diff --git a/tests/Tests/Readers/Markdown.hs b/tests/Tests/Readers/Markdown.hs new file mode 100644 index 000000000..5ad974adf --- /dev/null +++ b/tests/Tests/Readers/Markdown.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} +module Tests.Readers.Markdown (tests) where + +import Text.Pandoc.Definition +import Test.Framework +import Tests.Helpers +import Tests.Arbitrary() +import Text.Pandoc.Builder +-- import Text.Pandoc.Shared ( normalize ) +import Text.Pandoc + +markdown :: String -> Pandoc +markdown = readMarkdown defaultParserState{ stateStandalone = True } + +markdownSmart :: String -> Pandoc +markdownSmart = readMarkdown defaultParserState{ stateSmart = True } + +infix 4 =: +(=:) :: ToString c + => String -> (String, c) -> Test +(=:) = test markdown + +{- +p_markdown_round_trip :: Block -> Bool +p_markdown_round_trip b = matches d' d'' + where d' = normalize $ Pandoc (Meta [] [] []) [b] + d'' = normalize + $ readMarkdown defaultParserState{ stateSmart = True } + $ writeMarkdown defaultWriterOptions d' + matches (Pandoc _ [Plain []]) (Pandoc _ []) = True + matches (Pandoc _ [Para []]) (Pandoc _ []) = True + matches (Pandoc _ [Plain xs]) (Pandoc _ [Para xs']) = xs == xs' + matches x y = x == y +-} + +tests :: [Test] +tests = [ testGroup "inline code" + [ "with attribute" =: + "`document.write(\"Hello\");`{.javascript}" + =?> para + (codeWith ("",["javascript"],[]) "document.write(\"Hello\");") + , "with attribute space" =: + "`*` {.haskell .special x=\"7\"}" + =?> para (codeWith ("",["haskell","special"],[("x","7")]) "*") + ] + , testGroup "backslash escapes" + [ "in URL" =: + "[hi](/there\\))" + =?> para (link "/there)" "" "hi") + , "in title" =: + "[hi](/there \"a\\\"a\")" + =?> para (link "/there" "a\"a" "hi") + , "in reference link title" =: + "[hi]\n\n[hi]: /there (a\\)a)" + =?> para (link "/there" "a)a" "hi") + , "in reference link URL" =: + "[hi]\n\n[hi]: /there\\.0" + =?> para (link "/there.0" "" "hi") + ] + , testGroup "smart punctuation" + [ test markdownSmart "quote before ellipses" + ("'...hi'" + =?> para (singleQuoted ("…hi"))) + , test markdownSmart "apostrophe before emph" + ("D'oh! A l'*aide*!" + =?> para ("D’oh! A l’" <> emph "aide" <> "!")) + , test markdownSmart "apostrophe in French" + ("À l'arrivée de la guerre, le thème de l'«impossibilité du socialisme»" + =?> para ("À l’arrivée de la guerre, le thème de l’«impossibilité du socialisme»")) + ] + , testGroup "mixed emphasis and strong" + [ "emph and strong emph alternating" =: + "*xxx* ***xxx*** xxx\n*xxx* ***xxx*** xxx" + =?> para (emph "xxx" <> space <> strong (emph "xxx") <> + space <> "xxx" <> space <> + emph "xxx" <> space <> strong (emph "xxx") <> + space <> "xxx") + , "emph with spaced strong" =: + "*x **xx** x*" + =?> para (emph ("x" <> space <> strong "xx" <> space <> "x")) + ] + , testGroup "footnotes" + [ "indent followed by newline and flush-left text" =: + "[^1]\n\n[^1]: my note\n\n \nnot in note\n" + =?> para (note (para "my note")) <> para "not in note" + , "indent followed by newline and indented text" =: + "[^1]\n\n[^1]: my note\n \n in note\n" + =?> para (note (para "my note" <> para "in note")) + , "recursive note" =: + "[^1]\n\n[^1]: See [^1]\n" + =?> para (note (para "See [^1]")) + ] + , testGroup "lhs" + [ test (readMarkdown defaultParserState{stateLiterateHaskell = True}) + "inverse bird tracks and html" $ + "> a\n\n< b\n\n
\n" + =?> codeBlockWith ("",["sourceCode","literate","haskell"],[]) "a" + <> + codeBlockWith ("",["sourceCode","haskell"],[]) "b" + <> + rawBlock "html" "
\n\n" + ] +-- the round-trip properties frequently fail +-- , testGroup "round trip" +-- [ property "p_markdown_round_trip" p_markdown_round_trip +-- ] + ] diff --git a/tests/Tests/Readers/RST.hs b/tests/Tests/Readers/RST.hs new file mode 100644 index 000000000..3269092a6 --- /dev/null +++ b/tests/Tests/Readers/RST.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} +module Tests.Readers.RST (tests) where + +import Text.Pandoc.Definition +import Test.Framework +import Tests.Helpers +import Tests.Arbitrary() +import Text.Pandoc.Builder +import Text.Pandoc + +rst :: String -> Pandoc +rst = readRST defaultParserState{ stateStandalone = True } + +infix 4 =: +(=:) :: ToString c + => String -> (String, c) -> Test +(=:) = test rst + +tests :: [Test] +tests = [ "line block with blank line" =: + "| a\n|\n| b" =?> para (str "a" <> linebreak <> + linebreak <> str " " <> str "b") + , "field list" =: + [_LIT| +:Hostname: media08 +:IP address: 10.0.0.19 +:Size: 3ru +:Date: 2001-08-16 +:Version: 1 +:Authors: - Me + - Myself + - I +:Indentation: Since the field marker may be quite long, the second + and subsequent lines of the field body do not have to line up + with the first line, but they must be indented relative to the + field name marker, and they must line up with each other. +:Parameter i: integer +:Final: item + on two lines +|] =?> ( setAuthors ["Me","Myself","I"] + $ setDate "2001-08-16" + $ doc + $ definitionList [ (str "Hostname", [para "media08"]) + , (str "IP address", [para "10.0.0.19"]) + , (str "Size", [para "3ru"]) + , (str "Version", [para "1"]) + , (str "Indentation", [para "Since the field marker may be quite long, the second and subsequent lines of the field body do not have to line up with the first line, but they must be indented relative to the field name marker, and they must line up with each other."]) + , (str "Parameter i", [para "integer"]) + , (str "Final", [para "item on two lines"]) + ]) + , "URLs with following punctuation" =: + ("http://google.com, http://yahoo.com; http://foo.bar.baz.\n" ++ + "http://foo.bar/baz_(bam) (http://foo.bar)") =?> + para (link "http://google.com" "" "http://google.com" <> ", " <> + link "http://yahoo.com" "" "http://yahoo.com" <> "; " <> + link "http://foo.bar.baz" "" "http://foo.bar.baz" <> ". " <> + link "http://foo.bar/baz_(bam)" "" "http://foo.bar/baz_(bam)" + <> " (" <> link "http://foo.bar" "" "http://foo.bar" <> ")") + ] + diff --git a/tests/Tests/Shared.hs b/tests/Tests/Shared.hs new file mode 100644 index 000000000..f4bf13da4 --- /dev/null +++ b/tests/Tests/Shared.hs @@ -0,0 +1,26 @@ +module Tests.Shared (tests) where + +import Text.Pandoc.Definition +import Text.Pandoc.Shared +import Test.Framework +import Tests.Helpers +import Tests.Arbitrary() + +tests :: [Test] +tests = [ testGroup "normalize" + [ property "p_normalize_blocks_rt" p_normalize_blocks_rt + , property "p_normalize_inlines_rt" p_normalize_inlines_rt + , property "p_normalize_no_trailing_spaces" + p_normalize_no_trailing_spaces + ] + ] + +p_normalize_blocks_rt :: [Block] -> Bool +p_normalize_blocks_rt bs = normalize bs == normalize (normalize bs) + +p_normalize_inlines_rt :: [Inline] -> Bool +p_normalize_inlines_rt ils = normalize ils == normalize (normalize ils) + +p_normalize_no_trailing_spaces :: [Inline] -> Bool +p_normalize_no_trailing_spaces ils = null ils' || last ils' /= Space + where ils' = normalize $ ils ++ [Space] diff --git a/tests/Tests/Writers/ConTeXt.hs b/tests/Tests/Writers/ConTeXt.hs new file mode 100644 index 000000000..beb6411f0 --- /dev/null +++ b/tests/Tests/Writers/ConTeXt.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} +module Tests.Writers.ConTeXt (tests) where + +import Test.Framework +import Text.Pandoc.Builder +import Text.Pandoc +import Tests.Helpers +import Tests.Arbitrary() + +context :: (ToString a, ToPandoc a) => a -> String +context = writeConTeXt defaultWriterOptions . toPandoc + +context' :: (ToString a, ToPandoc a) => a -> String +context' = writeConTeXt defaultWriterOptions{ writerWrapText = False } + . toPandoc + +{- + "my test" =: X =?> Y + +is shorthand for + + test context "my test" $ X =?> Y + +which is in turn shorthand for + + test context "my test" (X,Y) +-} + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> Test +(=:) = test context + +tests :: [Test] +tests = [ testGroup "inline code" + [ "with '}'" =: code "}" =?> "\\mono{\\}}" + , "without '}'" =: code "]" =?> "\\type{]}" + , property "code property" $ \s -> null s || + if '{' `elem` s || '}' `elem` s + then (context' $ code s) == "\\mono{" ++ + (context' $ str s) ++ "}" + else (context' $ code s) == "\\type{" ++ s ++ "}" + ] + , testGroup "headers" + [ "level 1" =: + header 1 "My header" =?> "\\section[my-header]{My header}" + ] + , testGroup "bullet lists" + [ "nested" =: + bulletList [plain (text "top") + ,bulletList [plain (text "next") + ,bulletList [plain (text "bot")]]] + =?> [_LIT| +\startitemize +\item + top +\item + \startitemize + \item + next + \item + \startitemize + \item + bot + \stopitemize + \stopitemize +\stopitemize|] + ] + ] + diff --git a/tests/Tests/Writers/HTML.hs b/tests/Tests/Writers/HTML.hs new file mode 100644 index 000000000..8561aa421 --- /dev/null +++ b/tests/Tests/Writers/HTML.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} +module Tests.Writers.HTML (tests) where + +import Test.Framework +import Text.Pandoc.Builder +import Text.Pandoc +import Tests.Helpers +import Tests.Arbitrary() +import Text.Pandoc.Highlighting (languages) -- null if no hl support + +html :: (ToString a, ToPandoc a) => a -> String +html = writeHtmlString defaultWriterOptions{ writerWrapText = False } . toPandoc + +{- + "my test" =: X =?> Y + +is shorthand for + + test html "my test" $ X =?> Y + +which is in turn shorthand for + + test html "my test" (X,Y) +-} + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> Test +(=:) = test html + +tests :: [Test] +tests = [ testGroup "inline code" + [ "basic" =: code "@&" =?> "@&" + , "haskell" =: codeWith ("",["haskell"],[]) ">>=" + =?> if null languages + then ">>=" + else ">>=" + , "nolanguage" =: codeWith ("",["nolanguage"],[]) ">>=" + =?> ">>=" + ] + , testGroup "images" + [ "alt with formatting" =: + image "/url" "title" ("my " <> emph "image") + =?> "\"my" + ] + ] diff --git a/tests/Tests/Writers/LaTeX.hs b/tests/Tests/Writers/LaTeX.hs new file mode 100644 index 000000000..7987716f3 --- /dev/null +++ b/tests/Tests/Writers/LaTeX.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} +module Tests.Writers.LaTeX (tests) where + +import Test.Framework +import Text.Pandoc.Builder +import Text.Pandoc +import Tests.Helpers +import Tests.Arbitrary() + +latex :: (ToString a, ToPandoc a) => a -> String +latex = writeLaTeX defaultWriterOptions . toPandoc + +{- + "my test" =: X =?> Y + +is shorthand for + + test latex "my test" $ X =?> Y + +which is in turn shorthand for + + test latex "my test" (X,Y) +-} + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> Test +(=:) = test latex + +tests :: [Test] +tests = [ testGroup "code blocks" + [ "in footnotes" =: note (para "hi" <> codeBlock "hi") =?> + "\\footnote{hi\n\n\\begin{Verbatim}\nhi\n\\end{Verbatim}\n}" + ] + ] diff --git a/tests/Tests/Writers/Markdown.hs b/tests/Tests/Writers/Markdown.hs new file mode 100644 index 000000000..d90dc83b1 --- /dev/null +++ b/tests/Tests/Writers/Markdown.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} +module Tests.Writers.Markdown (tests) where + +import Test.Framework +import Text.Pandoc.Builder +import Text.Pandoc +import Tests.Helpers +import Tests.Arbitrary() + +markdown :: (ToString a, ToPandoc a) => a -> String +markdown = writeMarkdown defaultWriterOptions . toPandoc + +{- + "my test" =: X =?> Y + +is shorthand for + + test markdown "my test" $ X =?> Y + +which is in turn shorthand for + + test markdown "my test" (X,Y) +-} + +infix 4 =: +(=:) :: (ToString a, ToPandoc a) + => String -> (a, String) -> Test +(=:) = test markdown + +tests :: [Test] +tests = [ "indented code after list" + =: (orderedList [ para "one" <> para "two" ] <> codeBlock "test") + =?> "1. one\n\n two\n\n\n\n test" + ] diff --git a/tests/Tests/Writers/Native.hs b/tests/Tests/Writers/Native.hs new file mode 100644 index 000000000..19740e0f4 --- /dev/null +++ b/tests/Tests/Writers/Native.hs @@ -0,0 +1,21 @@ +module Tests.Writers.Native (tests) where + +import Test.Framework +import Text.Pandoc.Builder +import Text.Pandoc +import Tests.Helpers +import Tests.Arbitrary() + +p_write_rt :: Pandoc -> Bool +p_write_rt d = + read (writeNative defaultWriterOptions{ writerStandalone = True } d) == d + +p_write_blocks_rt :: [Block] -> Bool +p_write_blocks_rt bs = length bs > 20 || + read (writeNative defaultWriterOptions (Pandoc (Meta [] [] []) bs)) == + bs + +tests :: [Test] +tests = [ property "p_write_rt" p_write_rt + , property "p_write_blocks_rt" p_write_blocks_rt + ] diff --git a/tests/lhs-test.latex b/tests/lhs-test.latex index d2d1f9ab8..acfb86679 100644 --- a/tests/lhs-test.latex +++ b/tests/lhs-test.latex @@ -70,7 +70,7 @@ return a single value: \begin{Highlighting}[] \OtherTok{unsplit ::} \NormalTok{(}\DataTypeTok{Arrow} \NormalTok{a) }\OtherTok{=>} \NormalTok{(b }\OtherTok{->} \NormalTok{c }\OtherTok{->} \NormalTok{d) }\OtherTok{->} \NormalTok{a (b, c) d} \NormalTok{unsplit }\FunctionTok{=} \NormalTok{arr }\FunctionTok{.} \FunctionTok{uncurry} - \CommentTok{-- arr (\textbackslash{}op (x,y) -> x `op` y) } + \CommentTok{-- arr (\textbackslash{}op (x,y) -> x {\char18}op{\char18} y) } \end{Highlighting} \end{Shaded} diff --git a/tests/test-pandoc.hs b/tests/test-pandoc.hs new file mode 100644 index 000000000..968f31df6 --- /dev/null +++ b/tests/test-pandoc.hs @@ -0,0 +1,37 @@ +{-# OPTIONS_GHC -Wall #-} + +module Main where + +import Test.Framework + +import qualified Tests.Old +import qualified Tests.Readers.LaTeX +import qualified Tests.Readers.Markdown +import qualified Tests.Readers.RST +import qualified Tests.Writers.ConTeXt +import qualified Tests.Writers.LaTeX +import qualified Tests.Writers.HTML +import qualified Tests.Writers.Native +import qualified Tests.Writers.Markdown +import qualified Tests.Shared +import Text.Pandoc.Shared (inDirectory) + +tests :: [Test] +tests = [ testGroup "Old" Tests.Old.tests + , testGroup "Shared" Tests.Shared.tests + , testGroup "Writers" + [ testGroup "Native" Tests.Writers.Native.tests + , testGroup "ConTeXt" Tests.Writers.ConTeXt.tests + , testGroup "LaTeX" Tests.Writers.LaTeX.tests + , testGroup "HTML" Tests.Writers.HTML.tests + , testGroup "Markdown" Tests.Writers.Markdown.tests + ] + , testGroup "Readers" + [ testGroup "LaTeX" Tests.Readers.LaTeX.tests + , testGroup "Markdown" Tests.Readers.Markdown.tests + , testGroup "RST" Tests.Readers.RST.tests + ] + ] + +main :: IO () +main = inDirectory "tests" $ defaultMain tests -- cgit v1.2.3