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
= 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
[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