-- | Common exceptions
module Data.Exception.Types
  ( AlreadyExists (..)
  , DivideByZero  (..)
  , InvalidFormat (..)
  , NotAllowed    (..)
  , NotFound      (..)
  , OutOfBounds   (..)
  , WithMessage   (..)
  ) where

import           Data.Text

-- | Entity not found
data NotFound entity
  = NotFound
  deriving (Int -> NotFound entity -> ShowS
[NotFound entity] -> ShowS
NotFound entity -> String
(Int -> NotFound entity -> ShowS)
-> (NotFound entity -> String)
-> ([NotFound entity] -> ShowS)
-> Show (NotFound entity)
forall entity. Int -> NotFound entity -> ShowS
forall entity. [NotFound entity] -> ShowS
forall entity. NotFound entity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotFound entity] -> ShowS
$cshowList :: forall entity. [NotFound entity] -> ShowS
show :: NotFound entity -> String
$cshow :: forall entity. NotFound entity -> String
showsPrec :: Int -> NotFound entity -> ShowS
$cshowsPrec :: forall entity. Int -> NotFound entity -> ShowS
Show, NotFound entity -> NotFound entity -> Bool
(NotFound entity -> NotFound entity -> Bool)
-> (NotFound entity -> NotFound entity -> Bool)
-> Eq (NotFound entity)
forall entity. NotFound entity -> NotFound entity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotFound entity -> NotFound entity -> Bool
$c/= :: forall entity. NotFound entity -> NotFound entity -> Bool
== :: NotFound entity -> NotFound entity -> Bool
$c== :: forall entity. NotFound entity -> NotFound entity -> Bool
Eq)

-- | Action not allowed by user
data NotAllowed user entity =
  NotAllowed
    { NotAllowed user entity -> user
user   :: !user
    , NotAllowed user entity -> entity
entity :: !entity
    }
  deriving (Int -> NotAllowed user entity -> ShowS
[NotAllowed user entity] -> ShowS
NotAllowed user entity -> String
(Int -> NotAllowed user entity -> ShowS)
-> (NotAllowed user entity -> String)
-> ([NotAllowed user entity] -> ShowS)
-> Show (NotAllowed user entity)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall user entity.
(Show user, Show entity) =>
Int -> NotAllowed user entity -> ShowS
forall user entity.
(Show user, Show entity) =>
[NotAllowed user entity] -> ShowS
forall user entity.
(Show user, Show entity) =>
NotAllowed user entity -> String
showList :: [NotAllowed user entity] -> ShowS
$cshowList :: forall user entity.
(Show user, Show entity) =>
[NotAllowed user entity] -> ShowS
show :: NotAllowed user entity -> String
$cshow :: forall user entity.
(Show user, Show entity) =>
NotAllowed user entity -> String
showsPrec :: Int -> NotAllowed user entity -> ShowS
$cshowsPrec :: forall user entity.
(Show user, Show entity) =>
Int -> NotAllowed user entity -> ShowS
Show, NotAllowed user entity -> NotAllowed user entity -> Bool
(NotAllowed user entity -> NotAllowed user entity -> Bool)
-> (NotAllowed user entity -> NotAllowed user entity -> Bool)
-> Eq (NotAllowed user entity)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall user entity.
(Eq user, Eq entity) =>
NotAllowed user entity -> NotAllowed user entity -> Bool
/= :: NotAllowed user entity -> NotAllowed user entity -> Bool
$c/= :: forall user entity.
(Eq user, Eq entity) =>
NotAllowed user entity -> NotAllowed user entity -> Bool
== :: NotAllowed user entity -> NotAllowed user entity -> Bool
$c== :: forall user entity.
(Eq user, Eq entity) =>
NotAllowed user entity -> NotAllowed user entity -> Bool
Eq)

