nri-prelude 0.4.0.0 → 0.5.0.0

raw patch · 7 files changed

+210/−127 lines, 7 filesdep ~pretty-diffnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: pretty-diff

API changes (from Hackage documentation)

Files

• CHANGELOG.md +20/−5
• nri-prelude.cabal +3/−5
• src/Expect.hs +82/−10
• src/Log.hs +58/−78
• src/Test.hs +4/−0
• tests/LogSpec.hs +10/−13
• tests/TestSpec.hs +33/−16

@@ -1,12 +1,27 @@+# Unreleased next version++# 0.5.0.0++### Breaking changes:++- replace Log.userIs\* functions with more standard debug, info, warn, error (#48)++### Enhancements:++- Improved diff representation in failing tests. (#40, #41, #43, #44)+- Ported floating point comparison expectations from elm-test. (#41, #42)+  - FloatingPointTolerance (..), within, notWithin+- Expect.equalToContentsOf now includes proper stack traces (is this a bugfix? Let's call it an enhancement.) (#40)+ # 0.4.0.0 -Breraking changes:+### Breaking changes:  - `Expect.Task` has been removed. Most of it's functionality has been moved into `Expect`. - `Test.task` has been removed. Regular `Test.test` now supports monadic-style test writing. - `Expect.concat` has been removed. `do`-notation can now be used to run multiple expectations. -Enhancements:+### Enhancements:  - Test failure diffs now look much nicer if they contain multi-line output. - Test failures now show a snippet of the source code around the location of the failure.@@ -15,21 +30,21 @@  # 0.3.1.0 -Enhancements:+### Enhancements:  - `Platform.summary` can be used to decorate tracing spans with a text summary for use in dev tooling. - `Platform.writeSpanToDevLog` can be used to write a span for consumption by the new `log-explorer` tool.  # 0.3.0.0 -Breaking changs:+### Breaking changes:  - `Test.fromTestTree` has been removed. - `Fuzz.Fuzzer` is now an opague type and no a synonomy for `Hedgehog.Gen`. - `Expect.Task.TestFailure` renamed to `Expect.Task.failure`. - `Test.Runner.Tasy.main` renamed to `Test.run`. -Enhancements:+### Enhancements:  - Test reports now show source locations of failing tests. - `Fuzz` module has been extended and now covers almost the entire API of its Elm counterpart.

@@ -3,11 +3,9 @@ -- This file has been generated from package.yaml by hpack version 0.34.2. -- -- see: https://github.com/sol/hpack------ hash: 9de151f00a54609abe9dc131919b9b3ee60e55d86f4b08a01e852b2a62b118f5  name:           nri-prelude-version:        0.4.0.0+version:        0.5.0.0 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@@ -86,7 +84,7 @@     , ghc >=8.6.1 && <8.11     , hedgehog >=1.0.2 && <1.1     , junit-xml >=0.1.0.0 && <0.2.0.0-    , pretty-diff >=0.4.0.0 && <0.5+    , pretty-diff >=0.4.0.2 && <0.5     , pretty-show >=1.9.5 && <1.11     , safe-exceptions >=0.1.7.0 && <1.3     , terminal-size >=0.3.2.1 && <0.4@@ -161,7 +159,7 @@     , ghc >=8.6.1 && <8.11     , hedgehog >=1.0.2 && <1.1     , junit-xml >=0.1.0.0 && <0.2.0.0-    , pretty-diff >=0.4.0.0 && <0.5+    , pretty-diff >=0.4.0.2 && <0.5     , pretty-show >=1.9.5 && <1.11     , safe-exceptions >=0.1.7.0 && <1.3     , terminal-size >=0.3.2.1 && <0.4

