{-|
Module      : Test.Hspec.Golden
Description : Golden tests for Hspec
Copyright   : Stack Builders (c), 2019-2020
License     : MIT
Maintainer  : cmotoche@stackbuilders.com
Stability   : experimental
Portability : portable

Golden tests store the expected output in a separated file. Each time a golden test
is executed the output of the subject under test (SUT) is compared with the
expected output. If the output of the SUT changes then the test will fail until
the expected output is updated. We expose 'defaultGolden' for output of
type @String@. If your SUT has a different output, you can use 'Golden'.
-}

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TypeFamilies      #-}

module Test.Hspec.Golden
  ( Golden(..)
  , defaultGolden
  )
  where

import           Data.IORef
import           System.Directory     (createDirectoryIfMissing, doesFileExist)
import           System.FilePath      (takeDirectory, (</>))
import           Test.Hspec.Core.Spec (Example (..), FailureReason (..),
                                       Result (..), ResultStatus (..))


-- | Golden tests parameters
--
-- @
-- import           Data.Text (Text)
-- import qualified Data.Text.IO as T
--
-- goldenText :: String -> Text -> Golden Text
-- goldenText name actualOutput =
--   Golden {
--     output = actualOutput,
--     encodePretty = prettyText,
--     writeToFile = T.writeFile,
--     readFromFile = T.readFile,
--     goldenFile = ".specific-golden-dir" </> name </> "golden",
--     actualFile = Just (".specific-golden-dir" </> name </> "actual"),
--     failFirstTime = False
--   }
--
-- describe "myTextFunc" $
--   it "generates the right output with the right params" $
--     goldenText "myTextFunc" (myTextFunc params)
-- @

data Golden str =
  Golden {
    Golden str -> str
output        :: str, -- ^ Output
    Golden str -> str -> String
encodePretty  :: str -> String, -- ^ Makes the comparison pretty when the test fails
    Golden str -> String -> str -> IO ()
writeToFile   :: FilePath -> str -> IO (), -- ^ How to write into the golden file the file
    Golden str -> String -> IO str
readFromFile  :: FilePath -> IO str, -- ^ How to read the file,
    Golden str -> String
goldenFile    :: FilePath, -- ^ Where to read/write the golden file for this test.
    Golden str -> Maybe String
actualFile    :: Maybe FilePath, -- ^ Where to save the actual file for this test. If it is @Nothing@ then no file is written.
    Golden str -> Bool
failFirstTime :: Bool -- ^ Whether to record a failure the first time this test is run
  }

instance Eq str => Example (Golden str) where
  type Arg (Golden str) = ()
  evaluateExample :: Golden str
