{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Halfs.Errors where import Data.Word import Foreign.C.Error import Halfs.Monad import Halfs.Types data HalfsError = HE_AbsolutePathExpected | HE_AllocFailed | HE_BadFileHandleForRead | HE_BadFileHandleForWrite | HE_DecodeFail_BlockCarrier String | HE_DecodeFail_Ext String | HE_DecodeFail_Directory String | HE_DecodeFail_Inode String | HE_DirectoryHandleNotFound | HE_DirectoryNotEmpty | HE_ErrnoAnnotated HalfsError Errno | HE_FileNotFound | HE_FsckErr HalfsError | HE_InternalError String | HE_InvalidExtIdx | HE_InvalidStreamIndex Word64 | HE_InvalidDirHandle | HE_InvalidFileHandle | HE_MountFailed RsnHalfsMountFail | HE_ObjectExists FilePath | HE_ObjectDNE FilePath | HE_PathComponentNotFound String | HE_RenameFailed | HE_TestFailed String | HE_UnexpectedFileType FileType FilePath | HE_UnmountFailed deriving (Eq, Show) data RsnHalfsMountFail = BadSuperBlock String | DirtyUnmount deriving (Eq, Show) annErrno :: MonadError HalfsError m => HalfsError -> Errno -> m a e `annErrno` errno = throwError (e `HE_ErrnoAnnotated` errno) throwErrno :: Monad m => Errno -> HalfsError -> HalfsT HalfsError env m a throwErrno en = throwError . (`HE_ErrnoAnnotated` en) -- TODO: template haskell to make this a bit cleaner? instance Show Errno where show en | en == eOK = "EOK" | en == e2BIG = "E2BIG" | en == eACCES = "EACCES" | en == eADDRINUSE = "EADDRINUSE" | en == eADDRNOTAVAIL = "EADDRNOTAVAIL" | en == eADV = "EADV" | en == eAFNOSUPPORT = "EAFNOSUPPORT" | en == eAGAIN = "EAGAIN" | en == eALREADY = "EALREADY" | en == eBADF = "EBADF" | en == eBADMSG = "EBADMSG" | en == eBADRPC = "EBADRPC" | en == eBUSY = "EBUSY" | en == eCHILD = "ECHILD" | en == eCOMM = "ECOMM" | en == eCONNABORTED = "ECONNABORTED" | en == eCONNREFUSED = "ECONNREFUSED" | en == eCONNRESET = "ECONNRESET" | en == eDEADLK = "EDEADLK" | en == eDESTADDRREQ = "EDESTADDRREQ" | en == eDIRTY = "EDIRTY" | en == eDOM = "EDOM" | en == eDQUOT = "EDQUOT" | en == eEXIST = "EEXIST" | en == eFAULT = "EFAULT" | en == eFBIG = "EFBIG" | en == eFTYPE = "EFTYPE" | en == eHOSTDOWN = "EHOSTDOWN" | en == eHOSTUNREACH = "EHOSTUNREACH" | en == eIDRM = "EIDRM" | en == eILSEQ = "EILSEQ" | en == eINPROGRESS = "EINPROGRESS" | en == eINTR = "EINTR" | en == eINVAL = "EINVAL" | en == eIO = "EIO" | en == eISCONN = "EISCONN" | en == eISDIR = "EISDIR" | en == eLOOP = "ELOOP" | en == eMFILE = "EMFILE" | en == eMLINK = "EMLINK" | en == eMSGSIZE = "EMSGSIZE" | en == eMULTIHOP = "EMULTIHOP" | en == eNAMETOOLONG = "ENAMETOOLONG" | en == eNETDOWN = "ENETDOWN" | en == eNETRESET = "ENETRESET" | en == eNETUNREACH = "ENETUNREACH" | en == eNFILE = "ENFILE" | en == eNOBUFS = "ENOBUFS" | en == eNODATA = "ENODATA" | en == eNODEV = "ENODEV" | en == eNOENT = "ENOENT" | en == eNOEXEC = "ENOEXEC" | en == eNOLCK = "ENOLCK" | en == eNOLINK = "ENOLINK" | en == eNOMEM = "ENOMEM" | en == eNOMSG = "ENOMSG" | en == eNONET = "ENONET" | en == eNOPROTOOPT = "ENOPROTOOPT" | en == eNOSPC = "ENOSPC" | en == eNOSR = "ENOSR" | en == eNOSTR = "ENOSTR" | en == eNOSYS = "ENOSYS" | en == eNOTBLK = "ENOTBLK" | en == eNOTCONN = "ENOTCONN" | en == eNOTDIR = "ENOTDIR" | en == eNOTEMPTY = "ENOTEMPTY" | en == eNOTSOCK = "ENOTSOCK" | en == eNOTTY = "ENOTTY" | en == eNXIO = "ENXIO" | en == eOPNOTSUPP = "EOPNOTSUPP" | en == ePERM = "EPERM" | en == ePFNOSUPPORT = "EPFNOSUPPORT" | en == ePIPE = "EPIPE" | en == ePROCLIM = "EPROCLIM" | en == ePROCUNAVAIL = "EPROCUNAVAIL" | en == ePROGMISMATCH = "EPROGMISMATCH" | en == ePROGUNAVAIL = "EPROGUNAVAIL" | en == ePROTO = "EPROTO" | en == ePROTONOSUPPORT = "EPROTONOSUPPORT" | en == ePROTOTYPE = "EPROTOTYPE" | en == eRANGE = "ERANGE" | en == eREMCHG = "EREMCHG" | en == eREMOTE = "EREMOTE" | en == eROFS = "EROFS" | en == eRPCMISMATCH = "ERPCMISMATCH" | en == eRREMOTE = "ERREMOTE" | en == eSHUTDOWN = "ESHUTDOWN" | en == eSOCKTNOSUPPORT = "ESOCKTNOSUPPORT" | en == eSPIPE = "ESPIPE" | en == eSRCH = "ESRCH" | en == eSRMNT = "ESRMNT" | en == eSTALE = "ESTALE" | en == eTIME = "ETIME" | en == eTIMEDOUT = "ETIMEDOUT" | en == eTOOMANYREFS = "ETOOMANYREFS" | en == eTXTBSY = "ETXTBSY" | en == eUSERS = "EUSERS" | en == eWOULDBLOCK = "EWOULDBLOCK" | en == eXDEV = "EXDEV" | otherwise = ""