{-|
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 {
    forall str. Golden str -> str
output        :: str, -- ^ Output
    forall str. Golden str -> str -> String
encodePretty  :: str -> String, -- ^ Makes the comparison pretty when the test fails
    forall str. Golden str -> String -> str -> IO ()
writeToFile   :: FilePath -> str -> IO (), -- ^ How to write into the golden file the file
    forall str. Golden str -> String -> IO str
readFromFile  :: FilePath -> IO str, -- ^ How to read the file,
    forall str. Golden str -> String
goldenFile    :: FilePath, -- ^ Where to read/write the golden file for this test.
    forall str. 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.
    forall str. 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 = forall e.
Example e =>
e
-> Params
-> (ActionWith (Arg e) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample (\() -> Golden str
e)

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

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

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 <- forall a. a -> IO (IORef a)
newIORef (String -> ResultStatus -> Result
Result String
"" ResultStatus
Success)
    ActionWith (Arg (arg -> Golden str)) -> IO ()
action forall a b. (a -> b) -> a -> b
$ \Arg (arg -> Golden str)
arg -> do
      GoldenResult
r <- forall str. Eq str => Golden str -> IO GoldenResult
runGolden (arg -> Golden str
golden Arg (arg -> Golden str)
arg)
      forall a. IORef a -> a -> IO ()
writeIORef IORef Result
ref (GoldenResult -> Result
fromGoldenResult GoldenResult
r)
    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 didn't change" 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 forall a. Maybe a
Nothing (String -> FailureReason
Reason String
"Golden file did not exist and was created. Failed because 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 forall a. Maybe a
Nothing (Maybe String -> String -> String -> FailureReason
ExpectedButGot 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 {
    output :: String
output = String
output_,
    encodePretty :: String -> String
encodePretty = 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 = 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 :: forall str. Eq str => 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 -> 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
           forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Eq a => a -> a -> Bool
== str
output
             then forall (m :: * -> *) a. Monad m => a -> m a
return GoldenResult
SameOutput
             else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String -> GoldenResult
MissmatchOutput (str -> String
encodePretty str
contentGolden) (str -> String
encodePretty str
output)