module Hix.Error (
  module Hix.Data.Error,
  module Hix.Error,
) where

import Control.Monad.Trans.Except (ExceptT, throwE)
import Exon (exon)
import Path (Path, toFilePath)
import System.IO.Error (tryIOError)

import qualified Hix.Console as Console
import Hix.Console (errorMessage)
import Hix.Data.Error (Error (..))

pathText :: Path b t -> Text
pathText :: forall b t. Path b t -> Text
pathText =
  FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> (Path b t -> FilePath) -> Path b t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> FilePath
forall b t. Path b t -> FilePath
toFilePath

prefixedError ::
  MonadIO m =>
  Text ->
  Text ->
  m ()
prefixedError :: forall (m :: * -> *). MonadIO m => Text -> Text -> m ()
prefixedError Text
desc Text
msg =
  Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
Console.err (Text -> Text
errorMessage [exon|#{desc}: #{msg}|])

printPreprocError ::
  MonadIO m =>
  Text ->
  m ()
printPreprocError :: forall (m :: * -> *). MonadIO m => Text -> m ()
printPreprocError =
  Text -> Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> Text -> m ()
prefixedError Text
"Preprocessor generator failed"

printEnvError ::
  MonadIO m =>
  Text ->
  m ()
printEnvError :: forall (m :: * -> *). MonadIO m => Text -> m ()
printEnvError =
  Text -> Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> Text -> m ()
prefixedError Text
"Invalid env config"

printGhciError ::
  MonadIO m =>
  Text ->
  m ()
printGhciError :: forall (m :: * -> *). MonadIO m => Text -> m ()
printGhciError =
  Text -> Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> Text -> m ()
prefixedError Text
"Invalid ghci config"

printNewError ::
  MonadIO m =>
  Text ->
  m ()
printNewError :: forall (m :: * -> *). MonadIO m => Text -> m ()
printNewError =
  Text -> Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> Text -> m ()
prefixedError Text
"Can't create new project"

printBootstrapError ::
  MonadIO m =>
  Text ->
  m ()
printBootstrapError :: forall (m :: * -> *). MonadIO m => Text -> m ()
printBootstrapError =
  Text -> Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> Text -> m ()
prefixedError Text
"Can't bootstrap project"

printFatalError ::
  MonadIO m =>
  Text ->
  m ()
printFatalError :: forall (m :: * -> *). MonadIO m => Text -> m ()
printFatalError =
  Text -> Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> Text -> m ()
prefixedError Text
"Fatal error"

sourceError :: Text -> Path b t -> Text
sourceError :: forall b t. Text -> Path b t -> Text
sourceError Text
reason Path b t
source =
  [exon|#{reason} the source file '#{pathText source}'|]

catchIO ::
  (Text -> ExceptT e IO a) ->
  IO a ->
  ExceptT e IO a
catchIO :: forall e a. (Text -> ExceptT e IO a) -> IO a -> ExceptT e IO a
catchIO Text -> ExceptT e IO a
handleError IO a
ma =
  IO (Either IOError a) -> ExceptT e IO (Either IOError a)
forall a. IO a -> ExceptT e IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO (Either IOError a)
forall a. IO a -> IO (Either IOError a)
tryIOError IO a
ma) ExceptT e IO (Either IOError a)
-> (Either IOError a -> ExceptT e IO a) -> ExceptT e IO a
forall a b.
ExceptT e IO a -> (a -> ExceptT e IO b) -> ExceptT e IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right a
a -> a -> ExceptT e IO a
forall a. a -> ExceptT e IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    Left IOError
err -> Text -> ExceptT e IO a
handleError (IOError -> Text
forall b a. (Show a, IsString b) => a -> b
show IOError
err)

tryIOWith ::
  (Text -> e) ->
  IO a ->
  ExceptT e IO a
tryIOWith :: forall e a. (Text -> e) -> IO a -> ExceptT e IO a
tryIOWith Text -> e
mkErr IO a
ma =
  IO (Either IOError a) -> ExceptT e IO (Either IOError a)
forall a. IO a -> ExceptT e IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO (Either IOError a)
forall a. IO a -> IO (Either IOError a)
tryIOError IO a
ma) ExceptT e IO (Either IOError a)
-> (Either IOError a -> ExceptT e IO a) -> ExceptT e IO a
forall a b.
ExceptT e IO a -> (a -> ExceptT e IO b) -> ExceptT e IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right a
a -> a -> ExceptT e IO a
forall a. a -> ExceptT e IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    Left IOError
err -> e -> ExceptT e IO a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Text -> e
mkErr (IOError -> Text
forall b a. (Show a, IsString b) => a -> b
show IOError
err))

tryIO ::
  IO a ->
  ExceptT Error IO a
tryIO :: forall a. IO a -> ExceptT Error IO a
tryIO =
  (Text -> Error) -> IO a -> ExceptT Error IO a
forall e a. (Text -> e) -> IO a -> ExceptT e IO a
tryIOWith Text -> Error
Fatal

note :: Text -> Maybe a -> ExceptT Error IO a
note :: forall a. Text -> Maybe a -> ExceptT Error IO a
note Text
err =
  ExceptT Error IO a
-> (a -> ExceptT Error IO a) -> Maybe a -> ExceptT Error IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Error -> ExceptT Error IO a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Text -> Error
GhciError Text
err)) a -> ExceptT Error IO a
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

printError ::
  MonadIO m =>
  Bool ->
  Error ->
  m ()
printError :: forall (m :: * -> *). MonadIO m => Bool -> Error -> m ()
printError Bool
verbose = \case
  PreprocError Text
err -> Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
printPreprocError Text
err
  EnvError Text
err -> Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
printEnvError Text
err
  GhciError Text
err -> Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
printGhciError Text
err
  NewError Text
err -> Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
printNewError Text
err
  BootstrapError Text
err -> Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
printBootstrapError Text
err
  NoMatch Text
msg | Bool
verbose -> Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
printPreprocError Text
msg
  NoMatch Text
_ -> m ()
forall (f :: * -> *). Applicative f => f ()
unit
  Fatal Text
err -> Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
printFatalError Text
err
  Client Text
err -> Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
Console.err (Text -> Text
errorMessage Text
err)