module Test.Reporter.Internal where

import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as Builder
import qualified GHC.Stack as Stack
import qualified List
import NriPrelude
import qualified System.Console.ANSI as ANSI
import qualified System.Directory
import System.FilePath ((</>))
import qualified Test.Internal as Internal
import qualified Prelude

extraLinesOnFailure :: Int
extraLinesOnFailure :: Int
extraLinesOnFailure = Int
2

readSrcLoc :: Internal.SingleTest Internal.Failure -> Prelude.IO (Maybe (Stack.SrcLoc, BS.ByteString))
readSrcLoc :: SingleTest Failure -> IO (Maybe (SrcLoc, ByteString))
readSrcLoc SingleTest Failure
test =
  case SingleTest Failure -> Failure
forall a. SingleTest a -> a
Internal.body SingleTest Failure
test of
    Internal.FailedAssertion Text
_ (Just SrcLoc
loc) -> do
      FilePath
cwd <- IO FilePath
System.Directory.getCurrentDirectory
      let path :: FilePath
path = FilePath
cwd FilePath -> FilePath -> FilePath
</> SrcLoc -> FilePath
Stack.srcLocFile SrcLoc
loc
      Bool
exists <- FilePath -> IO Bool
System.Directory.doesFileExist FilePath
path
      if Bool
exists
        then do
          ByteString
contents <- FilePath -> IO ByteString
BS.readFile FilePath
path
          Maybe (SrcLoc, ByteString) -> IO (Maybe (SrcLoc, ByteString))
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ((SrcLoc, ByteString) -> Maybe (SrcLoc, ByteString)
forall a. a -> Maybe a
Just (SrcLoc
loc, ByteString
contents))
        else Maybe (SrcLoc, ByteString) -> IO (Maybe (SrcLoc, ByteString))
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Maybe (SrcLoc, ByteString)
forall a. Maybe a
Nothing
    Failure
_ -> Maybe (SrcLoc, ByteString) -> IO (Maybe (SrcLoc, ByteString))
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure Maybe (SrcLoc, ByteString)
forall a. Maybe a
Nothing

renderSrcLoc ::
  ([ANSI.SGR] -> Builder.Builder -> Builder.Builder) ->
  Stack.SrcLoc ->
  BS.ByteString ->
  Builder.Builder
renderSrcLoc :: ([SGR] -> Builder -> Builder) -> SrcLoc -> ByteString -> Builder
renderSrcLoc [SGR] -> Builder -> Builder
styled SrcLoc
loc ByteString
contents = do
  let startLine :: Int
startLine = Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (SrcLoc -> Int
Stack.srcLocStartLine SrcLoc
loc)
  let lines :: List Builder
lines =
        ByteString
contents
          ByteString -> (ByteString -> [ByteString]) -> [ByteString]
forall a b. a -> (a -> b) -> b
|> Word8 -> ByteString -> [ByteString]
BS.split Word8
10 -- splitting newlines
          [ByteString] -> ([ByteString] -> [ByteString]) -> [ByteString]
forall a b. a -> (a -> b) -> b
|> Int -> [ByteString] -> [ByteString]
forall a. Int -> List a -> List a
List.drop (Int
startLine Int -> Int -> Int
forall number. Num number => number -> number -> number
- Int
extraLinesOnFailure Int -> Int -> Int
forall number. Num number => number -> number -> number
- Int
1)
          [ByteString] -> ([ByteString] -> [ByteString]) -> [ByteString]
forall a b. a -> (a -> b) -> b
|> Int -> [ByteString] -> [ByteString]
forall a. Int -> List a -> List a
List.take (Int
extraLinesOnFailure Int -> Int -> Int
forall number. Num number => number -> number -> number
* Int
2 Int -> Int -> Int
forall number. Num number => number -> number -> number
+ Int
1)
          [ByteString] -> ([ByteString] -> List Builder) -> List Builder
forall a b. a -> (a -> b) -> b
|> (Int -> ByteString -> Builder) -> [ByteString] -> List Builder
forall a b. (Int -> a -> b) -> List a -> List b
List.indexedMap
            ( \Int
i ByteString
l ->
                Int -> Builder
Builder.intDec
                  ( Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral
                      (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
<| Int
startLine Int -> Int -> Int
forall number. Num number => number -> number -> number
+ Int
i Int -> Int -> Int
forall number. Num number => number -> number -> number
- Int
extraLinesOnFailure
                  )
                  Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
": "
                  Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ ByteString -> Builder
Builder.byteString ByteString
l
            )
  case List Builder
lines of
    [] -> Builder
""
    List Builder
lines' ->
      Builder
"\n"
        Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"Expectation failed at "
        Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ FilePath -> Builder
Builder.stringUtf8 (SrcLoc -> FilePath
Stack.srcLocFile SrcLoc
loc)
        Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
":"
        Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Builder
Builder.intDec (SrcLoc -> Int
Stack.srcLocStartLine SrcLoc
loc)
        Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
        Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ ((Int, Builder) -> Builder) -> [(Int, Builder)] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Prelude.foldMap
          ( \(Int
nr, Builder
line) ->
              if Int
nr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
extraLinesOnFailure
                then [SGR] -> Builder -> Builder
styled [SGR
red] (Builder
"✗ " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
line) Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
                else Builder
"  " Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [SGR] -> Builder -> Builder
styled [SGR
dullGrey] Builder
line Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"
          )
          ((Int -> Builder -> (Int, Builder))
-> List Builder -> [(Int, Builder)]
forall a b. (Int -> a -> b) -> List a -> List b
List.indexedMap (,) List Builder
lines')
        Builder -> Builder -> Builder
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Builder
"\n"

sgr :: [ANSI.SGR] -> Builder.Builder
sgr :: [SGR] -> Builder
sgr = FilePath -> Builder
Builder.stringUtf8 (FilePath -> Builder) -> ([SGR] -> FilePath) -> [SGR] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< [SGR] -> FilePath
ANSI.setSGRCode

red :: ANSI.SGR
red :: SGR
red = ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground ColorIntensity
ANSI.Dull Color
ANSI.Red

yellow :: ANSI.SGR
yellow :: SGR
yellow = ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground ColorIntensity
ANSI.Dull Color
ANSI.Yellow

green :: ANSI.SGR
green :: SGR
green = ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground ColorIntensity
ANSI.Dull Color
ANSI.Green

grey :: ANSI.SGR
grey :: SGR
grey = ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground ColorIntensity
ANSI.Vivid Color
ANSI.Black

dullGrey :: ANSI.SGR
dullGrey :: SGR
dullGrey = ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground ColorIntensity
ANSI.Dull Color
ANSI.Black

black :: ANSI.SGR
black :: SGR
black = ConsoleLayer -> ColorIntensity -> Color -> SGR
ANSI.SetColor ConsoleLayer
ANSI.Foreground ColorIntensity
ANSI.Dull Color
ANSI.White

underlined :: ANSI.SGR
underlined :: SGR
underlined = Underlining -> SGR
ANSI.SetUnderlining Underlining
ANSI.SingleUnderline