pandoc 1.9.4.3 → 1.9.4.4
raw patch · 33 files changed
+1291/−1366 lines, 33 filesdep +old-timedep +pandocdep −Diffdep −HUnitdep −QuickCheckdep ~basedep ~blaze-htmlsetup-changednew-component:exe:make-pandoc-man-pages
Dependencies added: old-time, pandoc
Dependencies removed: Diff, HUnit, QuickCheck, ansi-terminal, template-haskell, test-framework, test-framework-hunit, test-framework-quickcheck2
Dependency ranges changed: base, blaze-html
Files
- INSTALL +2/−2
- MakeManPage.hs +0/−99
- Setup.hs +16/−83
- changelog +15/−0
- man/make-pandoc-man-pages.hs +99/−0
- pandoc.cabal +47/−71
- src/Tests/Arbitrary.hs +0/−190
- src/Tests/Helpers.hs +0/−114
- src/Tests/Old.hs +0/−202
- src/Tests/Readers/LaTeX.hs +0/−169
- src/Tests/Readers/Markdown.hs +0/−107
- src/Tests/Readers/RST.hs +0/−60
- src/Tests/Shared.hs +0/−26
- src/Tests/Writers/ConTeXt.hs +0/−70
- src/Tests/Writers/HTML.hs +0/−46
- src/Tests/Writers/LaTeX.hs +0/−35
- src/Tests/Writers/Markdown.hs +0/−34
- src/Tests/Writers/Native.hs +0/−21
- src/test-pandoc.hs +0/−36
- tests/Tests/Arbitrary.hs +190/−0
- tests/Tests/Helpers.hs +114/−0
- tests/Tests/Old.hs +202/−0
- tests/Tests/Readers/LaTeX.hs +169/−0
- tests/Tests/Readers/Markdown.hs +107/−0
- tests/Tests/Readers/RST.hs +60/−0
- tests/Tests/Shared.hs +26/−0
- tests/Tests/Writers/ConTeXt.hs +70/−0
- tests/Tests/Writers/HTML.hs +46/−0
- tests/Tests/Writers/LaTeX.hs +35/−0
- tests/Tests/Writers/Markdown.hs +34/−0
- tests/Tests/Writers/Native.hs +21/−0
- tests/lhs-test.latex +1/−1
- tests/test-pandoc.hs +37/−0
INSTALL view
@@ -136,9 +136,9 @@ ------------- 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
− MakeManPage.hs
@@ -1,99 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--- 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.Time.Clock-import Data.Default-import Data.Time.Clock.POSIX-import Data.Maybe (catMaybes)-import qualified Control.Exception as E--instance Default ClockTime where- def = (TOD 0 0)--instance Default UTCTime where- def = posixSecondsToUTCTime (0::NominalDiffTime)--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 <- E.catch (getModificationTime file) $- \(e::E.IOException) -> if isDoesNotExistError e- then return def -- 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-
Setup.hs view
@@ -2,90 +2,42 @@ 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 ( (\\) )-import Data.Time.Clock-import Data.Default-import Data.Time.Clock.POSIX-import qualified Control.Exception as E -instance Default ClockTime where- def = (TOD 0 0)--instance Default UTCTime where- def = posixSecondsToUTCTime (0::NominalDiffTime)- 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"@@ -99,22 +51,3 @@ 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 <- E.catch (getModificationTime file) $- \(e::E.IOException) -> if isDoesNotExistError e- then return def -- 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-
changelog view
@@ -1,3 +1,18 @@+pando (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.
+ man/make-pandoc-man-pages.hs view
@@ -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+
pandoc.cabal view
@@ -1,5 +1,5 @@ Name: pandoc-Version: 1.9.4.3+Version: 1.9.4.4 Cabal-Version: >= 1.10 Build-Type: Custom License: GPL@@ -90,7 +90,6 @@ 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 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@@ -289,9 +285,9 @@ 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,@@ -369,43 +365,23 @@ 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.6,- parsec >= 3.1 && < 3.2,- mtl >= 1.1 && < 2.2,- network >= 2 && < 2.4,- filepath >= 1.1 && < 1.4,- process >= 1 && < 1.2,+-- 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,- 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+ filepath >= 1.1 && < 1.4,+ 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 @@ 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.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
− src/Tests/Arbitrary.hs
@@ -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" "<a id=\"eek\">"- , 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"- "<div>\n*&*\n</div>"- , 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"-
− src/Tests/Helpers.hs
@@ -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
− src/Tests/Old.hs
@@ -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)
− src/Tests/Readers/LaTeX.hs
@@ -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}"))- ]
− src/Tests/Readers/Markdown.hs
@@ -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<div>\n"- =?> codeBlockWith ("",["sourceCode","literate","haskell"],[]) "a"- <>- codeBlockWith ("",["sourceCode","haskell"],[]) "b"- <>- rawBlock "html" "<div>\n\n"- ]--- the round-trip properties frequently fail--- , testGroup "round trip"--- [ property "p_markdown_round_trip" p_markdown_round_trip--- ]- ]
− src/Tests/Readers/RST.hs
@@ -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" <> ")")- ]-
@@ -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]
− src/Tests/Writers/ConTeXt.hs
@@ -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|]- ]- ]-
− src/Tests/Writers/HTML.hs
@@ -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 "@&" =?> "<code>@&</code>"- , "haskell" =: codeWith ("",["haskell"],[]) ">>="- =?> if null languages- then "<code class=\"haskell\">>>=</code>"- else "<code class=\"sourceCode haskell\"><span class=\"fu\">>>=</span></code>"- , "nolanguage" =: codeWith ("",["nolanguage"],[]) ">>="- =?> "<code class=\"nolanguage\">>>=</code>"- ]- , testGroup "images"- [ "alt with formatting" =:- image "/url" "title" ("my " <> emph "image")- =?> "<img src=\"/url\" title=\"title\" alt=\"my image\" />"- ]- ]
− src/Tests/Writers/LaTeX.hs
@@ -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}"- ]- ]
− src/Tests/Writers/Markdown.hs
@@ -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"- ]
− src/Tests/Writers/Native.hs
@@ -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- ]
− src/test-pandoc.hs
@@ -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
+ tests/Tests/Arbitrary.hs view
@@ -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" "<a id=\"eek\">"+ , 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"+ "<div>\n*&*\n</div>"+ , 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"+
+ tests/Tests/Helpers.hs view
@@ -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
+ tests/Tests/Old.hs view
@@ -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)
+ tests/Tests/Readers/LaTeX.hs view
@@ -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}"))+ ]
+ tests/Tests/Readers/Markdown.hs view
@@ -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<div>\n"+ =?> codeBlockWith ("",["sourceCode","literate","haskell"],[]) "a"+ <>+ codeBlockWith ("",["sourceCode","haskell"],[]) "b"+ <>+ rawBlock "html" "<div>\n\n"+ ]+-- the round-trip properties frequently fail+-- , testGroup "round trip"+-- [ property "p_markdown_round_trip" p_markdown_round_trip+-- ]+ ]
+ tests/Tests/Readers/RST.hs view
@@ -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" <> ")")+ ]+
@@ -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]
+ tests/Tests/Writers/ConTeXt.hs view
@@ -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|]+ ]+ ]+
+ tests/Tests/Writers/HTML.hs view
@@ -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 "@&" =?> "<code>@&</code>"+ , "haskell" =: codeWith ("",["haskell"],[]) ">>="+ =?> if null languages+ then "<code class=\"haskell\">>>=</code>"+ else "<code class=\"sourceCode haskell\"><span class=\"fu\">>>=</span></code>"+ , "nolanguage" =: codeWith ("",["nolanguage"],[]) ">>="+ =?> "<code class=\"nolanguage\">>>=</code>"+ ]+ , testGroup "images"+ [ "alt with formatting" =:+ image "/url" "title" ("my " <> emph "image")+ =?> "<img src=\"/url\" title=\"title\" alt=\"my image\" />"+ ]+ ]
+ tests/Tests/Writers/LaTeX.hs view
@@ -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}"+ ]+ ]
+ tests/Tests/Writers/Markdown.hs view
@@ -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"+ ]
+ tests/Tests/Writers/Native.hs view
@@ -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+ ]
tests/lhs-test.latex view
@@ -70,7 +70,7 @@ \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}
+ tests/test-pandoc.hs view
@@ -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