{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Class of errors used in the Api.
module Cardano.Api.Error
  ( Error (..)
  , throwErrorAsException
  , ErrorAsException (..)
  , FileError (..)
  , fileIOExceptT
  , displayError
  )
where

import           Cardano.Api.Pretty

import           Control.Exception (Exception (..), IOException, throwIO)
import           Control.Monad.Except (throwError)
import           Control.Monad.IO.Class (MonadIO)
import           Control.Monad.Trans.Except (ExceptT)
import           Control.Monad.Trans.Except.Extra (handleIOExceptT)
import           System.Directory (doesFileExist)
import           System.IO (Handle)

class Error e where
  prettyError :: e -> Doc ann

instance Error () where
  prettyError :: forall ann. () -> Doc ann
prettyError () = Doc ann
""

-- | The preferred approach is to use 'Except' or 'ExceptT', but you can if
-- necessary use IO exceptions.
throwErrorAsException :: Error e => e -> IO a
throwErrorAsException :: forall e a. Error e => e -> IO a
throwErrorAsException e
e = ErrorAsException -> IO a
forall e a. Exception e => e -> IO a
throwIO (e -> ErrorAsException
forall e. Error e => e -> ErrorAsException
ErrorAsException e
e)

data ErrorAsException where
  ErrorAsException :: Error e => e -> ErrorAsException

instance Error ErrorAsException where
  prettyError :: forall ann. ErrorAsException -> Doc ann
prettyError (ErrorAsException e
e) =
    e -> Doc ann
forall ann. e -> Doc ann
forall e ann. Error e => e -> Doc ann
prettyError e
e

instance Show ErrorAsException where
  show :: ErrorAsException -> String
show (ErrorAsException e
e) =
    Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> String) -> Doc AnsiStyle -> String
forall a b. (a -> b) -> a -> b
$ e -> Doc AnsiStyle
forall ann. e -> Doc ann
forall e ann. Error e => e -> Doc ann
prettyError e
e

instance Exception ErrorAsException where
  displayException :: ErrorAsException -> String
displayException (ErrorAsException e
e) =
    Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> String) -> Doc AnsiStyle -> String
forall a b. (a -> b) -> a -> b
$ e -> Doc AnsiStyle
forall ann. e -> Doc ann
forall e ann. Error e => e -> Doc ann
prettyError e
e

displayError :: Error a => a -> String
displayError :: forall a. Error a => a -> String
displayError = Doc AnsiStyle -> String
docToString (Doc AnsiStyle -> String) -> (a -> Doc AnsiStyle) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc AnsiStyle
forall ann. a -> Doc ann
forall e ann. Error e => e -> Doc ann
prettyError

data FileError e
  = FileError FilePath e
  | FileErrorTempFile
      FilePath
      -- ^ Target path
      FilePath
      -- ^ Temporary path
      Handle
  | FileDoesNotExistError FilePath
  | FileIOError FilePath IOException
  deriving (Int -> FileError e -> ShowS
[FileError e] -> ShowS
FileError e -> String
(Int -> FileError e -> ShowS)
-> (FileError e -> String)
-> ([FileError e] -> ShowS)
-> Show (FileError e)
forall e. Show e => Int -> FileError e -> ShowS
forall e. Show e => [FileError e] -> ShowS
forall e. Show e => FileError e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> FileError e -> ShowS
showsPrec :: Int -> FileError e -> ShowS
$cshow :: forall e. Show e => FileError e -> String
show :: FileError e -> String
$cshowList :: forall e. Show e => [FileError e] -> ShowS
showList :: [FileError e] -> ShowS
Show, FileError e -> FileError e -> Bool
(FileError e -> FileError e -> Bool)
-> (FileError e -> FileError e -> Bool) -> Eq (FileError e)
forall e. Eq e => FileError e -> FileError e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => FileError e -> FileError e -> Bool
== :: FileError e -> FileError e -> Bool
$c/= :: forall e. Eq e => FileError e -> FileError e -> Bool
/= :: FileError e -> FileError e -> Bool
Eq, (forall a b. (a -> b) -> FileError a -> FileError b)
-> (forall a b. a -> FileError b -> FileError a)
-> Functor FileError
forall a b. a -> FileError b -> FileError a
forall a b. (a -> b) -> FileError a -> FileError b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> FileError a -> FileError b
fmap :: forall a b. (a -> b) -> FileError a -> FileError b
$c<$ :: forall a b. a -> FileError b -> FileError a
<$ :: forall a b. a -> FileError b -> FileError a
Functor)

instance Error e => Error (FileError e) where
  prettyError :: forall ann. FileError e -> Doc ann
prettyError = \case
    FileErrorTempFile String
targetPath String
tempPath Handle
h ->
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
        [ Doc ann
"Error creating temporary file at: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
tempPath
        , Doc ann
"Target path: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
targetPath
        , Doc ann
"Handle: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Handle -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Handle
h
        ]
    FileDoesNotExistError String
path ->
      Doc ann
"Error file not found at: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
path
    FileIOError String
path IOException
ioe ->
      String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
path Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (IOException -> String
forall e. Exception e => e -> String
displayException IOException
ioe)
    FileError String
path e
e ->
      String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
path Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> e -> Doc ann
forall ann. e -> Doc ann
forall e ann. Error e => e -> Doc ann
prettyError e
e

instance Error IOException where
  prettyError :: forall ann. IOException -> Doc ann
prettyError = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann)
-> (IOException -> String) -> IOException -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show

fileIOExceptT
  :: MonadIO m
  => FilePath
  -> (FilePath -> IO s)
  -> ExceptT (FileError e) m s
fileIOExceptT :: forall (m :: * -> *) s e.
MonadIO m =>
String -> (String -> IO s) -> ExceptT (FileError e) m s
fileIOExceptT String
fp String -> IO s
readFile' = do
  Bool
fileExists <- (IOException -> FileError e)
-> IO Bool -> ExceptT (FileError e) m Bool
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> FileError e
forall e. String -> IOException -> FileError e
FileIOError String
fp) (IO Bool -> ExceptT (FileError e) m Bool)
-> IO Bool -> ExceptT (FileError e) m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
fp
  if Bool
fileExists
    then (IOException -> FileError e) -> IO s -> ExceptT (FileError e) m s
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> FileError e
forall e. String -> IOException -> FileError e
FileIOError String
fp) (IO s -> ExceptT (FileError e) m s)
-> IO s -> ExceptT (FileError e) m s
forall a b. (a -> b) -> a -> b
$ String -> IO s
readFile' String
fp
    else FileError e -> ExceptT (FileError e) m s
forall a. FileError e -> ExceptT (FileError e) m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> FileError e
forall e. String -> FileError e
FileDoesNotExistError String
fp)