module Foreign.C.Error.Describe
  ( -- * Error Enum Names
    enumString
  , enumByteArray
  , enumShortText
  , enumText

    -- * Error Descriptions
  , descriptionString
  , descriptionByteArray
  , descriptionShortText
  , descriptionText

    -- * Legacy Function Names
  , string
  , byteArray
  ) where

import Control.Monad (when)
import Control.Monad.ST (runST)
import Data.ByteString.Short.Internal (ShortByteString (SBS))
import Data.Char (chr, ord)
import Data.Foldable (for_)
import Data.Primitive (ByteArray (..), SmallArray)
import Data.Primitive.Unlifted.Array (UnliftedArray)
import Data.Text (Text)
import Data.Text.Short (ShortText)
import Data.Word (Word8)
import Foreign.C.Error (Errno (..))
import Foreign.C.Types (CInt)

import qualified Data.Primitive as PM
import qualified Data.Primitive.Unlifted.Array as PM
import qualified Data.Text.Short as TS
import qualified Data.Text.Short.Unsafe as TS
import qualified GHC.Exts as E

string :: Errno -> String
string :: Errno -> String
string = Errno -> String
enumString

byteArray :: Errno -> ByteArray
byteArray :: Errno -> ByteArray
byteArray = Errno -> ByteArray
enumByteArray

enumString :: Errno -> String
enumString :: Errno -> String
enumString (Errno CInt
i) =
  if CInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Word
256 :: Word)
    then ByteArray -> String
asString (UnliftedArray ByteArray -> Int -> ByteArray
forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
PM.indexUnliftedArray UnliftedArray ByteArray
enumTable (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
i))
    else String
unknownString

enumByteArray :: Errno -> ByteArray
enumByteArray :: Errno -> ByteArray
enumByteArray (Errno CInt
i) =
  if CInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Word
256 :: Word)
    then UnliftedArray ByteArray -> Int -> ByteArray
forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
PM.indexUnliftedArray UnliftedArray ByteArray
enumTable (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
i)
    else case ByteArray
unknown of
      ByteArray ByteArray#
b -> ByteArray# -> ByteArray
ByteArray ByteArray#
b

enumShortText :: Errno -> ShortText
enumShortText :: Errno -> ShortText
enumShortText Errno
e = case Errno -> ByteArray
enumByteArray Errno
e of
  ByteArray ByteArray#
b -> ShortByteString -> ShortText
TS.fromShortByteStringUnsafe (ByteArray# -> ShortByteString
SBS ByteArray#
b)

enumText :: Errno -> Text
enumText :: Errno -> Text
enumText = ShortText -> Text
TS.toText (ShortText -> Text) -> (Errno -> ShortText) -> Errno -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Errno -> ShortText
enumShortText

descriptionString :: Errno -> String
descriptionString :: Errno -> String
descriptionString (Errno CInt
i) =
  if CInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Word
256 :: Word)
    then ByteArray -> String
asString (UnliftedArray ByteArray -> Int -> ByteArray
forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
PM.indexUnliftedArray UnliftedArray ByteArray
descriptionTable (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
i))
    else String
unknownString

descriptionByteArray :: Errno -> ByteArray
descriptionByteArray :: Errno -> ByteArray
descriptionByteArray (Errno CInt
i) =
  if CInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
i Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Word
256 :: Word)
    then UnliftedArray ByteArray -> Int -> ByteArray
forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
PM.indexUnliftedArray UnliftedArray ByteArray
descriptionTable (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
i)
    else case ByteArray
unknown of
      ByteArray ByteArray#
b -> ByteArray# -> ByteArray
ByteArray ByteArray#
b

descriptionShortText :: Errno -> ShortText
descriptionShortText :: Errno -> ShortText
descriptionShortText Errno
e = case Errno -> ByteArray
descriptionByteArray Errno
e of
  ByteArray ByteArray#
b -> ShortByteString -> ShortText
TS.fromShortByteStringUnsafe (ByteArray# -> ShortByteString
SBS ByteArray#
b)

descriptionText :: Errno -> Text
descriptionText :: Errno -> Text
descriptionText = ShortText -> Text
TS.toText (ShortText -> Text) -> (Errno -> ShortText) -> Errno -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Errno -> ShortText
descriptionShortText

