module Test.Tasty.Golden.Internal where
import Data.Typeable (Typeable)
import Control.Applicative
import Control.Monad.Cont
import Test.Tasty.Providers
import Data.ByteString.Lazy as LB
import Control.Exception
import System.IO
import Data.Maybe
data Golden =
forall a .
Golden
(forall r . ValueGetter r a)
(forall r . ValueGetter r a)
(a -> a -> IO (Maybe String))
(a -> IO ())
deriving Typeable
newtype ValueGetter r a = ValueGetter
{ runValueGetter :: ContT r IO a }
deriving (Functor, Applicative, Monad, MonadCont, MonadIO)
vgReadFile :: FilePath -> ValueGetter r ByteString
vgReadFile path =
(liftIO . LB.hGetContents =<<) $
ValueGetter $
ContT $ \k ->
bracket
(openBinaryFile path ReadMode)
hClose
k
vgRun :: ValueGetter r r -> IO r
vgRun (ValueGetter a) = runContT a evaluate
instance IsTest Golden where
run opts golden _ = runGolden golden
testOptions = return []
runGolden :: Golden -> IO Result
runGolden (Golden getGolden getTested cmp _) = do
result <- vgRun $ do
new <- getTested
ref <- getGolden
liftIO $ cmp ref new
return $
case result of
Just reason ->
Result False reason
Nothing ->
Result True ""