{-# LANGUAGE ExistentialQuantification #-}

-- |
--
-- Module      : Test.Tasty.Golden.Extra.GoldenVsShow
-- 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 @Show@ instances.
module Test.Tasty.Golden.Extra.GoldenVsShow
  ( goldenVsShow,
    GoldenVsShow (..),
  )
where

import qualified Data.Text.Lazy as Text
import Data.Text.Lazy.Encoding (encodeUtf8)
import Test.Tasty (TestName, TestTree)
import qualified Test.Tasty.Discover as Discover
import Test.Tasty.Golden
import Text.Show.Pretty (ppShow)

-- | Tasty-discoverable type for creating golden tests for @Show@ instances.
--
-- Example use:
--
-- @
--  import MySchemasWithShowAndToJSONInstances.Person (Person)
--  import qualified Data.Aeson as Aeson
--  import System.FilePath ((\</\>))
--  import Test.Tasty.Golden.Extra.GoldenVsShow (GoldenVsShow (..))
--
--  tasty_GoldenVsShow :: GoldenVsShow
--  tasty_GoldenVsShow =
--    GoldenVsShow (goldenFilesPath \</\> "Person.golden.txt") $
--      Aeson.eitherDecodeFileStrict @Person (goldenFilesPath \</\> "Person.json")
-- @
data GoldenVsShow = forall a. (Show a) => GoldenVsShow FilePath (IO a)

instance Discover.Tasty GoldenVsShow where
  tasty :: TastyInfo -> GoldenVsShow -> IO TestTree
tasty TastyInfo
info (GoldenVsShow FilePath
ref IO a
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 a -> TestTree
forall a. Show a => FilePath -> FilePath -> IO a -> TestTree
goldenVsShow (TastyInfo -> FilePath
Discover.nameOf TastyInfo
info) FilePath
ref IO a
act

-- | Helper function for creating a @TestTree@ for @Show@ golden tests.
-- Use when you want to test @Show@ instances against a golden example on disk.
--
-- Example use:
--
-- @
--  import MySchemasWithShowAndShowInstances.Person (Person)
--  import qualified Data.Aeson as Aeson
--  import System.FilePath ((\</\>))
--  import Test.Tasty.Golden.Extra.GoldenVsShow (goldenVsShow)
--
--  test_Show :: TestTree
--  test_Show = do
--    let inputFile = goldenFilesPath \</\> "Person.json"
--    goldenVsShow
--      "Test Show instance for Person"
--      (goldenFilesPath \</\> "Person.golden.txt")
--      (Aeson.decodeFileStrict' @Person inputFile)
-- @
goldenVsShow ::
  (Show a) =>
  -- | test name
  TestName ->
  -- | path to the «golden» file (the file that contains correct output)
  FilePath ->
  -- | action that returns an instance of the type whose instance is being tested
  IO a ->
  -- | the test verifies that the returned string is the same as the golden file contents
  TestTree
goldenVsShow :: forall a. Show a => FilePath -> FilePath -> IO a -> TestTree
goldenVsShow FilePath
name FilePath
ref =
  FilePath -> FilePath -> IO ByteString -> TestTree
goldenVsString FilePath
name FilePath
ref (IO ByteString -> TestTree)
-> (IO a -> IO ByteString) -> IO a -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ByteString) -> IO a -> IO ByteString
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (a -> Text) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack (FilePath -> Text) -> (a -> FilePath) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FilePath
forall a. Show a => a -> FilePath
ppShow)