{-# LANGUAGE ScopedTypeVariables #-}
-- | "Golden tests" using 'ediff' comparison.
module Data.TreeDiff.Golden (
    ediffGolden,
    ediffGolden1,
) where

import Data.TreeDiff
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
    :: 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.
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)
-> testName -> String -> (() -> IO a) -> testTree
forall a arg testName testTree.
ToExpr a =>
(testName
 -> IO Expr
 -> (arg -> IO Expr)
 -> (Expr -> Expr -> IO (Maybe String))
 -> (Expr -> IO ())
 -> testTree)
-> testName -> String -> (arg -> IO a) -> testTree
ediffGolden1 testName
-> IO Expr
-> (() -> IO Expr)
-> (Expr -> Expr -> IO (Maybe String))
-> (Expr -> IO ())
-> testTree
impl' testName
testName String
fp (\() -> IO a
x) where
    impl' :: testName
-> IO Expr
-> (() -> IO Expr)
-> (Expr -> Expr -> IO (Maybe String))
-> (Expr -> IO ())
-> testTree
impl' testName
n IO Expr
expect () -> IO Expr
actual = testName
-> IO Expr
-> IO Expr
-> (Expr -> Expr -> IO (Maybe String))
-> (Expr -> IO ())
-> testTree
impl testName
n IO Expr
expect (() -> IO Expr
actual ())

-- | Like 'ediffGolden1' but with an additional argument for generation of actual value.
--
-- @since 0.3.2
--
ediffGolden1
    :: forall a arg testName testTree. ToExpr a
    => (testName -> IO Expr -> (arg -> IO Expr) -> (Expr -> Expr -> IO (Maybe String)) -> (Expr -> IO ()) -> testTree) -- ^ 'goldenTest'
    -> testName  -- ^ test name
    -> FilePath  -- ^ path to "golden file"
    -> (arg -> IO a)      -- ^ result value
    -> testTree
ediffGolden1 :: forall a arg testName testTree.
ToExpr a =>
(testName
 -> IO Expr
 -> (arg -> IO Expr)
 -> (Expr -> Expr -> IO (Maybe String))
 -> (Expr -> IO ())
 -> testTree)
-> testName -> String -> (arg -> IO a) -> testTree
ediffGolden1 testName
-> IO Expr
-> (arg -> IO Expr)
-> (Expr -> Expr -> IO (Maybe String))
-> (Expr -> IO ())
-> testTree
impl testName
testName String
fp arg -> IO a
x = testName
-> IO Expr
-> (arg -> IO Expr)
-> (Expr -> Expr -> IO (Maybe String))
-> (Expr -> IO ())
-> testTree
impl testName
testName IO Expr
expect arg -> IO Expr
actual Expr -> Expr -> IO (Maybe String)
cmp Expr -> IO ()
wrt
  where
    actual :: arg -> IO Expr
    actual :: arg -> IO Expr
actual arg
arg = (a -> Expr) -> IO a -> IO Expr
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Expr
forall a. ToExpr a => a -> Expr
toExpr (arg -> IO a
x arg
arg)

    expect :: IO Expr
    expect :: IO Expr
expect = do
        ByteString
contents <- String -> IO ByteString
BS.readFile String
fp
        case Parsec Text () Expr -> String -> Text -> Either ParseError Expr
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Parsec Text () Expr
forall (m :: * -> *). (Monad m, TokenParsing m) => m Expr
exprParser Parsec Text () Expr
-> ParsecT Text () Identity () -> Parsec Text () Expr
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) String
fp (Text -> Either ParseError Expr) -> Text -> Either ParseError Expr
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 ByteString
contents of
            Left ParseError
err -> Expr -> IO Expr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> IO Expr) -> Expr -> IO Expr
forall a b. (a -> b) -> a -> b
$ String -> [Expr] -> Expr
App String
"ParseError" [String -> Expr
forall a. ToExpr a => a -> Expr
toExpr String
fp, String -> Expr
forall a. ToExpr a => a -> Expr
toExpr (ParseError -> String
forall a. Show a => a -> String
show ParseError
err)]
            Right Expr
r  -> Expr -> IO Expr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
r

    cmp :: Expr -> Expr -> IO (Maybe [Char])
    cmp :: Expr -> Expr -> IO (Maybe String)
cmp Expr
a Expr
b
        | Expr
a Expr -> Expr -> Bool
forall a. Eq a => a -> a -> Bool
== Expr
b    = Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
        | Bool
otherwise = Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$
            [SGR] -> String
setSGRCode [SGR
Reset] String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
showWL (Edit EditExpr -> Doc
ansiWlEditExprCompact (Edit EditExpr -> Doc) -> Edit EditExpr -> Doc
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Edit EditExpr
forall a. ToExpr a => a -> a -> Edit EditExpr
ediff Expr
a Expr
b)
    wrt :: Expr -> IO ()
wrt Expr
expr = String -> ByteString -> IO ()
BS.writeFile String
fp (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Doc -> String
showWL (Doc -> Doc
WL.plain (Expr -> Doc
ansiWlExpr Expr
expr)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

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