{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Skeletest.Internal.Error (
  SkeletestError (..),
  skeletestPluginError,
  invariantViolation,
) where

import Data.Text (Text)
import Data.Text qualified as Text
import GHC.Utils.Panic (pgmError)
import UnliftIO.Exception (Exception (..), impureThrow)

data SkeletestError
  = -- | A user error during compilation, e.g. during the preprocessor or plugin phases.
    CompilationError Text
  | -- | An error in a situation that should never happen, and indicates a bug.
    InvariantViolation Text
  | TestInfoNotFound
  | CliFlagNotFound Text
  | FixtureCircularDependency [Text]
  | SnapshotFileCorrupted FilePath
  deriving (Int -> SkeletestError -> ShowS
[SkeletestError] -> ShowS
SkeletestError -> String
(Int -> SkeletestError -> ShowS)
-> (SkeletestError -> String)
-> ([SkeletestError] -> ShowS)
-> Show SkeletestError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SkeletestError -> ShowS
showsPrec :: Int -> SkeletestError -> ShowS
$cshow :: SkeletestError -> String
show :: SkeletestError -> String
$cshowList :: [SkeletestError] -> ShowS
showList :: [SkeletestError] -> ShowS
Show)

instance Exception SkeletestError where
  displayException :: SkeletestError -> String
displayException =
    Text -> String
Text.unpack (Text -> String)
-> (SkeletestError -> Text) -> SkeletestError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      CompilationError Text
msg ->
        [Text] -> Text
Text.unlines
          [ Text
""
          , Text
"******************** skeletest failure ********************"
          , Text
msg
          ]
      InvariantViolation Text
msg ->
        [Text] -> Text
Text.unlines
          [ Text
"Invariant violation: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
          , Text
"**** This is a skeletest bug. Please report it at https://github.com/brandonchinn178/skeletest/issues"
          ]
      SkeletestError
TestInfoNotFound ->
        Text
"Could not find test info"
      CliFlagNotFound Text
name ->
        Text
"CLI flag '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' was not registered. Did you add it to cliFlags in Main.hs?"
      FixtureCircularDependency [Text]
fixtures ->
        Text
"Found circular dependency when resolving fixtures: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
" -> " [Text]
fixtures
      SnapshotFileCorrupted String
fp ->
        Text
"Snapshot file was corrupted: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
fp

skeletestPluginError :: String -> a
skeletestPluginError :: forall a. String -> a
skeletestPluginError = String -> a
forall a. HasCallStack => String -> a
pgmError (String -> a) -> ShowS -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
stripEnd ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SkeletestError -> String
forall e. Exception e => e -> String
displayException (SkeletestError -> String) -> (String -> SkeletestError) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SkeletestError
CompilationError (Text -> SkeletestError)
-> (String -> Text) -> String -> SkeletestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
  where
    stripEnd :: ShowS
stripEnd = Text -> String
Text.unpack (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.stripEnd (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

invariantViolation :: String -> a
invariantViolation :: forall a. String -> a
invariantViolation = SkeletestError -> a
forall e a. Exception e => e -> a
impureThrow (SkeletestError -> a) -> (String -> SkeletestError) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SkeletestError
InvariantViolation (Text -> SkeletestError)
-> (String -> Text) -> String -> SkeletestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack