fix: logWithExit_ should exit on Just

Changelog.md

@@ -1,5 +1,9 @@
 # Spectrometer Changelog
 
+## v2.10.2
+
+- Fixes an issue where some `fossa` commands (including `fossa test`) would exit non-zero on success ([#278](https://github.com/fossas/spectrometer/pull/278)).
+
 ## v2.10.1
 
 - Fixes an issue where `fossa container analyze` returned 0 exit code on failure ([#275](https://github.com/fossas/spectrometer/pull/275))

spectrometer.cabal

@@ -33,6 +33,7 @@ common lang
     GADTSyntax
     GeneralizedNewtypeDeriving
     HexFloatLiterals
+    ImportQualifiedPost
     InstanceSigs
     KindSignatures
     MultiParamTypeClasses
@@ -45,13 +46,12 @@ common lang
     RankNTypes
     ScopedTypeVariables
     StandaloneDeriving
+    StandaloneKindSignatures
     StrictData
     TupleSections
     TypeApplications
     TypeOperators
     TypeSynonymInstances
-    ImportQualifiedPost
-    StandaloneKindSignatures
 
   ghc-options:
     -Wall -Wincomplete-uni-patterns -Wcompat
@@ -74,8 +74,8 @@ common deps
     , conduit                      ^>=1.3.2
     , conduit-extra                ^>=1.3.5
     , containers                   ^>=0.6.0
-    , cryptonite                   ^>=0.28
     , cpio-conduit                 ^>=0.7.0
+    , cryptonite                   ^>=0.28
     , directory                    ^>=1.3.6.1
     , exceptions                   ^>=0.10.4
     , file-embed                   ^>=0.0.11
@@ -96,7 +96,7 @@ common deps
     , path-io                      ^>=1.6.0
     , prettyprinter                >=1.6      && <1.8
     , prettyprinter-ansi-terminal  ^>=1.1.1
-    , req                          >=3.7      && <3.8
+    , req                          ^>=3.7
     , semver                       ^>=0.4.0.1
     , split                        ^>=0.2.3.4
     , stm                          ^>=2.5.0
@@ -125,14 +125,14 @@ library
   -- cabal-fmt: expand src
   exposed-modules:
     Algebra.Graph.AdjacencyMap.Extra
-    App.Fossa.API.BuildLink
-    App.Fossa.API.BuildWait
     App.Fossa.Analyze
     App.Fossa.Analyze.Graph
     App.Fossa.Analyze.GraphBuilder
     App.Fossa.Analyze.GraphMangler
     App.Fossa.Analyze.Project
     App.Fossa.Analyze.Record
+    App.Fossa.API.BuildLink
+    App.Fossa.API.BuildWait
     App.Fossa.ArchiveUploader
     App.Fossa.Compatibility
     App.Fossa.Configuration
@@ -259,8 +259,8 @@ library
     Strategy.Python.SetupPy
     Strategy.Python.Setuptools
     Strategy.Python.Util
-    Strategy.RPM
     Strategy.Rebar3
+    Strategy.RPM
     Strategy.Ruby.BundleShow
     Strategy.Ruby.GemfileLock
     Strategy.Scala
@@ -301,9 +301,9 @@ test-suite unit-tests
   other-modules:
     App.Fossa.API.BuildLinkSpec
     App.Fossa.Configuration.ConfigurationSpec
+    App.Fossa.ManualDepsSpec
     App.Fossa.Report.AttributionSpec
     App.Fossa.VPS.NinjaGraphSpec
-    App.Fossa.ManualDepsSpec
     Cargo.MetadataSpec
     Carthage.CarthageSpec
     Clojure.ClojureSpec
@@ -312,6 +312,7 @@ test-suite unit-tests
     Composer.ComposerLockSpec
     Conda.CondaListSpec
     Conda.EnvironmentYmlSpec
+    Control.Carrier.DiagnosticsSpec
     Discovery.FiltersSpec
     Effect.ExecSpec
     Erlang.ConfigParserSpec
@@ -326,8 +327,8 @@ test-suite unit-tests
     Go.TransitiveSpec
     Googlesource.RepoManifestSpec
     Gradle.GradleSpec
-    GraphUtil
     GraphingSpec
+    GraphUtil
     Haskell.CabalSpec
     Haskell.StackSpec
     Maven.PluginStrategySpec

src/Control/Carrier/Diagnostics.hs

@@ -29,7 +29,7 @@ import Control.Monad.Trans
 import Data.Monoid (Endo (..))
 import Data.Text (Text)
 import Effect.Logger
-import System.Exit (exitFailure)
+import System.Exit (exitFailure, exitSuccess)
 
 newtype DiagnosticsC m a = DiagnosticsC {runDiagnosticsC :: ReaderC [Text] (ErrorC SomeDiagnostic (WriterC (Endo [SomeDiagnostic]) m)) a}
   deriving (Functor, Applicative, Monad, MonadIO)
@@ -49,10 +49,10 @@ logDiagnostic diag = do
     Right success -> pure $ Just success
 
 -- | Run a void Diagnostic effect into a logger, using the default error/warning renderers.
--- | Exits with non-zero if the result is a failure.
--- | Useful for setting up diagnostics from CLI entry points.
+-- Exits with zero if the result is a success, or non-zero if the result is a failure.
+-- Useful for setting up diagnostics from CLI entry points.
 logWithExit_ :: (Has (Lift IO) sig m, Has Logger sig m) => DiagnosticsC m () -> m ()
-logWithExit_ diag = logDiagnostic diag >>= maybe (sendIO exitFailure) pure
+logWithExit_ diag = logDiagnostic diag >>= maybe (sendIO exitFailure) (const (sendIO exitSuccess))
 
 runDiagnostics :: Applicative m => DiagnosticsC m a -> m (Either FailureBundle a)
 runDiagnostics = fmap bundle . runWriter (\w a -> pure (appEndo w [], a)) . runError @SomeDiagnostic . runReader [] . runDiagnosticsC

test/Control/Carrier/DiagnosticsSpec.hs

@@ -0,0 +1,24 @@
+module Control.Carrier.DiagnosticsSpec (spec) where
+
+import Control.Carrier.Diagnostics (logWithExit_)
+import Control.Effect.Diagnostics (ToDiagnostic(..), fatal)
+import Data.Text (Text)
+import Effect.Exec (ExitCode (..))
+import Effect.Logger (Severity (SevDebug), logInfo, withDefaultLogger, pretty)
+import Test.Hspec (Spec, describe, it, shouldThrow)
+
+spec :: Spec
+spec = describe "logWithExit_" $ do
+  it "exits on success" $ do
+    successAction `shouldThrow` (== ExitSuccess)
+  it "exits on failure" $ do
+    failureAction `shouldThrow` (== ExitFailure 1)
+  where
+    successAction = withDefaultLogger SevDebug $ logWithExit_ $ logInfo "Action succeeded!"
+    failureAction = withDefaultLogger SevDebug $ logWithExit_ $ fatal $ TestError "Action failed!"
+
+newtype TestError = TestError Text
+  deriving (Eq, Ord, Show)
+
+instance ToDiagnostic TestError where
+  renderDiagnostic (TestError e) = pretty e