{-# LANGUAGE LambdaCase #-}

module Skeletest.Internal.Exit (
  TestExitCode (..),
  exitWith,
  handleUnknownErrors,
) where

import Data.Text qualified as Text
import Skeletest.Internal.Utils.Term qualified as Term
import System.Exit qualified as Exit
import UnliftIO.Exception (
  displayException,
  fromException,
  handleJust,
 )

-- | All exit codes for Skeletest.
--
-- Should be kept in sync with README.
data TestExitCode
  = ExitSuccess
  | ExitTestFailure
  | ExitNoTests
  | ExitCLIFailure
  | ExitOutdatedSnapshots
  | ExitPreprocessorFailure
  | ExitOther
  deriving (Int -> TestExitCode -> ShowS
[TestExitCode] -> ShowS
TestExitCode -> String
(Int -> TestExitCode -> ShowS)
-> (TestExitCode -> String)
-> ([TestExitCode] -> ShowS)
-> Show TestExitCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestExitCode -> ShowS
showsPrec :: Int -> TestExitCode -> ShowS
$cshow :: TestExitCode -> String
show :: TestExitCode -> String
$cshowList :: [TestExitCode] -> ShowS
showList :: [TestExitCode] -> ShowS
Show, TestExitCode -> TestExitCode -> Bool
(TestExitCode -> TestExitCode -> Bool)
-> (TestExitCode -> TestExitCode -> Bool) -> Eq TestExitCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestExitCode -> TestExitCode -> Bool
== :: TestExitCode -> TestExitCode -> Bool
$c/= :: TestExitCode -> TestExitCode -> Bool
/= :: TestExitCode -> TestExitCode -> Bool
Eq, Eq TestExitCode
Eq TestExitCode =>
(TestExitCode -> TestExitCode -> Ordering)
-> (TestExitCode -> TestExitCode -> Bool)
-> (TestExitCode -> TestExitCode -> Bool)
-> (TestExitCode -> TestExitCode -> Bool)
-> (TestExitCode -> TestExitCode -> Bool)
-> (TestExitCode -> TestExitCode -> TestExitCode)
-> (TestExitCode -> TestExitCode -> TestExitCode)
-> Ord TestExitCode
TestExitCode -> TestExitCode -> Bool
TestExitCode -> TestExitCode -> Ordering
TestExitCode -> TestExitCode -> TestExitCode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TestExitCode -> TestExitCode -> Ordering
compare :: TestExitCode -> TestExitCode -> Ordering
$c< :: TestExitCode -> TestExitCode -> Bool
< :: TestExitCode -> TestExitCode -> Bool
$c<= :: TestExitCode -> TestExitCode -> Bool
<= :: TestExitCode -> TestExitCode -> Bool
$c> :: TestExitCode -> TestExitCode -> Bool
> :: TestExitCode -> TestExitCode -> Bool
$c>= :: TestExitCode -> TestExitCode -> Bool
>= :: TestExitCode -> TestExitCode -> Bool
$cmax :: TestExitCode -> TestExitCode -> TestExitCode
max :: TestExitCode -> TestExitCode -> TestExitCode
$cmin :: TestExitCode -> TestExitCode -> TestExitCode
min :: TestExitCode -> TestExitCode -> TestExitCode
Ord)

fromExitCode :: TestExitCode -> Exit.ExitCode
fromExitCode :: TestExitCode -> ExitCode
fromExitCode = \case
  TestExitCode
ExitSuccess -> ExitCode
Exit.ExitSuccess
  TestExitCode
ExitTestFailure -> Int -> ExitCode
Exit.ExitFailure Int
1
  TestExitCode
ExitNoTests -> Int -> ExitCode
Exit.ExitFailure Int
3
  TestExitCode
ExitCLIFailure -> Int -> ExitCode
Exit.ExitFailure Int
4
  TestExitCode
ExitOutdatedSnapshots -> Int -> ExitCode
Exit.ExitFailure Int
5
  TestExitCode
ExitPreprocessorFailure -> Int -> ExitCode
Exit.ExitFailure Int
10
  TestExitCode
ExitOther -> Int -> ExitCode
Exit.ExitFailure Int
99

exitWith :: TestExitCode -> IO a
exitWith :: forall a. TestExitCode -> IO a
exitWith TestExitCode
code = do
  IO ()
Term.flush -- Be absolutely sure to flush everything
  ExitCode -> IO a
forall a. ExitCode -> IO a
Exit.exitWith (ExitCode -> IO a) -> ExitCode -> IO a
forall a b. (a -> b) -> a -> b
$ TestExitCode -> ExitCode
fromExitCode TestExitCode
code

handleUnknownErrors :: IO a -> IO a
handleUnknownErrors :: forall a. IO a -> IO a
handleUnknownErrors = (SomeException -> Maybe SomeException)
-> (SomeException -> IO a) -> IO a -> IO a
forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust SomeException -> Maybe SomeException
isUnknown ((SomeException -> IO a) -> IO a -> IO a)
-> (SomeException -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ \SomeException
e -> do
  Text -> IO ()
Term.outputErr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ (String -> Text
Text.pack (String -> Text)
-> (SomeException -> String) -> SomeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
displayException) SomeException
e
  TestExitCode -> IO a
forall a. TestExitCode -> IO a
exitWith TestExitCode
ExitOther
 where
  isUnknown :: SomeException -> Maybe SomeException
isUnknown SomeException
e =
    case SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
      Maybe ExitCode
Nothing -> SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e
      -- Don't catch 'exitWith' calls
      Just (ExitCode
_ :: Exit.ExitCode) -> Maybe SomeException
forall a. Maybe a
Nothing