-- | Requested entity already exists; a conflict
newtype AlreadyExists entity
  = AlreadyExists entity
  deriving (Int -> AlreadyExists entity -> ShowS
[AlreadyExists entity] -> ShowS
AlreadyExists entity -> String
(Int -> AlreadyExists entity -> ShowS)
-> (AlreadyExists entity -> String)
-> ([AlreadyExists entity] -> ShowS)
-> Show (AlreadyExists entity)
forall entity. Show entity => Int -> AlreadyExists entity -> ShowS
forall entity. Show entity => [AlreadyExists entity] -> ShowS
forall entity. Show entity => AlreadyExists entity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlreadyExists entity] -> ShowS
$cshowList :: forall entity. Show entity => [AlreadyExists entity] -> ShowS
show :: AlreadyExists entity -> String
$cshow :: forall entity. Show entity => AlreadyExists entity -> String
showsPrec :: Int -> AlreadyExists entity -> ShowS
$cshowsPrec :: forall entity. Show entity => Int -> AlreadyExists entity -> ShowS
Show, AlreadyExists entity -> AlreadyExists entity -> Bool
(AlreadyExists entity -> AlreadyExists entity -> Bool)
-> (AlreadyExists entity -> AlreadyExists entity -> Bool)
-> Eq (AlreadyExists entity)
forall entity.
Eq entity =>
AlreadyExists entity -> AlreadyExists entity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlreadyExists entity -> AlreadyExists entity -> Bool
$c/= :: forall entity.
Eq entity =>
AlreadyExists entity -> AlreadyExists entity -> Bool
== :: AlreadyExists entity -> AlreadyExists entity -> Bool
$c== :: forall entity.
Eq entity =>
AlreadyExists entity -> AlreadyExists entity -> Bool
Eq)

instance Functor AlreadyExists where
  fmap :: (a -> b) -> AlreadyExists a -> AlreadyExists b
fmap a -> b
f (AlreadyExists a
entity') = b -> AlreadyExists b
forall entity. entity -> AlreadyExists entity
AlreadyExists (b -> AlreadyExists b) -> b -> AlreadyExists b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
entity'

-- | Requested index is out of bounds
newtype OutOfBounds entity index
  = OutOfBounds index
  deriving (Int -> OutOfBounds entity index -> ShowS
[OutOfBounds entity index] -> ShowS
OutOfBounds entity index -> String
(Int -> OutOfBounds entity index -> ShowS)
-> (OutOfBounds entity index -> String)
-> ([OutOfBounds entity index] -> ShowS)
-> Show (OutOfBounds entity index)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall entity index.
Show index =>
Int -> OutOfBounds entity index -> ShowS
forall entity index.
Show index =>
[OutOfBounds entity index] -> ShowS
forall entity index.
Show index =>
OutOfBounds entity index -> String
showList :: [OutOfBounds entity index] -> ShowS
$cshowList :: forall entity index.
Show index =>
[OutOfBounds entity index] -> ShowS
show :: OutOfBounds entity index -> String
$cshow :: forall entity index.
Show index =>
OutOfBounds entity index -> String
showsPrec :: Int -> OutOfBounds entity index -> ShowS
$cshowsPrec :: forall entity index.
Show index =>
Int -> OutOfBounds entity index -> ShowS
Show, OutOfBounds entity index -> OutOfBounds entity index -> Bool
(OutOfBounds entity index -> OutOfBounds entity index -> Bool)
-> (OutOfBounds entity index -> OutOfBounds entity index -> Bool)
-> Eq (OutOfBounds entity index)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall entity index.
Eq index =>
OutOfBounds entity index -> OutOfBounds entity index -> Bool
/= :: OutOfBounds entity index -> OutOfBounds entity index -> Bool
$c/= :: forall entity index.
Eq index =>
OutOfBounds entity index -> OutOfBounds entity index -> Bool
== :: OutOfBounds entity index -> OutOfBounds entity index -> Bool
$c== :: forall entity index.
Eq index =>
OutOfBounds entity index -> OutOfBounds entity index -> Bool
Eq)

instance Functor (OutOfBounds entity) where
  fmap :: (a -> b) -> OutOfBounds entity a -> OutOfBounds entity b
fmap a -> b
f (OutOfBounds a
index') = b -> OutOfBounds entity b
forall entity index. index -> OutOfBounds entity index
OutOfBounds (b -> OutOfBounds entity b) -> b -> OutOfBounds entity b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
index'

-- | Arithmetic divide by zero error
data DivideByZero
  = DivideByZero
  deriving (Int -> DivideByZero -> ShowS
[DivideByZero] -> ShowS
DivideByZero -> String
(Int -> DivideByZero -> ShowS)
-> (DivideByZero -> String)
-> ([DivideByZero] -> ShowS)
-> Show DivideByZero
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DivideByZero] -> ShowS
$cshowList :: [DivideByZero] -> ShowS
show :: DivideByZero -> String
$cshow :: DivideByZero -> String
showsPrec :: Int -> DivideByZero -> ShowS
$cshowsPrec :: Int -> DivideByZero -> ShowS
Show, DivideByZero -> DivideByZero -> Bool
(DivideByZero -> DivideByZero -> Bool)
-> (DivideByZero -> DivideByZero -> Bool) -> Eq DivideByZero
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DivideByZero -> DivideByZero -> Bool
$c/= :: DivideByZero -> DivideByZero -> Bool
== :: DivideByZero -> DivideByZero -> Bool
$c== :: DivideByZero -> DivideByZero -> Bool
Eq)

-- | Invalid format for entity (e.g. bad JSON)
newtype InvalidFormat entity
  = InvalidFormat entity
  deriving (Int -> InvalidFormat entity -> ShowS
[InvalidFormat entity] -> ShowS
InvalidFormat entity -> String
(Int -> InvalidFormat entity -> ShowS)
-> (InvalidFormat entity -> String)
-> ([InvalidFormat entity] -> ShowS)
-> Show (InvalidFormat entity)
forall entity. Show entity => Int -> InvalidFormat entity -> ShowS
forall entity. Show entity => [InvalidFormat entity] -> ShowS
forall entity. Show entity => InvalidFormat entity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidFormat entity] -> ShowS
$cshowList :: forall entity. Show entity => [InvalidFormat entity] -> ShowS
show :: InvalidFormat entity -> String
$cshow :: forall entity. Show entity => InvalidFormat entity -> String
showsPrec :: Int -> InvalidFormat entity -> ShowS
$cshowsPrec :: forall entity. Show entity => Int -> InvalidFormat entity -> ShowS
Show, InvalidFormat entity -> InvalidFormat entity -> Bool
(InvalidFormat entity -> InvalidFormat entity -> Bool)
-> (InvalidFormat entity -> InvalidFormat entity -> Bool)
-> Eq (InvalidFormat entity)
forall entity.
Eq entity =>
InvalidFormat entity -> InvalidFormat entity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidFormat entity -> InvalidFormat entity -> Bool
$c/= :: forall entity.
Eq entity =>
InvalidFormat entity -> InvalidFormat entity -> Bool
== :: InvalidFormat entity -> InvalidFormat entity -> Bool
$c== :: forall entity.
Eq entity =>
InvalidFormat entity -> InvalidFormat entity -> Bool
Eq)

