module Michelson.Test.Util
( leftToShowPanic
, leftToPrettyPanic
, failedProp
, succeededProp
, qcIsLeft
, qcIsRight
, roundtripTest
) where
import Data.Typeable (typeRep)
import Fmt (Buildable, pretty)
import Test.QuickCheck (Arbitrary)
import Test.QuickCheck.Property (Property, Result(..), failed, property, (===))
import Test.Tasty (TestTree)
import Test.Tasty.QuickCheck (testProperty)
leftToShowPanic :: (Show e, HasCallStack) => Either e a -> a
leftToShowPanic = either (error . show) id
leftToPrettyPanic :: (Buildable e, HasCallStack) => Either e a -> a
leftToPrettyPanic = either (error . pretty) id
failedProp :: Text -> Property
failedProp r = property $ failed { reason = toString r }
succeededProp :: Property
succeededProp = property True
qcIsLeft :: Show b => Either a b -> Property
qcIsLeft = \case
Left _ -> property True
Right x -> failedProp $ "expected Left, got Right (" <> show x <> ")"
qcIsRight :: Show a => Either a b -> Property
qcIsRight = \case
Right _ -> property True
Left x -> failedProp $ "expected Right, got Left (" <> show x <> ")"
roundtripTest ::
forall x y err.
( Show x
, Show err
, Typeable x
, Arbitrary x
, Eq x
, Eq err
)
=> (x -> y)
-> (y -> Either err x)
-> TestTree
roundtripTest xToY yToX = testProperty typeName check
where
typeName = show $ typeRep (Proxy @x)
check :: x -> Property
check x = yToX (xToY x) === Right x