-- |
-- Stability   :  Ultra-Violence
-- Portability :  I'm too young to die
-- The exceptions one would want to throw to be understood by the existing 9P clients.

module Network.NineP.Error
	( NineError(..)
	) where

import Control.Exception
import Data.Typeable
import Data.Word

data NineError =
	ENotImplemented String |
	ENotADir |
	EDir |
	ENoFile String |
	ENoFid Word32 |
	ENoAuthRequired |
	EPermissionDenied |
	EInval |
	OtherError String deriving (Typeable)

instance Exception NineError

-- |See also: @linux\/net\/9p\/error.c@
instance Show NineError where
	show :: NineError -> String
show (ENotImplemented String
s) = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not implemented"
	show NineError
ENotADir = String
"not a directory"
	show NineError
EDir = String
"Is a directory"
	show (ENoFile String
s) = String
"file not found"
	show (ENoFid Word32
i) = String
"fid " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not registered on the server"
	show NineError
ENoAuthRequired = String
"the server doesn't require any kind of authentication"
	show NineError
EPermissionDenied = String
"permission denied"
	show NineError
EInval = String
"Invalid argument"
	show (OtherError String
s) = String
s