module Test.Reporter.Internal where

import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as TE
import qualified GHC.Stack as Stack
import qualified List
import NriPrelude
import qualified System.Directory
import System.FilePath ((</>))
import qualified Test.Internal as Internal
import qualified Text
import Text.Colour (chunk)
import qualified Text.Colour
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 :: Stack.SrcLoc -> BS.ByteString -> List Text.Colour.Chunk
renderSrcLoc :: SrcLoc -> ByteString -> List Chunk
renderSrcLoc 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 Text
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 Text) -> List Text
forall a b. a -> (a -> b) -> b
|> (Int -> ByteString -> Text) -> [ByteString] -> List Text
forall a b. (Int -> a -> b) -> List a -> List b
List.indexedMap
            ( \Int
i ByteString
l ->
                Int -> Text
Text.fromInt (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)
                  Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
": "
                  Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ ByteString -> Text
TE.decodeUtf8 ByteString
l
            )
  case List Text
lines of
    [] -> []
    List Text
lines' ->
      List (List Chunk) -> List Chunk
forall a. List (List a) -> List a
List.concat
        [ [ Chunk
"\n",
            Chunk
"Expectation failed at ",
            Text -> Chunk
chunk (FilePath -> Text
Text.fromList (SrcLoc -> FilePath
Stack.srcLocFile SrcLoc
loc)),
            Chunk
":",
            Text -> Chunk
chunk (Int -> Text
Text.fromInt (Int -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (SrcLoc -> Int
Stack.srcLocStartLine SrcLoc
loc))),
            Chunk
"\n"
          ],
          (Int -> Text -> Chunk) -> List Text -> List Chunk
forall a b. (Int -> a -> b) -> List a -> List b
List.indexedMap
            ( \Int
nr Text
line ->
                if Int
nr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
extraLinesOnFailure
                  then Chunk -> Chunk
red (Text -> Chunk
chunk (Text
"✗ " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
line Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"\n"))
                  else Chunk -> Chunk
dullGrey (Text -> Chunk
chunk (Text
"  " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
line Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
"\n"))
            )
            List Text
lines',
          [Chunk
"\n"]
        ]

red :: Text.Colour.Chunk -> Text.Colour.Chunk
red :: Chunk -> Chunk
red = Colour -> Chunk -> Chunk
Text.Colour.fore Colour
Text.Colour.red

yellow :: Text.Colour.Chunk -> Text.Colour.Chunk
yellow :: Chunk -> Chunk
yellow = Colour -> Chunk -> Chunk
Text.Colour.fore Colour
Text.Colour.yellow

green :: Text.Colour.Chunk -> Text.Colour.Chunk
green :: Chunk -> Chunk
green = Colour -> Chunk -> Chunk
Text.Colour.fore Colour
Text.Colour.green

grey :: Text.Colour.Chunk -> Text.Colour.Chunk
grey :: Chunk -> Chunk
grey = Colour -> Chunk -> Chunk
Text.Colour.fore Colour
Text.Colour.brightBlack

dullGrey :: Text.Colour.Chunk -> Text.Colour.Chunk
dullGrey :: Chunk -> Chunk
dullGrey = Colour -> Chunk -> Chunk
Text.Colour.fore Colour
Text.Colour.black

black :: Text.Colour.Chunk -> Text.Colour.Chunk
black :: Chunk -> Chunk
black = Colour -> Chunk -> Chunk
Text.Colour.fore Colour
Text.Colour.white