{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}

module Skeletest.Internal.Snapshot.Renderer (
  SnapshotRenderer (..),
  getSnapshotRenderers,
  setSnapshotRenderers,

  -- * Renderer implementations
  plainRenderer,
  renderWithShow,
  defaultSnapshotRenderers,
) where

import Control.Monad.IO.Class (MonadIO)
import Data.Aeson qualified as Aeson
import Data.Aeson.Encode.Pretty qualified as Aeson
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Lazy qualified as TextL
import Data.Text.Lazy.Encoding qualified as TextL
import Data.Typeable (Typeable)
import Skeletest.Internal.Utils.Text (showT)
import System.IO.Unsafe (unsafePerformIO)
import UnliftIO.IORef (IORef, newIORef, readIORef, writeIORef)

data SnapshotRenderer
  = forall a.
  (Typeable a) =>
  SnapshotRenderer
  { ()
render :: a -> Text
  , SnapshotRenderer -> Maybe Text
snapshotLang :: Maybe Text
  }

plainRenderer :: (Typeable a) => (a -> Text) -> SnapshotRenderer
plainRenderer :: forall a. Typeable a => (a -> Text) -> SnapshotRenderer
plainRenderer a -> Text
render =
  SnapshotRenderer
    { a -> Text
render :: a -> Text
render :: a -> Text
render
    , snapshotLang :: Maybe Text
snapshotLang = Maybe Text
forall a. Maybe a
Nothing
    }

renderWithShow :: forall a. (Typeable a, Show a) => SnapshotRenderer
renderWithShow :: forall a. (Typeable a, Show a) => SnapshotRenderer
renderWithShow = (a -> Text) -> SnapshotRenderer
forall a. Typeable a => (a -> Text) -> SnapshotRenderer
plainRenderer (forall a. Show a => a -> Text
showT @a)

defaultSnapshotRenderers :: [SnapshotRenderer]
defaultSnapshotRenderers :: [SnapshotRenderer]
defaultSnapshotRenderers =
  [ forall a. Typeable a => (a -> Text) -> SnapshotRenderer
plainRenderer @String String -> Text
Text.pack
  , forall a. Typeable a => (a -> Text) -> SnapshotRenderer
plainRenderer @Text Text -> Text
forall a. a -> a
id
  , SnapshotRenderer
jsonRenderer
  ]
 where
  jsonRenderer :: SnapshotRenderer
jsonRenderer =
    SnapshotRenderer
      { render :: Value -> Text
render = LazyText -> Text
TextL.toStrict (LazyText -> Text) -> (Value -> LazyText) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LazyText
TextL.decodeUtf8 (ByteString -> LazyText)
-> (Value -> ByteString) -> Value -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
Aeson.encodePretty @Aeson.Value
      , snapshotLang :: Maybe Text
snapshotLang = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"json"
      }

snapshotRenderersRef :: IORef [SnapshotRenderer]
snapshotRenderersRef :: IORef [SnapshotRenderer]
snapshotRenderersRef = IO (IORef [SnapshotRenderer]) -> IORef [SnapshotRenderer]
forall a. IO a -> a
unsafePerformIO (IO (IORef [SnapshotRenderer]) -> IORef [SnapshotRenderer])
-> IO (IORef [SnapshotRenderer]) -> IORef [SnapshotRenderer]
forall a b. (a -> b) -> a -> b
$ [SnapshotRenderer] -> IO (IORef [SnapshotRenderer])
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef []
{-# NOINLINE snapshotRenderersRef #-}

setSnapshotRenderers :: [SnapshotRenderer] -> IO ()
setSnapshotRenderers :: [SnapshotRenderer] -> IO ()
setSnapshotRenderers = IORef [SnapshotRenderer] -> [SnapshotRenderer] -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef [SnapshotRenderer]
snapshotRenderersRef

getSnapshotRenderers :: (MonadIO m) => m [SnapshotRenderer]
getSnapshotRenderers :: forall (m :: * -> *). MonadIO m => m [SnapshotRenderer]
getSnapshotRenderers = IORef [SnapshotRenderer] -> m [SnapshotRenderer]
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef [SnapshotRenderer]
snapshotRenderersRef