module Require.Error where

import Control.Exception
import Relude
import qualified Require.File as File
import System.Console.ANSI
import System.IO


data Error
  = MissingRequiresFile
  | MissingOptionalRequiresFile
  | AutorequireImpossible
  deriving (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)


describe :: Error -> [String]
describe :: Error -> [String]
describe Error
MissingRequiresFile =
  [ String
"`autorequirepp` couldn't find a `Requires` file in the system." ]
describe Error
MissingOptionalRequiresFile =
  [ String
"Discovered an `autorequire` directive but no `Requires` file was found." ]
describe Error
AutorequireImpossible =
  [ String
"Unable to determine where to insert the autorequire contents."
  , String
"Use the `autorequire` directive to specify a location yourself."
  ]


die :: File.Name -> Error -> IO a
die :: Name -> Error -> IO a
die (File.Name Text
fn) Error
e = do
  let outputHeaderColored :: IO ()
outputHeaderColored = do
        Handle -> [SGR] -> IO ()
hSetSGR Handle
stderr [ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity]
        Handle -> String -> IO ()
hPutStr Handle
stderr (Text -> String
forall a. ToString a => a -> String
toString Text
fn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": ")
        Handle -> [SGR] -> IO ()
hSetSGR Handle
stderr [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Red]
        Handle -> String -> IO ()
hPutStr Handle
stderr String
"error:\n"

  -- Don't mess up the terminal if there is an exception half-way through.
  IO ()
outputHeaderColored IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Handle -> [SGR] -> IO ()
hSetSGR Handle
stderr []

  let indent :: ShowS
indent String
s = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
4 Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
  (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> ShowS -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
indent) (Error -> [String]
describe Error
e)
  IO a
forall (m :: * -> *) a. MonadIO m => m a
exitFailure