From d5b98c8c6ec13556911876ac5632efb63a1ce40d Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sat, 14 Apr 2018 10:38:21 -0700 Subject: Man writer: Don't escape U+2019 as '. Closes #4550. --- test/Tests/Helpers.hs.orig | 138 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 138 insertions(+) create mode 100644 test/Tests/Helpers.hs.orig (limited to 'test/Tests/Helpers.hs.orig') diff --git a/test/Tests/Helpers.hs.orig b/test/Tests/Helpers.hs.orig new file mode 100644 index 000000000..2a6543ea0 --- /dev/null +++ b/test/Tests/Helpers.hs.orig @@ -0,0 +1,138 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeSynonymInstances #-} +-- Utility functions for the test suite. + +module Tests.Helpers ( test + , TestResult(..) + , showDiff + , findPandoc + , (=?>) + , purely + , ToString(..) + , ToPandoc(..) + ) + where + +import Data.Algorithm.Diff +import qualified Data.Map as M +import Data.Text (Text, unpack) +import System.Directory +import System.Environment.Executable (getExecutablePath) +import System.Exit +import System.FilePath +import Test.Tasty +import Test.Tasty.HUnit +import Text.Pandoc.Builder (Blocks, Inlines, doc, plain) +import Text.Pandoc.Class +import Text.Pandoc.Definition +import Text.Pandoc.Options +import Text.Pandoc.Shared (trimr) +import Text.Pandoc.Writers.Native (writeNative) +import Text.Printf + +test :: (ToString a, ToString b, ToString c) + => (a -> b) -- ^ function to test + -> String -- ^ name of test case + -> (a, c) -- ^ (input, expected value) + -> TestTree +test fn name (input, expected) = + testCase name' $ assertBool msg (actual' == expected') + where msg = nl ++ dashes "input" ++ nl ++ input' ++ nl ++ + dashes "result" ++ nl ++ + unlines (map vividize diff) ++ + dashes "" + nl = "\n" + name' = if length name > 54 + then take 52 name ++ "..." -- avoid wide output + else name + input' = toString input + actual' = lines $ toString $ fn input + expected' = lines $ toString expected + diff = getDiff expected' actual' + dashes "" = replicate 72 '-' + dashes x = replicate (72 - length x - 5) '-' ++ " " ++ x ++ " ---" + +data TestResult = TestPassed + | TestError ExitCode + | TestFailed String FilePath [Diff 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) -> [Diff String] -> String +showDiff _ [] = "" +showDiff (l,r) (First ln : ds) = + printf "+%4d " l ++ ln ++ "\n" ++ showDiff (l+1,r) ds +showDiff (l,r) (Second ln : ds) = + printf "-%4d " r ++ ln ++ "\n" ++ showDiff (l,r+1) ds +showDiff (l,r) (Both _ _ : ds) = + showDiff (l+1,r+1) ds + +-- | Find pandoc executable relative to test-pandoc +-- First, try in same directory (e.g. if both in ~/.cabal/bin) +-- Second, try ../pandoc (e.g. if in dist/XXX/build/test-pandoc) +findPandoc :: IO FilePath +findPandoc = do + testExePath <- getExecutablePath + let testExeDir = takeDirectory testExePath + found <- doesFileExist (testExeDir "pandoc") + return $ if found + then testExeDir "pandoc" + else case splitDirectories testExeDir of + [] -> error "test-pandoc: empty testExeDir" + xs -> joinPath (init xs) "pandoc" "pandoc" + + +vividize :: Diff String -> String +vividize (Both s _) = " " ++ s +vividize (First s) = "- " ++ s +vividize (Second s) = "+ " ++ s + +purely :: (b -> PandocPure a) -> b -> a +purely f = either (error . show) id . runPure . f + +infix 5 =?> +(=?>) :: a -> b -> (a,b) +x =?> y = (x, y) + +class ToString a where + toString :: a -> String + +instance ToString Pandoc where + toString d = unpack $ + purely (writeNative def{ writerTemplate = s }) $ toPandoc d + where s = case d of + (Pandoc (Meta m) _) + | M.null m -> Nothing + | otherwise -> Just "" -- need this to get meta output + +instance ToString Blocks where + toString = unpack . purely (writeNative def) . toPandoc + +instance ToString Inlines where + toString = trimr . unpack . purely (writeNative def) . toPandoc + +instance ToString String where + toString = id + +instance ToString Text where + toString = unpack + +class ToPandoc a where + toPandoc :: a -> Pandoc + +instance ToPandoc Pandoc where + toPandoc = id + +instance ToPandoc Blocks where + toPandoc = doc + +instance ToPandoc Inlines where + toPandoc = doc . plain -- cgit v1.2.3