    {-# OPTIONS_HADDOCK not-home #-}
    module Hedgehog.Internal.Tripping (
        tripping
      ) where

    import           Hedgehog.Internal.Property (MonadTest, Diff(..), success, failWith)
    import           Hedgehog.Internal.Show (valueDiff, mkValue, showPretty)
    import           Hedgehog.Internal.Source (HasCallStack, withFrozenCallStack)

    -- | Test that a pair of encode / decode functions are compatible.
    --
    -- Given a printer from some type @a -> b@, and a parser with a
    -- potential failure case @b -> f a@. Ensure that a valid @a@ round
    -- trips through the "print" and "parse" to yield the same @a@.
    --
    -- For example, types /should/ have tripping 'Read' and 'Show'
    -- instances:
    --
    -- @
    -- trippingShowRead :: (Show a, Read a, Eq a, MonadTest m) => a -> m ()
    -- trippingShowRead a = tripping a show readEither
    -- @
    tripping ::
         (MonadTest m, Applicative f, Show b, Show (f a), Eq (f a), HasCallStack)
      => a
      -> (a -> b)
      -> (b -> f a)
      -> m ()
    tripping :: forall (m :: * -> *) (f :: * -> *) b a.
    (MonadTest m, Applicative f, Show b, Show (f a), Eq (f a),
     HasCallStack) =>
    a -> (a -> b) -> (b -> f a) -> m ()
    tripping a
    x a -> b
    encode b -> f a
    decode =
      let
        mx :: f a
    mx =
          a -> f a
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    x

        i :: b
    i =
          a -> b
    encode a
    x

        my :: f a
    my =
          b -> f a
    decode b
    i
      in
        if f a
    mx f a -> f a -> Bool
    forall a. Eq a => a -> a -> Bool
    == f a
    my then
          m ()
    forall (m :: * -> *). MonadTest m => m ()
    success
        else
          case Value -> Value -> ValueDiff
    valueDiff (Value -> Value -> ValueDiff)
    -> Maybe Value -> Maybe (Value -> ValueDiff)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f a -> Maybe Value
    forall a. Show a => a -> Maybe Value
    mkValue f a
    mx Maybe (Value -> ValueDiff) -> Maybe Value -> Maybe ValueDiff
    forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> f a -> Maybe Value
    forall a. Show a => a -> Maybe Value
    mkValue f a
    my of
            Maybe ValueDiff
    Nothing ->
              (HasCallStack => m ()) -> m ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $
                Maybe Diff -> String -> m ()
    forall (m :: * -> *) a.
    (MonadTest m, HasCallStack) =>
    Maybe Diff -> String -> m a
    failWith Maybe Diff
    forall a. Maybe a
    Nothing (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines [
                    String
    "━━━ Original ━━━"
                  , f a -> String
    forall a. Show a => a -> String
    showPretty f a
    mx
                  , String
    "━━━ Intermediate ━━━"
                  , b -> String
    forall a. Show a => a -> String
    showPretty b
    i
                  , String
    "━━━ Roundtrip ━━━"
                  , f a -> String
    forall a. Show a => a -> String
    showPretty f a
    my
                  ]

            Just ValueDiff
    diff ->
              (HasCallStack => m ()) -> m ()
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack ((HasCallStack => m ()) -> m ()) -> (HasCallStack => m ()) -> m ()
    forall a b. (a -> b) -> a -> b
    $
                Maybe Diff -> String -> m ()
    forall (m :: * -> *) a.
    (MonadTest m, HasCallStack) =>
    Maybe Diff -> String -> m a
    failWith
                  (Diff -> Maybe Diff
    forall a. a -> Maybe a
    Just (Diff -> Maybe Diff) -> Diff -> Maybe Diff
    forall a b. (a -> b) -> a -> b
    $
                    String -> String -> String -> String -> String -> ValueDiff -> Diff
    Diff String
    "━━━ " String
    "- Original" String
    ") (" String
    "+ Roundtrip" String
    " ━━━" ValueDiff
    diff) (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $
                  [String] -> String
    unlines [
                      String
    "━━━ Intermediate ━━━"
                    , b -> String
    forall a. Show a => a -> String
    showPretty b
    i
                    ]