    {-# LANGUAGE RankNTypes #-}
    -- | Syntactic sugar that improves the usability of 'Control.Exception.assert'
    -- and 'error'. The original @assert@ function is here re-exported
    -- for convenience.
    --
    -- Make sure to enable assertions for your cabal package, e.g., by setting
    --
    -- > ghc-options: -fno-ignore-asserts
    --
    -- in your .cabal file. Otherwise, some of the functions will have
    -- no effect at all.
    module Control.Exception.Assert.Sugar
      ( assert, blame, showFailure, swith, allB
        -- * DEPRECATED
      , twith, failure, forceEither
      ) where

    import           Control.Exception (assert)
    import           Data.Text (Text)
    import           Debug.Trace (trace)
    import           Prelude
    import qualified Text.Show.Pretty as Show.Pretty (ppShow)

    infix 1 `blame`
    -- | If the condition fails, display the value blamed for the failure.
    -- Used as in
    --
    -- > assert (age < 120 `blame` age) $ savings / (120 - age)
    blame :: Show v => Bool -> v -> Bool
    {-# INLINABLE blame #-}
    blame :: forall v. Show v => Bool -> v -> Bool
    blame Bool
    True v
    _ = Bool
    True
    blame Bool
    False v
    blamed = String -> Bool -> Bool
    forall a. String -> a -> a
    trace (v -> String
    forall v. Show v => v -> String
    blameMessage v
    blamed) Bool
    False

    blameMessage :: Show v => v -> String
    blameMessage :: forall v. Show v => v -> String
    blameMessage v
    blamed = String
    "Contract failed and the following is to blame:\n  "
                          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ v -> String
    forall v. Show v => v -> String
    Show.Pretty.ppShow v
    blamed

    infix 2 `showFailure`
    -- | A helper function for 'error'. To be used as in
    --
    -- > case xs of
    -- >   0 : _ -> error $ "insignificant zero" `showFailure` xs
    --
    -- Fixing the first argument to @String@ instead of anything Showable
    -- prevents warnings about defaulting, even when @OverloadedStrings@
    -- extension is enabled.
    showFailure :: Show v => String -> v -> String
    {-# INLINABLE showFailure #-}
    showFailure :: forall v. Show v => String -> v -> String
    showFailure String
    s v
    blamed =
      String
    "Internal failure occurred and the following is to blame:\n  "
      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n  "
      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ v -> String
    forall v. Show v => v -> String
    Show.Pretty.ppShow v
    blamed

    infix 2 `swith`
    -- | Syntactic sugar for the pair operation, to be used for 'blame' as in
    --
    -- > assert (age < 120 `blame` "age too high" `swith` age) $ savings / (120 - age)
    --
    -- Fixing the first component of the pair to @String@ prevents warnings
    -- about defaulting, even when @OverloadedStrings@ extension is enabled.
    swith :: String -> v -> (String, v)
    {-# INLINE swith #-}
    swith :: forall v. String -> v -> (String, v)
    swith String
    s v
    blamed = (String
    s, v
    blamed)

    -- | Like 'List.all', but if the predicate fails, blame all the list elements
    -- and especially those for which it fails. To be used as in
    --
    -- > assert (allB (<= height) [yf, y1, y2])
    allB :: Show v => (v -> Bool) -> [v] -> Bool
    {-# INLINABLE allB #-}
    allB :: forall v. Show v => (v -> Bool) -> [v] -> Bool
    allB v -> Bool
    predicate [v]
    l = case (v -> Bool) -> [v] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all v -> Bool
    predicate [v]
    l of
      Bool
    True -> Bool
    True
      Bool
    False -> String -> Bool -> Bool
    forall a. String -> a -> a
    trace ((v -> Bool) -> [v] -> String
    forall v. Show v => (v -> Bool) -> [v] -> String
    allBMessage v -> Bool
    predicate [v]
    l) Bool
    False

    allBMessage :: Show v => (v -> Bool) -> [v] -> String
    {-# INLINABLE allBMessage #-}
    allBMessage :: forall v. Show v => (v -> Bool) -> [v] -> String
    allBMessage v -> Bool
    predicate [v]
    l =
      String
    "The following items on the list don't respect the contract:\n"
      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [v] -> String
    forall v. Show v => v -> String
    Show.Pretty.ppShow ((v -> Bool) -> [v] -> [v]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (v -> Bool) -> v -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . v -> Bool
    predicate) [v]
    l)
      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\nout of all the list items below:\n"
      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [v] -> String
    forall v. Show v => v -> String
    Show.Pretty.ppShow [v]
    l

    -- * DEPRECATED

    infix 2 `twith`
    -- | Syntactic sugar for the pair operation, to be used for 'blame' as in
    --
    -- > assert (age < 120 `blame` "age too high" `twith` age) $ savings / (120 - age)
    -- Fixing the first component of the pair to @Text@ prevents warnings
    -- about defaulting, even when @OverloadedStrings@ extension is enabled.
    {-# DEPRECATED twith
          "consider using 'swith' instead, for simplicity, because GHC optimizes lazy 'String' constants very well." #-}
    twith :: Text -> b -> (Text, b)
    {-# INLINE twith #-}
    twith :: forall b. Text -> b -> (Text, b)
    twith Text
    t b
    b = (Text
    t, b
    b)

    infix 1 `failure`
    -- | Like 'error', but shows the source position (in newer GHCs
    -- @error@ shows source position as well, hence deprecation)
    -- and also the value to blame for the failure. To be used as in
    --
    -- > case xs of
    -- >   0 : _ -> assert `failure` (xs, "has an insignificant zero")
    {-# DEPRECATED failure
          "use 'error' and 'showFailure' instead, now that 'error' prints source positions." #-}
    failure :: Show a => (forall x. Bool -> x -> x) -> a -> b
    {-# NOINLINE failure #-}
    failure :: forall a b. Show a => (forall x. Bool -> x -> x) -> a -> b
    failure forall x. Bool -> x -> x
    asrt a
    blamed =
      let s :: String
    s = String
    "Internal failure occurred and the following is to blame:\n  "
              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall v. Show v => v -> String
    Show.Pretty.ppShow a
    blamed
      in String -> b -> b
    forall a. String -> a -> a
    trace String
    s
         (b -> b) -> b -> b
    forall a b. (a -> b) -> a -> b
    $ Bool -> b -> b
    forall x. Bool -> x -> x
    asrt Bool
    False
         (b -> b) -> b -> b
    forall a b. (a -> b) -> a -> b
    $ String -> b
    forall a. HasCallStack => String -> a
    error String
    "Control.Exception.Assert.Sugar.failure"
             -- Lack of no-ignore-asserts or GHC < 7.4.

    infix 1 `forceEither`
    -- | Assuming that @Left@ signifies an error condition,
    -- check the @Either@ value and, if @Left@ is encountered,
    -- fail outright and show the error message (in newer GHCs
    -- @error@ shows source position as well, hence deprecation). Used as in
    --
    -- > assert `forceEither` parseOrFailWithMessage code
    forceEither :: Show a => (forall x. Bool -> x -> x) -> Either a b -> b
    {-# DEPRECATED forceEither
          "use 'either (error . show) id' instead, now that 'error' prints source positions." #-}
    {-# NOINLINE forceEither #-}
    forceEither :: forall a b. Show a => (forall x. Bool -> x -> x) -> Either a b -> b
    forceEither forall x. Bool -> x -> x
    asrt (Left a
    a)  = Bool -> x -> x
    forall x. Bool -> x -> x
    asrt (forall x. Bool -> x -> x) -> a -> b
    forall a b. Show a => (forall x. Bool -> x -> x) -> a -> b
    `failure` a
    a
    forceEither forall x. Bool -> x -> x
    _    (Right b
    b) = b
    b