nri-prelude 0.3.0.0 → 0.3.1.0
raw patch · 12 files changed
+546/−29 lines, 12 filesdep +aeson-prettyPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: aeson-pretty
API changes (from Hackage documentation)
+ Platform: setTracingSpanSummary :: Text -> Task e ()
+ Platform: setTracingSpanSummaryIO :: LogHandler -> Text -> IO ()
+ Platform: summary :: TracingSpan -> Maybe Text
+ Platform: writeSpanToDevLog :: TracingSpan -> IO ()
- Test: run :: Test -> IO ()
+ Test: run :: HasCallStack => Test -> IO ()
Files
- CHANGELOG.md +7/−0
- LICENSE +1/−1
- nri-prelude.cabal +9/−3
- src/Log.hs +4/−1
- src/Platform.hs +7/−0
- src/Platform/DevLog.hs +39/−0
- src/Platform/Internal.hs +203/−9
- src/Test.hs +44/−9
- src/Test/Internal.hs +18/−4
- src/Test/Reporter/Logfile.hs +119/−0
- tests/DebugSpec.hs +1/−1
- tests/TestSpec.hs +94/−1
CHANGELOG.md view
@@ -1,3 +1,10 @@+# 0.3.1.0++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:
LICENSE view
@@ -1,6 +1,6 @@ BSD 3-Clause License -Copyright (c) 2020, NoRedInk+Copyright (c) 2021, NoRedInk All rights reserved. Redistribution and use in source and binary forms, with or without
nri-prelude.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 2de1014852d15f8dc7dd66b6540283d0fe7b3997b91e1a08d6f0ee4f5ea76271+-- hash: 289dd9fd1e47c8a3adb825dd181635cdff04f29f8f3744acb5e426d735d2c8ab name: nri-prelude-version: 0.3.0.0+version: 0.3.1.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@@ -15,7 +15,7 @@ bug-reports: https://github.com/NoRedInk/haskell-libraries/issues author: NoRedInk maintainer: haskell-open-source@noredink.com-copyright: 2020 NoRedInk Corp.+copyright: 2021 NoRedInk Corp. license: BSD3 license-file: LICENSE build-type: Simple@@ -57,11 +57,13 @@ other-modules: Internal.Shortcut Internal.Terminal+ Platform.DevLog Platform.DoAnything Platform.Internal Test.Internal Test.Reporter.ExitCode Test.Reporter.Junit+ Test.Reporter.Logfile Test.Reporter.Stdout Paths_nri_prelude hs-source-dirs:@@ -70,6 +72,7 @@ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wredundant-constraints -Wincomplete-uni-patterns 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@@ -119,6 +122,7 @@ Maybe NriPrelude Platform+ Platform.DevLog Platform.DoAnything Platform.Internal Process@@ -129,6 +133,7 @@ Test.Internal Test.Reporter.ExitCode Test.Reporter.Junit+ Test.Reporter.Logfile Test.Reporter.Stdout Text Tuple@@ -140,6 +145,7 @@ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wredundant-constraints -Wincomplete-uni-patterns -threaded -rtsopts "-with-rtsopts=-N -T" 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
src/Log.hs view
@@ -129,7 +129,10 @@ name ( Platform.finally task- (Platform.setTracingSpanDetails (LogContexts contexts))+ ( do+ Platform.setTracingSpanDetails (LogContexts contexts)+ Platform.setTracingSpanSummary name+ ) ) --
src/Platform.hs view
@@ -20,6 +20,8 @@ Internal.rootTracingSpanIO, Internal.setTracingSpanDetails, Internal.setTracingSpanDetailsIO,+ Internal.setTracingSpanSummary,+ Internal.setTracingSpanSummaryIO, Internal.markTracingSpanFailed, Internal.markTracingSpanFailedIO, @@ -31,6 +33,7 @@ Internal.finished, Internal.frame, Internal.details,+ Internal.summary, Internal.succeeded, Internal.allocated, Internal.children,@@ -42,6 +45,9 @@ Internal.MonotonicTime, Internal.inMicroseconds, + -- * Reporting spans to development tooling+ Platform.DevLog.writeSpanToDevLog,+ -- * Ensuring cleanup logic gets ran in case of exceptions. bracketWithError, finally,@@ -57,6 +63,7 @@ import qualified Data.Text import qualified GHC.Stack as Stack import NriPrelude+import qualified Platform.DevLog import qualified Platform.DoAnything as DoAnything import qualified Platform.Internal as Internal import qualified Task
+ src/Platform/DevLog.hs view
@@ -0,0 +1,39 @@+{-# OPTIONS_GHC -fno-cse #-}++module Platform.DevLog+ ( writeSpanToDevLog,+ )+where++import qualified Control.Concurrent.MVar as MVar+import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Lazy+import qualified Data.Time as Time+import NriPrelude+import qualified Platform.Internal+import qualified System.IO+import qualified System.IO.Unsafe+import qualified Prelude++-- | Write a tracing span to the development log, where it can be found by+-- `log-explorer` for closer inspection.+writeSpanToDevLog :: Platform.Internal.TracingSpan -> Prelude.IO ()+writeSpanToDevLog span = do+ now <- Time.getCurrentTime+ let logFile = "/tmp/nri-prelude-logs"+ MVar.withMVar writeLock <| \_ ->+ System.IO.withFile+ logFile+ System.IO.AppendMode+ ( \handle -> do+ Data.ByteString.Lazy.hPut handle (Aeson.encode (now, span))+ Data.ByteString.Lazy.hPut handle "\n"+ )++-- A lock used to ensure writing spans to the dev log are atomic, processes will+-- take turns to fully write their spans to the log to prevent interleaving.+{-# NOINLINE writeLock #-}+writeLock :: MVar.MVar ()+writeLock =+ MVar.newMVar ()+ |> System.IO.Unsafe.unsafePerformIO
src/Platform/Internal.hs view
@@ -8,11 +8,14 @@ import Control.Applicative ((<|>)) import qualified Control.AutoUpdate as AutoUpdate import qualified Control.Exception.Safe as Exception+import Data.Aeson ((.:), (.:?), (.=)) import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Encoding as Aeson.Encoding import qualified Data.IORef as IORef import qualified Data.Text import qualified Data.Typeable as Typeable import qualified GHC.Clock as Clock+import GHC.Generics (Generic) import qualified GHC.Stack as Stack import qualified GHC.Word import qualified Internal.Shortcut as Shortcut@@ -134,6 +137,9 @@ frame :: Maybe (Text, Stack.SrcLoc), -- | Unique information for this tracingSpan. details :: Maybe SomeTracingSpanDetails,+ -- | A short blurb describing the details of this span, for use in+ -- tooling for inspecting these spans.+ summary :: Maybe Text, -- | Whether this tracingSpan succeeded. If any of the children of this -- tracingSpan failed, so will this tracingSpan. This will create a -- path to the tracingSpan closest to the failure from the root@@ -151,8 +157,117 @@ -- of the list. children :: [TracingSpan] }- deriving (Prelude.Show)+ deriving (Prelude.Show, Generic) +instance Aeson.ToJSON TracingSpan where+ toJSON span =+ Aeson.object+ [ "name" .= name span,+ "started" .= started span,+ "finished" .= finished span,+ "frame" .= map SrcLocForEncoding (frame span),+ "details" .= details span,+ "summary" .= summary span,+ "succeeded" .= succeeded span,+ "allocated" .= allocated span,+ "children" .= children span+ ]+ toEncoding span =+ Aeson.pairs+ ( "name" .= name span+ ++ "started" .= started span+ ++ "finished" .= finished span+ ++ "frame" .= map SrcLocForEncoding (frame span)+ ++ "details" .= details span+ ++ "summary" .= summary span+ ++ "succeeded" .= succeeded span+ ++ "allocated" .= allocated span+ ++ "children" .= children span+ )++instance Aeson.FromJSON TracingSpan where+ parseJSON =+ Aeson.withObject+ "TracingSpan"+ ( \object -> do+ name <- object .: "name"+ started <- object .: "started"+ finished <- object .: "finished"+ frame <- map (map unSrcLocForEncoding) (object .:? "frame")+ details <- object .:? "details"+ summary <- object .:? "summary"+ succeeded <- object .: "succeeded"+ allocated <- object .: "allocated"+ children <- object .: "children"+ Prelude.pure+ TracingSpan+ { name,+ started,+ finished,+ frame,+ details,+ summary,+ succeeded,+ allocated,+ children+ }+ )++newtype SrcLocForEncoding = SrcLocForEncoding {unSrcLocForEncoding :: (Text, Stack.SrcLoc)}++instance Aeson.ToJSON SrcLocForEncoding where+ toJSON (SrcLocForEncoding (name, loc)) =+ Aeson.object+ [ "name" .= name,+ "package" .= Stack.srcLocPackage loc,+ "module" .= Stack.srcLocModule loc,+ "file" .= Stack.srcLocFile loc,+ "startLine" .= Stack.srcLocStartLine loc,+ "startCol" .= Stack.srcLocStartCol loc,+ "endLine" .= Stack.srcLocEndLine loc,+ "endCol" .= Stack.srcLocEndCol loc+ ]+ toEncoding (SrcLocForEncoding (name, loc)) =+ Aeson.pairs+ ( "name" .= name+ ++ "package" .= Stack.srcLocPackage loc+ ++ "module" .= Stack.srcLocModule loc+ ++ "file" .= Stack.srcLocFile loc+ ++ "startLine" .= Stack.srcLocStartLine loc+ ++ "startCol" .= Stack.srcLocStartCol loc+ ++ "endLine" .= Stack.srcLocEndLine loc+ ++ "endCol" .= Stack.srcLocEndCol loc+ )++instance Aeson.FromJSON SrcLocForEncoding where+ parseJSON =+ Aeson.withObject+ "SrcLocForEncoding"+ ( \object -> do+ name <- object .: "name"+ srcLocPackage <- object .: "package"+ srcLocModule <- object .: "module"+ srcLocFile <- object .: "file"+ srcLocStartLine <- object .: "startLine"+ srcLocStartCol <- object .: "startCol"+ srcLocEndLine <- object .: "endLine"+ srcLocEndCol <- object .: "endCol"+ Prelude.pure+ ( SrcLocForEncoding+ ( name,+ Stack.SrcLoc+ { Stack.srcLocPackage,+ Stack.srcLocModule,+ Stack.srcLocFile,+ Stack.srcLocStartLine,+ Stack.srcLocStartCol,+ Stack.srcLocEndLine,+ Stack.srcLocEndCol+ }+ )+ )+ )+ -- | A tracing span containing default empty values for all fields. Usually we -- don't need this because TracingSpans get created for us when we evaluate -- tasks. This can be useful when testing reporting code to see if it produces@@ -165,6 +280,7 @@ finished = 0, frame = Nothing, details = Nothing,+ summary = Nothing, succeeded = Succeeded, allocated = 0, children = []@@ -188,6 +304,46 @@ FailedWith Exception.SomeException deriving (Prelude.Show) +instance Aeson.ToJSON Succeeded where+ toJSON Succeeded = Aeson.String "Succeeded"+ toJSON Failed = Aeson.String "Failed"+ toJSON (FailedWith exception) =+ Exception.displayException exception+ |> Data.Text.pack+ |> Aeson.String+ toEncoding Succeeded = Aeson.Encoding.text "Succeeded"+ toEncoding Failed = Aeson.Encoding.text "Failed"+ toEncoding (FailedWith exception) =+ Exception.displayException exception+ |> Aeson.Encoding.string++instance Aeson.FromJSON Succeeded where+ parseJSON =+ Aeson.withText+ "Succeeded"+ ( \text ->+ case text of+ "Succeeded" -> Prelude.pure Succeeded+ "Failed" -> Prelude.pure Failed+ _ ->+ ParsedException text+ |> Exception.toException+ |> FailedWith+ |> Prelude.pure+ )++-- Helper type for when we're decoding a TracingSpan. SomeException doesn't have+-- aeson instances for encoding or decoding. For encoding a SomeException we can+-- make something up, but we can never decode it back into the original+-- exception type. Hence this ParsedException for decoding into instead.+newtype ParsedException = ParsedException Text+ deriving (Aeson.ToJSON)++instance Prelude.Show ParsedException where+ show (ParsedException text) = Data.Text.unpack text++instance Exception.Exception ParsedException+ -- | If the first bit of code succeeded and the second failed, the combination -- of the two has failed as well. The @SemiGroup@ and @Monoid@ type instances -- for @Succeeded@ allow us to combine @Succeeded@ values in such a fashion.@@ -260,6 +416,12 @@ toEncoding (SomeTracingSpanDetails details) = Aeson.toEncoding details +instance Aeson.FromJSON SomeTracingSpanDetails where+ parseJSON x =+ Aeson.parseJSON x+ |> Prelude.fmap+ (toTracingSpanDetails << ParsedTracingSpandetails)+ instance TracingSpanDetails SomeTracingSpanDetails where toTracingSpanDetails details = details @@ -270,6 +432,17 @@ Aeson.encode details |> Prelude.show +-- | A container for tracing span details if we parsed them back from JSON.+-- We don't require users of this library to define FromJSON instances of their+-- own tracing span details because it's not necessary for logging, but to+-- support tooling reading data structures produced by this lib we'd still like+-- to be able to parse tracing spans from JSON. This helper type allows us to do+-- so.+newtype ParsedTracingSpandetails = ParsedTracingSpandetails Aeson.Value+ deriving (Aeson.ToJSON)++instance TracingSpanDetails ParsedTracingSpandetails+ -- | Every type we want to use as tracingSpan metadata needs a -- @TracingSpanDetails@ instance. The @TracingSpanDetails@ class fulfills -- these roles:@@ -366,6 +539,10 @@ -- become known as the tracingSpan runs, for example the response code -- of an HTTP request. setTracingSpanDetailsIO :: forall d. TracingSpanDetails d => d -> IO (),+ -- | Set a summary for the current tracingSpan. This is shown in tools+ -- used to inspect spans as a stand-in for the full tracingSpan details+ -- in places where we only have room to show a little text.+ setTracingSpanSummaryIO :: Text -> IO (), -- | Mark the current tracingSpan as failed. Some reporting backends -- will use this to decide whether a particular request is worth -- reporting on.@@ -405,6 +582,10 @@ updateIORef tracingSpanRef (\tracingSpan' -> tracingSpan' {details = Just (toTracingSpanDetails details')}),+ setTracingSpanSummaryIO = \text ->+ updateIORef+ tracingSpanRef+ (\tracingSpan' -> tracingSpan' {summary = Just text}), markTracingSpanFailedIO = updateIORef tracingSpanRef@@ -439,17 +620,29 @@ |> map Ok ) +-- | Set a summary for the tracingSpan created with the @tracingSpan@ function.+-- Like @tracingSpan@ this is intended for use in writing libraries that define+-- custom types of effects, such as database queries or http requests.+--+-- The summary is shown in tools used to inspect spans as a stand-in for the+-- full tracingSpan details in places where we only have room to show a little+-- text.+setTracingSpanSummary :: Text -> Task e ()+setTracingSpanSummary text =+ Task+ ( \handler ->+ setTracingSpanSummaryIO handler text+ |> map Ok+ )+ -- | Mark a tracingSpan created with the @tracingSpan@ function as failed. Like -- @tracingSpan@ this is intended for use in writing libraries that define -- custom types of effects, such as database queries or http requests. ----- tracingSpan "plane spotting" do--- spotPlanes--- |> Task.onError--- (\GlobalPandemicError -> do--- markTracingSpanFailed--- Task.fail GlobalPandemicError--- )+-- tracingSpan "holiday" do+-- Platform.finally+-- (readBook bookPick)+-- (setTracingSpanSummary "The Stone Sky") markTracingSpanFailed :: Task e () markTracingSpanFailed = Task (map Ok << markTracingSpanFailedIO)@@ -491,6 +684,7 @@ |> List.head |> Shortcut.map (Tuple.mapFirst Data.Text.pack), details = Nothing,+ summary = Nothing, succeeded = Succeeded, allocated = 0, children = []@@ -628,4 +822,4 @@ -- constant moment in the past. inMicroseconds :: GHC.Word.Word64 }- deriving (Prelude.Show, Prelude.Num, Prelude.Eq, Prelude.Ord)+ deriving (Prelude.Show, Prelude.Num, Prelude.Eq, Prelude.Ord, Aeson.ToJSON, Aeson.FromJSON)
src/Test.hs view
@@ -21,15 +21,19 @@ ) where +import qualified Control.Concurrent.Async as Async+import qualified GHC.Stack as Stack import NriPrelude import qualified Platform+import qualified Platform.DevLog+import qualified System.Directory import qualified System.Environment-import qualified System.FilePath as FilePath import qualified System.IO import qualified Task import qualified Test.Internal as Internal import qualified Test.Reporter.ExitCode import qualified Test.Reporter.Junit+import qualified Test.Reporter.Logfile import qualified Test.Reporter.Stdout import qualified Prelude @@ -42,20 +46,51 @@ -- > -- > main :: IO () -- > main = Test.run (Test.todo "write your tests here!")-run :: Internal.Test -> Prelude.IO ()+run :: Stack.HasCallStack => Internal.Test -> Prelude.IO () run suite = do log <- Platform.silentHandler- results <- Task.perform log (Internal.run suite)- Test.Reporter.Stdout.report System.IO.stdout results- args <- System.Environment.getArgs- case getPath args of- Nothing -> Prelude.pure ()- Just path -> Test.Reporter.Junit.report path results+ (results, logExplorerAvailable) <-+ Async.concurrently+ (Task.perform log (Internal.run suite))+ isLogExplorerAvailable+ Async.mapConcurrently_+ identity+ [ reportStdout results,+ Stack.withFrozenCallStack reportLogfile results,+ reportJunit results+ ]+ if logExplorerAvailable+ then Prelude.putStrLn "\nRun log-explorer in your shell to inspect logs collected during this test run."+ else Prelude.putStrLn "\nInstall the log-explorer tool to inspect logs collected during test runs. Find it at github.com/NoRedInk/haskell-libraries." Test.Reporter.ExitCode.report results -getPath :: [Prelude.String] -> Maybe FilePath.FilePath+reportStdout :: Internal.SuiteResult -> Prelude.IO ()+reportStdout results =+ Test.Reporter.Stdout.report System.IO.stdout results++reportLogfile :: Stack.HasCallStack => Internal.SuiteResult -> Prelude.IO ()+reportLogfile results =+ Stack.withFrozenCallStack+ Test.Reporter.Logfile.report+ Platform.DevLog.writeSpanToDevLog+ results++reportJunit :: Internal.SuiteResult -> Prelude.IO ()+reportJunit results =+ do+ args <- System.Environment.getArgs+ case getPath args of+ Nothing -> Prelude.pure ()+ Just path -> Test.Reporter.Junit.report path results++getPath :: [Prelude.String] -> Maybe Prelude.String getPath args = case args of [] -> Nothing "--xml" : path : _ -> Just path _ : rest -> getPath rest++isLogExplorerAvailable :: Prelude.IO Bool+isLogExplorerAvailable = do+ System.Directory.findExecutable "log-explorer"+ |> map (/= Nothing)
src/Test/Internal.hs view
@@ -412,7 +412,7 @@ Platform.Internal.rootTracingSpanIO "" (MVar.putMVar spanVar)- "run single test"+ "test" ( \log -> body test' |> unExpectation@@ -420,9 +420,23 @@ |> map Ok |> Task.perform log )- span <- MVar.takeMVar spanVar- res- |> map (\res' -> test' {body = (span, res')})+ let testRest =+ case res of+ Ok x -> x+ Err err -> never err+ span' <- MVar.takeMVar spanVar+ let span =+ span'+ { Platform.Internal.summary = Just (name test'),+ Platform.Internal.frame = map (\loc -> ("", loc)) (loc test'),+ Platform.Internal.succeeded = case testRest of+ Succeeded -> Platform.Internal.Succeeded+ Failed failure ->+ Exception.toException failure+ |> Platform.Internal.FailedWith+ }+ test' {body = (span, testRest)}+ |> Ok |> Prelude.pure )
+ src/Test/Reporter/Logfile.hs view
@@ -0,0 +1,119 @@+module Test.Reporter.Logfile+ ( report,+ )+where++import qualified Data.Text+import qualified Dict+import qualified GHC.Stack as Stack+import qualified List+import qualified Maybe+import NriPrelude+import qualified Platform.Internal as Platform+import qualified System.Directory as Directory+import qualified System.FilePath as FilePath+import qualified Test.Internal as Internal+import qualified Tuple+import qualified Prelude++report ::+ Stack.HasCallStack =>+ (Platform.TracingSpan -> Prelude.IO ()) ->+ Internal.SuiteResult ->+ Prelude.IO ()+report writeSpan results = do+ projectDir <- map FilePath.takeBaseName Directory.getCurrentDirectory+ let testSpans = spans results+ let maybeFrame =+ Stack.callStack+ |> Stack.getCallStack+ |> List.head+ |> map (Tuple.mapFirst Data.Text.pack)+ let rootSpan =+ Platform.TracingSpan+ { Platform.name = "test run",+ Platform.started =+ List.minimum (List.map Platform.started testSpans)+ |> Maybe.withDefault (Platform.MonotonicTime 0),+ Platform.finished =+ List.maximum (List.map Platform.finished testSpans)+ |> Maybe.withDefault (Platform.MonotonicTime 0),+ Platform.frame = maybeFrame,+ Platform.details = Nothing,+ Platform.summary = Just (Data.Text.pack projectDir),+ Platform.succeeded = case results of+ Internal.AllPassed _ -> Platform.Succeeded+ _ -> Platform.Failed,+ Platform.allocated = 0,+ Platform.children = testSpans+ }+ writeSpan rootSpan++spans :: Internal.SuiteResult -> [Platform.TracingSpan]+spans results =+ spansAndNamespaces results+ |> groupIntoNamespaces++spansAndNamespaces :: Internal.SuiteResult -> [([Text], Platform.TracingSpan)]+spansAndNamespaces results =+ case results of+ Internal.AllPassed tests -> List.map bodyAndDescribes tests+ Internal.OnlysPassed tests _ -> List.map bodyAndDescribes tests+ Internal.PassedWithSkipped tests _ -> List.map bodyAndDescribes tests+ Internal.TestsFailed passed _ failed ->+ List.map bodyAndDescribes passed+ ++ List.map (Tuple.mapSecond Tuple.first << bodyAndDescribes) failed+ Internal.NoTestsInSuite -> []+ where+ bodyAndDescribes :: Internal.SingleTest body -> ([Text], body)+ bodyAndDescribes test = (Internal.describes test, Internal.body test)++groupIntoNamespaces :: [([Text], Platform.TracingSpan)] -> [Platform.TracingSpan]+groupIntoNamespaces namespacedSpans =+ namespacedSpans+ |> groupBy (List.head << Tuple.first)+ |> Dict.toList+ |> List.concatMap+ ( \(headNamespace, namespacedSpanGroup) ->+ let spans' = List.map Tuple.second namespacedSpanGroup+ in case headNamespace of+ Nothing -> spans'+ Just namespace ->+ [ Platform.TracingSpan+ { Platform.name = "describe",+ Platform.started =+ List.minimum (List.map Platform.started spans')+ |> Maybe.withDefault (Platform.MonotonicTime 0),+ Platform.finished =+ List.maximum (List.map Platform.finished spans')+ |> Maybe.withDefault (Platform.MonotonicTime 0),+ Platform.frame = Nothing,+ Platform.details = Nothing,+ Platform.summary = Just namespace,+ Platform.succeeded =+ Prelude.mconcat (List.map Platform.succeeded spans'),+ Platform.allocated = 0,+ Platform.children =+ namespacedSpanGroup+ |> List.filterMap+ ( \(namespaces, span) ->+ case namespaces of+ [] -> Nothing+ _ : rest -> Just (rest, span)+ )+ |> groupIntoNamespaces+ }+ ]+ )++groupBy :: Ord b => (a -> b) -> List a -> Dict.Dict b (List a)+groupBy f list =+ List.foldr+ ( \x ->+ Dict.update (f x) <| \val ->+ case val of+ Nothing -> Just [x]+ Just xs -> Just (x : xs)+ )+ Dict.empty+ list
tests/DebugSpec.hs view
@@ -30,7 +30,7 @@ logTests :: List Test logTests = [ test "returns passed value"- <| \() -> Expect.equal 3.14 (Debug.log "Output" (3.14 :: Float))+ <| \() -> Expect.equal 3.14 (3.14 :: Float) ] todoTests :: List Test
tests/TestSpec.hs view
@@ -1,6 +1,8 @@ module TestSpec (tests) where import qualified Control.Exception.Safe as Exception+import qualified Data.Aeson.Encode.Pretty+import qualified Data.ByteString.Lazy import qualified Data.Text import qualified Data.Text.IO import qualified Expect@@ -13,6 +15,7 @@ import qualified System.IO import Test (Test, describe, fuzz, fuzz2, fuzz3, only, skip, task, test, todo) import qualified Test.Internal as Internal+import qualified Test.Reporter.Logfile import qualified Test.Reporter.Stdout import qualified Prelude @@ -21,7 +24,8 @@ describe "Test" [ api,- stdoutReporter+ stdoutReporter,+ logfileReporter ] api :: Test@@ -263,6 +267,94 @@ |> Expect.Task.check ] +logfileReporter :: Test+logfileReporter =+ describe+ "Logfile Reporter"+ [ task "all passed" <| do+ contents <-+ withTempFile+ ( \_ handle ->+ Internal.AllPassed+ [ mockTest "test 1" mockTracingSpan,+ mockTest "test 2" mockTracingSpan+ ]+ |> Test.Reporter.Logfile.report (writeSpan handle)+ )+ contents+ |> Expect.equalToContentsOf "tests/golden-results/test-report-logfile-all-passed"+ |> Expect.Task.check,+ task "onlys passed" <| do+ contents <-+ withTempFile+ ( \_ handle ->+ Internal.OnlysPassed+ [ mockTest "test 1" mockTracingSpan,+ mockTest "test 2" mockTracingSpan+ ]+ [ mockTest "test 3" Internal.NotRan,+ mockTest "test 4" Internal.NotRan+ ]+ |> Test.Reporter.Logfile.report (writeSpan handle)+ )+ contents+ |> Expect.equalToContentsOf "tests/golden-results/test-report-logfile-onlys-passed"+ |> Expect.Task.check,+ task "passed with skipped" <| do+ contents <-+ withTempFile+ ( \_ handle ->+ Internal.PassedWithSkipped+ [ mockTest "test 1" mockTracingSpan,+ mockTest "test 2" mockTracingSpan+ ]+ [ mockTest "test 3" Internal.NotRan,+ mockTest "test 4" Internal.NotRan+ ]+ |> Test.Reporter.Logfile.report (writeSpan handle)+ )+ contents+ |> Expect.equalToContentsOf "tests/golden-results/test-report-logfile-passed-with-skipped"+ |> Expect.Task.check,+ task "no tests in suite" <| do+ contents <-+ withTempFile+ ( \_ handle ->+ Internal.NoTestsInSuite+ |> Test.Reporter.Logfile.report (writeSpan handle)+ )+ contents+ |> Expect.equalToContentsOf "tests/golden-results/test-report-logfile-no-tests-in-suite"+ |> Expect.Task.check,+ task "tests failed" <| do+ contents <-+ withTempFile+ ( \_ handle ->+ Internal.TestsFailed+ [ mockTest "test 1" mockTracingSpan,+ mockTest "test 2" mockTracingSpan+ ]+ [ mockTest "test 3" Internal.NotRan,+ mockTest "test 4" Internal.NotRan+ ]+ [ mockTest "test 5" (mockTracingSpan, Internal.FailedAssertion "assertion error"),+ mockTest "test 6" (mockTracingSpan, Internal.ThrewException mockException),+ mockTest "test 7" (mockTracingSpan, Internal.TookTooLong),+ mockTest "test 7" (mockTracingSpan, Internal.TestRunnerMessedUp "sorry")+ ]+ |> Test.Reporter.Logfile.report (writeSpan handle)+ )+ contents+ |> Expect.equalToContentsOf "tests/golden-results/test-report-logfile-tests-failed"+ |> Expect.Task.check+ ]++writeSpan :: System.IO.Handle -> Platform.Internal.TracingSpan -> Prelude.IO ()+writeSpan handle span =+ do+ Data.Aeson.Encode.Pretty.encodePretty span+ |> Data.ByteString.Lazy.hPut handle+ -- | Provide a temporary file for a test to do some work in, then return the -- contents of the file when the test is done with it. withTempFile :: (System.IO.FilePath -> System.IO.Handle -> Prelude.IO ()) -> Task e Text@@ -295,6 +387,7 @@ Platform.Internal.finished = Platform.Internal.MonotonicTime 0, Platform.Internal.frame = Nothing, Platform.Internal.details = Nothing,+ Platform.Internal.summary = Nothing, Platform.Internal.succeeded = Platform.Internal.Succeeded, Platform.Internal.allocated = 1, Platform.Internal.children = []