{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Bilge.Assert
( Assertions,
Contains (..),
(!!!),
(<!!),
(===),
(=/=),
(=~=),
assertResponse,
assertTrue,
assertTrue_,
assert,
assert_,
)
where
import Control.Monad.Catch
import Control.Monad.Writer.Class
import Control.Monad.Writer.Strict
import Data.ByteString qualified as S
import Data.ByteString.Lazy qualified as Lazy
import Imports
import Network.HTTP.Client
import System.Console.ANSI
import Text.Printf
class Contains a where
contains :: a -> a -> Bool
instance Contains ByteString where
contains :: ByteString -> ByteString -> Bool
contains ByteString
a ByteString
b = Bool -> Bool
not (Bool -> Bool)
-> ((ByteString, ByteString) -> Bool)
-> (ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
S.null (ByteString -> Bool)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> Bool)
-> (ByteString, ByteString) -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> (ByteString, ByteString)
S.breakSubstring ByteString
a ByteString
b
instance Contains Lazy.ByteString where
contains :: ByteString -> ByteString -> Bool
contains ByteString
a ByteString
b = ByteString -> ByteString -> Bool
forall a. Contains a => a -> a -> Bool
contains (ByteString -> ByteString
Lazy.toStrict ByteString
a) (ByteString -> ByteString
Lazy.toStrict ByteString
b)
instance (Eq a) => Contains [a] where
contains :: [a] -> [a] -> Bool
contains = [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf
instance (Contains a) => Contains (Maybe a) where
contains :: Maybe a -> Maybe a -> Bool
contains (Just a
a) (Just a
b) = a -> a -> Bool
forall a. Contains a => a -> a -> Bool
contains a
a a
b
contains Maybe a
Nothing Maybe a
_ = Bool
True
contains Maybe a
_ Maybe a
Nothing = Bool
False
newtype Assertions a = Assertions
{ forall a.
Assertions a
-> Writer [Response (Maybe ByteString) -> Maybe String] a
_assertions :: Writer [Response (Maybe Lazy.ByteString) -> Maybe String] a
}
deriving ((forall a b. (a -> b) -> Assertions a -> Assertions b)
-> (forall a b. a -> Assertions b -> Assertions a)
-> Functor Assertions
forall a b. a -> Assertions b -> Assertions a
forall a b. (a -> b) -> Assertions a -> Assertions b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Assertions a -> Assertions b
fmap :: forall a b. (a -> b) -> Assertions a -> Assertions b
$c<$ :: forall a b. a -> Assertions b -> Assertions a
<$ :: forall a b. a -> Assertions b -> Assertions a
Functor, Functor Assertions
Functor Assertions =>
(forall a. a -> Assertions a)
-> (forall a b.
Assertions (a -> b) -> Assertions a -> Assertions b)
-> (forall a b c.
(a -> b -> c) -> Assertions a -> Assertions b -> Assertions c)
-> (forall a b. Assertions a -> Assertions b -> Assertions b)
-> (forall a b. Assertions a -> Assertions b -> Assertions a)
-> Applicative Assertions
forall a. a -> Assertions a
forall a b. Assertions a -> Assertions b -> Assertions a
forall a b. Assertions a -> Assertions b -> Assertions b
forall a b. Assertions (a -> b) -> Assertions a -> Assertions b
forall a b c.
(a -> b -> c) -> Assertions a -> Assertions b -> Assertions c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Assertions a
pure :: forall a. a -> Assertions a
$c<*> :: forall a b. Assertions (a -> b) -> Assertions a -> Assertions b
<*> :: forall a b. Assertions (a -> b) -> Assertions a -> Assertions b
$cliftA2 :: forall a b c.
(a -> b -> c) -> Assertions a -> Assertions b -> Assertions c
liftA2 :: forall a b c.
(a -> b -> c) -> Assertions a -> Assertions b -> Assertions c
$c*> :: forall a b. Assertions a -> Assertions b -> Assertions b
*> :: forall a b. Assertions a -> Assertions b -> Assertions b
$c<* :: forall a b. Assertions a -> Assertions b -> Assertions a
<* :: forall a b. Assertions a -> Assertions b -> Assertions a
Applicative, Applicative Assertions
Applicative Assertions =>
(forall a b. Assertions a -> (a -> Assertions b) -> Assertions b)
-> (forall a b. Assertions a -> Assertions b -> Assertions b)
-> (forall a. a -> Assertions a)
-> Monad Assertions
forall a. a -> Assertions a
forall a b. Assertions a -> Assertions b -> Assertions b
forall a b. Assertions a -> (a -> Assertions b) -> Assertions b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Assertions a -> (a -> Assertions b) -> Assertions b
>>= :: forall a b. Assertions a -> (a -> Assertions b) -> Assertions b
$c>> :: forall a b. Assertions a -> Assertions b -> Assertions b
>> :: forall a b. Assertions a -> Assertions b -> Assertions b
$creturn :: forall a. a -> Assertions a
return :: forall a. a -> Assertions a
Monad)
(<!!) ::
(HasCallStack, MonadIO m, MonadCatch m) =>
m (Response (Maybe Lazy.ByteString)) ->
Assertions () ->
m (Response (Maybe Lazy.ByteString))
m (Response (Maybe ByteString))
io <!! :: forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadCatch m) =>
m (Response (Maybe ByteString))
-> Assertions () -> m (Response (Maybe ByteString))
<!! Assertions ()
aa = do
Response (Maybe ByteString)
r <- m (Response (Maybe ByteString))
io m (Response (Maybe ByteString))
-> (SomeException -> m (Response (Maybe ByteString)))
-> m (Response (Maybe ByteString))
forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`catch` SomeException -> m (Response (Maybe ByteString))
forall {k} (m :: k -> *) (a :: k). SomeException -> m a
printErr
let results :: [Maybe String]
results = ((Response (Maybe ByteString) -> Maybe String) -> Maybe String)
-> [Response (Maybe ByteString) -> Maybe String] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map ((Response (Maybe ByteString) -> Maybe String)
-> Response (Maybe ByteString) -> Maybe String
forall a b. (a -> b) -> a -> b
$ Response (Maybe ByteString)
r) (Writer [Response (Maybe ByteString) -> Maybe String] ()
-> [Response (Maybe ByteString) -> Maybe String]
forall w a. Writer w a -> w
execWriter (Writer [Response (Maybe ByteString) -> Maybe String] ()
-> [Response (Maybe ByteString) -> Maybe String])
-> (Assertions ()
-> Writer [Response (Maybe ByteString) -> Maybe String] ())
-> Assertions ()
-> [Response (Maybe ByteString) -> Maybe String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assertions ()
-> Writer [Response (Maybe ByteString) -> Maybe String] ()
forall a.
Assertions a
-> Writer [Response (Maybe ByteString) -> Maybe String] a
_assertions (Assertions () -> [Response (Maybe ByteString) -> Maybe String])
-> Assertions () -> [Response (Maybe ByteString) -> Maybe String]
forall a b. (a -> b) -> a -> b
$ Assertions ()
aa)
let failures :: [(Int, Maybe String)]
failures = ((Int, Maybe String) -> Bool)
-> [(Int, Maybe String)] -> [(Int, Maybe String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> ((Int, Maybe String) -> Maybe String)
-> (Int, Maybe String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe String) -> Maybe String
forall a b. (a, b) -> b
snd) ([(Int, Maybe String)] -> [(Int, Maybe String)])
-> [(Int, Maybe String)] -> [(Int, Maybe String)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Maybe String] -> [(Int, Maybe String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [Maybe String]
results
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Int, Maybe String)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Maybe String)]
failures) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> ([String] -> String) -> [String] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> m ()) -> [String] -> m ()
forall a b. (a -> b) -> a -> b
$
String -> String
title String
"Assertions failed:\n"
String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"\n" (((Int, Maybe String) -> String)
-> [(Int, Maybe String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Maybe String) -> String
msg [(Int, Maybe String)]
failures)
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"\n\nResponse was:\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Response (Maybe ByteString) -> String
forall a. Show a => a -> String
show Response (Maybe ByteString)
r]
Response (Maybe ByteString) -> m (Response (Maybe ByteString))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response (Maybe ByteString)
r
where
msg :: (Int, Maybe String) -> String
msg :: (Int, Maybe String) -> String
msg (Int
i, Just String
m) = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%2d: " Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
err String
m
msg (Int, Maybe String)
_ = String
""
printErr :: SomeException -> m a
printErr :: forall {k} (m :: k -> *) (a :: k). SomeException -> m a
printErr SomeException
e = String -> m a
forall a. HasCallStack => String -> a
error (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String -> String
title String
"Error executing request: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
err (SomeException -> String
forall a. Show a => a -> String
show SomeException
e)
(!!!) ::
(HasCallStack, MonadIO m, MonadCatch m) =>
m (Response (Maybe Lazy.ByteString)) ->
Assertions () ->
m ()
!!! :: forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadCatch m) =>
m (Response (Maybe ByteString)) -> Assertions () -> m ()
(!!!) m (Response (Maybe ByteString))
io = m (Response (Maybe ByteString)) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Response (Maybe ByteString)) -> m ())
-> (Assertions () -> m (Response (Maybe ByteString)))
-> Assertions ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Response (Maybe ByteString))
-> Assertions () -> m (Response (Maybe ByteString))
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadCatch m) =>
m (Response (Maybe ByteString))
-> Assertions () -> m (Response (Maybe ByteString))
(<!!) m (Response (Maybe ByteString))
io
infix 4 ===
infix 4 =/=
infixr 3 !!!
infixr 3 <!!
(===) ::
(HasCallStack, Eq a, Show a) =>
(Response (Maybe Lazy.ByteString) -> a) ->
(Response (Maybe Lazy.ByteString) -> a) ->
Assertions ()
Response (Maybe ByteString) -> a
f === :: forall a.
(HasCallStack, Eq a, Show a) =>
(Response (Maybe ByteString) -> a)
-> (Response (Maybe ByteString) -> a) -> Assertions ()
=== Response (Maybe ByteString) -> a
g = Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ()
forall a.
Writer [Response (Maybe ByteString) -> Maybe String] a
-> Assertions a
Assertions (Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ())
-> Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ()
forall a b. (a -> b) -> a -> b
$ [Response (Maybe ByteString) -> Maybe String]
-> Writer [Response (Maybe ByteString) -> Maybe String] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [\Response (Maybe ByteString)
r -> String -> (a -> a -> Bool) -> a -> a -> Maybe String
forall a.
(HasCallStack, Show a) =>
String -> (a -> a -> Bool) -> a -> a -> Maybe String
test String
" =/= " a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Response (Maybe ByteString) -> a
f Response (Maybe ByteString)
r) (Response (Maybe ByteString) -> a
g Response (Maybe ByteString)
r)]
(=/=) ::
(HasCallStack, Eq a, Show a) =>
(Response (Maybe Lazy.ByteString) -> a) ->
(Response (Maybe Lazy.ByteString) -> a) ->
Assertions ()
Response (Maybe ByteString) -> a
f =/= :: forall a.
(HasCallStack, Eq a, Show a) =>
(Response (Maybe ByteString) -> a)
-> (Response (Maybe ByteString) -> a) -> Assertions ()
=/= Response (Maybe ByteString) -> a
g = Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ()
forall a.
Writer [Response (Maybe ByteString) -> Maybe String] a
-> Assertions a
Assertions (Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ())
-> Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ()
forall a b. (a -> b) -> a -> b
$ [Response (Maybe ByteString) -> Maybe String]
-> Writer [Response (Maybe ByteString) -> Maybe String] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [\Response (Maybe ByteString)
r -> String -> (a -> a -> Bool) -> a -> a -> Maybe String
forall a.
(HasCallStack, Show a) =>
String -> (a -> a -> Bool) -> a -> a -> Maybe String
test String
" === " a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (Response (Maybe ByteString) -> a
f Response (Maybe ByteString)
r) (Response (Maybe ByteString) -> a
g Response (Maybe ByteString)
r)]
(=~=) ::
(HasCallStack, Show a, Contains a) =>
(Response (Maybe Lazy.ByteString) -> a) ->
(Response (Maybe Lazy.ByteString) -> a) ->
Assertions ()
Response (Maybe ByteString) -> a
f =~= :: forall a.
(HasCallStack, Show a, Contains a) =>
(Response (Maybe ByteString) -> a)
-> (Response (Maybe ByteString) -> a) -> Assertions ()
=~= Response (Maybe ByteString) -> a
g = Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ()
forall a.
Writer [Response (Maybe ByteString) -> Maybe String] a
-> Assertions a
Assertions (Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ())
-> Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ()
forall a b. (a -> b) -> a -> b
$ [Response (Maybe ByteString) -> Maybe String]
-> Writer [Response (Maybe ByteString) -> Maybe String] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [\Response (Maybe ByteString)
r -> String -> (a -> a -> Bool) -> a -> a -> Maybe String
forall a.
(HasCallStack, Show a) =>
String -> (a -> a -> Bool) -> a -> a -> Maybe String
test String
" not in " a -> a -> Bool
forall a. Contains a => a -> a -> Bool
contains (Response (Maybe ByteString) -> a
f Response (Maybe ByteString)
r) (Response (Maybe ByteString) -> a
g Response (Maybe ByteString)
r)]
assertResponse :: (HasCallStack) => (Response (Maybe Lazy.ByteString) -> Maybe String) -> Assertions ()
assertResponse :: HasCallStack =>
(Response (Maybe ByteString) -> Maybe String) -> Assertions ()
assertResponse Response (Maybe ByteString) -> Maybe String
f = Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ()
forall a.
Writer [Response (Maybe ByteString) -> Maybe String] a
-> Assertions a
Assertions (Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ())
-> Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ()
forall a b. (a -> b) -> a -> b
$ [Response (Maybe ByteString) -> Maybe String]
-> Writer [Response (Maybe ByteString) -> Maybe String] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Response (Maybe ByteString) -> Maybe String
f]
assertTrue :: (HasCallStack) => String -> (Response (Maybe Lazy.ByteString) -> Bool) -> Assertions ()
assertTrue :: HasCallStack =>
String -> (Response (Maybe ByteString) -> Bool) -> Assertions ()
assertTrue String
e Response (Maybe ByteString) -> Bool
f = Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ()
forall a.
Writer [Response (Maybe ByteString) -> Maybe String] a
-> Assertions a
Assertions (Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ())
-> Writer [Response (Maybe ByteString) -> Maybe String] ()
-> Assertions ()
forall a b. (a -> b) -> a -> b
$ [Response (Maybe ByteString) -> Maybe String]
-> Writer [Response (Maybe ByteString) -> Maybe String] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [\Response (Maybe ByteString)
r -> if Response (Maybe ByteString) -> Bool
f Response (Maybe ByteString)
r then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
e]
assertTrue_ :: (HasCallStack) => (Response (Maybe Lazy.ByteString) -> Bool) -> Assertions ()
assertTrue_ :: HasCallStack =>
(Response (Maybe ByteString) -> Bool) -> Assertions ()
assertTrue_ = HasCallStack =>
String -> (Response (Maybe ByteString) -> Bool) -> Assertions ()
String -> (Response (Maybe ByteString) -> Bool) -> Assertions ()
assertTrue String
"false"
assert :: (HasCallStack) => String -> Bool -> Assertions ()
assert :: HasCallStack => String -> Bool -> Assertions ()
assert String
m = HasCallStack =>
String -> (Response (Maybe ByteString) -> Bool) -> Assertions ()
String -> (Response (Maybe ByteString) -> Bool) -> Assertions ()
assertTrue String
m ((Response (Maybe ByteString) -> Bool) -> Assertions ())
-> (Bool -> Response (Maybe ByteString) -> Bool)
-> Bool
-> Assertions ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Response (Maybe ByteString) -> Bool
forall a b. a -> b -> a
const
assert_ :: (HasCallStack) => Bool -> Assertions ()
assert_ :: HasCallStack => Bool -> Assertions ()
assert_ = HasCallStack =>
(Response (Maybe ByteString) -> Bool) -> Assertions ()
(Response (Maybe ByteString) -> Bool) -> Assertions ()
assertTrue_ ((Response (Maybe ByteString) -> Bool) -> Assertions ())
-> (Bool -> Response (Maybe ByteString) -> Bool)
-> Bool
-> Assertions ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Response (Maybe ByteString) -> Bool
forall a b. a -> b -> a
const
test :: (HasCallStack, Show a) => String -> (a -> a -> Bool) -> a -> a -> Maybe String
test :: forall a.
(HasCallStack, Show a) =>
String -> (a -> a -> Bool) -> a -> a -> Maybe String
test String
s a -> a -> Bool
o a
a a
b
| a -> a -> Bool
o a
a a
b = Maybe String
forall a. Maybe a
Nothing
| Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b
title, err :: String -> String
title :: String -> String
title = Color -> String -> String
with Color
Yellow
err :: String -> String
err = Color -> String -> String
with Color
Red
with :: Color -> String -> String
with :: Color -> String -> String
with Color
c String
a =
[SGR] -> String
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
c] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ [SGR] -> String
setSGRCode []