module System.XDG.Error where

import Control.Exception
import Path

-- | The type of exceptions raised by this library.
data XDGError
  = FileNotFound (Path Abs File)
  | NoReadableFile
  | -- | This exception is raised when an environment variable that should be defined is not. It is not raised when an optional environment variable is not defined.
    MissingEnv String
  | -- | This exception is raised when an invalid file path or a relative path is found instead of a valid absolute path.
    InvalidPath FilePath
  deriving (XDGError -> XDGError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XDGError -> XDGError -> Bool
$c/= :: XDGError -> XDGError -> Bool
== :: XDGError -> XDGError -> Bool
$c== :: XDGError -> XDGError -> Bool
Eq, Int -> XDGError -> ShowS
[XDGError] -> ShowS
XDGError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XDGError] -> ShowS
$cshowList :: [XDGError] -> ShowS
show :: XDGError -> String
$cshow :: XDGError -> String
showsPrec :: Int -> XDGError -> ShowS
$cshowsPrec :: Int -> XDGError -> ShowS
Show)

instance Exception XDGError

throwIOLeft :: Exception e => Either e a -> IO a
throwIOLeft :: forall e a. Exception e => Either e a -> IO a
throwIOLeft = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure