nri-prelude 0.5.0.1 → 0.5.0.2
raw patch · 5 files changed
+178/−185 lines, 5 filesdep +safe-coloured-textdep −ansi-terminaldep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: safe-coloured-text
Dependencies removed: ansi-terminal
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- CHANGELOG.md +6/−0
- nri-prelude.cabal +5/−5
- src/Test/Reporter/Internal.hs +38/−46
- src/Test/Reporter/Junit.hs +3/−5
- src/Test/Reporter/Stdout.hs +126/−129
CHANGELOG.md view
@@ -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:
nri-prelude.cabal view
@@ -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 <https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-prelude>. 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
src/Test/Reporter/Internal.hs view
@@ -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
src/Test/Reporter/Junit.hs view
@@ -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)
src/Test/Reporter/Stdout.hs view
@@ -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"