-- | Pretty printing failure reasons

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.Sandwich.Formatters.Print.FailureReason (
  printFailureReason
  ) where

import Control.Exception.Safe
import Control.Monad.Reader
import qualified Data.List as L
import Data.String.Interpolate
import System.IO
import Test.Sandwich.Formatters.Print.Color
import Test.Sandwich.Formatters.Print.PrintPretty
import Test.Sandwich.Formatters.Print.Printing as P
import Test.Sandwich.Formatters.Print.Types
import Test.Sandwich.Formatters.Print.Util
import Test.Sandwich.Types.Spec
import Text.Show.Pretty as P


printFailureReason :: FailureReason -> ReaderT (PrintFormatter, Int, Handle) IO ()
printFailureReason :: FailureReason -> ReaderT (PrintFormatter, Int, Handle) IO ()
printFailureReason (Reason Maybe CallStack
_ String
s) = do
  String -> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
printShowBoxPrettyWithTitleString String
"Reason: " String
s
printFailureReason (ChildrenFailed Maybe CallStack
_ Int
n) = do
  Colour Float
-> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
picn Colour Float
midWhite ([i|#{n} #{if n == 1 then ("child" :: String) else "children"} failed|] :: String)
printFailureReason (ExpectedButGot Maybe CallStack
_ ShowEqBox
seb1 ShowEqBox
seb2) = do
  String -> ShowEqBox -> ReaderT (PrintFormatter, Int, Handle) IO ()
printShowBoxPrettyWithTitle String
"Expected: " ShowEqBox
seb1
  String -> ShowEqBox -> ReaderT (PrintFormatter, Int, Handle) IO ()
printShowBoxPrettyWithTitle String
"But got: " ShowEqBox
seb2
printFailureReason (DidNotExpectButGot Maybe CallStack
_ ShowEqBox
seb) = do
  String -> ShowEqBox -> ReaderT (PrintFormatter, Int, Handle) IO ()
printShowBoxPrettyWithTitle String
"Did not expect: " ShowEqBox
seb
printFailureReason (GotException Maybe CallStack
_ Maybe String
maybeMessage e :: SomeExceptionWithEq
e@(SomeExceptionWithEq SomeException
baseException)) =
  case SomeException -> Maybe FailureReason
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
baseException of
    Just (FailureReason
fr :: FailureReason) -> do
      Colour Float
-> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
picn Colour Float
midWhite String
"Got exception:"
      FailureReason -> ReaderT (PrintFormatter, Int, Handle) IO ()
printFailureReason FailureReason
fr
    Maybe FailureReason
_ -> case Maybe String
maybeMessage of
      Maybe String
Nothing -> String -> ShowEqBox -> ReaderT (PrintFormatter, Int, Handle) IO ()
printShowBoxPrettyWithTitle String
"Got exception: " (SomeExceptionWithEq -> ShowEqBox
forall s. (Show s, Eq s) => s -> ShowEqBox
SEB SomeExceptionWithEq
e)
      Just String
s -> String -> ShowEqBox -> ReaderT (PrintFormatter, Int, Handle) IO ()
printShowBoxPrettyWithTitle [i|Got exception (#{s})|] (SomeExceptionWithEq -> ShowEqBox
forall s. (Show s, Eq s) => s -> ShowEqBox
SEB SomeExceptionWithEq
e)
printFailureReason (Pending Maybe CallStack
_ Maybe String
maybeMessage) = case Maybe String
maybeMessage of
  Maybe String
Nothing -> () -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Just allow the yellow heading to show the pending state
  Just String
s -> String -> ShowEqBox -> ReaderT (PrintFormatter, Int, Handle) IO ()
printShowBoxPrettyWithTitle String
"Pending reason: " (String -> ShowEqBox
forall s. (Show s, Eq s) => s -> ShowEqBox
SEB String
s)
printFailureReason (GetContextException Maybe CallStack
_ e :: SomeExceptionWithEq
e@(SomeExceptionWithEq SomeException
baseException)) = do
  case SomeException -> Maybe FailureReason
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
baseException of
    Just (FailureReason
fr :: FailureReason) -> do
      Colour Float
-> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
picn Colour Float
midWhite String
"Context exception:"
      FailureReason -> ReaderT (PrintFormatter, Int, Handle) IO ()
printFailureReason FailureReason
fr
    Maybe FailureReason
_ -> String -> ShowEqBox -> ReaderT (PrintFormatter, Int, Handle) IO ()
printShowBoxPrettyWithTitle String
"Context exception: " (SomeExceptionWithEq -> ShowEqBox
forall s. (Show s, Eq s) => s -> ShowEqBox
SEB SomeExceptionWithEq
e)
printFailureReason (GotAsyncException Maybe CallStack
_ Maybe String
maybeMessage SomeAsyncExceptionWithEq
e) = case Maybe String
maybeMessage of
  Maybe String
Nothing -> String -> ShowEqBox -> ReaderT (PrintFormatter, Int, Handle) IO ()
printShowBoxPrettyWithTitle String
"Async exception" (SomeAsyncExceptionWithEq -> ShowEqBox
forall s. (Show s, Eq s) => s -> ShowEqBox
SEB SomeAsyncExceptionWithEq
e)
  Just String
s -> String -> ShowEqBox -> ReaderT (PrintFormatter, Int, Handle) IO ()
printShowBoxPrettyWithTitle [i|Async exception (#{e}) |] (String -> ShowEqBox
forall s. (Show s, Eq s) => s -> ShowEqBox
SEB String
s)

-- * Pretty printing

printShowBoxPrettyWithTitle :: String -> ShowEqBox -> ReaderT (PrintFormatter, Int, Handle) IO ()
printShowBoxPrettyWithTitle :: String -> ShowEqBox -> ReaderT (PrintFormatter, Int, Handle) IO ()
printShowBoxPrettyWithTitle String
title (SEB s
v) = case s -> Maybe Value
forall a. Show a => a -> Maybe Value
P.reify s
v of
  Maybe Value
Nothing -> do
    Colour Float
-> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
picn Colour Float
midWhite String
title
    ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *) c b.
MonadReader (PrintFormatter, Int, c) m =>
m b -> m b
withBumpIndent (ReaderT (PrintFormatter, Int, Handle) IO ()
 -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a b. (a -> b) -> a -> b
$ do
      [String]
-> (String -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (String -> [String]
L.lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ s -> String
forall a. Show a => a -> String
show s
v) String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pin
    String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall b (m :: * -> *).
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
  Just Value
x
    | Value -> Bool
isSingleLine Value
x -> do
        Colour Float
-> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pic Colour Float
midWhite String
title
        Bool -> Value -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
False Value
x ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall b (m :: * -> *).
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
    | Bool
otherwise -> do
        Colour Float
-> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
picn Colour Float
midWhite String
title
        Bool -> Value -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
True Value
x ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall b (m :: * -> *).
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"

printShowBoxPrettyWithTitleString :: String -> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
printShowBoxPrettyWithTitleString :: String -> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
printShowBoxPrettyWithTitleString String
title String
s = do
  Colour Float
-> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
picn Colour Float
midWhite String
title
  ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *) c b.
MonadReader (PrintFormatter, Int, c) m =>
m b -> m b
withBumpIndent (ReaderT (PrintFormatter, Int, Handle) IO ()
 -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a b. (a -> b) -> a -> b
$ do
    [String]
-> (String -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (String -> [String]
L.lines String
s) String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pin
  String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall b (m :: * -> *).
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"