-- |
--
-- Module      : Test.Tasty.Golden.Extra.GoldenVsString
-- Copyright   : (C) 2024 Bellroy Pty Ltd
-- License     : BSD-3-Clause
-- Maintainer  : Bellroy Tech Team <haskell@bellroy.com>
-- Stability   : experimental
--
-- These helpers are useful for creating golden tests for functions that
-- produce textual output.
module Test.Tasty.Golden.Extra.GoldenVsString
  ( GoldenVsString (..),
    goldenVsString,
  )
where

import Data.ByteString.Lazy (ByteString)
import qualified Test.Tasty.Discover as Discover
import Test.Tasty.Golden

-- | Tasty-discoverable type for creating golden tests for functions that produce
-- textual output.
--
-- Example use:
--
-- @
--  import MySchemasWithShowAndToJSONInstances.Person (convertToCSVText)
--  import qualified Data.Aeson as Aeson
--  import System.FilePath ((\</\>))
--  import Test.Tasty.Golden.Extra.GoldenVsString (GoldenVsString (..))
--
--  tasty_FromJSON_ToJSON :: GoldenVsString
--  tasty_FromJSON_ToJSON =
--    GoldenVsString (goldenFilesPath \</\> "Person.golden.csv") $
--      maybe "Error" convertToCSVText <$>
--        Aeson.decodeFileStrict' (goldenFilesPath \</\> "Person.json")
-- @
data GoldenVsString = GoldenVsString FilePath (IO ByteString)

instance Discover.Tasty GoldenVsString where
  tasty :: TastyInfo -> GoldenVsString -> IO TestTree
tasty TastyInfo
info (GoldenVsString FilePath
ref IO ByteString
act) = TestTree -> IO TestTree
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestTree -> IO TestTree) -> TestTree -> IO TestTree
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ByteString -> TestTree
goldenVsString (TastyInfo -> FilePath
Discover.nameOf TastyInfo
info) FilePath
ref IO ByteString
act