module Cachix.Client.Exception (CachixException (..)) where

import Protolude

data CachixException
  = UnsupportedNixVersion Text
  | UserEnvNotSet Text
  | MustBeRoot Text
  | NixOSInstructions Text
  | AmbiguousInput Text
  | NoSigningKey Text
  | NoInput Text
  | NoConfig Text
  | NetRcParseError Text
  | NarStreamingError ExitCode Text
  | NarHashMismatch Text
  | DeprecatedCommand Text
  | AccessDeniedBinaryCache Text
  | BinaryCacheNotFound Text
  deriving (Int -> CachixException -> ShowS
[CachixException] -> ShowS
CachixException -> String
(Int -> CachixException -> ShowS)
-> (CachixException -> String)
-> ([CachixException] -> ShowS)
-> Show CachixException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CachixException] -> ShowS
$cshowList :: [CachixException] -> ShowS
show :: CachixException -> String
$cshow :: CachixException -> String
showsPrec :: Int -> CachixException -> ShowS
$cshowsPrec :: Int -> CachixException -> ShowS
Show, Typeable)

instance Exception CachixException where
  displayException :: CachixException -> String
displayException (UnsupportedNixVersion s :: Text
s) = Text -> String
forall a b. StringConv a b => a -> b
toS Text
s
  displayException (UserEnvNotSet s :: Text
s) = Text -> String
forall a b. StringConv a b => a -> b
toS Text
s
  displayException (MustBeRoot s :: Text
s) = Text -> String
forall a b. StringConv a b => a -> b
toS Text
s
  displayException (NixOSInstructions s :: Text
s) = Text -> String
forall a b. StringConv a b => a -> b
toS Text
s
  displayException (AmbiguousInput s :: Text
s) = Text -> String
forall a b. StringConv a b => a -> b
toS Text
s
  displayException (NoInput s :: Text
s) = Text -> String
forall a b. StringConv a b => a -> b
toS Text
s
  displayException (NoConfig s :: Text
s) = Text -> String
forall a b. StringConv a b => a -> b
toS Text
s
  displayException (NoSigningKey s :: Text
s) = Text -> String
forall a b. StringConv a b => a -> b
toS Text
s
  displayException (NetRcParseError s :: Text
s) = Text -> String
forall a b. StringConv a b => a -> b
toS Text
s
  displayException (NarStreamingError _ s :: Text
s) = Text -> String
forall a b. StringConv a b => a -> b
toS Text
s
  displayException (NarHashMismatch s :: Text
s) = Text -> String
forall a b. StringConv a b => a -> b
toS Text
s
  displayException (DeprecatedCommand s :: Text
s) = Text -> String
forall a b. StringConv a b => a -> b
toS Text
s
  displayException (AccessDeniedBinaryCache s :: Text
s) = Text -> String
forall a b. StringConv a b => a -> b
toS Text
s
  displayException (BinaryCacheNotFound s :: Text
s) = Text -> String
forall a b. StringConv a b => a -> b
toS Text
s