module Test.Golden
( goldenVsFile
, goldenVsString
, goldenVsFileDiff
, goldenVsStringDiff
)
where
import Test.Framework.Providers.API hiding (liftIO)
import Test.Golden.Advanced
import Text.Printf
import qualified Data.ByteString.Lazy as LB
import System.IO
import System.IO.Temp
import System.Process
import System.Exit
import System.FilePath
import Control.Exception
import Control.Monad
import Control.Monad.Error (liftIO)
goldenVsFile
:: TestName
-> FilePath
-> FilePath
-> IO ()
-> Test
goldenVsFile name ref new act =
goldenTest
name
(vgReadFile ref)
(liftIO act >> vgReadFile new)
cmp
upd
where
cmp = simpleCmp $ printf "Files '%s' and '%s' differ" ref new
upd = LB.writeFile ref
goldenVsString
:: TestName
-> FilePath
-> IO LB.ByteString
-> Test
goldenVsString name ref act =
goldenTest
name
(vgReadFile ref)
(liftIO act)
cmp
upd
where
cmp x y = simpleCmp msg x y
where
msg = printf "Test output was different from '%s'. It was: %s" ref (show y)
upd = LB.writeFile ref
simpleCmp :: Eq a => String -> a -> a -> IO (Maybe String)
simpleCmp e x y =
return $ if x == y then Nothing else Just e
goldenVsFileDiff
:: TestName
-> (FilePath -> FilePath -> [String])
-> FilePath
-> FilePath
-> IO ()
-> Test
goldenVsFileDiff name cmdf ref new act =
goldenTest
name
(return ())
(liftIO act)
cmp
upd
where
cmd = cmdf ref new
cmp _ _ | null cmd = error "goldenVsFileDiff: empty command line"
cmp _ _ = do
(_, Just sout, _, pid) <- createProcess (proc (head cmd) (tail cmd)) { std_out = CreatePipe }
out <- hGetContents sout
evaluate $ length out
r <- waitForProcess pid
return $ case r of
ExitSuccess -> Nothing
_ -> Just out
upd _ = LB.readFile new >>= LB.writeFile ref
goldenVsStringDiff
:: TestName
-> (FilePath -> FilePath -> [String])
-> FilePath
-> IO LB.ByteString
-> Test
goldenVsStringDiff name cmdf ref act =
goldenTest
name
(vgReadFile ref)
(liftIO act)
cmp
upd
where
template = takeFileName ref <.> "actual"
cmp _ actBS = withSystemTempFile template $ \tmpFile tmpHandle -> do
LB.hPut tmpHandle actBS >> hFlush tmpHandle
let cmd = cmdf ref tmpFile
when (null cmd) $ error "goldenVsFileDiff: empty command line"
(_, Just sout, _, pid) <- createProcess (proc (head cmd) (tail cmd)) { std_out = CreatePipe }
out <- hGetContents sout
_ <- evaluate $ length out
r <- waitForProcess pid
return $ case r of
ExitSuccess -> Nothing
_ -> Just (printf "Test output was different from '%s'. Output of %s:\n%s" ref (show cmd) out)
upd = LB.writeFile ref