{-# LANGUAGE OverloadedStrings #-}
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 `addContext` to improve the messages generated by 'showToError' and 'exceptionToError'.
    showToError,
    exceptionToError,
    -- * Adding context
    addContext,
    -- * 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 if there was an error.
    --
    -- 'expectError' should usually be preffered, 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,
  )
where

import Data.Function ((&))
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Stack (HasCallStack)
import Control.Exception (Exception (displayException))

-- | 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@ ('addContext')
-- * pretty-printed (`prettyError`)
newtype Error = Error [Text]

-- | 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 :: a -> Error
showToError = Text -> Error
newError (Text -> Error) -> (a -> Text) -> a -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
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 :: exc -> Error
exceptionToError = Text -> Error
newError (Text -> Error) -> (exc -> Text) -> exc -> Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (exc -> String) -> exc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. exc -> String
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 'addContext',
-- and describe why you wanted to open the file in the first place:
--
-- @
-- addContext "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'.
addContext :: Text -> Error -> Error
addContext :: Text -> Error -> Error
addContext Text
e (Error [Text]
es) = [Text] -> Error
Error ([Text] -> Error) -> [Text] -> Error
forall a b. (a -> b) -> a -> b
$ Text
e Text -> [Text] -> [Text]
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
--     $ addContext "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 p -> p
unwrapError :: Either Error p -> p
unwrapError Either Error p
e = case Either Error p
e of
  Left Error
err -> String -> p
forall a. HasCallStack => String -> a
error (Error -> Text
prettyError Error
err Text -> (Text -> String) -> String
forall a b. a -> (a -> b) -> b
& Text -> String
Text.unpack)
  Right p
a -> p
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 :: Text -> Either Error p -> p
expectError Text
context Either Error p
e = case Either Error p
e of
  Left Error
err ->
    String -> p
forall a. HasCallStack => String -> a
error
      ( Error
err
          Error -> (Error -> Error) -> Error
forall a b. a -> (a -> b) -> b
& Text -> Error -> Error
addContext Text
context
          Error -> (Error -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Error -> Text
prettyError
          Text -> (Text -> String) -> String
forall a b. a -> (a -> b) -> b
& Text -> String
Text.unpack
      )
  Right p
a -> p
a