{-# NOINLINE unknown #-}
unknown :: ByteArray
unknown :: ByteArray
unknown = String -> ByteArray
asBytes String
unknownString

unknownString :: String
unknownString :: String
unknownString = String
"UNKNOWN"

enumTable :: UnliftedArray ByteArray
enumTable :: UnliftedArray ByteArray
enumTable = (forall s. ST s (UnliftedArray ByteArray))
-> UnliftedArray ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (UnliftedArray ByteArray))
 -> UnliftedArray ByteArray)
-> (forall s. ST s (UnliftedArray ByteArray))
-> UnliftedArray ByteArray
forall a b. (a -> b) -> a -> b
$ do
  MutableUnliftedArray_ ByteArray# s ByteArray
m <- Int
-> ByteArray
-> ST s (MutableUnliftedArray (PrimState (ST s)) ByteArray)
forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
Int -> a -> m (MutableUnliftedArray (PrimState m) a)
PM.newUnliftedArray Int
256 (ByteArray
forall a. Monoid a => a
mempty :: ByteArray)
  SmallArray Description -> (Description -> ST s ()) -> ST s ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ SmallArray Description
codes ((Description -> ST s ()) -> ST s ())
-> (Description -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Description CInt
code ByteArray
descr ByteArray
_) -> do
    let ix :: Int
ix = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
code :: Int
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.when ((Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
256 :: Int)) Bool -> Bool -> Bool
&& (Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ MutableUnliftedArray (PrimState (ST s)) ByteArray
-> Int -> ByteArray -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
PM.writeUnliftedArray MutableUnliftedArray_ ByteArray# s ByteArray
MutableUnliftedArray (PrimState (ST s)) ByteArray
m Int
ix ByteArray
descr
  MutableUnliftedArray (PrimState (ST s)) ByteArray
-> ST s (UnliftedArray ByteArray)
forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
PM.unsafeFreezeUnliftedArray MutableUnliftedArray_ ByteArray# s ByteArray
MutableUnliftedArray (PrimState (ST s)) ByteArray
m

descriptionTable :: UnliftedArray ByteArray
descriptionTable :: UnliftedArray ByteArray
descriptionTable = (forall s. ST s (UnliftedArray ByteArray))
-> UnliftedArray ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (UnliftedArray ByteArray))
 -> UnliftedArray ByteArray)
-> (forall s. ST s (UnliftedArray ByteArray))
-> UnliftedArray ByteArray
forall a b. (a -> b) -> a -> b
$ do
  MutableUnliftedArray_ ByteArray# s ByteArray
m <- Int
-> ByteArray
-> ST s (MutableUnliftedArray (PrimState (ST s)) ByteArray)
forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
Int -> a -> m (MutableUnliftedArray (PrimState m) a)
PM.newUnliftedArray Int
256 (ByteArray
forall a. Monoid a => a
mempty :: ByteArray)
  SmallArray Description -> (Description -> ST s ()) -> ST s ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ SmallArray Description
codes ((Description -> ST s ()) -> ST s ())
-> (Description -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Description CInt
code ByteArray
_ ByteArray
descr) -> do
    let ix :: Int
ix = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
code :: Int
    Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
256 :: Int)) Bool -> Bool -> Bool
&& (Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ MutableUnliftedArray (PrimState (ST s)) ByteArray
-> Int -> ByteArray -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
PM.writeUnliftedArray MutableUnliftedArray_ ByteArray# s ByteArray
MutableUnliftedArray (PrimState (ST s)) ByteArray
m Int
ix ByteArray
descr
  MutableUnliftedArray (PrimState (ST s)) ByteArray
-> ST s (UnliftedArray ByteArray)
forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
PM.unsafeFreezeUnliftedArray MutableUnliftedArray_ ByteArray# s ByteArray
MutableUnliftedArray (PrimState (ST s)) ByteArray
m

data Description = Description !CInt !ByteArray !ByteArray

asBytes :: String -> ByteArray
asBytes :: String -> ByteArray
asBytes String
s = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
  MutableByteArray s
m <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s)
  [(Int, Char)] -> ((Int, Char) -> ST s ()) -> ST s ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int]
forall a. Enum a => a -> [a]
enumFrom (Int
0 :: Int)) String
s) (((Int, Char) -> ST s ()) -> ST s ())
-> ((Int, Char) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Int
ix, Char
c) -> do
    MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
