~singpolyma/tokyocabinet-haskell

ref: 092c4e9f28ad06b2bf8bea2b55229493f6aef3a8 tokyocabinet-haskell/Database/TokyoCabinet/Error.hsc -rw-r--r-- 3.6 KiB View raw
092c4e9fStephen Paul Weber Merge branch 'master' of https://github.com/athanclark/tokyocabinet-haskell 3 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
module Database.TokyoCabinet.Error
    (
    -- * Error code
      ECODE(..)
    -- * Utility function
    , errmsg
    , cintToError
    , errorToCInt
    -- * Other constants
    , cINT_MIN
    ) where

import System.IO.Unsafe (unsafePerformIO)
import Foreign
import Foreign.C.Types
import Foreign.C.String

#include <tcutil.h>

-- | Represents error
data ECODE =
    ESUCCESS | -- ^ success            
    ETHREAD  | -- ^ threading error    
    EINVALID | -- ^ invalid operation  
    ENOFILE  | -- ^ file not found     
    ENOPERM  | -- ^ no permission      
    EMETA    | -- ^ invalid meta data  
    ERHEAD   | -- ^ invalid record header 
    EOPEN    | -- ^ open error         
    ECLOSE   | -- ^ close error        
    ETRUNC   | -- ^ trunc error        
    ESYNC    | -- ^ sync error         
    ESTAT    | -- ^ stat error         
    ESEEK    | -- ^ seek error         
    EREAD    | -- ^ read error         
    EWRITE   | -- ^ write error        
    EMMAP    | -- ^ mmap error         
    ELOCK    | -- ^ lock error         
    EUNLINK  | -- ^ unlink error       
    ERENAME  | -- ^ rename error       
    EMKDIR   | -- ^ mkdir error        
    ERMDIR   | -- ^ rmdir error        
    EKEEP    | -- ^ existing record    
    ENOREC   | -- ^ no record found    
    EMISC      -- ^ miscellaneous error
    deriving (Eq, Ord)

instance Show ECODE where
    show e =  errmsg e ++ " (code:" ++ show (errorToCInt e) ++ ")"

errorToCInt :: ECODE -> CInt
errorToCInt ESUCCESS = #const TCESUCCESS
errorToCInt ETHREAD  = #const TCETHREAD
errorToCInt EINVALID = #const TCEINVALID
errorToCInt ENOFILE  = #const TCENOFILE
errorToCInt ENOPERM  = #const TCENOPERM
errorToCInt EMETA    = #const TCEMETA
errorToCInt ERHEAD   = #const TCERHEAD
errorToCInt EOPEN    = #const TCEOPEN
errorToCInt ECLOSE   = #const TCECLOSE
errorToCInt ETRUNC   = #const TCETRUNC
errorToCInt ESYNC    = #const TCESYNC
errorToCInt ESTAT    = #const TCESTAT
errorToCInt ESEEK    = #const TCESEEK
errorToCInt EREAD    = #const TCEREAD
errorToCInt EWRITE   = #const TCEWRITE
errorToCInt EMMAP    = #const TCEMMAP
errorToCInt ELOCK    = #const TCELOCK
errorToCInt EUNLINK  = #const TCEUNLINK
errorToCInt ERENAME  = #const TCERENAME
errorToCInt EMKDIR   = #const TCEMKDIR
errorToCInt ERMDIR   = #const TCERMDIR
errorToCInt EKEEP    = #const TCEKEEP
errorToCInt ENOREC   = #const TCENOREC
errorToCInt EMISC    = #const TCEMISC

cintToError :: CInt -> ECODE
cintToError #{const TCESUCCESS} = ESUCCESS
cintToError #{const TCETHREAD} = ETHREAD
cintToError #{const TCEINVALID} = EINVALID
cintToError #{const TCENOFILE} = ENOFILE
cintToError #{const TCENOPERM} = ENOPERM
cintToError #{const TCEMETA} = EMETA
cintToError #{const TCERHEAD} = ERHEAD
cintToError #{const TCEOPEN} = EOPEN
cintToError #{const TCECLOSE} = ECLOSE
cintToError #{const TCETRUNC} = ETRUNC
cintToError #{const TCESYNC} = ESYNC
cintToError #{const TCESTAT} = ESTAT
cintToError #{const TCESEEK} = ESEEK
cintToError #{const TCEREAD} = EREAD
cintToError #{const TCEWRITE} = EWRITE
cintToError #{const TCEMMAP} = EMMAP
cintToError #{const TCELOCK} = ELOCK
cintToError #{const TCEUNLINK} = EUNLINK
cintToError #{const TCERENAME} = ERENAME
cintToError #{const TCEMKDIR} = EMKDIR
cintToError #{const TCERMDIR} = ERMDIR
cintToError #{const TCEKEEP} = EKEEP
cintToError #{const TCENOREC} = ENOREC
cintToError #{const TCEMISC} = EMISC
cintToError _ = error "unknown error code"

cINT_MIN :: CInt
cINT_MIN = #const INT_MIN

-- | Convert error code to message string.
errmsg :: ECODE -> String
errmsg = unsafePerformIO . peekCString . c_tcerrmsg . errorToCInt

foreign import ccall "tcerrmsg"
  c_tcerrmsg :: CInt -> CString