warnLeft

src/Control/Effect/Diagnostics.hs

@@ -46,13 +46,15 @@ module Control.Effect.Diagnostics (
   ToDiagnostic (..),
   SomeDiagnostic (..),
   module Diagnostic,
+  warnLeft,
 ) where
 
 import Control.Algebra as X -- intentionally implicit
 import Control.Effect.Lift (Lift)
 import Control.Effect.Stack (Stack, context)
 import Control.Exception (Exception, IOException, SomeException (..))
 import Control.Exception.Extra (safeCatch)
+import Data.Functor (($>))
 import Data.List.NonEmpty qualified as NE
 import Data.Maybe (catMaybes)
 import Data.Semigroup (sconcat)
@@ -157,6 +159,11 @@ fatalText = fatal
 fromEither :: (ToDiagnostic err, Has Diagnostics sig m) => Either err a -> m a
 fromEither = either fatal pure
 
+-- | Sometimes the only thing to do with the @Left@ part of an @Either a b@ is emit it as a warning.
+-- This function does that and eliminates the error value.
+warnLeft :: (ToDiagnostic warn, Has Diagnostics sig m) => Either warn a -> m (Maybe a)
+warnLeft = either (\e -> warn e $> Nothing) (pure . Just)
+
 -- | Lift an Either result into the Diagnostics effect, given a Show instance for the error type
 fromEitherShow :: (Show err, Has Diagnostics sig m) => Either err a -> m a
 fromEitherShow = either (fatal . toText . show) pure