{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Error
-- Copyright   :  (C) 2021-2022 Profpatsch
-- License     :  MIT
-- Maintainer  :  Profpatsch <mail@profpatsch.de>
-- Stability   :  stable
-- Portability :  portable
--------------------------------------------------------------------------------
module Data.Error
  ( Error,
    -- * Error creation
    newError,
    -- *** From 'Show' and 'Exception'

    -- | These two functions can be helpful, but consider that they don’t always provide very user-friendly error messages.
    -- It is recommended that you use `errorContext` to improve the messages generated by 'showToError' and 'exceptionToError'.
    showToError,
    exceptionToError,
    -- * Adding context
    errorContext,
    -- * Pretty printing
    prettyError,
    -- * Unsafe unwrapping

    -- | Sometimes you want to assure that an 'Error' could not have happened at runtime,
    -- even though there is the possibility in the types.
    --
    -- In that case you can use 'expectError'/'unwrapError'.
    -- They will panic at runtime (via 'error') if there was an error.
    --
    -- You can also use 'expectIOError'/'unwrapIOError' if your code is in 'IO',
    -- which will crash with 'Exc.throwIO' instead of 'error'.
    --
    -- 'expectError'/'expectIOError' should usually be preferred, since it adds a context message.
    --
    -- These are modelled after @<https://doc.rust-lang.org/std/result/enum.Result.html#method.expect Result::expect()>@
    -- and @<https://doc.rust-lang.org/std/result/enum.Result.html#method.unwrap Result::unwrap()>@ in the rust stdlib.
    expectError,
    unwrapError,
    expectIOError,
    unwrapIOError,
    -- * Catching @Exceptions@ in 'IO'
    ifIOError,
    ifError
  )
where

import Data.Function ((&))
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Stack (HasCallStack)
import Control.Exception (Exception (displayException))
import qualified Control.Exception as Exc
import Data.Bifunctor (first)
import Data.String (IsString (fromString))

-- | The canonical @Error@ type.
--
-- It can be
--
-- * created from a human-readable error message ('newError')
-- * more semantic context can be added to an existing @Error@ ('errorContext')
-- * pretty-printed (`prettyError`)
newtype Error = Error [Text]

-- | The 'Show' instance exists for the user’s convenience on the REPL.
--
-- If you want to display an error, use 'prettyError' instead.
deriving instance Show Error

-- | This makes it possible to treat any literal string as 'Error' (with @OverloadedStrings@ enabled).
--
-- >>> prettyError $ errorContext "oops" $ "my Error"
-- "oops: my Error"
--
-- No 'newError' necessary!
instance IsString Error where
  fromString :: String -> Error
fromString = Text -> Error
newError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

-- | Create an ad-hoc 'Error' from an error message.
newError :: Text -> Error
newError :: Text -> Error
newError Text
msg = [Text] -> Error
Error [Text
msg]

-- | Create an error from a `Show` type.
--
-- If your type implements 'Exception', it is usually better to use 'exceptionToError' instead.
-- Strings produced by 'show' are usually not very user-friendly.
--
-- Note: goes via `String`, so not efficient.
showToError :: Show a => a -> Error
showToError :: forall a. Show a => a -> Error
showToError = Text -> Error
newError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

-- | Create an error from an 'Exception' type.
--
-- The default implementation of 'displayException' is 'show', so the same user-friendliness problems of 'showToError' apply.
--
-- Note: goes via `String`, so not efficient.
exceptionToError :: Exception exc => exc -> Error
exceptionToError :: forall exc. Exception exc => exc -> Error
exceptionToError = Text -> Error
newError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> String
displayException

-- | Add a higher-level context to an 'Error'.
--
-- For example, your code hits a “file not found” I/O exception.
-- Instead of propagating it unseen, you catch it and annotate it with 'errorContext',
-- and describe why you wanted to open the file in the first place:
--
-- @
-- errorContext "Trying to open config file"
--   $ newError "file not found: ./foo"
-- @
--
-- This way, when a user see the error, they will understand better what happened:
--
-- @
-- "Trying to open config file: file not found: ./foo"
-- @
--
-- See 'prettyError'.
errorContext :: Text -> Error -> Error
errorContext :: Text -> Error -> Error
errorContext Text
e (Error [Text]
es) = [Text] -> Error
Error forall a b. (a -> b) -> a -> b
$ Text
e forall a. a -> [a] -> [a]
: [Text]
es

-- | Pretty print the error.
--
-- It will print all context messages, starting with the outermost.
--
-- Example:
--
-- >>> prettyError $ newError "file not found: ./foo"
-- "file not found: ./foo"
--
-- >>> :{
--   prettyError
--     $ errorContext "Trying to open config file"
--       $ newError "file not found: ./foo"
-- :}
-- "Trying to open config file: file not found: ./foo"
prettyError :: Error -> Text
prettyError :: Error -> Text
prettyError (Error [Text]
es) = Text -> [Text] -> Text
Text.intercalate Text
": " [Text]
es

-- | Return the value from a potentially failing computation.
--
-- Abort with the 'Error's message if it was a 'Left'.
--
-- __Panics:__ if Error
--
-- Example:
--
-- >>> unwrapError $ Left (newError "oh no!")
-- *** Exception: oh no!
-- ...
--
-- >>> unwrapError $ Right 42
-- 42
unwrapError :: HasCallStack => Either Error a -> a
unwrapError :: forall a. HasCallStack => Either Error a -> a
unwrapError Either Error a
e = case Either Error a
e of
  Left Error
err -> forall a. HasCallStack => String -> a
error (Error -> Text
prettyError Error
err forall a b. a -> (a -> b) -> b
& Text -> String
Text.unpack)
  Right a
a -> a
a

-- | Return the value from a potentially failing computation.
--
-- Abort with the error message if it was an error.
--
-- The text message is added to the 'Error' as additional context before aborting.
--
-- __Panics:__ if Error
--
-- Example:
--
-- >>> expectError "something bad happened" $ Left (newError "oh no!")
-- *** Exception: something bad happened: oh no!
-- ...
--
-- >>> expectError "something bad happened" $ Right 42
-- 42
expectError :: HasCallStack => Text -> Either Error p -> p
expectError :: forall p. HasCallStack => Text -> Either Error p -> p
expectError Text
context Either Error p
e = case Either Error p
e of
  Left Error
err ->
    forall a. HasCallStack => String -> a
error
      ( Error
err
          forall a b. a -> (a -> b) -> b
& Text -> Error -> Error
errorContext Text
context
          forall a b. a -> (a -> b) -> b
& Error -> Text
prettyError
          forall a b. a -> (a -> b) -> b
& Text -> String
Text.unpack
      )
  Right p
a -> p
a

-- | This Exception is not exported so that it’s impossible to catch and handle via 'Data.Typeable.Typeable'.
newtype ErrorException = ErrorException Error

-- | Show the pretty printed string without quotes.
instance Show ErrorException where
  showsPrec :: Int -> ErrorException -> ShowS
showsPrec Int
i (ErrorException Error
err) = String -> ShowS
showString (Error
err forall a b. a -> (a -> b) -> b
& Error -> Text
prettyError forall a b. a -> (a -> b) -> b
& Text -> String
Text.unpack)
instance Exception ErrorException where
  displayException :: ErrorException -> String
displayException = forall a. Show a => a -> String
show

-- | Like 'unwrapError', but instead of using 'error', it will 'Exc.throwIO' the pretty-printed error.
--
-- The advantage over `unwrapError` is that it crashes immediately, and not just when the 'Either' is forced,
-- leading to a deterministic immediate abortion of your IO code
-- (<https://github.com/ghc-proposals/ghc-proposals/pull/330 but no stack trace can be produced at the moment!>).
--
-- __Throws opaque Exception:__ if Error
--
-- Example:
--
-- >>> unwrapIOError $ Left (newError "oh no!")
-- *** Exception: oh no!
--
-- Important: 'Error' itself does /not/ implement 'Exception' to discourage the exception workflow.
-- The 'Exception' thrown is private to this module and thus can’t be “caught” in a typed manner.
-- If you use this function, you either have to catch 'Exc.SomeException', or it will bubble up and lead to
-- your program crashing.
unwrapIOError :: Either Error a -> IO a
unwrapIOError :: forall a. Either Error a -> IO a
unwrapIOError = \case
  Left Error
err -> forall e a. Exception e => e -> IO a
Exc.throwIO forall a b. (a -> b) -> a -> b
$ Error -> ErrorException
ErrorException Error
err
  Right a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | Like 'expectError', but instead of using 'error', it will 'Exc.throwIO' the pretty-printed error.
--
-- The advantage over `expectError` is that it crashes immediately, and not just when the 'Either' is forced,
-- leading to a deterministic immediate abortion of your IO code
-- (<https://github.com/ghc-proposals/ghc-proposals/pull/330 but no stack trace can be produced at the moment!>).
--
--
-- __Throws opaque Exception:__ if Error
--
-- Example:
--
-- >>> expectIOError "something bad happened" $ Left (newError "oh no!")
-- *** Exception: something bad happened: oh no!
--
-- Important: 'Error' itself does /not/ implement 'Exception' to discourage the exception workflow.
-- The 'Exception' thrown is private to this module and thus can’t be “caught” in a typed manner.
-- If you use this function, you either have to catch 'Exc.SomeException', or it will bubble up and lead to
-- your program crashing.
expectIOError :: Text -> Either Error a -> IO a
expectIOError :: forall a. Text -> Either Error a -> IO a
expectIOError Text
context = \case
  Left Error
err -> forall e a. Exception e => e -> IO a
Exc.throwIO forall a b. (a -> b) -> a -> b
$ Error -> ErrorException
ErrorException (Text -> Error -> Error
errorContext Text
context Error
err)
  Right a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | Catch any 'Exc.IOException's thrown by an @IO a@ as @Either Error a@.
--
-- The IOException is converted to an error with 'exceptionToError', and the given message
-- is added with 'errorContext'. This prevents the common pattern of bubbling up exceptions
-- without any context.
--
-- >>> ifIOError "could not open file" (Control.Exception.throwIO (userError "oh noes!"))
-- Left (Error ["could not open file","user error (oh noes!)"])
--
-- It can then be handled like a normal 'Error'.
--
-- The function lends itself to piping with '(&)':
--
-- >>> Control.Exception.throwIO (userError "oh noes!") & ifIOError "could not open file"
-- Left (Error ["could not open file","user error (oh noes!)"])
--
-- and if you just want to annotate the error and directly throw it again:
--
-- >>> Control.Exception.throwIO (userError "oh noes!") & ifIOError "could not open file" >>= unwrapIOError
-- *** Exception: could not open file: user error (oh noes!)
ifIOError :: Text -> IO a -> IO (Either Error a)
ifIOError :: forall a. Text -> IO a -> IO (Either Error a)
ifIOError = forall exc a. Exception exc => Text -> IO a -> IO (Either Error a)
ifError @Exc.IOException

-- | Catch any 'Exc.Exception's thrown by an @IO a@ as @Either Error a@.
--
-- The IOException is converted to an error with 'exceptionToError', and the given message
-- is added with 'errorContext'. This prevents the common pattern of bubbling up exceptions
-- without any context.
--
-- Use @TypeApplications@ to specify the 'Exception' you want to catch.
--
-- >>> :set -XTypeApplications
-- >>> ifError @Exc.ArithException "arithmetic exception" (putStr $ show $ 1 Data.Ratio.% 0)
-- Left (Error ["arithmetic exception","Ratio has zero denominator"])
--
-- It can then be handled like a normal 'Error'.
--
-- The function lends itself to piping with '(&)':
--
-- >>> (putStr $ show $ 1 Data.Ratio.% 0) & ifError @Exc.ArithException "arithmetic exception"
-- Left (Error ["arithmetic exception","Ratio has zero denominator"])
--
-- Bear in mind that pure exceptions are only raised when the resulting code is forced
-- (thus the @putStrLn $ show@ in the above example).
ifError :: forall exc a. (Exception exc) => Text -> IO a -> IO (Either Error a)
ifError :: forall exc a. Exception exc => Text -> IO a -> IO (Either Error a)
ifError Text
context IO a
io = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Error -> Error
errorContext Text
context forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall exc. Exception exc => exc -> Error
exceptionToError) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. Exception e => IO a -> IO (Either e a)
Exc.try @exc IO a
io