module Network.IPFS.Peer.Error (Error (..)) where

import           Network.IPFS.Peer.Types
import           Network.IPFS.Prelude

data Error
  = DecodeFailure    String
  | CannotConnect    Peer
  | CannotDisconnect Peer
  | UnknownErr Text
  deriving ( Show Error
Typeable Error
SomeException -> Maybe Error
Error -> String
Error -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: Error -> String
$cdisplayException :: Error -> String
fromException :: SomeException -> Maybe Error
$cfromException :: SomeException -> Maybe Error
toException :: Error -> SomeException
$ctoException :: Error -> SomeException
Exception
           , Error -> Error -> Bool
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
           , forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Error x -> Error
$cfrom :: forall x. Error -> Rep Error x
Generic
           , Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
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
           )

instance Display Error where
  display :: Error -> Utf8Builder
display = \case
    DecodeFailure String
err  -> Utf8Builder
"Unable to decode: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow String
err
    CannotConnect Peer
peer -> Utf8Builder
"Unable to connect to " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Peer
peer
    CannotDisconnect Peer
peer -> Utf8Builder
"Unable to disconnect from " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Peer
peer
    UnknownErr    Text
msg  -> Utf8Builder
"Unknown IPFS peer list error: " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
msg