m Int
ix (Char -> Word8
charToWord8 Char
c)
  MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
m

asString :: ByteArray -> String
asString :: ByteArray -> String
asString = (Word8 -> String -> String) -> String -> ByteArray -> String
forall a b. Prim a => (a -> b -> b) -> b -> ByteArray -> b
PM.foldrByteArray (\Word8
b String
cs -> Word8 -> Char
word8ToChar Word8
b Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs) []

charToWord8 :: Char -> Word8
charToWord8 :: Char -> Word8
charToWord8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

word8ToChar :: Word8 -> Char
word8ToChar :: Word8 -> Char
word8ToChar = Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

codes :: SmallArray Description
codes :: SmallArray Description
codes =
  [Item (SmallArray Description)] -> SmallArray Description
forall l. IsList l => [Item l] -> l
E.fromList
    [ {- 000 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
0 (String -> ByteArray
asBytes String
"EOK") (String -> ByteArray
asBytes String
"OK")
    , {- 001 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
1 (String -> ByteArray
asBytes String
"EPERM") (String -> ByteArray
asBytes String
"Operation not permitted")
    , {- 002 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
2 (String -> ByteArray
asBytes String
"ENOENT") (String -> ByteArray
asBytes String
"No such file or directory")
    , {- 003 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
3 (String -> ByteArray
asBytes String
"ESRCH") (String -> ByteArray
asBytes String
"No such process")
    , {- 004 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
4 (String -> ByteArray
asBytes String
"EINTR") (String -> ByteArray
asBytes String
"Interrupted system call")
    , {- 005 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
5 (String -> ByteArray
asBytes String
"EIO") (String -> ByteArray
asBytes String
"Input/output error")
    , {- 006 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
6 (String -> ByteArray
asBytes String
"ENXIO") (String -> ByteArray
asBytes String
"No such device or address")
    , {- 007 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
7 (String -> ByteArray
asBytes String
"E2BIG") (String -> ByteArray
asBytes String
"Argument list too long")
    , {- 008 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
8 (String -> ByteArray
asBytes String
"ENOEXEC") (String -> ByteArray
asBytes String
"Exec format error")
    , {- 009 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
9 (String -> ByteArray
asBytes String
"EBADF") (String -> ByteArray
asBytes String
"Bad file descriptor")
    , {- 010 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
10 (String -> ByteArray
asBytes String
"ECHILD") (String -> ByteArray
asBytes String
"No child processes")
    , {- 011 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
11 (String -> ByteArray
asBytes String
"EAGAIN") (String -> ByteArray
asBytes String
"Resource temporarily unavailable")
    , {- 012 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
12 (String -> ByteArray
asBytes String
"ENOMEM") (String -> ByteArray
asBytes String
"Cannot allocate memory")
    , {- 013 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
13 (String -> ByteArray
asBytes String
"EACCES") (String -> ByteArray
asBytes String
"Permission denied")
    , {- 014 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
14 (String -> ByteArray
asBytes String
"EFAULT") (String -> ByteArray
asBytes String
"Bad address")
    , {- 015 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
15 (String -> ByteArray
asBytes String
"ENOTBLK") (String -> ByteArray
asBytes String
"Block device required")
    , {- 016 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
16 (String -> ByteArray
asBytes String
"EBUSY") (String -> ByteArray
asBytes String
"Device or resource busy")
    , {- 017 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
17 (String -> ByteArray
asBytes String
"EEXIST") (String -> ByteArray
asBytes String
"File exists")
    , {- 018 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
18 (String -> ByteArray
asBytes String
"EXDEV") (String -> ByteArray
asBytes String
"Invalid cross-device link")
    , {- 019 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
19 (String -> ByteArray
asBytes String
"ENODEV") (String -> ByteArray
asBytes String
"No such device")
    , {- 020 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
20 (String -> ByteArray
asBytes String
"ENOTDIR") (String -> ByteArray
asBytes String
"Not a directory")
    , {- 021 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
21 (String -> ByteArray
asBytes String
"EISDIR") (String -> ByteArray
asBytes String
"Is a directory")
    , {- 022 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
22 (String -> ByteArray
asBytes String
"EINVAL") (String -> ByteArray
asBytes String
"Invalid argument")
    , {- 023 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
23 (String -> ByteArray
asBytes String
"ENFILE") (String -> ByteArray
asBytes String
"Too many open files in system")
    , {- 024 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
24 (String -> ByteArray
asBytes String
"EMFILE") (String -> ByteArray
asBytes String
"Too many open files")
    , {- 025 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
25 (String -> ByteArray
asBytes String
"ENOTTY") (String -> ByteArray
asBytes String
"Inappropriate ioctl for device")
    , {- 026 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
26 (String -> ByteArray
asBytes String
"ETXTBSY") (String -> ByteArray
asBytes String
"Text file busy")
    , {- 027 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
27 (String -> ByteArray
asBytes String
"EFBIG") (String -> ByteArray
asBytes String
"File too large")
    , {- 028 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
28 (String -> ByteArray
asBytes String
"ENOSPC") (String -> ByteArray
asBytes String
"No space left on device")
    , {- 029 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
29 (String -> ByteArray
asBytes String
"ESPIPE") (String -> ByteArray
asBytes String
"Illegal seek")
    , {- 030 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
30 (String -> ByteArray
asBytes String
"EROFS") (String -> ByteArray
asBytes String
"Read-only file system")
    , {- 031 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
31 (String -> ByteArray
asBytes String
"EMLINK") (String -> ByteArray
asBytes String
"Too many links")
    , {- 032 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
32 (String -> ByteArray
asBytes String
"EPIPE") (String -> ByteArray
asBytes String
"Broken pipe")
    , {- 033 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
33 (String -> ByteArray
asBytes String
"EDOM") (String -> ByteArray
asBytes String
"Numerical argument out of domain")
    , {- 034 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
34 (String -> ByteArray
asBytes String
"ERANGE") (String -> ByteArray
asBytes String
"Numerical result out of range")
    , {- 035 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
35 (String -> ByteArray
asBytes String
"EDEADLK") (String -> ByteArray
asBytes String
"Resource deadlock avoided")
    , {- 036 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
36 (String -> ByteArray
asBytes String
"ENAMETOOLONG") (String -> ByteArray
asBytes String
"File name too long")
    , {- 037 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
37 (String -> ByteArray
asBytes String
"ENOLCK") (String -> ByteArray
asBytes String
"No locks available")
    , {- 038 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
38 (String -> ByteArray
asBytes String
"ENOSYS") (String -> ByteArray
asBytes String
"Function not implemented")
    , {- 039 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
39 (String -> ByteArray
asBytes String
"ENOTEMPTY") (String -> ByteArray
asBytes String
"Directory not empty")
    , {- 040 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
40 (String -> ByteArray
asBytes String
"ELOOP") (String -> ByteArray
asBytes String
"Too many levels of symbolic links")
    , {- 042 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
42 (String -> ByteArray
asBytes String
"ENOMSG") (String -> ByteArray
asBytes String
"No message of desired type")
    , {- 043 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
43 (String -> ByteArray
asBytes String
"EIDRM") (String -> ByteArray
asBytes String
"Identifier removed")
    , {- 044 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
44 (String -> ByteArray
asBytes String
"ECHRNG") (String -> ByteArray
asBytes String
"Channel number out of range")
    , {- 045 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
45 (String -> ByteArray
asBytes String
"EL2NSYNC") (String -> ByteArray
asBytes String
"Level 2 not synchronized")
    , {- 046 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
46 (String -> ByteArray
asBytes String
"EL3HLT") (String -> ByteArray
asBytes String
"Level 3 halted")
    , {- 047 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
47 (String -> ByteArray
asBytes String
"EL3RST") (String -> ByteArray
asBytes String
"Level 3 reset")
    , {- 048 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
48 (String -> ByteArray
asBytes String
"ELNRNG") (String -> ByteArray
asBytes String
"Link number out of range")
    , {- 049 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
49 (String -> ByteArray
asBytes String
"EUNATCH") (String -> ByteArray
asBytes String
"Protocol driver not attached")
    , {- 050 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
50 (String -> ByteArray
asBytes String
"ENOCSI") (String -> ByteArray
asBytes String
"No CSI structure available")
    , {- 051 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
51 (String -> ByteArray
asBytes String
"EL2HLT") (String -> ByteArray
asBytes String
"Level 2 halted")
    , {- 052 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
52 (String -> ByteArray
asBytes String
"EBADE") (String -> ByteArray
asBytes String
"Invalid exchange")
    , {- 053 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
53 (String -> ByteArray
asBytes String
"EBADR") (String -> ByteArray
asBytes String
"Invalid request descriptor")
    , {- 054 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
54 (String -> ByteArray
asBytes String
"EXFULL") (String -> ByteArray
asBytes String
"Exchange full")
    , {- 055 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
55 (String -> ByteArray
asBytes String
"ENOANO") (String -> ByteArray
asBytes String
"No anode")
    , {- 056 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
56 (String -> ByteArray
asBytes String
"EBADRQC") (String -> ByteArray
asBytes String
"Invalid request code")
    , {- 057 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
57 (String -> ByteArray
asBytes String
"EBADSLT") (String -> ByteArray
asBytes String
"Invalid slot")
    , {- 059 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
59 (String -> ByteArray
asBytes String
"EBFONT") (String -> ByteArray
asBytes String
"Bad font file format")
    , {- 060 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
60 (String -> ByteArray
asBytes String
"ENOSTR") (String -> ByteArray
asBytes String
"Device not a stream")
    , {- 061 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
61 (String -> ByteArray
asBytes String
"ENODATA") (String -> ByteArray
asBytes String
"No data available")
    , {- 062 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
62 (String -> ByteArray
asBytes String
"ETIME") (String -> ByteArray
asBytes String
"Timer expired")
    , {- 063 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
63 (String -> ByteArray
asBytes String
"ENOSR") (String -> ByteArray
asBytes String
"Out of streams resources")
    , {- 064 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
64 (String -> ByteArray
asBytes String
"ENONET") (String -> ByteArray
asBytes String
"Machine is not on the network")
    , {- 065 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
65 (String -> ByteArray
asBytes String
"ENOPKG") (String -> ByteArray
asBytes String
"Package not installed")
    , {- 066 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
66 (String -> ByteArray
asBytes String
"EREMOTE") (String -> ByteArray
asBytes String
"Object is remote")
    , {- 067 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
67 (String -> ByteArray
asBytes String
"ENOLINK") (String -> ByteArray
asBytes String
"Link has been severed")
    , {- 068 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
68 (String -> ByteArray
asBytes String
"EADV") (String -> ByteArray
asBytes String
"Advertise error")
    , {- 069 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
69 (String -> ByteArray
asBytes String
"ESRMNT") (String -> ByteArray
asBytes String
"Srmount error")
    , {- 070 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
70 (String -> ByteArray
asBytes String
"ECOMM") (String -> ByteArray
asBytes String
"Communication error on send")
    , {- 071 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
71 (String -> ByteArray
asBytes String
"EPROTO") (String -> ByteArray
asBytes String
"Protocol error")
    , {- 072 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
72 (String -> ByteArray
asBytes String
"EMULTIHOP") (String -> ByteArray
asBytes String
"Multihop attempted")
    , {- 073 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
73 (String -> ByteArray
asBytes String
"EDOTDOT") (String -> ByteArray
asBytes String
"RFS specific error")
    , {- 074 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
74 (String -> ByteArray
asBytes String
"EBADMSG") (String -> ByteArray
asBytes String
"Bad message")
    , {- 075 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
75 (String -> ByteArray
asBytes String
"EOVERFLOW") (String -> ByteArray
asBytes String
"Value too large for defined data type")
    , {- 076 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
76 (String -> ByteArray
asBytes String
"ENOTUNIQ") (String -> ByteArray
asBytes String
"Name not unique on network")
    , {- 077 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
77 (String -> ByteArray
asBytes String
"EBADFD") (String -> ByteArray
asBytes String
"File descriptor in bad state")
    , {- 078 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
78 (String -> ByteArray
asBytes String
"EREMCHG") (String -> ByteArray
asBytes String
"Remote address changed")
    , {- 079 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
79 (String -> ByteArray
asBytes String
"ELIBACC") (String -> ByteArray
asBytes String
"Can not access a needed shared library")
    , {- 080 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
80 (String -> ByteArray
asBytes String
"ELIBBAD") (String -> ByteArray
asBytes String
"Accessing a corrupted shared library")
    , {- 081 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
81 (String -> ByteArray
asBytes String
"ELIBSCN") (String -> ByteArray
asBytes String
".lib section in a.out corrupted")
    , {- 082 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
82 (String -> ByteArray
asBytes String
"ELIBMAX") (String -> ByteArray
asBytes String
"Attempting to link in too many shared libraries")
    , {- 083 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
83 (String -> ByteArray
asBytes String
"ELIBEXEC") (String -> ByteArray
asBytes String
"Cannot exec a shared library directly")
    , {- 084 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
84 (String -> ByteArray
asBytes String
"EILSEQ") (String -> ByteArray
asBytes String
"Invalid or incomplete multibyte or wide character")
    , {- 085 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
85 (String -> ByteArray
asBytes String
"ERESTART") (String -> ByteArray
asBytes String
"Interrupted system call should be restarted")
    , {- 086 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
86 (String -> ByteArray
asBytes String
"ESTRPIPE") (String -> ByteArray
asBytes String
"Streams pipe error")
    , {- 087 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
87 (String -> ByteArray
asBytes String
"EUSERS") (String -> ByteArray
asBytes String
"Too many users")
    , {- 088 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
88 (String -> ByteArray
asBytes String
"ENOTSOCK") (String -> ByteArray
asBytes String
"Socket operation on non-socket")
    , {- 089 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
89 (String -> ByteArray
asBytes String
"EDESTADDRREQ") (String -> ByteArray
asBytes String
"Destination address required")
    , {- 090 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
90 (String -> ByteArray
asBytes String
"EMSGSIZE") (String -> ByteArray
asBytes String
"Message too long")
    , {- 091 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
91 (String -> ByteArray
asBytes String
"EPROTOTYPE") (String -> ByteArray
asBytes String
"Protocol wrong type for socket")
    , {- 092 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
92 (String -> ByteArray
asBytes String
"ENOPROTOOPT") (String -> ByteArray
asBytes String
"Protocol not available")
    , {- 093 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
93 (String -> ByteArray
asBytes String
"EPROTONOSUPPORT") (String -> ByteArray
asBytes String
"Protocol not supported")
    , {- 094 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
94 (String -> ByteArray
asBytes String
"ESOCKTNOSUPPORT") (String -> ByteArray
asBytes String
"Socket type not supported")
    , {- 095 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
95 (String -> ByteArray
asBytes String
"EOPNOTSUPP") (String -> ByteArray
asBytes String
"Operation not supported")
    , {- 096 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
96 (String -> ByteArray
asBytes String
"EPFNOSUPPORT") (String -> ByteArray
asBytes String
"Protocol family not supported")
    , {- 097 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
97 (String -> ByteArray
asBytes String
"EAFNOSUPPORT") (String -> ByteArray
asBytes String
"Address family not supported by protocol")
    , {- 098 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
98 (String -> ByteArray
asBytes String
"EADDRINUSE") (String -> ByteArray
asBytes String
"Address already in use")
    , {- 099 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
99 (String -> ByteArray
asBytes String
"EADDRNOTAVAIL") (String -> ByteArray
asBytes String
"Cannot assign requested address")
    , {- 100 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
100 (String -> ByteArray
asBytes String
"ENETDOWN") (String -> ByteArray
asBytes String
"Network is down")
    , {- 101 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
101 (String -> ByteArray
asBytes String
"ENETUNREACH") (String -> ByteArray
asBytes String
"Network is unreachable")
    , {- 102 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
102 (String -> ByteArray
asBytes String
"ENETRESET") (String -> ByteArray
asBytes String
"Network dropped connection on reset")
    , {- 103 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
103 (String -> ByteArray
asBytes String
"ECONNABORTED") (String -> ByteArray
asBytes String
"Software caused connection abort")
    , {- 104 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
104 (String -> ByteArray
asBytes String
"ECONNRESET") (String -> ByteArray
asBytes String
"Connection reset by peer")
    , {- 105 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
105 (String -> ByteArray
asBytes String
"ENOBUFS") (String -> ByteArray
asBytes String
"No buffer space available")
    , {- 106 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
106 (String -> ByteArray
asBytes String
"EISCONN") (String -> ByteArray
asBytes String
"Transport endpoint is already connected")
    , {- 107 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
107 (String -> ByteArray
asBytes String
"ENOTCONN") (String -> ByteArray
asBytes String
"Transport endpoint is not connected")
    , {- 108 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
108 (String -> ByteArray
asBytes String
"ESHUTDOWN") (String -> ByteArray
asBytes String
"Cannot send after transport endpoint shutdown")
    , {- 109 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
109 (String -> ByteArray
asBytes String
"ETOOMANYREFS") (String -> ByteArray
asBytes String
"Too many references: cannot splice")
    , {- 110 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
110 (String -> ByteArray
asBytes String
"ETIMEDOUT") (String -> ByteArray
asBytes String
"Connection timed out")
    , {- 111 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
111 (String -> ByteArray
asBytes String
"ECONNREFUSED") (String -> ByteArray
asBytes String
"Connection refused")
    , {- 112 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
112 (String -> ByteArray
asBytes String
"EHOSTDOWN") (String -> ByteArray
asBytes String
"Host is down")
    , {- 113 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
113 (String -> ByteArray
asBytes String
"EHOSTUNREACH") (String -> ByteArray
asBytes String
"No route to host")
    , {- 114 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
114 (String -> ByteArray
asBytes String
"EALREADY") (String -> ByteArray
asBytes String
"Operation already in progress")
    , {- 115 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
115 (String -> ByteArray
asBytes String
"EINPROGRESS") (String -> ByteArray
asBytes String
"Operation now in progress")
    , {- 116 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
116 (String -> ByteArray
asBytes String
"ESTALE") (String -> ByteArray
asBytes String
"Stale file handle")
    , {- 117 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
117 (String -> ByteArray
asBytes String
"EUCLEAN") (String -> ByteArray
asBytes String
"Structure needs cleaning")
    , {- 118 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
118 (String -> ByteArray
asBytes String
"ENOTNAM") (String -> ByteArray
asBytes String
"Not a XENIX named type file")
    , {- 119 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
119 (String -> ByteArray
asBytes String
"ENAVAIL") (String -> ByteArray
asBytes String
"No XENIX semaphores available")
    , {- 120 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
120 (String -> ByteArray
asBytes String
"EISNAM") (String -> ByteArray
asBytes String
"Is a named type file")
    , {- 121 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
121 (String -> ByteArray
asBytes String
"EREMOTEIO") (String -> ByteArray
asBytes String
"Remote I/O error")
    , {- 122 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
122 (String -> ByteArray
asBytes String
"EDQUOT") (String -> ByteArray
asBytes String
"Disk quota exceeded")
    , {- 123 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
123 (String -> ByteArray
asBytes String
"ENOMEDIUM") (String -> ByteArray
asBytes String
"No medium found")
    , {- 124 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
124 (String -> ByteArray
asBytes String
"EMEDIUMTYPE") (String -> ByteArray
asBytes String
"Wrong medium type")
    , {- 125 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
125 (String -> ByteArray
asBytes String
"ECANCELED") (String -> ByteArray
asBytes String
"Operation canceled")
    , {- 126 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
126 (String -> ByteArray
asBytes String
"ENOKEY") (String -> ByteArray
asBytes String
"Required key not available")
    , {- 127 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
127 (String -> ByteArray
asBytes String
"EKEYEXPIRED") (String -> ByteArray
asBytes String
"Key has expired")
    , {- 128 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
128 (String -> ByteArray
asBytes String
"EKEYREVOKED") (String -> ByteArray
asBytes String
"Key has been revoked")
    , {- 129 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
129 (String -> ByteArray
asBytes String
"EKEYREJECTED") (String -> ByteArray
asBytes String
"Key was rejected by service")
    , {- 130 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
130 (String -> ByteArray
asBytes String
"EOWNERDEAD") (String -> ByteArray
asBytes String
"Owner died")
    , {- 131 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
131 (String -> ByteArray
asBytes String
"ENOTRECOVERABLE") (String -> ByteArray
asBytes String
"State not recoverable")
    , {- 132 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
132 (String -> ByteArray
asBytes String
"ERFKILL") (String -> ByteArray
asBytes String
"Operation not possible due to RF-kill")
    , {- 133 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
133 (String -> ByteArray
asBytes String
"EHWPOISON") (String -> ByteArray
asBytes String
"Memory page has hardware error")
    , {- 254 -} CInt -> ByteArray -> ByteArray -> Description
Description CInt
254 (String -> ByteArray
asBytes String
"EEOI") (String -> ByteArray
asBytes String
"End of input")
    ]