@@ -1,6 +1,6 @@ {-# LANGUAGE RankNTypes #-} --- |  A library to create @Expectation@s, which describe a claim to be tested.+-- | A library to create @Expectation@s, which describe a claim to be tested. -- -- = Quick Reference --@@ -20,6 +20,11 @@     all,     equalToContentsOf, +    -- * Floating Point Comparisons+    FloatingPointTolerance (..),+    within,+    notWithin,+     -- * Numeric Comparisons     lessThan,     atMost,@@ -265,6 +270,67 @@ atLeast :: (Stack.HasCallStack, Show a, Ord a) => a -> a -> Expectation atLeast = Stack.withFrozenCallStack assert (<=) "Expect.atLeast" +-- | A type to describe how close a floating point number must be to the+-- expected value for the test to pass. This may be specified as absolute or+-- relative.+--+-- 'AbsoluteOrRelative' tolerance uses a logical OR between the absolute+-- (specified first) and relative tolerance. If you want a logical AND, use+-- 'Expect.all'.+data FloatingPointTolerance+  = Absolute Float+  | Relative Float+  | AbsoluteOrRelative Float Float+  deriving (Show)++-- | Passes if the second and third arguments are equal within a tolerance+-- specified by the first argument. This is intended to avoid failing because+-- of minor inaccuracies introduced by floating point arithmetic.+--+-- > -- Fails because 0.1 + 0.2 == 0.30000000000000004 (0.1 is non-terminating in base 2)+-- > 0.1 + 0.2 |> Expect.equal 0.3+-- >+-- > -- So instead write this test, which passes+-- > 0.1 + 0.2 |> Expect.within (Absolute 0.000000001) 0.3+--+-- Failures resemble code written in pipeline style, so you can tell which argument is which:+--+-- > -- Fails because 3.14 is not close enough to pi+-- > 3.14 |> Expect.within (Absolute 0.0001) pi+-- >+-- > {-+-- >+-- > 3.14+-- > ╷+-- > │ Expect.within Absolute 0.0001+-- > ╵+-- > 3.141592653589793+-- >+-- > -}+within :: (Stack.HasCallStack) => FloatingPointTolerance -> Float -> Float -> Expectation+within tolerance =+  Stack.withFrozenCallStack+    assert+    (withinHelper tolerance)+    ("Expect.within " ++ Data.Text.pack (Prelude.show tolerance))++-- | Passes if (and only if) a call to within with the same arguments would have failed.+notWithin :: (Stack.HasCallStack) => FloatingPointTolerance -> Float -> Float -> Expectation+notWithin tolerance =+  Stack.withFrozenCallStack+    assert+    (\expected actual -> not (withinHelper tolerance expected actual))+    ("Expect.notWithin " ++ Data.Text.pack (Prelude.show tolerance))++withinHelper :: FloatingPointTolerance -> Float -> Float -> Bool+withinHelper tolerance expected actual =+  case tolerance of+    Absolute absTolerance -> abs (actual - expected) <= absTolerance+    Relative relTolerance -> abs (actual - expected) / expected <= relTolerance+    AbsoluteOrRelative absTolerance relTolerance ->+      withinHelper (Absolute absTolerance) expected actual+        || withinHelper (Relative relTolerance) expected actual+ -- | Passes if the argument is 'True', and otherwise fails with the given message. -- -- > Expect.true "Expected the list to be empty." (List.isEmpty [])@@ -283,7 +349,10 @@ -- > -- > -} true :: Stack.HasCallStack => Bool -> Expectation-true x = Stack.withFrozenCallStack assert (&&) "Expect.true" x True+true x =+  if x+    then Stack.withFrozenCallStack Internal.pass "Expect.true" ()+    else Stack.withFrozenCallStack Internal.failAssertion "Expect.true" "I expected a True but got False"  -- | Passes if the argument is 'False', and otherwise fails with the given message. --@@ -303,7 +372,10 @@ -- > -- > -} false :: Stack.HasCallStack => Bool -> Expectation-false x = Stack.withFrozenCallStack assert xor "Expect.false" x True+false x =+  if x+    then Stack.withFrozenCallStack Internal.failAssertion "Expect.false" "I expected a False but got True"+    else Stack.withFrozenCallStack Internal.pass "Expect.false" ()  -- | Passes if each of the given functions passes when applied to the subject. --@@ -429,7 +501,7 @@ -- encodings. When a test fails we can throw away the file, rerun the test, and -- use @git diff golden-results/complicated-object.txt@ to check whether the -- changes are acceptable.-equalToContentsOf :: Text -> Text -> Expectation+equalToContentsOf :: Stack.HasCallStack => Text -> Text -> Expectation equalToContentsOf filepath' actual = do   let filepath = Data.Text.unpack filepath'   exists <-@@ -442,14 +514,14 @@       Stack.withFrozenCallStack         assert         (==)-        "Expect.equalToContentsOf"+        ("Expect.equalToContentsOf " ++ filepath')         (UnescapedShow expected)         (UnescapedShow actual)     else do       fromIO (Data.Text.IO.writeFile filepath actual)       Stack.withFrozenCallStack         Internal.pass-        "Expect.equalToContentsOf"+        ("Expect.equalToContentsOf " ++ filepath')         ()  -- By default we will compare values with each other after they have been@@ -473,16 +545,16 @@   show (UnescapedShow text) = Data.Text.unpack text  assert :: (Stack.HasCallStack, Show a) => (a -> a -> Bool) -> Text -> a -> a -> Expectation-assert pred funcName actual expected =-  if pred actual expected+assert pred funcName expected actual =+  if pred expected actual     then Stack.withFrozenCallStack Internal.pass funcName ()     else do       window <- fromIO Terminal.size       let terminalWidth = case window of             Just Terminal.Window {Terminal.width} -> width - 4 -- indentation             Nothing -> 80-      let expectedText = Data.Text.pack (Text.Show.Pretty.ppShow expected)-      let actualText = Data.Text.pack (Text.Show.Pretty.ppShow actual)+      let expectedText = Data.Text.pack (Text.Show.Pretty.ppShow actual)+      let actualText = Data.Text.pack (Text.Show.Pretty.ppShow expected)       let numLines text = List.length (Data.Text.lines text)       Stack.withFrozenCallStack Internal.failAssertion funcName         <| Diff.pretty

@@ -10,11 +10,10 @@ -- This module does not have an Elm counterpart. module Log   ( -- * Logging+    debug,     info,-    userIsAnnoyed,-    userIsConfused,-    userIsPained,-    userIsBlocked,+    warn,+    error,     withContext,     context, @@ -26,8 +25,6 @@     -- * For use in observability modules     Context (..),     LogContexts (..),-    TriageInfo (..),-    Impact (..),   ) where @@ -41,6 +38,21 @@ import qualified Text.Show import qualified Prelude +-- | A log message that is probably only useful in development, or when we're+-- really confused about something and need ALL THE CONTEXT.+--+-- In addition to a log message you can pass additional key-value pairs with+-- information that might be relevant for debugging.+--+-- > debug "Computation partially succeeded" [context "answer" 2]+debug :: Stack.HasCallStack => Text -> [Context] -> Task e ()+debug message contexts =+  Stack.withFrozenCallStack+    log+    message+    ReportAsSucceeded+    (Context "level" Debug : contexts)+ -- | A log message useful for when things have gone off the rails. -- We should have a ton of messages at this level. -- It should help us out when we're dealing with something hard.@@ -50,52 +62,43 @@ -- -- > info "I added 1 and 1" [context "answer" 2] info :: Stack.HasCallStack => Text -> [Context] -> Task e ()-info message contexts = Stack.withFrozenCallStack log message ReportAsSucceeded contexts+info message contexts =+  Stack.withFrozenCallStack+    log+    message+    ReportAsSucceeded+    (Context "level" Info : contexts) --- | A log message when the user is annoyed, but not blocked.+-- | A log message when something went wrong, but it did not go wrong in a way+-- to totally break the thing we're doing. These should be triaged and fixed+-- soon, but aren't show-stoppers. ----- > Log.userIsAnnoyed--- >   "We poked the user unnecessarily."--- >   "Try to stop poking the user."--- >   [ Log.context "The type of poking stick" poker ]-userIsAnnoyed :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()-userIsAnnoyed message advisory contexts =-  let triage = TriageInfo UserAnnoyed advisory-   in Stack.withFrozenCallStack-        log-        message-        ReportAsFailed-        (Context "triage" triage : contexts)---- | Like 'userIsAnnoyed', but when the user is userIsConfused.-userIsConfused :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()-userIsConfused message advisory contexts =-  let triage = TriageInfo UserConfused advisory-   in Stack.withFrozenCallStack-        log-        message-        ReportAsFailed-        (Context "triage" triage : contexts)---- | Like 'userIsAnnoyed', but when the user is in pain.-userIsPained :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()-userIsPained message advisory contexts =-  let triage = TriageInfo UserInPain advisory-   in Stack.withFrozenCallStack-        log-        message-        ReportAsFailed-        (Context "triage" triage : contexts)+-- In addition to a log message you can pass additional key-value pairs with+-- information that might be relevant for debugging.+--+-- > warn "This field was sent, but we're gonna deprecate it!" []+warn :: Stack.HasCallStack => Text -> [Context] -> Task e ()+warn message contexts =+  Stack.withFrozenCallStack+    log+    message+    ReportAsFailed+    (Context "level" Warn : contexts) --- | Like 'userIsAnnoyed', but when the user is blocked.-userIsBlocked :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()-userIsBlocked message advisory contexts =-  let triage = TriageInfo UserBlocked advisory-   in Stack.withFrozenCallStack-        log-        message-        ReportAsFailed-        (Context "triage" triage : contexts)+-- | A log message when we can't continue with what we were trying to do+-- because of a problem.+--+-- In addition to a log message you can pass additional key-value pairs with+-- information that might be relevant for debugging.+--+-- > error "The user tried to request this thing, but they aren't allowed!" []+error :: Stack.HasCallStack => Text -> [Context] -> Task e ()+error message contexts =+  Stack.withFrozenCallStack+    log+    message+    ReportAsFailed+    (Context "level" Error : contexts)  -- | Mark a block of code as a logical unit by giving it a name. This name will -- be used in logs and monitoring dashboards, so use this function to help@@ -216,37 +219,14 @@ -- TRIAGE -- --- | A logged message for log levels warning and above. Because these levels--- indicate a (potential) problem we want to provide some additional data that--- would help a triager figure out what next steps to take.-data TriageInfo = TriageInfo-  { impact :: Impact,-    advisory :: Text-  }+data LogLevel+  = Debug+  | Info+  | Warn+  | Error   deriving (Generic) -instance Aeson.ToJSON TriageInfo---- | Classification of the levels of impact an issue might have on end-users.-data Impact-  = UserAnnoyed-  | UserConfused-  | UserInPain-  | UserBlocked-  deriving (Show)--instance Aeson.ToJSON Impact where-  toJSON = Aeson.toJSON << impactToText--  toEncoding = Aeson.toEncoding << impactToText--impactToText :: Impact -> Text-impactToText kind =-  case kind of-    UserAnnoyed -> "This is causing inconveniences to users but they will be able to achieve want they want."-    UserBlocked -> "User is blocked from performing an action."-    UserConfused -> "The UI did something unexpected and it's unclear why."-    UserInPain -> "This is causing pain to users and workaround is not obvious."+instance Aeson.ToJSON LogLevel  -- ReportAsFailed marks the request as a failure in logging, but has no impact on the resulting Task. E.g. will not trigger a 500 error but will report an error to, e.g. BugSnag. data ReportStatus = ReportAsFailed | ReportAsSucceeded

@@ -19,6 +19,7 @@ where  import qualified Control.Concurrent.Async as Async+import qualified GHC.IO.Encoding import qualified GHC.Stack as Stack import NriPrelude import qualified Platform@@ -45,6 +46,9 @@ -- > main = Test.run (Test.todo "write your tests here!") run :: Stack.HasCallStack => Internal.Test -> Prelude.IO () run suite = do+  -- Work around `hGetContents: invalid argument (invalid byte sequence)` bug on+  -- Nix: https://github.com/dhall-lang/dhall-haskell/issues/865+  GHC.IO.Encoding.setLocaleEncoding System.IO.utf8   log <- Platform.silentHandler   (results, logExplorerAvailable) <-     Async.concurrently

@@ -31,48 +31,45 @@         spans           |> Debug.toString           |> Expect.equalToContentsOf "tests/golden-results/log-info",-      test "`userIsAnnoyed` produces expected debugging info" <| \_ -> do+      test "`debug` produces expected debugging info" <| \_ -> do         spans <-           Expect.fromIO <| do             (recordedTracingSpans, handler) <- newHandler             _ <--              userIsAnnoyed-                "the button didn't work"-                "fix the button"+              debug+                "pressed the button"                 [context "button" ("PRESS" :: Text)]                 |> Task.attempt handler             recordedTracingSpans         spans           |> Debug.toString-          |> Expect.equalToContentsOf "tests/golden-results/log-user-is-annoyed",-      test "`userIsPained` produces expected debugging info" <| \_ -> do+          |> Expect.equalToContentsOf "tests/golden-results/debug",+      test "`warn` produces expected debugging info" <| \_ -> do         spans <-           Expect.fromIO <| do             (recordedTracingSpans, handler) <- newHandler             _ <--              userIsPained+              warn                 "user cut themselves on the modal"-                "file modal's sharp edges"                 [context "modal" ("SURPRISE!" :: Text)]                 |> Task.attempt handler             recordedTracingSpans         spans           |> Debug.toString-          |> Expect.equalToContentsOf "tests/golden-results/log-user-is-pained",-      test "`userIsBlocked` produces expected debugging info" <| \_ -> do+          |> Expect.equalToContentsOf "tests/golden-results/warn",+      test "`error` produces expected debugging info" <| \_ -> do         spans <-           Expect.fromIO <| do             (recordedTracingSpans, handler) <- newHandler             _ <--              userIsBlocked+              error                 "door is blocked"-                "find key"                 [context "house number" (5 :: Int)]                 |> Task.attempt handler             recordedTracingSpans         spans           |> Debug.toString-          |> Expect.equalToContentsOf "tests/golden-results/log-user-is-blocked",+          |> Expect.equalToContentsOf "tests/golden-results/error",       test "nested spans pruduce expected debugging info" <| \_ -> do         spans <-           Expect.fromIO <| do

@@ -25,6 +25,7 @@   describe     "Test"     [ api,+      floatComparison,       stdoutReporter,       logfileReporter     ]@@ -127,6 +128,21 @@           |> expectSingleTest (expectSrcFile "tests/TestSpec.hs")     ] +floatComparison :: Test+floatComparison =+  describe+    "Float comparison expectations"+    [ test "Expect.within" <| \_ -> do+        Expect.within (Expect.Absolute 1) 0.1 0.5+        Expect.within (Expect.Relative 1) 3 5+        Expect.within (Expect.AbsoluteOrRelative 1 1) 0.1 0.5+        Expect.within (Expect.AbsoluteOrRelative 1 1) 3 5,+      test "Expect.notWithin" <| \_ -> do+        Expect.notWithin (Expect.Absolute 1) 3 5+        Expect.notWithin (Expect.Relative 1) 0.1 0.5+        Expect.notWithin (Expect.AbsoluteOrRelative 1 1) 3 10+    ]+ expectSingleTest ::   (Internal.SingleTest Internal.Expectation -> Expect.Expectation) ->   Test ->@@ -256,29 +272,30 @@         let suite =               describe                 "suite loc"-                [ test "test 1" (\_ -> Expect.fail "fail"),-                  test "test 2" (\_ -> Expect.equal True False),-                  test "test 3" (\_ -> Expect.notEqual True True),+                [ test "test fail" (\_ -> Expect.fail "fail"),+                  test "test equal" (\_ -> Expect.equal True False),+                  test "test notEqual" (\_ -> Expect.notEqual True True),                   test-                    "test 4"+                    "test all"                     ( \_ ->                         True                           |> Expect.all                             [ Expect.equal False                             ]                     ),-                  test "test 5" (\_ -> Expect.lessThan 1 (2 :: Int)),-                  test "test 6" (\_ -> Expect.atMost 1 (2 :: Int)),-                  test "test 7" (\_ -> Expect.greaterThan 2 (1 :: Int)),-                  test "test 8" (\_ -> Expect.atLeast 2 (1 :: Int)),-                  test "test 9" (\_ -> Expect.atLeast 2 (1 :: Int)),-                  test "test 10" (\_ -> Expect.true False),-                  test "test 11" (\_ -> Expect.false True),-                  test "test 12" (\_ -> Expect.ok (Err ())),-                  test "test 13" (\_ -> Expect.err (Ok ())),-                  test "test 14" (\_ -> Expect.succeeds (Task.fail "oops")),-                  test "test 15" (\_ -> Expect.fails (Task.succeed "oops")),-                  test "test 16" (\_ -> Task.succeed (1 :: Int) |> Expect.andCheck (Expect.equal 2) |> map (\_ -> ()))+                  test "test lessThan" (\_ -> Expect.lessThan 1 (2 :: Int)),+                  test "test astMost" (\_ -> Expect.atMost 1 (2 :: Int)),+                  test "test greatherThan" (\_ -> Expect.greaterThan 2 (1 :: Int)),+                  test "test atLeast" (\_ -> Expect.atLeast 2 (1 :: Int)),+                  test "test within" (\_ -> Expect.within (Expect.Absolute 0.1) 1 2),+                  test "test notWithin" (\_ -> Expect.notWithin (Expect.Relative 0.1) 1 1),+                  test "test true" (\_ -> Expect.true False),+                  test "test false" (\_ -> Expect.false True),+                  test "test ok" (\_ -> Expect.ok (Err ())),+                  test "test err" (\_ -> Expect.err (Ok ())),+                  test "test succeeds" (\_ -> Expect.succeeds (Task.fail "oops")),+                  test "test fails" (\_ -> Expect.fails (Task.succeed "oops")),+                  test "test andCheck" (\_ -> Task.succeed (1 :: Int) |> Expect.andCheck (Expect.equal 2) |> map (\_ -> ()))                 ]         contents <-           withTempFile