diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Unreleased next version +# 0.5.0.2 + +### Enhancements: + +- Relax version bounds to ecompass `base-4.15.x`. + # 0.5.0.1 ### Enhancements: diff --git a/nri-prelude.cabal b/nri-prelude.cabal --- a/nri-prelude.cabal +++ b/nri-prelude.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: nri-prelude -version: 0.5.0.1 +version: 0.5.0.2 synopsis: A Prelude inspired by the Elm programming language description: Please see the README at . category: Web @@ -73,10 +73,9 @@ build-depends: aeson >=1.4.6.0 && <1.6 , aeson-pretty >=0.8.0 && <0.9 - , ansi-terminal >=0.9.1 && <0.12 , async >=2.2.2 && <2.3 , auto-update >=0.1.6 && <0.2 - , base >=4.12.0.0 && <4.15 + , base >=4.12.0.0 && <4.16 , bytestring >=0.10.8.2 && <0.12 , containers >=0.6.0.1 && <0.7 , directory >=1.3.3.0 && <1.4 @@ -87,6 +86,7 @@ , junit-xml >=0.1.0.0 && <0.2.0.0 , pretty-diff >=0.4.0.2 && <0.5 , pretty-show >=1.9.5 && <1.11 + , safe-coloured-text >=0.0.0.0 && <0.1 , safe-exceptions >=0.1.7.0 && <1.3 , terminal-size >=0.3.2.1 && <0.4 , text >=1.2.3.1 && <1.3 @@ -149,10 +149,9 @@ build-depends: aeson >=1.4.6.0 && <1.6 , aeson-pretty >=0.8.0 && <0.9 - , ansi-terminal >=0.9.1 && <0.12 , async >=2.2.2 && <2.3 , auto-update >=0.1.6 && <0.2 - , base >=4.12.0.0 && <4.15 + , base >=4.12.0.0 && <4.16 , bytestring >=0.10.8.2 && <0.12 , containers >=0.6.0.1 && <0.7 , directory >=1.3.3.0 && <1.4 @@ -163,6 +162,7 @@ , junit-xml >=0.1.0.0 && <0.2.0.0 , pretty-diff >=0.4.0.2 && <0.5 , pretty-show >=1.9.5 && <1.11 + , safe-coloured-text >=0.0.0.0 && <0.1 , safe-exceptions >=0.1.7.0 && <1.3 , terminal-size >=0.3.2.1 && <0.4 , text >=1.2.3.1 && <1.3 diff --git a/src/Test/Reporter/Internal.hs b/src/Test/Reporter/Internal.hs --- a/src/Test/Reporter/Internal.hs +++ b/src/Test/Reporter/Internal.hs @@ -1,14 +1,16 @@ module Test.Reporter.Internal where import qualified Data.ByteString as BS -import qualified Data.ByteString.Builder as Builder +import qualified Data.Text.Encoding as TE 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 Text +import Text.Colour (chunk) +import qualified Text.Colour import qualified Prelude extraLinesOnFailure :: Int @@ -28,12 +30,8 @@ else Prelude.pure Nothing _ -> Prelude.pure Nothing -renderSrcLoc :: - ([ANSI.SGR] -> Builder.Builder -> Builder.Builder) -> - Stack.SrcLoc -> - BS.ByteString -> - Builder.Builder -renderSrcLoc styled loc contents = do +renderSrcLoc :: Stack.SrcLoc -> BS.ByteString -> List Text.Colour.Chunk +renderSrcLoc loc contents = do let startLine = Prelude.fromIntegral (Stack.srcLocStartLine loc) let lines = contents @@ -42,51 +40,45 @@ |> List.take (extraLinesOnFailure * 2 + 1) |> List.indexedMap ( \i l -> - Builder.intDec - ( Prelude.fromIntegral - <| startLine + i - extraLinesOnFailure - ) + Text.fromInt (startLine + i - extraLinesOnFailure) ++ ": " - ++ Builder.byteString l + ++ TE.decodeUtf8 l ) case lines of - [] -> "" + [] -> [] lines' -> - "\n" - ++ "Expectation failed at " - ++ Builder.stringUtf8 (Stack.srcLocFile loc) - ++ ":" - ++ Builder.intDec (Stack.srcLocStartLine loc) - ++ "\n" - ++ Prelude.foldMap - ( \(nr, line) -> - if nr == extraLinesOnFailure - then styled [red] ("✗ " ++ line) ++ "\n" - else " " ++ styled [dullGrey] line ++ "\n" - ) - (List.indexedMap (,) lines') - ++ "\n" - -sgr :: [ANSI.SGR] -> Builder.Builder -sgr = Builder.stringUtf8 << ANSI.setSGRCode - -red :: ANSI.SGR -red = ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Red + List.concat + [ [ "\n", + "Expectation failed at ", + chunk (Text.fromList (Stack.srcLocFile loc)), + ":", + chunk (Text.fromInt (Prelude.fromIntegral (Stack.srcLocStartLine loc))), + "\n" + ], + List.indexedMap + ( \nr line -> + if nr == extraLinesOnFailure + then red (chunk ("✗ " ++ line ++ "\n")) + else dullGrey (chunk (" " ++ line ++ "\n")) + ) + lines', + ["\n"] + ] -yellow :: ANSI.SGR -yellow = ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Yellow +red :: Text.Colour.Chunk -> Text.Colour.Chunk +red = Text.Colour.fore Text.Colour.red -green :: ANSI.SGR -green = ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Green +yellow :: Text.Colour.Chunk -> Text.Colour.Chunk +yellow = Text.Colour.fore Text.Colour.yellow -grey :: ANSI.SGR -grey = ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Black +green :: Text.Colour.Chunk -> Text.Colour.Chunk +green = Text.Colour.fore Text.Colour.green -dullGrey :: ANSI.SGR -dullGrey = ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Black +grey :: Text.Colour.Chunk -> Text.Colour.Chunk +grey = Text.Colour.fore Text.Colour.brightBlack -black :: ANSI.SGR -black = ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.White +dullGrey :: Text.Colour.Chunk -> Text.Colour.Chunk +dullGrey = Text.Colour.fore Text.Colour.black -underlined :: ANSI.SGR -underlined = ANSI.SetUnderlining ANSI.SingleUnderline +black :: Text.Colour.Chunk -> Text.Colour.Chunk +black = Text.Colour.fore Text.Colour.white diff --git a/src/Test/Reporter/Junit.hs b/src/Test/Reporter/Junit.hs --- a/src/Test/Reporter/Junit.hs +++ b/src/Test/Reporter/Junit.hs @@ -10,8 +10,6 @@ import qualified Control.Exception.Safe as Exception import qualified Data.ByteString as BS -import qualified Data.ByteString.Builder as Builder -import qualified Data.ByteString.Lazy import qualified Data.Text import qualified Data.Text.Encoding as TE import qualified GHC.Stack as Stack @@ -23,6 +21,7 @@ import qualified Test.Internal as Internal import qualified Test.Reporter.Internal import qualified Text +import qualified Text.Colour import qualified Text.XML.JUnit as JUnit import qualified Tuple import qualified Prelude @@ -82,9 +81,8 @@ let msg' = case maybeSrcLoc of Nothing -> msg Just (loc, src) -> - Test.Reporter.Internal.renderSrcLoc (\_ -> identity) loc src - |> Builder.toLazyByteString - |> Data.ByteString.Lazy.toStrict + Test.Reporter.Internal.renderSrcLoc loc src + |> Text.Colour.renderChunksBS Text.Colour.WithoutColours |> TE.decodeUtf8 |> (\srcStr -> srcStr ++ "\n" ++ msg) in JUnit.failed (Internal.name test) diff --git a/src/Test/Reporter/Stdout.hs b/src/Test/Reporter/Stdout.hs --- a/src/Test/Reporter/Stdout.hs +++ b/src/Test/Reporter/Stdout.hs @@ -8,172 +8,169 @@ import qualified Control.Exception as Exception import qualified Data.ByteString as BS -import qualified Data.ByteString.Builder as Builder -import qualified Data.Text.Encoding as TE import qualified GHC.Stack as Stack import qualified List import NriPrelude -import qualified System.Console.ANSI as ANSI import qualified System.IO import qualified Test.Internal as Internal -import Test.Reporter.Internal (black, green, grey, red, sgr, underlined, yellow) +import Test.Reporter.Internal (black, green, grey, red, yellow) import qualified Test.Reporter.Internal +import qualified Text +import Text.Colour (chunk) +import qualified Text.Colour import qualified Tuple import qualified Prelude report :: System.IO.Handle -> Internal.SuiteResult -> Prelude.IO () report handle results = do - color <- ANSI.hSupportsANSIColor handle - let styled = - if color - then (\styles builder -> sgr styles ++ builder ++ sgr [ANSI.Reset]) - else (\_ builder -> builder) - reportByteString <- renderReport styled results - Builder.hPutBuilder handle reportByteString + terminalCapabilities <- Text.Colour.getTerminalCapabilitiesFromHandle handle + reportChunks <- renderReport results + Text.Colour.hPutChunksWith terminalCapabilities handle reportChunks System.IO.hFlush handle -renderReport :: - ([ANSI.SGR] -> Builder.Builder -> Builder.Builder) -> - Internal.SuiteResult -> - Prelude.IO Builder.Builder -renderReport styled results = +renderReport :: Internal.SuiteResult -> Prelude.IO (List (Text.Colour.Chunk)) +renderReport results = case results of Internal.AllPassed passed -> let amountPassed = List.length passed in Prelude.pure - ( styled [green, underlined] "TEST RUN PASSED" - ++ "\n\n" - ++ styled [black] ("Passed: " ++ Builder.int64Dec amountPassed) - ++ "\n" - ) + [ green (Text.Colour.underline "TEST RUN PASSED"), + "\n\n", + black (chunk <| "Passed: " ++ Text.fromInt amountPassed), + "\n" + ] Internal.OnlysPassed passed skipped -> let amountPassed = List.length passed amountSkipped = List.length skipped in Prelude.pure - ( Prelude.foldMap - ( \only -> - prettyPath styled [yellow] only - ++ "This test passed, but there is a `Test.only` in your test.\n" - ++ "I failed the test, because it's easy to forget to remove `Test.only`.\n" - ++ "\n\n" - ) - passed - ++ styled [yellow, underlined] "TEST RUN INCOMPLETE" - ++ styled [yellow] " because there is an `only` in your tests." - ++ "\n\n" - ++ styled [black] ("Passed: " ++ Builder.int64Dec amountPassed) - ++ "\n" - ++ styled [black] ("Skipped: " ++ Builder.int64Dec amountSkipped) - ++ "\n" - ) + <| List.concat + [ List.concatMap + ( \only -> + prettyPath yellow only + ++ [ "This test passed, but there is a `Test.only` in your test.\n", + "I failed the test, because it's easy to forget to remove `Test.only`.\n", + "\n\n" + ] + ) + passed, + [ yellow (Text.Colour.underline ("TEST RUN INCOMPLETE")), + yellow " because there is an `only` in your tests.", + "\n\n", + black (chunk <| "Passed: " ++ Text.fromInt amountPassed), + "\n", + black (chunk <| "Skipped: " ++ Text.fromInt amountSkipped), + "\n" + ] + ] Internal.PassedWithSkipped passed skipped -> let amountPassed = List.length passed amountSkipped = List.length skipped in Prelude.pure - ( Prelude.foldMap - ( \only -> - prettyPath styled [yellow] only - ++ "This test was skipped." - ++ "\n\n" - ) - skipped - ++ styled [yellow, underlined] "TEST RUN INCOMPLETE" - ++ styled - [yellow] - ( case List.length skipped of - 1 -> " because 1 test was skipped" - n -> " because " ++ Builder.int64Dec n ++ " tests were skipped" + <| List.concat + [ List.concatMap + ( \only -> + prettyPath yellow only + ++ [ "This test was skipped.", + "\n\n" + ] ) - ++ "\n\n" - ++ styled [black] ("Passed: " ++ Builder.int64Dec amountPassed) - ++ "\n" - ++ styled [black] ("Skipped: " ++ Builder.int64Dec amountSkipped) - ++ "\n" - ) + skipped, + [ yellow (Text.Colour.underline "TEST RUN INCOMPLETE"), + yellow + ( chunk <| case List.length skipped of + 1 -> " because 1 test was skipped" + n -> " because " ++ Text.fromInt n ++ " tests were skipped" + ), + "\n\n", + black (chunk <| "Passed: " ++ Text.fromInt amountPassed), + "\n", + black (chunk <| "Skipped: " ++ Text.fromInt amountSkipped), + "\n" + ] + ] Internal.TestsFailed passed skipped failed -> do let amountPassed = List.length passed let amountFailed = List.length failed let amountSkipped = List.length skipped let failures = List.map (map Tuple.second) failed srcLocs <- Prelude.traverse Test.Reporter.Internal.readSrcLoc failures - let failuresSrcs = List.map (renderFailureInFile styled) srcLocs + let failuresSrcs = List.map renderFailureInFile srcLocs Prelude.pure - ( Prelude.foldMap - ( \(srcLines, test) -> - prettyPath styled [red] test - ++ srcLines - ++ testFailure test - ++ "\n\n" - ) - (List.map2 (,) failuresSrcs failures) - ++ styled [red, underlined] "TEST RUN FAILED" - ++ "\n\n" - ++ styled [black] ("Passed: " ++ Builder.int64Dec amountPassed) - ++ "\n" - ++ ( if amountSkipped == 0 - then "" - else - styled [black] ("Skipped: " ++ Builder.int64Dec amountSkipped) - ++ "\n" - ) - ++ styled [black] ("Failed: " ++ Builder.int64Dec amountFailed) - ++ "\n" - ) + <| List.concat + [ List.concat + <| List.map2 + ( \srcLines test -> + prettyPath red test + ++ srcLines + ++ [testFailure test, "\n\n"] + ) + failuresSrcs + failures, + [ red (Text.Colour.underline "TEST RUN FAILED"), + "\n\n", + black (chunk <| "Passed: " ++ Text.fromInt amountPassed), + "\n" + ], + if amountSkipped == 0 + then [] + else + [ black (chunk <| "Skipped: " ++ Text.fromInt amountSkipped), + "\n" + ], + [black (chunk <| "Failed: " ++ Text.fromInt amountFailed), "\n"] + ] Internal.NoTestsInSuite -> Prelude.pure - ( styled [yellow, underlined] "TEST RUN INCOMPLETE" - ++ styled [yellow] (" because the test suite is empty.") - ++ "\n" - ) + [ yellow (Text.Colour.underline "TEST RUN INCOMPLETE"), + yellow " because the test suite is empty.", + "\n" + ] -renderFailureInFile :: - ([ANSI.SGR] -> Builder.Builder -> Builder.Builder) -> - Maybe (Stack.SrcLoc, BS.ByteString) -> - Builder.Builder -renderFailureInFile styled maybeSrcLoc = +renderFailureInFile :: Maybe (Stack.SrcLoc, BS.ByteString) -> List Text.Colour.Chunk +renderFailureInFile maybeSrcLoc = case maybeSrcLoc of - Just (loc, src) -> - Test.Reporter.Internal.renderSrcLoc styled loc src - Nothing -> "" + Just (loc, src) -> Test.Reporter.Internal.renderSrcLoc loc src + Nothing -> [] -prettyPath :: - ([ANSI.SGR] -> Builder.Builder -> Builder.Builder) -> - [ANSI.SGR] -> - Internal.SingleTest a -> - Builder.Builder -prettyPath styled styles test = - ( case Internal.loc test of - Nothing -> "" - Just loc -> - styled - [grey] - ( "↓ " - ++ Builder.stringUtf8 (Stack.srcLocFile loc) - ++ ":" - ++ Builder.intDec (Stack.srcLocStartLine loc) - ++ "\n" - ) - ) - ++ Prelude.foldMap - (\text -> styled [grey] ("↓ " ++ TE.encodeUtf8Builder text) ++ "\n") - (Internal.describes test) - ++ styled styles ("✗ " ++ TE.encodeUtf8Builder (Internal.name test)) - ++ "\n" +prettyPath :: (Text.Colour.Chunk -> Text.Colour.Chunk) -> Internal.SingleTest a -> List Text.Colour.Chunk +prettyPath style test = + List.concat + [ case Internal.loc test of + Nothing -> [] + Just loc -> + [ grey + <| chunk + ( "↓ " + ++ Text.fromList (Stack.srcLocFile loc) + ++ ":" + ++ Text.fromInt (Prelude.fromIntegral (Stack.srcLocStartLine loc)) + ++ "\n" + ) + ], + [ grey + ( chunk + <| Prelude.foldMap + (\text -> "↓ " ++ text ++ "\n") + (Internal.describes test) + ), + style (chunk ("✗ " ++ Internal.name test)), + "\n" + ] + ] -testFailure :: Internal.SingleTest Internal.Failure -> Builder.Builder +testFailure :: Internal.SingleTest Internal.Failure -> Text.Colour.Chunk testFailure test = - case Internal.body test of - Internal.FailedAssertion msg _ -> - TE.encodeUtf8Builder msg - Internal.ThrewException exception -> - "Test threw an exception\n" - ++ Builder.stringUtf8 (Exception.displayException exception) - Internal.TookTooLong -> - "Test timed out" - Internal.TestRunnerMessedUp msg -> - "Test runner encountered an unexpected error:\n" - ++ TE.encodeUtf8Builder msg - ++ "\n" - ++ "This is a bug.\n\n" - ++ "If you have some time to report the bug it would be much appreciated!\n" - ++ "You can do so here: https://github.com/NoRedInk/haskell-libraries/issues" + chunk + <| case Internal.body test of + Internal.FailedAssertion msg _ -> msg + Internal.ThrewException exception -> + "Test threw an exception\n" + ++ Text.fromList (Exception.displayException exception) + Internal.TookTooLong -> "Test timed out" + Internal.TestRunnerMessedUp msg -> + "Test runner encountered an unexpected error:\n" + ++ msg + ++ "\n" + ++ "This is a bug.\n\n" + ++ "If you have some time to report the bug it would be much appreciated!\n" + ++ "You can do so here: https://github.com/NoRedInk/haskell-libraries/issues"