{-# LANGUAGE RankNTypes #-}
module Control.Exception.Assert.Sugar
( assert, blame, showFailure, swith, allB
, failure, twith, 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`
blame :: Show a => Bool -> a -> Bool
{-# INLINE blame #-}
blame :: Bool -> a -> Bool
blame True _ = Bool
True
blame False blamed :: a
blamed = String -> Bool -> Bool
forall a. String -> a -> a
trace (a -> String
forall a. Show a => a -> String
blameMessage a
blamed) Bool
False
blameMessage :: Show a => a -> String
{-# NOINLINE blameMessage #-}
blameMessage :: a -> String
blameMessage blamed :: a
blamed = "Contract failed and the following is to blame:\n "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
Show.Pretty.ppShow a
blamed
infix 1 `failure`
{-# 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 x. Bool -> x -> x) -> a -> b
failure asrt :: forall x. Bool -> x -> x
asrt blamed :: a
blamed =
let s :: String
s = "Internal failure occurred and the following is to blame:\n "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> 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 "Control.Exception.Assert.Sugar.failure"
infix 2 `showFailure`
showFailure :: Show v => String -> v -> String
{-# NOINLINE showFailure #-}
showFailure :: String -> v -> String
showFailure s :: String
s v :: v
v =
"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]
++ "\n "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ v -> String
forall a. Show a => a -> String
Show.Pretty.ppShow v
v
infix 2 `twith`
{-# DEPRECATED twith
"consider using 'swith' instead, for simplicity, because GHC optimizes lazy 'String' constants very well." #-}
twith :: Text -> b -> (Text, b)
{-# INLINE twith #-}
twith :: Text -> b -> (Text, b)
twith t :: Text
t b :: b
b = (Text
t, b
b)
infix 2 `swith`
swith :: String -> v -> (String, v)
{-# INLINE swith #-}
swith :: String -> v -> (String, v)
swith s :: String
s v :: v
v = (String
s, v
v)
allB :: Show a => (a -> Bool) -> [a] -> Bool
{-# INLINE allB #-}
allB :: (a -> Bool) -> [a] -> Bool
allB predicate :: a -> Bool
predicate l :: [a]
l = Bool -> String -> Bool
forall a. Show a => Bool -> a -> Bool
blame ((a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all a -> Bool
predicate [a]
l) (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> String
forall a. Show a => (a -> Bool) -> [a] -> String
allBMessage a -> Bool
predicate [a]
l
allBMessage :: Show a => (a -> Bool) -> [a] -> String
{-# NOINLINE allBMessage #-}
allBMessage :: (a -> Bool) -> [a] -> String
allBMessage predicate :: a -> Bool
predicate l :: [a]
l = [a] -> String
forall a. Show a => a -> String
Show.Pretty.ppShow ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
predicate) [a]
l)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ " in the context of "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
Show.Pretty.ppShow [a]
l
infix 1 `forceEither`
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 x. Bool -> x -> x) -> Either a b -> b
forceEither asrt :: forall x. Bool -> x -> x
asrt (Left a :: a
a) = 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 _ (Right b :: b
b) = b
b