-- | This module contains an extensible error infrastructure.
--
-- Each kind of errors gets a separate type class which encodes
-- a 'Prism' (roughly a getter and a constructor). The 'Reader's, then,
-- have the constraints for precisely the set of errors they can return.
module Env.Internal.Error
  ( Error(..)
  , AsUnset(..)
  , AsEmpty(..)
  , AsUnread(..)
  ) where


-- | The type of errors returned by @envparse@'s 'Reader's. These fall into 3
-- categories:
--
--   * Variables that are unset in the environment.
--   * Variables whose value is empty.
--   * Variables whose value cannot be parsed.
data Error
  = UnsetError
  | EmptyError
  | UnreadError String
    deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq)

-- | The class of types that contain and can be constructed from
-- the error returned from parsing unset variables.
class AsUnset e where
  unset :: e
  tryUnset :: e -> Maybe ()

instance AsUnset Error where
  unset :: Error
unset = Error
UnsetError
  tryUnset :: Error -> Maybe ()
tryUnset Error
err =
    case Error
err of
      Error
UnsetError -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
      Error
_ -> Maybe ()
forall a. Maybe a
Nothing

-- | The class of types that contain and can be constructed from
-- the error returned from parsing variables whose value is empty.
class AsEmpty e where
  empty :: e
  tryEmpty :: e -> Maybe ()

instance AsEmpty Error where
  empty :: Error
empty = Error
EmptyError
  tryEmpty :: Error -> Maybe ()
tryEmpty Error
err =
    case Error
err of
      Error
EmptyError -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
      Error
_ -> Maybe ()
forall a. Maybe a
Nothing

-- | The class of types that contain and can be constructed from
-- the error returned from parsing variable whose value cannot be parsed.
class AsUnread e where
  unread :: String -> e
  tryUnread :: e -> Maybe String

instance AsUnread Error where
  unread :: String -> Error
unread = String -> Error
UnreadError
  tryUnread :: Error -> Maybe String
tryUnread Error
err =
    case Error
err of
      UnreadError String
msg -> String -> Maybe String
forall a. a -> Maybe a
Just String
msg
      Error
_ -> Maybe String
forall a. Maybe a
Nothing