{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{- |
This module provides a simplified interface. If you want more, see "Test.Tasty.Silver.Advanced".

=== Note about filenames

They are looked up in the usual way, thus relative
names are relative to the processes current working directory.
It is common to run tests from the package's root directory (via @cabal
test@ or @stack test@), so if your test files are under
the @tests\/@ subdirectory, your relative file names should start with
@tests\/@ (even if your @test.hs@ is itself under @tests\/@, too).

=== Note about line endings

The best way to avoid headaches with line endings
(when running tests both on UNIX and Windows) is to treat your golden files
as binary, even when they are actually textual.

This means:

* When writing output files from Haskell code, open them in binary mode
(see 'System.IO.openBinaryFile', 'System.IO.withBinaryFile' and 'System.IO.hSetBinaryMode'). This will
disable automatic @\\n -> \\r\\n@ conversion on Windows.
When using 'Data.ByteString.ByteString', note that
"Data.ByteString" and "Data.ByteString.Lazy" use binary mode for
@'writeFile'@, while "Data.ByteString.Char8" and "Data.ByteString.Lazy.Char8"
use text mode.

* Tell your version control not to do any newline conversion for golden files. For
 git, check in a @.gitattributes@ file with the following contents (assuming
 your golden files have @.golden@ extension):

>*.golden	-text

On its side, `tasty-silver` reads and writes files in binary mode, too.

Why not let Haskell/git do automatic conversion on Windows? Well, for
instance, @tar@ will not do the conversion for you when unpacking a release
tarball, so when you run e.g. @stack install your-package --tests@, the
tests will be broken.

As a last resort, you can strip all @\\r@ characters from both arguments in your
comparison function when necessary. But most of the time treating the files
as binary does the job.
-}

module Test.Tasty.Silver
  ( goldenVsFile
  , goldenVsProg
  , goldenVsAction

  , printProcResult

  , findByExtension
  )
  where

import Control.Monad
#if !(MIN_VERSION_base(4,8,0))
import Data.Functor ( (<$>) )
#endif
import qualified Data.ByteString as BS
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text.Encoding

import System.Directory
import System.Exit
import System.FilePath
import System.Process.Text as PT

import Test.Tasty.Providers (TestTree, TestName)
import Test.Tasty.Silver.Advanced

-- | Compare a given file contents against the golden file contents. Assumes that both text files are utf8 encoded.
goldenVsFile
  :: TestName -- ^ test name
  -> FilePath -- ^ path to the «golden» file (the file that contains correct output)
  -> FilePath -- ^ path to the output file
  -> IO () -- ^ action that creates the output file
  -> TestTree -- ^ the test verifies that the output file contents is the same as the golden file contents
goldenVsFile :: TestName -> TestName -> TestName -> IO () -> TestTree
goldenVsFile TestName
name TestName
ref TestName
new IO ()
act =
  TestName
-> IO (Maybe Text)
-> IO Text
-> (Text -> Text -> GDiff)
-> (Text -> GShow)
-> (Text -> IO ())
-> TestTree
forall a.
TestName
-> IO (Maybe a)
-> IO a
-> (a -> a -> GDiff)
-> (a -> GShow)
-> (a -> IO ())
-> TestTree
goldenTest1
    TestName
name
    ((ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8 (Maybe ByteString -> Maybe Text)
-> IO (Maybe ByteString) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestName -> IO (Maybe ByteString)
readFileMaybe TestName
ref)
    (IO ()
act IO () -> IO Text -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString -> Text
decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestName -> IO ByteString
BS.readFile TestName
new))
    Text -> Text -> GDiff
textLikeDiff
    Text -> GShow
textLikeShow
    (Text -> IO ()
upd)
  where upd :: Text -> IO ()
upd = TestName -> ByteString -> IO ()
BS.writeFile TestName
ref (ByteString -> IO ()) -> (Text -> ByteString) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- | Compares a given file with the output (exit code, stdout, stderr) of a program. Assumes
-- that the program output is utf8 encoded.
goldenVsProg
  :: TestName   -- ^ test name
  -> FilePath   -- ^ path to the golden file
  -> FilePath   -- ^ executable to run.
  -> [String]   -- ^ arguments to pass.
  -> T.Text     -- ^ stdin
  -> TestTree
goldenVsProg :: TestName -> TestName -> TestName -> [TestName] -> Text -> TestTree
goldenVsProg TestName
name TestName
ref TestName
cmd [TestName]
args Text
inp =
  TestName
-> TestName
-> IO (ExitCode, Text, Text)
-> ((ExitCode, Text, Text) -> Text)
-> TestTree
forall a. TestName -> TestName -> IO a -> (a -> Text) -> TestTree
goldenVsAction TestName
name TestName
ref IO (ExitCode, Text, Text)
runProg (ExitCode, Text, Text) -> Text
printProcResult
  where runProg :: IO (ExitCode, Text, Text)
runProg = TestName -> [TestName] -> Text -> IO (ExitCode, Text, Text)
PT.readProcessWithExitCode TestName
cmd [TestName]
args Text
inp

-- | Compare something text-like against the golden file contents.
-- For the conversion of inputs to text you may want to use the Data.Text.Encoding
-- or/and System.Process.Text modules.
goldenVsAction
  :: TestName -- ^ test name
  -> FilePath -- ^ path to the «golden» file (the file that contains correct output)
  -> IO a -- ^ action that returns a text-like value.
  -> (a -> T.Text) -- ^ Converts a value to it's textual representation.
  -> TestTree -- ^ the test verifies that the returned textual representation
              --   is the same as the golden file contents
goldenVsAction :: forall a. TestName -> TestName -> IO a -> (a -> Text) -> TestTree
goldenVsAction TestName
name TestName
ref IO a
act a -> Text
toTxt =
  TestName