-> Params
-> (ActionWith (Arg (Golden str)) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample Golden str
e = (() -> Golden str)
-> Params
-> (ActionWith (Arg (() -> Golden str)) -> IO ())
-> ProgressCallback
-> IO Result
forall e.
Example e =>
e
-> Params
-> (ActionWith (Arg e) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample (\() -> Golden str
e)

instance Eq str => Example (arg -> Golden str) where
  type Arg (arg -> Golden str) = arg
  evaluateExample :: (arg -> Golden str)
-> Params
-> (ActionWith (Arg (arg -> Golden str)) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample arg -> Golden str
golden Params
_ ActionWith (Arg (arg -> Golden str)) -> IO ()
action ProgressCallback
_ = do
    IORef Result
ref <- Result -> IO (IORef Result)
forall a. a -> IO (IORef a)
newIORef (String -> ResultStatus -> Result
Result String
"" ResultStatus
Success)
    ActionWith (Arg (arg -> Golden str)) -> IO ()
action (ActionWith (Arg (arg -> Golden str)) -> IO ())
-> ActionWith (Arg (arg -> Golden str)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Arg (arg -> Golden str)
arg -> do
      GoldenResult
r <- Golden str -> IO GoldenResult
forall str. Eq str => Golden str -> IO GoldenResult
runGolden (arg -> Golden str
golden arg
Arg (arg -> Golden str)
arg)
      IORef Result -> Result -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Result
ref (GoldenResult -> Result
fromGoldenResult GoldenResult
r)
    IORef Result -> IO Result
forall a. IORef a -> IO a
readIORef IORef Result
ref

-- | Transform a GoldenResult into a Result from Hspec

fromGoldenResult :: GoldenResult -> Result
fromGoldenResult :: GoldenResult -> Result
fromGoldenResult GoldenResult
SameOutput             = String -> ResultStatus -> Result
Result String
"Golden and Actual output hasn't changed" ResultStatus
Success
fromGoldenResult GoldenResult
FirstExecutionSucceed  = String -> ResultStatus -> Result
Result String
"First time execution. Golden file created." ResultStatus
Success
fromGoldenResult GoldenResult
FirstExecutionFail =
  String -> ResultStatus -> Result
Result String
"First time execution. Golden file created."
         (Maybe Location -> FailureReason -> ResultStatus
Failure Maybe Location
forall a. Maybe a
Nothing (String -> FailureReason
Reason String
"failFirstTime is set to True"))
fromGoldenResult (MissmatchOutput String
expected String
actual) =
  String -> ResultStatus -> Result
Result String
"Files golden and actual not match"
         (Maybe Location -> FailureReason -> ResultStatus
Failure Maybe Location
forall a. Maybe a
Nothing (Maybe String -> String -> String -> FailureReason
ExpectedButGot Maybe String
forall a. Maybe a
Nothing String
expected String
actual))

-- | An example of Golden tests which output is 'String'
--
-- @
--  describe "html" $ do
--    context "given a valid generated html" $
--      it "generates html" $
--        defaultGolden "html" someHtml
-- @

defaultGolden :: String -> String -> Golden String
defaultGolden :: String -> String -> Golden String
defaultGolden String
name String
output_ =
  Golden :: forall str.
str
-> (str -> String)
-> (String -> str -> IO ())
-> (String -> IO str)
-> String
-> Maybe String
-> Bool
-> Golden str
Golden {
    output :: String
output = String
output_,
    encodePretty :: String -> String
encodePretty = String -> String
forall a. Show a => a -> String
show,
    writeToFile :: String -> String -> IO ()
writeToFile = String -> String -> IO ()
writeFile,
    readFromFile :: String -> IO String
readFromFile = String -> IO String
readFile,
    goldenFile :: String
goldenFile = String
".golden" String -> String -> String
</> String
name String -> String -> String
</> String
"golden",
    actualFile :: Maybe String
actualFile = String -> Maybe String
forall a. a -> Maybe a
Just (String
".golden" String -> String -> String
</> String
name String -> String -> String
</> String
"actual"),
    failFirstTime :: Bool
failFirstTime = Bool
False
  }

-- | Possible results from a golden test execution

data GoldenResult =
   MissmatchOutput String String
   | SameOutput
   | FirstExecutionSucceed
   | FirstExecutionFail

-- | Runs a Golden test.

runGolden :: Eq str => Golden str -> IO GoldenResult
runGolden :: Golden str -> IO GoldenResult
runGolden Golden{str
Bool
String
Maybe String
str -> String
String -> IO str
String -> str -> IO ()
failFirstTime :: Bool
actualFile :: Maybe String
goldenFile :: String
readFromFile :: String -> IO str
writeToFile :: String -> str -> IO ()
encodePretty :: str -> String
output :: str
failFirstTime :: forall str. Golden str -> Bool
actualFile :: forall str. Golden str -> Maybe String
goldenFile :: forall str. Golden str -> String
readFromFile :: forall str. Golden str -> String -> IO str
writeToFile :: forall str. Golden str -> String -> str -> IO ()
encodePretty :: forall str. Golden str -> str -> String
output :: forall str. Golden str -> str
..} =
  let goldenTestDir :: String
goldenTestDir = String -> String
takeDirectory String
goldenFile
   in do
     Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
goldenTestDir
     Bool
goldenFileExist <- String -> IO Bool
doesFileExist String
goldenFile

     case Maybe String
actualFile of
       Maybe String
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just String
actual -> do
           -- It is recommended to always write the actual file, this way,
           -- hgold will always upgrade based on the latest run
           let actualDir :: String
actualDir = String -> String
takeDirectory String
actual
           Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
actualDir
           String -> str -> IO ()
writeToFile String
actual str
output

     if Bool -> Bool
not Bool
goldenFileExist
       then do
           String -> str -> IO ()
writeToFile String
goldenFile str
output
           GoldenResult -> IO GoldenResult
forall (m :: * -> *) a. Monad m => a -> m a
return (GoldenResult -> IO GoldenResult)
-> GoldenResult -> IO GoldenResult
forall a b. (a -> b) -> a -> b
$ if Bool
failFirstTime
               then GoldenResult
FirstExecutionFail
               else GoldenResult
FirstExecutionSucceed
       else do
          str
contentGolden <- String -> IO str
readFromFile String
goldenFile

          if str
contentGolden str -> str -> Bool
forall a. Eq a => a -> a -> Bool
== str
output
             then GoldenResult -> IO GoldenResult
forall (m :: * -> *) a. Monad m => a -> m a
return GoldenResult
SameOutput
             else GoldenResult -> IO GoldenResult
forall (m :: * -> *) a. Monad m => a -> m a
return (GoldenResult -> IO GoldenResult)
-> GoldenResult -> IO GoldenResult
forall a b. (a -> b) -> a -> b
$ String -> String -> GoldenResult
MissmatchOutput (str -> String
encodePretty str
contentGolden) (str -> String
encodePretty str
output)