module Test.Tasty.Silver.Internal where
import Control.Applicative
import Control.Exception
import Data.Typeable (Typeable)
import Data.ByteString as SB
import System.IO.Error
import qualified Data.Text as T
import Options.Applicative
import Data.Tagged
import Data.Proxy
import Data.Maybe
import Test.Tasty.Providers
import Test.Tasty.Options
data Golden =
forall a .
Golden
(IO (Maybe a))
(IO a)
(a -> a -> IO GDiff)
(a -> IO GShow)
(a -> IO ())
deriving Typeable
newtype AcceptTests = AcceptTests Bool
deriving (Eq, Ord, Typeable)
instance IsOption AcceptTests where
defaultValue = AcceptTests False
parseValue = fmap AcceptTests . safeRead
optionName = return "accept"
optionHelp = return "Accept current results of golden tests"
optionCLParser =
fmap AcceptTests $
switch
( long (untag (optionName :: Tagged AcceptTests String))
<> help (untag (optionHelp :: Tagged AcceptTests String))
)
readFileMaybe :: FilePath -> IO (Maybe SB.ByteString)
readFileMaybe path = catchJust
(\e -> if isDoesNotExistErrorType (ioeGetErrorType e) then Just () else Nothing)
(Just <$> SB.readFile path)
(const $ return Nothing)
data GDiff
= Equal
| DiffText { gReason :: (Maybe String), gActual :: T.Text, gExpected :: T.Text }
| ShowDiffed { gReason :: (Maybe String), gDiff :: T.Text }
data GShow
= ShowText T.Text
instance IsTest Golden where
run opts golden _ = runGolden golden (lookupOption opts)
testOptions = return [Option (Proxy :: Proxy AcceptTests)]
runGolden :: Golden -> AcceptTests -> IO Result
runGolden (Golden getGolden getActual cmp _ upd) (AcceptTests accept) = do
ref' <- getGolden
case ref' of
Nothing | accept -> do
new <- getActual
upd new
return $ testPassed "Created golden file."
Nothing -> return $ testFailed "Missing golden value."
Just ref -> do
new <- getActual
cmp' <- cmp ref new
case cmp' of
Equal -> return $ testPassed ""
_ | accept -> do
upd new
return $ testPassed "Updated golden file."
d | isJust (gReason d) -> return $ testFailed $ fromJust $ gReason d
_ -> return $ testFailed "Result did not match expected output. Use interactive mode to see full output."