-- |
--
-- Copyright:
--   This file is part of the package byline. It is subject to the
--   license terms in the LICENSE file found in the top-level
--   directory of this distribution and at:
--
--     https://github.com/pjones/byline
--
--   No part of this package, including this file, may be copied,
--   modified, propagated, or distributed except according to the
--   terms contained in the LICENSE file.
--
-- License: BSD-2-Clause
module Byline.Exit
  ( -- * Exiting with style
    die,

    -- * Warnings
    warn,

    -- * Re-exports
    module Byline,
  )
where

import Byline
import Byline.Internal.Eval (defaultRenderMode)
import Byline.Internal.Stylized (render)
import qualified System.Environment as Environment
import qualified System.Exit as Exit
import qualified System.IO as IO
import Prelude hiding (die)

-- | Exit the current process after printing a pretty error message.
--
-- This function is similar to 'Exit.die' except that the name of the
-- current process along with a 'Stylized' error message is printed to
-- the standard error handle before exiting with a failure code.
--
-- @since 1.0.0.0
die :: (MonadIO m, ToStylizedText a) => a -> m b
die :: a -> m b
die a
a = do
  a -> m ()
forall (m :: * -> *) a. (MonadIO m, ToStylizedText a) => a -> m ()
warn a
a
  IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
IO.hFlush Handle
stderr IO () -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
forall a. IO a
Exit.exitFailure)

-- | Print a message to standard error.
--
-- Unlike 'die', this function will __not__ exit the current process.
--
-- @since 1.0.0.0
warn :: (MonadIO m, ToStylizedText a) => a -> m ()
warn :: a -> m ()
warn a
a = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Text
name <- IO String
Environment.getProgName IO String -> (String -> Text) -> IO Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Text
forall a. ToText a => a -> Text
toText

  let msg :: Stylized Text
msg =
        [Stylized Text] -> Stylized Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text -> Stylized Text
text Text
name,
            Text -> Stylized Text
text Text
": ",
            a -> Stylized Text
forall a. ToStylizedText a => a -> Stylized Text
toStylizedText a
a,
            Text -> Stylized Text
text Text
"\n"
          ]

  RenderMode
mode <- Handle -> IO RenderMode
defaultRenderMode Handle
stderr
  RenderMode -> Handle -> Stylized Text -> IO ()
render RenderMode
mode Handle
stderr Stylized Text
msg