{-| This module is based on hgold from hspec-golden-0.2.0.0, which is MIT licensed -}

module Test.Sandwich.Golden.Update (
  updateGolden
  , defaultDirGoldenTest
  ) where

import Control.Exception.Safe
import Control.Monad
import Data.Maybe
import Data.String.Interpolate
import System.Console.ANSI
import System.Directory
import System.Environment


defaultDirGoldenTest :: FilePath
defaultDirGoldenTest :: FilePath
defaultDirGoldenTest = FilePath
".golden"

updateGolden :: Maybe FilePath -> IO ()
updateGolden :: Maybe FilePath -> IO ()
updateGolden (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
defaultDirGoldenTest -> FilePath
dir) = do
  EnableColor
enableColor <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"NO_COLOR" IO (Maybe FilePath)
-> (Maybe FilePath -> IO EnableColor) -> IO EnableColor
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe FilePath
Nothing -> EnableColor -> IO EnableColor
forall (m :: * -> *) a. Monad m => a -> m a
return EnableColor
EnableColor
    Just FilePath
_ -> EnableColor -> IO EnableColor
forall (m :: * -> *) a. Monad m => a -> m a
return EnableColor
DisableColor

  EnableColor -> SGR -> FilePath -> IO ()
putStrLnColor EnableColor
enableColor SGR
green FilePath
"Replacing golden with actual..."
  EnableColor -> FilePath -> IO ()
go EnableColor
enableColor FilePath
dir
  EnableColor -> SGR -> FilePath -> IO ()
putStrLnColor EnableColor
enableColor SGR
green FilePath
"Done!"

  where
    go :: EnableColor -> FilePath -> IO ()
go EnableColor
enableColor FilePath
dir = FilePath -> IO [FilePath]
listDirectory FilePath
dir IO [FilePath] -> ([FilePath] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (EnableColor -> FilePath -> IO ()
processEntry EnableColor
enableColor)

    processEntry :: EnableColor -> FilePath -> IO ()
processEntry EnableColor
enableColor (((FilePath
dir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) -> FilePath
entryInDir) = do
      Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
entryInDir
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isDir (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        EnableColor -> FilePath -> IO ()
mvActualToGolden EnableColor
enableColor FilePath
entryInDir
        EnableColor -> FilePath -> IO ()
go EnableColor
enableColor FilePath
entryInDir

mvActualToGolden :: EnableColor -> FilePath -> IO ()
mvActualToGolden :: EnableColor -> FilePath -> IO ()
mvActualToGolden EnableColor
enableColor FilePath
testPath = do
  let actualFilePath :: FilePath
actualFilePath = FilePath
testPath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/actual"
  let goldenFilePath :: FilePath
goldenFilePath = FilePath
testPath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/golden"

  Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
actualFilePath
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> IO ()
putStr [i|  #{goldenFilePath}|]
    EnableColor -> SGR -> FilePath -> IO ()
putStrColor EnableColor
enableColor SGR
magenta FilePath
" <-- "
    EnableColor -> SGR -> FilePath -> IO ()
putStrLnColor EnableColor
enableColor SGR
red [i|#{actualFilePath}|]

    FilePath -> FilePath -> IO ()
renameFile FilePath
actualFilePath FilePath
goldenFilePath

green, red, magenta :: SGR
green :: SGR
green = ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Green
red :: SGR
red = ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Red
magenta :: SGR
magenta = ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Magenta

putStrColor :: EnableColor -> SGR -> FilePath -> IO ()
putStrColor EnableColor
EnableColor SGR
color FilePath
s = IO () -> IO () -> IO () -> IO ()
forall (m :: * -> *) a b c. MonadMask m => m a -> m b -> m c -> m c
bracket_ ([SGR] -> IO ()
setSGR [SGR
color]) ([SGR] -> IO ()
setSGR [SGR
Reset]) (FilePath -> IO ()
putStr FilePath
s)
putStrColor EnableColor
DisableColor SGR
_ FilePath
s = FilePath -> IO ()
putStr FilePath
s

putStrLnColor :: EnableColor -> SGR -> FilePath -> IO ()
putStrLnColor EnableColor
EnableColor SGR
color FilePath
s = IO () -> IO () -> IO () -> IO ()
forall (m :: * -> *) a b c. MonadMask m => m a -> m b -> m c -> m c
bracket_ ([SGR] -> IO ()
setSGR [SGR
color]) ([SGR] -> IO ()
setSGR [SGR
Reset]) (FilePath -> IO ()
putStrLn FilePath
s)
putStrLnColor EnableColor
DisableColor SGR
_ FilePath
s = FilePath -> IO ()
putStrLn FilePath
s

data EnableColor = EnableColor | DisableColor