-- | "Golden tests" using 'ediff' comparison.
module Data.TreeDiff.Golden (
    ediffGolden,
) where

import Data.TreeDiff
import Prelude ()
import Prelude.Compat
import System.Console.ANSI (SGR (Reset), setSGRCode)
import Text.Parsec         (eof, parse)
import Text.Parsec.Text ()

import qualified Data.ByteString              as BS
import qualified Data.Text                    as T
import qualified Data.Text.Encoding           as TE
import qualified Text.PrettyPrint.ANSI.Leijen as WL

-- | Make a golden tests.
--
-- 'ediffGolden' is testing framework agnostic, thus the type
-- looks intimidating.
--
-- An example using @tasty-golden@,
-- 'goldenTest' is imported from "Test.Tasty.Golden.Advanced"
--
-- @
-- exTest :: TestTree
-- exTest = 'ediffGolden' goldenTest "golden test" "fixtures/ex.expr" $
--    action constructing actual value
-- @
--
-- The 'ediffGolden' will read an 'Expr' from provided path to golden file,
-- and compare it with a 'toExpr' of a result. If values differ,
-- the (compact) diff of two will be printed.
--
-- See <https://github.com/phadej/tree-diff/blob/master/tests/Tests.hs>
-- for a proper example.
--
ediffGolden
    :: (Eq a, ToExpr a)
    => (testName -> IO Expr -> IO Expr -> (Expr -> Expr -> IO (Maybe String)) -> (Expr -> IO ()) -> testTree) -- ^ 'goldenTest'
    -> testName  -- ^ test name
    -> FilePath  -- ^ path to "golden file"
    -> IO a      -- ^ result value
    -> testTree
ediffGolden :: forall a testName testTree.
(Eq a, ToExpr a) =>
(testName
 -> IO Expr
 -> IO Expr
 -> (Expr -> Expr -> IO (Maybe String))
 -> (Expr -> IO ())
 -> testTree)
-> testName -> String -> IO a -> testTree
ediffGolden testName
-> IO Expr
-> IO Expr
-> (Expr -> Expr -> IO (Maybe String))
-> (Expr -> IO ())
-> testTree
impl testName
testName String
fp IO a
x = testName
-> IO Expr
-> IO Expr
-> (Expr -> Expr -> IO (Maybe String))
-> (Expr -> IO ())
-> testTree
impl testName
testName IO Expr
expect IO Expr
actual forall {a} {m :: * -> *}.
(Eq a, Monad m, ToExpr a) =>
a -> a -> m (Maybe String)
cmp Expr -> IO ()
wrt
  where
    actual :: IO Expr
actual = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToExpr a => a -> Expr
toExpr IO a
x
    expect :: IO Expr
expect = do
        ByteString
contents <- String -> IO ByteString
BS.readFile String
fp
        case forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (forall (m :: * -> *). (Monad m, TokenParsing m) => m Expr
exprParser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) String
fp forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 ByteString
contents of
            Left ParseError
err -> forall a. Show a => a -> IO ()
print ParseError
err forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parse error"
            Right Expr
r  -> forall (m :: * -> *) a. Monad m => a -> m a
return Expr
r
    cmp :: a -> a -> m (Maybe String)
cmp a
a a
b
        | a
a forall a. Eq a => a -> a -> Bool
== a
b    = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            [SGR] -> String
setSGRCode [SGR
Reset] forall a. [a] -> [a] -> [a]
++ Doc -> String
showWL (Edit EditExpr -> Doc
ansiWlEditExprCompact forall a b. (a -> b) -> a -> b
$ forall a. ToExpr a => a -> a -> Edit EditExpr
ediff a
a a
b)
    wrt :: Expr -> IO ()
wrt Expr
expr = String -> ByteString -> IO ()
BS.writeFile String
fp forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Doc -> String
showWL (Doc -> Doc
WL.plain (Expr -> Doc
ansiWlExpr Expr
expr)) forall a. [a] -> [a] -> [a]
++ String
"\n"

showWL :: WL.Doc -> String
showWL :: Doc -> String
showWL Doc
doc = SimpleDoc -> ShowS
WL.displayS (Float -> Int -> Doc -> SimpleDoc
WL.renderSmart Float
0.4 Int
80 Doc
doc) String
""