{-|
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
  , golden
  )
  where

import           Control.Monad.IO.Class (MonadIO (liftIO))
import           Data.IORef
import           Data.List              (intercalate)
import           System.Directory       (createDirectoryIfMissing,
                                         doesFileExist)
import           System.FilePath        (takeDirectory, (</>))
import           Test.Hspec.Core.Spec   (Example (..), FailureReason (..),
                                         Result (..), ResultStatus (..), Spec,
                                         SpecWith, getSpecDescriptionPath, it)


-- | 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 = (() -> 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 (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 = (() -> IO (Golden str))
-> Params
-> (ActionWith (Arg (() -> IO (Golden str))) -> IO ())
-> ProgressCallback
-> IO Result
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 <- Result -> IO (IORef Result)
forall a. a -> IO (IORef a)
newIORef (String -> ResultStatus -> Result
Result String
"" ResultStatus
Success)
    ActionWith (Arg (arg -> IO (Golden str))) -> IO ()
action (ActionWith (Arg (arg -> IO (Golden str))) -> IO ())
-> ActionWith (Arg (arg -> IO (Golden str))) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Arg (arg -> IO (Golden str))
arg -> do
      GoldenResult
r <- Golden str -> IO GoldenResult
forall str. Eq str => Golden str -> IO GoldenResult
runGolden (Golden str -> IO GoldenResult)
-> IO (Golden str) -> IO GoldenResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< arg -> IO (Golden str)
golden arg
Arg (arg -> IO (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

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 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 Maybe Location
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 (MismatchOutput 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 {
    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 =
   MismatchOutput 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 ()
output :: forall str. Golden str -> str
encodePretty :: forall str. Golden str -> str -> String
writeToFile :: forall str. Golden str -> String -> str -> IO ()
readFromFile :: forall str. Golden str -> String -> IO str
goldenFile :: forall str. Golden str -> String
actualFile :: forall str. Golden str -> Maybe String
failFirstTime :: forall str. Golden str -> Bool
output :: str
encodePretty :: str -> String
writeToFile :: String -> str -> IO ()
readFromFile :: String -> IO str
goldenFile :: String
actualFile :: Maybe String
failFirstTime :: Bool
..} =
  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 a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GoldenResult
SameOutput
             else GoldenResult -> IO GoldenResult
forall a. a -> IO a
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
MismatchOutput (str -> String
encodePretty str
contentGolden) (str -> String
encodePretty str
output)


-- | A helper function to create a golden test.
--
-- @
--  describe "function" $
--    golden "some name" $
--      return content
-- @

golden
  :: String     -- ^ Test description
  -> IO String  -- ^ Content (@return content@ for pure functions)
  -> Spec
golden :: String -> IO String -> Spec
golden String
description IO String
runAction = do
  [String]
path <- ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
words String
description) ([String] -> [String]) -> SpecM () [String] -> SpecM () [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecM () [String]
forall a. SpecM a [String]
getSpecDescriptionPath
  String -> IO (Golden String) -> SpecWith (Arg (IO (Golden String)))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
description (IO (Golden String) -> SpecWith (Arg (IO (Golden String))))
-> IO (Golden String) -> SpecWith (Arg (IO (Golden String)))
forall a b. (a -> b) -> a -> b
$
    String -> String -> Golden String
defaultGolden (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"-" [String]
path) (String -> Golden String) -> IO String -> IO (Golden String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
runAction