instance Functor InvalidFormat where
  fmap :: (a -> b) -> InvalidFormat a -> InvalidFormat b
fmap a -> b
f (InvalidFormat a
entity') = b -> InvalidFormat b
forall entity. entity -> InvalidFormat entity
InvalidFormat (b -> InvalidFormat b) -> b -> InvalidFormat b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
entity'

-- | Attach a message to an exception, typicaly for runtime user feedback
--
-- ==== __Examples__
--
-- >>> :set -XOverloadedStrings
-- >>> show $ InvalidFormat "foo" `WithMessage` "Not a valid JSON object"
-- "InvalidFormat \"foo\" `WithMessage` \"Not a valid JSON object\""
data WithMessage err
  = !err `WithMessage` !Text
  deriving (Int -> WithMessage err -> ShowS
[WithMessage err] -> ShowS
WithMessage err -> String
(Int -> WithMessage err -> ShowS)
-> (WithMessage err -> String)
-> ([WithMessage err] -> ShowS)
-> Show (WithMessage err)
forall err. Show err => Int -> WithMessage err -> ShowS
forall err. Show err => [WithMessage err] -> ShowS
forall err. Show err => WithMessage err -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithMessage err] -> ShowS
$cshowList :: forall err. Show err => [WithMessage err] -> ShowS
show :: WithMessage err -> String
$cshow :: forall err. Show err => WithMessage err -> String
showsPrec :: Int -> WithMessage err -> ShowS
$cshowsPrec :: forall err. Show err => Int -> WithMessage err -> ShowS
Show, WithMessage err -> WithMessage err -> Bool
(WithMessage err -> WithMessage err -> Bool)
-> (WithMessage err -> WithMessage err -> Bool)
-> Eq (WithMessage err)
forall err. Eq err => WithMessage err -> WithMessage err -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithMessage err -> WithMessage err -> Bool
$c/= :: forall err. Eq err => WithMessage err -> WithMessage err -> Bool
== :: WithMessage err -> WithMessage err -> Bool
$c== :: forall err. Eq err => WithMessage err -> WithMessage err -> Bool
Eq)

instance Functor WithMessage where
  fmap :: (a -> b) -> WithMessage a -> WithMessage b
fmap a -> b
f (WithMessage a
err Text
msg) = b -> Text -> WithMessage b
forall err. err -> Text -> WithMessage err
WithMessage (a -> b
f a
err) Text
msg