{-# LANGUAGE CPP #-}

module Test.Sandwich.Formatters.Slack.Internal.Markdown where

import Data.Function
import qualified Data.List as L
import Data.String.Interpolate
import qualified Data.Text as T
import GHC.Stack
import Test.Sandwich
import Test.Sandwich.Formatters.Slack.Internal.Types


toMarkdown :: FailureReason -> T.Text
toMarkdown :: FailureReason -> Text
toMarkdown (Reason {String
Maybe CallStack
failureCallStack :: FailureReason -> Maybe CallStack
failureReason :: FailureReason -> String
failureReason :: String
failureCallStack :: Maybe CallStack
..}) = String -> Text
T.pack String
failureReason
#ifndef mingw32_HOST_OS
toMarkdown (RawImage {String
Maybe CallStack
Image
failureFallback :: FailureReason -> String
failureRawImage :: FailureReason -> Image
failureRawImage :: Image
failureFallback :: String
failureCallStack :: Maybe CallStack
failureCallStack :: FailureReason -> Maybe CallStack
..}) = String -> Text
T.pack String
failureFallback
#endif
toMarkdown (ChildrenFailed {failureNumChildren :: FailureReason -> Int
failureNumChildren=Int
n}) = [i|#{n} #{if n == 1 then ("child" :: T.Text) else "children"} failed|]
toMarkdown (ExpectedButGot {Maybe CallStack
ShowEqBox
failureValue1 :: FailureReason -> ShowEqBox
failureValue2 :: FailureReason -> ShowEqBox
failureValue2 :: ShowEqBox
failureValue1 :: ShowEqBox
failureCallStack :: Maybe CallStack
failureCallStack :: FailureReason -> Maybe CallStack
..}) = [i|Expected *#{failureValue1}* but got *#{failureValue2}*|]
toMarkdown (DidNotExpectButGot {Maybe CallStack
ShowEqBox
failureValue1 :: ShowEqBox
failureCallStack :: Maybe CallStack
failureValue1 :: FailureReason -> ShowEqBox
failureCallStack :: FailureReason -> Maybe CallStack
..}) = [i|Did not expect *#{failureValue1}*|]
toMarkdown (GotException {Maybe String
Maybe CallStack
SomeExceptionWithEq
failureMessage :: FailureReason -> Maybe String
failureException :: FailureReason -> SomeExceptionWithEq
failureException :: SomeExceptionWithEq
failureMessage :: Maybe String
failureCallStack :: Maybe CallStack
failureCallStack :: FailureReason -> Maybe CallStack
..}) = case Maybe String
failureMessage of
  Just String
msg -> [i|Got exception (_#{msg}_): #{failureException}|]
  Maybe String
Nothing -> [i|Got exception (no message): #{failureException}|]
toMarkdown (Pending {Maybe String
Maybe CallStack
failurePendingMessage :: FailureReason -> Maybe String
failurePendingMessage :: Maybe String
failureCallStack :: Maybe CallStack
failureCallStack :: FailureReason -> Maybe CallStack
..}) = Text
"Example was pending"
toMarkdown (GetContextException {Maybe CallStack
SomeExceptionWithEq
failureException :: SomeExceptionWithEq
failureCallStack :: Maybe CallStack
failureException :: FailureReason -> SomeExceptionWithEq
failureCallStack :: FailureReason -> Maybe CallStack
..}) = [i|Context exception: #{failureException}|]
toMarkdown (GotAsyncException {Maybe String
Maybe CallStack
SomeAsyncExceptionWithEq
failureAsyncException :: FailureReason -> SomeAsyncExceptionWithEq
failureAsyncException :: SomeAsyncExceptionWithEq
failureMessage :: Maybe String
failureCallStack :: Maybe CallStack
failureMessage :: FailureReason -> Maybe String
failureCallStack :: FailureReason -> Maybe CallStack
..}) = case Maybe String
failureMessage of
  Just String
msg -> [i|Got async exception (_#{msg}_): #{failureAsyncException}|]
  Maybe String
Nothing -> [i|Got async exception: #{failureAsyncException}|]

callStackToMarkdown :: SlackFormatterShowCallStacks -> CallStack -> T.Text
callStackToMarkdown :: SlackFormatterShowCallStacks -> CallStack -> Text
callStackToMarkdown SlackFormatterShowCallStacks
SlackFormatterNoCallStacks CallStack
_cs = Text
""
callStackToMarkdown (SlackFormatterTopNCallStackFrames Int
n) CallStack
cs = Text
"\n\n" forall a. Semigroup a => a -> a -> a
<> CallStack -> Text
showCallStack ([(String, SrcLoc)] -> CallStack
fromCallSiteList forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
L.take Int
n forall a b. (a -> b) -> a -> b
$ CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs)
callStackToMarkdown SlackFormatterShowCallStacks
SlackFormatterFullCallStack CallStack
cs = Text
"\n\n" forall a. Semigroup a => a -> a -> a
<> CallStack -> Text
showCallStack CallStack
cs

showCallStack :: CallStack -> Text
showCallStack (CallStack -> [(String, SrcLoc)]
getCallStack -> [(String, SrcLoc)]
rows) = [Text
"> *" forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack String
name) forall a. Semigroup a => a -> a -> a
<> Text
"*, called at "
                                        forall a. Semigroup a => a -> a -> a
<> [i|_#{srcLocPackage}_:*#{srcLocFile}*:#{srcLocStartLine}:#{srcLocStartCol}|]
                                       | (String
name, SrcLoc {Int
String
srcLocEndCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocFile :: SrcLoc -> String
srcLocModule :: SrcLoc -> String
srcLocPackage :: SrcLoc -> String
srcLocStartCol :: SrcLoc -> Int
srcLocStartLine :: SrcLoc -> Int
srcLocEndCol :: Int
srcLocEndLine :: Int
srcLocModule :: String
srcLocStartCol :: Int
srcLocStartLine :: Int
srcLocFile :: String
srcLocPackage :: String
..}) <- [(String, SrcLoc)]
rows]
  forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
T.intercalate Text
"\n"