content: {-# LANGUAGE TypeFamilies #-}
  
  -- This module is based on Test.Hspec.Golden from hspec-golden-0.2.0.0, which is MIT licensed.
  
  -- | Functions for [golden testing](https://ro-che.info/articles/2017-12-04-golden-tests).
  
  module Test.Sandwich.Golden (
    -- * Main test function
    golden
  
    -- * Built-in Goldens
    , goldenText
    , goldenString
    , goldenJSON
    , goldenShowable
    , mkGolden
  
    -- * Parameters for a 'Golden'
    , goldenOutput
    , goldenWriteToFile
    , goldenReadFromFile
    , goldenFile
    , goldenActualFile
    , goldenFailFirstTime
    ) where
  
  import Control.Monad
  import Control.Monad.Free
  import Control.Monad.IO.Class
  import Data.Aeson as A
  import qualified Data.ByteString.Lazy as BL
  import Data.String.Interpolate
  import qualified Data.Text as T
  import qualified Data.Text.IO as T
  import GHC.Stack
  import System.Directory
  import System.FilePath
  import Test.Sandwich
  import Test.Sandwich.Golden.Update
  import Test.Sandwich.Types.Spec
  import UnliftIO.Exception
  
  
  data Golden a = Golden {
    -- | Name
    goldenName :: String
    -- | Expected output.
    , goldenOutput :: a
    -- | How to write into the golden file the file.
    , goldenWriteToFile :: FilePath -> a -> IO ()
    -- | How to read the file.
    , goldenReadFromFile :: FilePath -> IO a
    -- | Where to read/write the golden file for this test.
    , goldenFile :: FilePath
    -- | Where to save the actual file for this test. If it is @Nothing@ then no file is written.
    , goldenActualFile :: Maybe FilePath
    -- | Whether to record a failure the first time this test is run.
    , goldenFailFirstTime :: Bool
    }
  
  
  -- | Make your own 'Golden' constructor by providing 'goldenWriteToFile' and 'goldenReadFromFile'.
  mkGolden :: (FilePath -> a -> IO ()) -> (FilePath -> IO a) -> String -> a -> Golden a
  mkGolden goldenWriteToFile goldenReadFromFile name output = Golden {
    goldenName = name
    , goldenOutput = output
    , goldenWriteToFile = goldenWriteToFile
    , goldenReadFromFile = goldenReadFromFile
    , goldenFile = defaultDirGoldenTest </> name </> "golden"
    , goldenActualFile = Just (defaultDirGoldenTest </> name </> "actual")
    , goldenFailFirstTime = False
    }
  
  -- | Golden for a 'T.Text'.
  goldenText :: String -> T.Text -> Golden T.Text
  goldenText = mkGolden T.writeFile T.readFile
  
  -- | Golden for a 'String'.
  goldenString :: String -> String -> Golden String
  goldenString = mkGolden writeFile readFile
  
  -- | Golden for an Aeson value ('ToJSON'/'FromJSON').
  goldenJSON :: (A.ToJSON a, A.FromJSON a) => String -> a -> Golden a
  goldenJSON = mkGolden (\f x -> BL.writeFile f $ A.encode x) $ \f ->
    eitherDecodeFileStrict' f >>= \case
      Left err -> expectationFailure [i|Failed to decode JSON value in #{f}: #{err}|]
      Right x -> return x
  
  -- | Golden for a general 'Show'/'Read' type.
  goldenShowable :: (Show a, Read a) => String -> a -> Golden a
  goldenShowable = mkGolden (\f x -> writeFile f (show x)) ((read <$>) . readFile)
  
  -- | Runs a Golden test.
  
  golden :: (MonadIO m, Eq str, Show str) => Golden str -> Free (SpecCommand context m) ()
  golden (Golden {..}) = it goldenName $ do
    let goldenTestDir = takeDirectory goldenFile
    liftIO $ createDirectoryIfMissing True goldenTestDir
    goldenFileExist <- liftIO $ doesFileExist goldenFile
  
    case goldenActualFile of
      Nothing -> return ()
      Just actual -> do
        -- It is recommended to always write the actual file
        let actualDir = takeDirectory actual
        liftIO $ createDirectoryIfMissing True actualDir
        liftIO $ goldenWriteToFile actual goldenOutput
  
    if not goldenFileExist
      then do
          liftIO $ goldenWriteToFile goldenFile goldenOutput
          when goldenFailFirstTime $ expectationFailure [i|Failed due to first execution and goldenFailFirstTime=True.|]
      else do
         liftIO (goldenReadFromFile goldenFile) >>= \case
           x | x == goldenOutput -> return ()
           x -> throwIO $ ExpectedButGot (Just callStack) (SEB x) (SEB goldenOutput)
  