-> IO (Maybe Text)
-> IO Text
-> (Text -> Text -> GDiff)
-> (Text -> GShow)
-> (Text -> IO ())
-> TestTree
forall a.
TestName
-> IO (Maybe a)
-> IO a
-> (a -> a -> GDiff)
-> (a -> GShow)
-> (a -> IO ())
-> TestTree
goldenTest1
    TestName
name
    ((ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8 (Maybe ByteString -> Maybe Text)
-> IO (Maybe ByteString) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestName -> IO (Maybe ByteString)
readFileMaybe TestName
ref)
    (a -> Text
toTxt (a -> Text) -> IO a -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
act)
    Text -> Text -> GDiff
textLikeDiff
    Text -> GShow
textLikeShow
    (TestName -> ByteString -> IO ()
BS.writeFile TestName
ref (ByteString -> IO ()) -> (Text -> ByteString) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8)

textLikeShow :: T.Text -> GShow
textLikeShow :: Text -> GShow
textLikeShow = Text -> GShow
ShowText

textLikeDiff :: T.Text -> T.Text -> GDiff
textLikeDiff :: Text -> Text -> GDiff
textLikeDiff Text
x Text
y | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
y    = GDiff
Equal
textLikeDiff Text
x Text
y | Bool
otherwise =  Maybe TestName -> Text -> Text -> GDiff
DiffText Maybe TestName
forall a. Maybe a
Nothing Text
x Text
y


-- | Converts the output of a process produced by e.g. System.Process.Text to a textual representation.
-- Stdout/stderr are written seperately, any ordering relation between the two streams
-- is lost in the translation.
printProcResult :: (ExitCode, T.Text, T.Text) -> T.Text
-- first line is exit code, then out block, then err block
printProcResult :: (ExitCode, Text, Text) -> Text
printProcResult (ExitCode
ex, Text
a, Text
b) = [Text] -> Text
T.unlines ([Text
"ret > " Text -> Text -> Text
`T.append` TestName -> Text
T.pack (ExitCode -> TestName
forall a. Show a => a -> TestName
show ExitCode
ex)]
                            [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Text -> Text -> [Text]
addPrefix Text
"out >" Text
a [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Text -> Text -> [Text]
addPrefix Text
"err >" Text
b)
    where addPrefix :: Text -> Text -> [Text]
addPrefix Text
_    Text
t | Text -> Bool
T.null Text
t  = []
          addPrefix Text
pref Text
t | Bool
otherwise = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Text
f Text
pref) (Text -> Text -> [Text]
T.splitOn Text
"\n" Text
t)
          -- don't add trailing whitespace if line is empty. git diff will mark trailing whitespace
          -- as error, which looks distracting.
          f :: Text -> Text -> Text
f Text
pref Text
ln | Text -> Bool
T.null Text
ln = Text
pref
          f Text
pref Text
ln | Bool
otherwise = Text
pref Text -> Text -> Text
`T.append` Text
" " Text -> Text -> Text
`T.append` Text
ln



-- | Find all files in the given directory and its subdirectories that have
-- the given extensions.
-- It is typically used to find all test files and produce a golden test
-- per test file.
--
-- The returned paths use forward slashes (@'/'@) to separate path components,
-- /even on Windows/. Thus if the file name ends up in a golden file, it
-- will not differ when run on another platform.
--
-- The semantics of extensions is the same as in 'takeExtension'. In
-- particular, non-empty extensions should have the form @".ext"@.
--
-- This function may throw any exception that 'getDirectoryContents' may
-- throw.
--
-- It doesn't do anything special to handle symlinks (in particular, it
-- probably won't work on symlink loops).
-- Nor is it optimized to work with huge directory trees (you'd probably
-- want to use some form of coroutines for that).
findByExtension
  :: [FilePath] -- ^ extensions
  -> FilePath -- ^ directory
  -> IO [FilePath] -- ^ paths
findByExtension :: [TestName] -> TestName -> IO [TestName]
findByExtension [TestName]
extsList = TestName -> IO [TestName]
go
  where
  exts :: Set TestName
exts = [TestName] -> Set TestName
forall a. Ord a => [a] -> Set a
Set.fromList [TestName]
extsList
  go :: TestName -> IO [TestName]
go TestName
dir = do
    [TestName]
allEntries <- TestName -> IO [TestName]
getDirectoryContents TestName
dir
    let entries :: [TestName]
entries = (TestName -> Bool) -> [TestName] -> [TestName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TestName -> Bool) -> TestName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestName -> [TestName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TestName
".", TestName
".."])) [TestName]
allEntries
    ([[TestName]] -> [TestName]) -> IO [[TestName]] -> IO [TestName]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[TestName]] -> [TestName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[TestName]] -> IO [TestName])
-> IO [[TestName]] -> IO [TestName]
forall a b. (a -> b) -> a -> b
$ [TestName] -> (TestName -> IO [TestName]) -> IO [[TestName]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TestName]
entries ((TestName -> IO [TestName]) -> IO [[TestName]])
-> (TestName -> IO [TestName]) -> IO [[TestName]]
forall a b. (a -> b) -> a -> b
$ \TestName
e -> do
      let path :: TestName
path = TestName
dir TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
"/" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
e         -- NOT </>! Slash accepted even on Windows.
      Bool
isDir <- TestName -> IO Bool
doesDirectoryExist TestName
path
      if Bool
isDir
        then TestName -> IO [TestName]
go TestName
path
        else [TestName] -> IO [TestName]
forall (m :: * -> *) a. Monad m => a -> m a
return [ TestName
path | TestName -> TestName
takeExtension TestName
path TestName -> Set TestName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TestName
exts ]