{- |
   Module     : Data.Convertible.Instances.C
   Copyright  : Copyright (C) 2009-2011 John Goerzen
   License    : BSD3

   Maintainer : John Goerzen <jgoerzen@complete.org>
   Stability  : provisional
   Portability: portable

Numeric instances for Convertible for C types.  See comments in
"Data.Convertible.Instances.Num".

Copyright (C) 2009-2011 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file LICENSE
-}
module Data.Convertible.Instances.C()
where

import Data.Convertible.Base
import Data.Convertible.Utils
import Data.Convertible.Instances.Num()
import Data.Int
import Data.Word
import Foreign.C.Types

-- remainder of this file generated by utils/genCinstances.hs

-- Section 1
instance Convertible CFloat Int where
    safeConvert :: CFloat -> ConvertResult Int
safeConvert = (CFloat -> ConvertResult Int) -> CFloat -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CFloat -> Int) -> CFloat -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Int CFloat where
    safeConvert :: Int -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (Int -> CFloat) -> Int -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CFloat Int8 where
    safeConvert :: CFloat -> ConvertResult Int8
safeConvert = (CFloat -> ConvertResult Int8) -> CFloat -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CFloat -> Int8) -> CFloat -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Int8
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Int8 CFloat where
    safeConvert :: Int8 -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (Int8 -> CFloat) -> Int8 -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CFloat Int16 where
    safeConvert :: CFloat -> ConvertResult Int16
safeConvert = (CFloat -> ConvertResult Int16) -> CFloat -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CFloat -> Int16) -> CFloat -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Int16
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Int16 CFloat where
    safeConvert :: Int16 -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (Int16 -> CFloat) -> Int16 -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CFloat Int32 where
    safeConvert :: CFloat -> ConvertResult Int32
safeConvert = (CFloat -> ConvertResult Int32) -> CFloat -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CFloat -> Int32) -> CFloat -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Int32
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Int32 CFloat where
    safeConvert :: Int32 -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (Int32 -> CFloat) -> Int32 -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CFloat Int64 where
    safeConvert :: CFloat -> ConvertResult Int64
safeConvert = (CFloat -> ConvertResult Int64) -> CFloat -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CFloat -> Int64) -> CFloat -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Int64 CFloat where
    safeConvert :: Int64 -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (Int64 -> CFloat) -> Int64 -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CFloat Word where
    safeConvert :: CFloat -> ConvertResult Word
safeConvert = (CFloat -> ConvertResult Word) -> CFloat -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CFloat -> Word) -> CFloat -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Word
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Word CFloat where
    safeConvert :: Word -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (Word -> CFloat) -> Word -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CFloat Word8 where
    safeConvert :: CFloat -> ConvertResult Word8
safeConvert = (CFloat -> ConvertResult Word8) -> CFloat -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CFloat -> Word8) -> CFloat -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Word8
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Word8 CFloat where
    safeConvert :: Word8 -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (Word8 -> CFloat) -> Word8 -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CFloat Word16 where
    safeConvert :: CFloat -> ConvertResult Word16
safeConvert = (CFloat -> ConvertResult Word16) -> CFloat -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CFloat -> Word16) -> CFloat -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Word16
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Word16 CFloat where
    safeConvert :: Word16 -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (Word16 -> CFloat) -> Word16 -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CFloat Word32 where
    safeConvert :: CFloat -> ConvertResult Word32
safeConvert = (CFloat -> ConvertResult Word32) -> CFloat -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CFloat -> Word32) -> CFloat -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Word32 CFloat where
    safeConvert :: Word32 -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (Word32 -> CFloat) -> Word32 -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CFloat Word64 where
    safeConvert :: CFloat -> ConvertResult Word64
safeConvert = (CFloat -> ConvertResult Word64) -> CFloat -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CFloat -> Word64) -> CFloat -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Word64 CFloat where
    safeConvert :: Word64 -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (Word64 -> CFloat) -> Word64 -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CDouble Int where
    safeConvert :: CDouble -> ConvertResult Int
safeConvert = (CDouble -> ConvertResult Int) -> CDouble -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CDouble -> Int) -> CDouble -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Int CDouble where
    safeConvert :: Int -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (Int -> CDouble) -> Int -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CDouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CDouble Int8 where
    safeConvert :: CDouble -> ConvertResult Int8
safeConvert = (CDouble -> ConvertResult Int8) -> CDouble -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CDouble -> Int8) -> CDouble -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Int8
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Int8 CDouble where
    safeConvert :: Int8 -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (Int8 -> CDouble) -> Int8 -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CDouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CDouble Int16 where
    safeConvert :: CDouble -> ConvertResult Int16
safeConvert = (CDouble -> ConvertResult Int16) -> CDouble -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CDouble -> Int16) -> CDouble -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Int16
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Int16 CDouble where
    safeConvert :: Int16 -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (Int16 -> CDouble) -> Int16 -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CDouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CDouble Int32 where
    safeConvert :: CDouble -> ConvertResult Int32
safeConvert = (CDouble -> ConvertResult Int32) -> CDouble -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CDouble -> Int32) -> CDouble -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Int32
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Int32 CDouble where
    safeConvert :: Int32 -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (Int32 -> CDouble) -> Int32 -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CDouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CDouble Int64 where
    safeConvert :: CDouble -> ConvertResult Int64
safeConvert = (CDouble -> ConvertResult Int64) -> CDouble -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CDouble -> Int64) -> CDouble -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Int64 CDouble where
    safeConvert :: Int64 -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (Int64 -> CDouble) -> Int64 -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CDouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CDouble Word where
    safeConvert :: CDouble -> ConvertResult Word
safeConvert = (CDouble -> ConvertResult Word) -> CDouble -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CDouble -> Word) -> CDouble -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Word
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Word CDouble where
    safeConvert :: Word -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (Word -> CDouble) -> Word -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CDouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CDouble Word8 where
    safeConvert :: CDouble -> ConvertResult Word8
safeConvert = (CDouble -> ConvertResult Word8) -> CDouble -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CDouble -> Word8) -> CDouble -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Word8
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Word8 CDouble where
    safeConvert :: Word8 -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (Word8 -> CDouble) -> Word8 -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CDouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CDouble Word16 where
    safeConvert :: CDouble -> ConvertResult Word16
safeConvert = (CDouble -> ConvertResult Word16)
-> CDouble -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CDouble -> Word16) -> CDouble -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Word16
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Word16 CDouble where
    safeConvert :: Word16 -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (Word16 -> CDouble) -> Word16 -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CDouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CDouble Word32 where
    safeConvert :: CDouble -> ConvertResult Word32
safeConvert = (CDouble -> ConvertResult Word32)
-> CDouble -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CDouble -> Word32) -> CDouble -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Word32 CDouble where
    safeConvert :: Word32 -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (Word32 -> CDouble) -> Word32 -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CDouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CDouble Word64 where
    safeConvert :: CDouble -> ConvertResult Word64
safeConvert = (CDouble -> ConvertResult Word64)
-> CDouble -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CDouble -> Word64) -> CDouble -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
truncate)
instance Convertible Word64 CDouble where
    safeConvert :: Word64 -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (Word64 -> CDouble) -> Word64 -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CDouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- Section 2
instance Convertible CFloat Double where
    safeConvert :: CFloat -> ConvertResult Double
safeConvert = Double -> ConvertResult Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> ConvertResult Double)
-> (CFloat -> Double) -> CFloat -> ConvertResult Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance Convertible Double CFloat where
    safeConvert :: Double -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (Double -> CFloat) -> Double -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance Convertible CFloat Float where
    safeConvert :: CFloat -> ConvertResult Float
safeConvert = Float -> ConvertResult Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> ConvertResult Float)
-> (CFloat -> Float) -> CFloat -> ConvertResult Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance Convertible Float CFloat where
    safeConvert :: Float -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (Float -> CFloat) -> Float -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance Convertible CFloat Rational where
    safeConvert :: CFloat -> ConvertResult Rational
safeConvert = Rational -> ConvertResult Rational
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> ConvertResult Rational)
-> (CFloat -> Rational) -> CFloat -> ConvertResult Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance Convertible Rational CFloat where
    safeConvert :: Rational -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (Rational -> CFloat) -> Rational -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance Convertible CDouble Double where
    safeConvert :: CDouble -> ConvertResult Double
safeConvert = Double -> ConvertResult Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> ConvertResult Double)
-> (CDouble -> Double) -> CDouble -> ConvertResult Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance Convertible Double CDouble where
    safeConvert :: Double -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (Double -> CDouble) -> Double -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance Convertible CDouble Float where
    safeConvert :: CDouble -> ConvertResult Float
safeConvert = Float -> ConvertResult Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> ConvertResult Float)
-> (CDouble -> Float) -> CDouble -> ConvertResult Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance Convertible Float CDouble where
    safeConvert :: Float -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (Float -> CDouble) -> Float -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance Convertible CDouble Rational where
    safeConvert :: CDouble -> ConvertResult Rational
safeConvert = Rational -> ConvertResult Rational
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> ConvertResult Rational)
-> (CDouble -> Rational) -> CDouble -> ConvertResult Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance Convertible Rational CDouble where
    safeConvert :: Rational -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (Rational -> CDouble) -> Rational -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- Section 3
instance Convertible CChar Int where
    safeConvert :: CChar -> ConvertResult Int
safeConvert = (CChar -> ConvertResult Int) -> CChar -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CChar -> Int) -> CChar -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int CChar where
    safeConvert :: Int -> ConvertResult CChar
safeConvert = (Int -> ConvertResult CChar) -> Int -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (Int -> CChar) -> Int -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar Int8 where
    safeConvert :: CChar -> ConvertResult Int8
safeConvert = (CChar -> ConvertResult Int8) -> CChar -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CChar -> Int8) -> CChar -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int8 CChar where
    safeConvert :: Int8 -> ConvertResult CChar
safeConvert = (Int8 -> ConvertResult CChar) -> Int8 -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (Int8 -> CChar) -> Int8 -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar Int16 where
    safeConvert :: CChar -> ConvertResult Int16
safeConvert = (CChar -> ConvertResult Int16) -> CChar -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CChar -> Int16) -> CChar -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int16 CChar where
    safeConvert :: Int16 -> ConvertResult CChar
safeConvert = (Int16 -> ConvertResult CChar) -> Int16 -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (Int16 -> CChar) -> Int16 -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar Int32 where
    safeConvert :: CChar -> ConvertResult Int32
safeConvert = (CChar -> ConvertResult Int32) -> CChar -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CChar -> Int32) -> CChar -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int32 CChar where
    safeConvert :: Int32 -> ConvertResult CChar
safeConvert = (Int32 -> ConvertResult CChar) -> Int32 -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (Int32 -> CChar) -> Int32 -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar Int64 where
    safeConvert :: CChar -> ConvertResult Int64
safeConvert = (CChar -> ConvertResult Int64) -> CChar -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CChar -> Int64) -> CChar -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int64 CChar where
    safeConvert :: Int64 -> ConvertResult CChar
safeConvert = (Int64 -> ConvertResult CChar) -> Int64 -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (Int64 -> CChar) -> Int64 -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar Word where
    safeConvert :: CChar -> ConvertResult Word
safeConvert = (CChar -> ConvertResult Word) -> CChar -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CChar -> Word) -> CChar -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word CChar where
    safeConvert :: Word -> ConvertResult CChar
safeConvert = (Word -> ConvertResult CChar) -> Word -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (Word -> CChar) -> Word -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar Word8 where
    safeConvert :: CChar -> ConvertResult Word8
safeConvert = (CChar -> ConvertResult Word8) -> CChar -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CChar -> Word8) -> CChar -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word8 CChar where
    safeConvert :: Word8 -> ConvertResult CChar
safeConvert = (Word8 -> ConvertResult CChar) -> Word8 -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (Word8 -> CChar) -> Word8 -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar Word16 where
    safeConvert :: CChar -> ConvertResult Word16
safeConvert = (CChar -> ConvertResult Word16) -> CChar -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CChar -> Word16) -> CChar -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word16 CChar where
    safeConvert :: Word16 -> ConvertResult CChar
safeConvert = (Word16 -> ConvertResult CChar) -> Word16 -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (Word16 -> CChar) -> Word16 -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar Word32 where
    safeConvert :: CChar -> ConvertResult Word32
safeConvert = (CChar -> ConvertResult Word32) -> CChar -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CChar -> Word32) -> CChar -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word32 CChar where
    safeConvert :: Word32 -> ConvertResult CChar
safeConvert = (Word32 -> ConvertResult CChar) -> Word32 -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (Word32 -> CChar) -> Word32 -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar Word64 where
    safeConvert :: CChar -> ConvertResult Word64
safeConvert = (CChar -> ConvertResult Word64) -> CChar -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CChar -> Word64) -> CChar -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word64 CChar where
    safeConvert :: Word64 -> ConvertResult CChar
safeConvert = (Word64 -> ConvertResult CChar) -> Word64 -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (Word64 -> CChar) -> Word64 -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar Int where
    safeConvert :: CSChar -> ConvertResult Int
safeConvert = (CSChar -> ConvertResult Int) -> CSChar -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CSChar -> Int) -> CSChar -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int CSChar where
    safeConvert :: Int -> ConvertResult CSChar
safeConvert = (Int -> ConvertResult CSChar) -> Int -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (Int -> CSChar) -> Int -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar Int8 where
    safeConvert :: CSChar -> ConvertResult Int8
safeConvert = (CSChar -> ConvertResult Int8) -> CSChar -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CSChar -> Int8) -> CSChar -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int8 CSChar where
    safeConvert :: Int8 -> ConvertResult CSChar
safeConvert = (Int8 -> ConvertResult CSChar) -> Int8 -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (Int8 -> CSChar) -> Int8 -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar Int16 where
    safeConvert :: CSChar -> ConvertResult Int16
safeConvert = (CSChar -> ConvertResult Int16) -> CSChar -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CSChar -> Int16) -> CSChar -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int16 CSChar where
    safeConvert :: Int16 -> ConvertResult CSChar
safeConvert = (Int16 -> ConvertResult CSChar) -> Int16 -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (Int16 -> CSChar) -> Int16 -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar Int32 where
    safeConvert :: CSChar -> ConvertResult Int32
safeConvert = (CSChar -> ConvertResult Int32) -> CSChar -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CSChar -> Int32) -> CSChar -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int32 CSChar where
    safeConvert :: Int32 -> ConvertResult CSChar
safeConvert = (Int32 -> ConvertResult CSChar) -> Int32 -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (Int32 -> CSChar) -> Int32 -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar Int64 where
    safeConvert :: CSChar -> ConvertResult Int64
safeConvert = (CSChar -> ConvertResult Int64) -> CSChar -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CSChar -> Int64) -> CSChar -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int64 CSChar where
    safeConvert :: Int64 -> ConvertResult CSChar
safeConvert = (Int64 -> ConvertResult CSChar) -> Int64 -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (Int64 -> CSChar) -> Int64 -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar Word where
    safeConvert :: CSChar -> ConvertResult Word
safeConvert = (CSChar -> ConvertResult Word) -> CSChar -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CSChar -> Word) -> CSChar -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word CSChar where
    safeConvert :: Word -> ConvertResult CSChar
safeConvert = (Word -> ConvertResult CSChar) -> Word -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (Word -> CSChar) -> Word -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar Word8 where
    safeConvert :: CSChar -> ConvertResult Word8
safeConvert = (CSChar -> ConvertResult Word8) -> CSChar -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CSChar -> Word8) -> CSChar -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word8 CSChar where
    safeConvert :: Word8 -> ConvertResult CSChar
safeConvert = (Word8 -> ConvertResult CSChar) -> Word8 -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (Word8 -> CSChar) -> Word8 -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar Word16 where
    safeConvert :: CSChar -> ConvertResult Word16
safeConvert = (CSChar -> ConvertResult Word16) -> CSChar -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CSChar -> Word16) -> CSChar -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word16 CSChar where
    safeConvert :: Word16 -> ConvertResult CSChar
safeConvert = (Word16 -> ConvertResult CSChar) -> Word16 -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (Word16 -> CSChar) -> Word16 -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar Word32 where
    safeConvert :: CSChar -> ConvertResult Word32
safeConvert = (CSChar -> ConvertResult Word32) -> CSChar -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CSChar -> Word32) -> CSChar -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word32 CSChar where
    safeConvert :: Word32 -> ConvertResult CSChar
safeConvert = (Word32 -> ConvertResult CSChar) -> Word32 -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (Word32 -> CSChar) -> Word32 -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar Word64 where
    safeConvert :: CSChar -> ConvertResult Word64
safeConvert = (CSChar -> ConvertResult Word64) -> CSChar -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CSChar -> Word64) -> CSChar -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word64 CSChar where
    safeConvert :: Word64 -> ConvertResult CSChar
safeConvert = (Word64 -> ConvertResult CSChar) -> Word64 -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (Word64 -> CSChar) -> Word64 -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar Int where
    safeConvert :: CUChar -> ConvertResult Int
safeConvert = (CUChar -> ConvertResult Int) -> CUChar -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CUChar -> Int) -> CUChar -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int CUChar where
    safeConvert :: Int -> ConvertResult CUChar
safeConvert = (Int -> ConvertResult CUChar) -> Int -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (Int -> CUChar) -> Int -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar Int8 where
    safeConvert :: CUChar -> ConvertResult Int8
safeConvert = (CUChar -> ConvertResult Int8) -> CUChar -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CUChar -> Int8) -> CUChar -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int8 CUChar where
    safeConvert :: Int8 -> ConvertResult CUChar
safeConvert = (Int8 -> ConvertResult CUChar) -> Int8 -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (Int8 -> CUChar) -> Int8 -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar Int16 where
    safeConvert :: CUChar -> ConvertResult Int16
safeConvert = (CUChar -> ConvertResult Int16) -> CUChar -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CUChar -> Int16) -> CUChar -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int16 CUChar where
    safeConvert :: Int16 -> ConvertResult CUChar
safeConvert = (Int16 -> ConvertResult CUChar) -> Int16 -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (Int16 -> CUChar) -> Int16 -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar Int32 where
    safeConvert :: CUChar -> ConvertResult Int32
safeConvert = (CUChar -> ConvertResult Int32) -> CUChar -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CUChar -> Int32) -> CUChar -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int32 CUChar where
    safeConvert :: Int32 -> ConvertResult CUChar
safeConvert = (Int32 -> ConvertResult CUChar) -> Int32 -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (Int32 -> CUChar) -> Int32 -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar Int64 where
    safeConvert :: CUChar -> ConvertResult Int64
safeConvert = (CUChar -> ConvertResult Int64) -> CUChar -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CUChar -> Int64) -> CUChar -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int64 CUChar where
    safeConvert :: Int64 -> ConvertResult CUChar
safeConvert = (Int64 -> ConvertResult CUChar) -> Int64 -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (Int64 -> CUChar) -> Int64 -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar Word where
    safeConvert :: CUChar -> ConvertResult Word
safeConvert = (CUChar -> ConvertResult Word) -> CUChar -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CUChar -> Word) -> CUChar -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word CUChar where
    safeConvert :: Word -> ConvertResult CUChar
safeConvert = (Word -> ConvertResult CUChar) -> Word -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (Word -> CUChar) -> Word -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar Word8 where
    safeConvert :: CUChar -> ConvertResult Word8
safeConvert = (CUChar -> ConvertResult Word8) -> CUChar -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CUChar -> Word8) -> CUChar -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word8 CUChar where
    safeConvert :: Word8 -> ConvertResult CUChar
safeConvert = (Word8 -> ConvertResult CUChar) -> Word8 -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (Word8 -> CUChar) -> Word8 -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar Word16 where
    safeConvert :: CUChar -> ConvertResult Word16
safeConvert = (CUChar -> ConvertResult Word16) -> CUChar -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CUChar -> Word16) -> CUChar -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word16 CUChar where
    safeConvert :: Word16 -> ConvertResult CUChar
safeConvert = (Word16 -> ConvertResult CUChar) -> Word16 -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (Word16 -> CUChar) -> Word16 -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar Word32 where
    safeConvert :: CUChar -> ConvertResult Word32
safeConvert = (CUChar -> ConvertResult Word32) -> CUChar -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CUChar -> Word32) -> CUChar -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word32 CUChar where
    safeConvert :: Word32 -> ConvertResult CUChar
safeConvert = (Word32 -> ConvertResult CUChar) -> Word32 -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (Word32 -> CUChar) -> Word32 -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar Word64 where
    safeConvert :: CUChar -> ConvertResult Word64
safeConvert = (CUChar -> ConvertResult Word64) -> CUChar -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CUChar -> Word64) -> CUChar -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word64 CUChar where
    safeConvert :: Word64 -> ConvertResult CUChar
safeConvert = (Word64 -> ConvertResult CUChar) -> Word64 -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (Word64 -> CUChar) -> Word64 -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort Int where
    safeConvert :: CShort -> ConvertResult Int
safeConvert = (CShort -> ConvertResult Int) -> CShort -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CShort -> Int) -> CShort -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int CShort where
    safeConvert :: Int -> ConvertResult CShort
safeConvert = (Int -> ConvertResult CShort) -> Int -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (Int -> CShort) -> Int -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort Int8 where
    safeConvert :: CShort -> ConvertResult Int8
safeConvert = (CShort -> ConvertResult Int8) -> CShort -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CShort -> Int8) -> CShort -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int8 CShort where
    safeConvert :: Int8 -> ConvertResult CShort
safeConvert = (Int8 -> ConvertResult CShort) -> Int8 -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (Int8 -> CShort) -> Int8 -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort Int16 where
    safeConvert :: CShort -> ConvertResult Int16
safeConvert = (CShort -> ConvertResult Int16) -> CShort -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CShort -> Int16) -> CShort -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int16 CShort where
    safeConvert :: Int16 -> ConvertResult CShort
safeConvert = (Int16 -> ConvertResult CShort) -> Int16 -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (Int16 -> CShort) -> Int16 -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort Int32 where
    safeConvert :: CShort -> ConvertResult Int32
safeConvert = (CShort -> ConvertResult Int32) -> CShort -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CShort -> Int32) -> CShort -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int32 CShort where
    safeConvert :: Int32 -> ConvertResult CShort
safeConvert = (Int32 -> ConvertResult CShort) -> Int32 -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (Int32 -> CShort) -> Int32 -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort Int64 where
    safeConvert :: CShort -> ConvertResult Int64
safeConvert = (CShort -> ConvertResult Int64) -> CShort -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CShort -> Int64) -> CShort -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int64 CShort where
    safeConvert :: Int64 -> ConvertResult CShort
safeConvert = (Int64 -> ConvertResult CShort) -> Int64 -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (Int64 -> CShort) -> Int64 -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort Word where
    safeConvert :: CShort -> ConvertResult Word
safeConvert = (CShort -> ConvertResult Word) -> CShort -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CShort -> Word) -> CShort -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word CShort where
    safeConvert :: Word -> ConvertResult CShort
safeConvert = (Word -> ConvertResult CShort) -> Word -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (Word -> CShort) -> Word -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort Word8 where
    safeConvert :: CShort -> ConvertResult Word8
safeConvert = (CShort -> ConvertResult Word8) -> CShort -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CShort -> Word8) -> CShort -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word8 CShort where
    safeConvert :: Word8 -> ConvertResult CShort
safeConvert = (Word8 -> ConvertResult CShort) -> Word8 -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (Word8 -> CShort) -> Word8 -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort Word16 where
    safeConvert :: CShort -> ConvertResult Word16
safeConvert = (CShort -> ConvertResult Word16) -> CShort -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CShort -> Word16) -> CShort -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word16 CShort where
    safeConvert :: Word16 -> ConvertResult CShort
safeConvert = (Word16 -> ConvertResult CShort) -> Word16 -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (Word16 -> CShort) -> Word16 -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort Word32 where
    safeConvert :: CShort -> ConvertResult Word32
safeConvert = (CShort -> ConvertResult Word32) -> CShort -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CShort -> Word32) -> CShort -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word32 CShort where
    safeConvert :: Word32 -> ConvertResult CShort
safeConvert = (Word32 -> ConvertResult CShort) -> Word32 -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (Word32 -> CShort) -> Word32 -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort Word64 where
    safeConvert :: CShort -> ConvertResult Word64
safeConvert = (CShort -> ConvertResult Word64) -> CShort -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CShort -> Word64) -> CShort -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word64 CShort where
    safeConvert :: Word64 -> ConvertResult CShort
safeConvert = (Word64 -> ConvertResult CShort) -> Word64 -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (Word64 -> CShort) -> Word64 -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort Int where
    safeConvert :: CUShort -> ConvertResult Int
safeConvert = (CUShort -> ConvertResult Int) -> CUShort -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CUShort -> Int) -> CUShort -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int CUShort where
    safeConvert :: Int -> ConvertResult CUShort
safeConvert = (Int -> ConvertResult CUShort) -> Int -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (Int -> CUShort) -> Int -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort Int8 where
    safeConvert :: CUShort -> ConvertResult Int8
safeConvert = (CUShort -> ConvertResult Int8) -> CUShort -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CUShort -> Int8) -> CUShort -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int8 CUShort where
    safeConvert :: Int8 -> ConvertResult CUShort
safeConvert = (Int8 -> ConvertResult CUShort) -> Int8 -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (Int8 -> CUShort) -> Int8 -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort Int16 where
    safeConvert :: CUShort -> ConvertResult Int16
safeConvert = (CUShort -> ConvertResult Int16) -> CUShort -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CUShort -> Int16) -> CUShort -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int16 CUShort where
    safeConvert :: Int16 -> ConvertResult CUShort
safeConvert = (Int16 -> ConvertResult CUShort) -> Int16 -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (Int16 -> CUShort) -> Int16 -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort Int32 where
    safeConvert :: CUShort -> ConvertResult Int32
safeConvert = (CUShort -> ConvertResult Int32) -> CUShort -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CUShort -> Int32) -> CUShort -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int32 CUShort where
    safeConvert :: Int32 -> ConvertResult CUShort
safeConvert = (Int32 -> ConvertResult CUShort) -> Int32 -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (Int32 -> CUShort) -> Int32 -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort Int64 where
    safeConvert :: CUShort -> ConvertResult Int64
safeConvert = (CUShort -> ConvertResult Int64) -> CUShort -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CUShort -> Int64) -> CUShort -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int64 CUShort where
    safeConvert :: Int64 -> ConvertResult CUShort
safeConvert = (Int64 -> ConvertResult CUShort) -> Int64 -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (Int64 -> CUShort) -> Int64 -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort Word where
    safeConvert :: CUShort -> ConvertResult Word
safeConvert = (CUShort -> ConvertResult Word) -> CUShort -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CUShort -> Word) -> CUShort -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word CUShort where
    safeConvert :: Word -> ConvertResult CUShort
safeConvert = (Word -> ConvertResult CUShort) -> Word -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (Word -> CUShort) -> Word -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort Word8 where
    safeConvert :: CUShort -> ConvertResult Word8
safeConvert = (CUShort -> ConvertResult Word8) -> CUShort -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CUShort -> Word8) -> CUShort -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word8 CUShort where
    safeConvert :: Word8 -> ConvertResult CUShort
safeConvert = (Word8 -> ConvertResult CUShort) -> Word8 -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (Word8 -> CUShort) -> Word8 -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort Word16 where
    safeConvert :: CUShort -> ConvertResult Word16
safeConvert = (CUShort -> ConvertResult Word16)
-> CUShort -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CUShort -> Word16) -> CUShort -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word16 CUShort where
    safeConvert :: Word16 -> ConvertResult CUShort
safeConvert = (Word16 -> ConvertResult CUShort)
-> Word16 -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (Word16 -> CUShort) -> Word16 -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort Word32 where
    safeConvert :: CUShort -> ConvertResult Word32
safeConvert = (CUShort -> ConvertResult Word32)
-> CUShort -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CUShort -> Word32) -> CUShort -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word32 CUShort where
    safeConvert :: Word32 -> ConvertResult CUShort
safeConvert = (Word32 -> ConvertResult CUShort)
-> Word32 -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (Word32 -> CUShort) -> Word32 -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort Word64 where
    safeConvert :: CUShort -> ConvertResult Word64
safeConvert = (CUShort -> ConvertResult Word64)
-> CUShort -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CUShort -> Word64) -> CUShort -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word64 CUShort where
    safeConvert :: Word64 -> ConvertResult CUShort
safeConvert = (Word64 -> ConvertResult CUShort)
-> Word64 -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (Word64 -> CUShort) -> Word64 -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt Int where
    safeConvert :: CInt -> ConvertResult Int
safeConvert = (CInt -> ConvertResult Int) -> CInt -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CInt -> Int) -> CInt -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int CInt where
    safeConvert :: Int -> ConvertResult CInt
safeConvert = (Int -> ConvertResult CInt) -> Int -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (Int -> CInt) -> Int -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt Int8 where
    safeConvert :: CInt -> ConvertResult Int8
safeConvert = (CInt -> ConvertResult Int8) -> CInt -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CInt -> Int8) -> CInt -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int8 CInt where
    safeConvert :: Int8 -> ConvertResult CInt
safeConvert = (Int8 -> ConvertResult CInt) -> Int8 -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (Int8 -> CInt) -> Int8 -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt Int16 where
    safeConvert :: CInt -> ConvertResult Int16
safeConvert = (CInt -> ConvertResult Int16) -> CInt -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CInt -> Int16) -> CInt -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int16 CInt where
    safeConvert :: Int16 -> ConvertResult CInt
safeConvert = (Int16 -> ConvertResult CInt) -> Int16 -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (Int16 -> CInt) -> Int16 -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt Int32 where
    safeConvert :: CInt -> ConvertResult Int32
safeConvert = (CInt -> ConvertResult Int32) -> CInt -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CInt -> Int32) -> CInt -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int32 CInt where
    safeConvert :: Int32 -> ConvertResult CInt
safeConvert = (Int32 -> ConvertResult CInt) -> Int32 -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (Int32 -> CInt) -> Int32 -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt Int64 where
    safeConvert :: CInt -> ConvertResult Int64
safeConvert = (CInt -> ConvertResult Int64) -> CInt -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CInt -> Int64) -> CInt -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int64 CInt where
    safeConvert :: Int64 -> ConvertResult CInt
safeConvert = (Int64 -> ConvertResult CInt) -> Int64 -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (Int64 -> CInt) -> Int64 -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt Word where
    safeConvert :: CInt -> ConvertResult Word
safeConvert = (CInt -> ConvertResult Word) -> CInt -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CInt -> Word) -> CInt -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word CInt where
    safeConvert :: Word -> ConvertResult CInt
safeConvert = (Word -> ConvertResult CInt) -> Word -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (Word -> CInt) -> Word -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt Word8 where
    safeConvert :: CInt -> ConvertResult Word8
safeConvert = (CInt -> ConvertResult Word8) -> CInt -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CInt -> Word8) -> CInt -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word8 CInt where
    safeConvert :: Word8 -> ConvertResult CInt
safeConvert = (Word8 -> ConvertResult CInt) -> Word8 -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (Word8 -> CInt) -> Word8 -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt Word16 where
    safeConvert :: CInt -> ConvertResult Word16
safeConvert = (CInt -> ConvertResult Word16) -> CInt -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CInt -> Word16) -> CInt -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word16 CInt where
    safeConvert :: Word16 -> ConvertResult CInt
safeConvert = (Word16 -> ConvertResult CInt) -> Word16 -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (Word16 -> CInt) -> Word16 -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt Word32 where
    safeConvert :: CInt -> ConvertResult Word32
safeConvert = (CInt -> ConvertResult Word32) -> CInt -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CInt -> Word32) -> CInt -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word32 CInt where
    safeConvert :: Word32 -> ConvertResult CInt
safeConvert = (Word32 -> ConvertResult CInt) -> Word32 -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (Word32 -> CInt) -> Word32 -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt Word64 where
    safeConvert :: CInt -> ConvertResult Word64
safeConvert = (CInt -> ConvertResult Word64) -> CInt -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CInt -> Word64) -> CInt -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word64 CInt where
    safeConvert :: Word64 -> ConvertResult CInt
safeConvert = (Word64 -> ConvertResult CInt) -> Word64 -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (Word64 -> CInt) -> Word64 -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt Int where
    safeConvert :: CUInt -> ConvertResult Int
safeConvert = (CUInt -> ConvertResult Int) -> CUInt -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CUInt -> Int) -> CUInt -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int CUInt where
    safeConvert :: Int -> ConvertResult CUInt
safeConvert = (Int -> ConvertResult CUInt) -> Int -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (Int -> CUInt) -> Int -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt Int8 where
    safeConvert :: CUInt -> ConvertResult Int8
safeConvert = (CUInt -> ConvertResult Int8) -> CUInt -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CUInt -> Int8) -> CUInt -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int8 CUInt where
    safeConvert :: Int8 -> ConvertResult CUInt
safeConvert = (Int8 -> ConvertResult CUInt) -> Int8 -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (Int8 -> CUInt) -> Int8 -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt Int16 where
    safeConvert :: CUInt -> ConvertResult Int16
safeConvert = (CUInt -> ConvertResult Int16) -> CUInt -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CUInt -> Int16) -> CUInt -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int16 CUInt where
    safeConvert :: Int16 -> ConvertResult CUInt
safeConvert = (Int16 -> ConvertResult CUInt) -> Int16 -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (Int16 -> CUInt) -> Int16 -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt Int32 where
    safeConvert :: CUInt -> ConvertResult Int32
safeConvert = (CUInt -> ConvertResult Int32) -> CUInt -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CUInt -> Int32) -> CUInt -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int32 CUInt where
    safeConvert :: Int32 -> ConvertResult CUInt
safeConvert = (Int32 -> ConvertResult CUInt) -> Int32 -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (Int32 -> CUInt) -> Int32 -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt Int64 where
    safeConvert :: CUInt -> ConvertResult Int64
safeConvert = (CUInt -> ConvertResult Int64) -> CUInt -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CUInt -> Int64) -> CUInt -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int64 CUInt where
    safeConvert :: Int64 -> ConvertResult CUInt
safeConvert = (Int64 -> ConvertResult CUInt) -> Int64 -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (Int64 -> CUInt) -> Int64 -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt Word where
    safeConvert :: CUInt -> ConvertResult Word
safeConvert = (CUInt -> ConvertResult Word) -> CUInt -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CUInt -> Word) -> CUInt -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word CUInt where
    safeConvert :: Word -> ConvertResult CUInt
safeConvert = (Word -> ConvertResult CUInt) -> Word -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (Word -> CUInt) -> Word -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt Word8 where
    safeConvert :: CUInt -> ConvertResult Word8
safeConvert = (CUInt -> ConvertResult Word8) -> CUInt -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CUInt -> Word8) -> CUInt -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word8 CUInt where
    safeConvert :: Word8 -> ConvertResult CUInt
safeConvert = (Word8 -> ConvertResult CUInt) -> Word8 -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (Word8 -> CUInt) -> Word8 -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt Word16 where
    safeConvert :: CUInt -> ConvertResult Word16
safeConvert = (CUInt -> ConvertResult Word16) -> CUInt -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CUInt -> Word16) -> CUInt -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word16 CUInt where
    safeConvert :: Word16 -> ConvertResult CUInt
safeConvert = (Word16 -> ConvertResult CUInt) -> Word16 -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (Word16 -> CUInt) -> Word16 -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt Word32 where
    safeConvert :: CUInt -> ConvertResult Word32
safeConvert = (CUInt -> ConvertResult Word32) -> CUInt -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CUInt -> Word32) -> CUInt -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word32 CUInt where
    safeConvert :: Word32 -> ConvertResult CUInt
safeConvert = (Word32 -> ConvertResult CUInt) -> Word32 -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (Word32 -> CUInt) -> Word32 -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt Word64 where
    safeConvert :: CUInt -> ConvertResult Word64
safeConvert = (CUInt -> ConvertResult Word64) -> CUInt -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CUInt -> Word64) -> CUInt -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word64 CUInt where
    safeConvert :: Word64 -> ConvertResult CUInt
safeConvert = (Word64 -> ConvertResult CUInt) -> Word64 -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (Word64 -> CUInt) -> Word64 -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong Int where
    safeConvert :: CLong -> ConvertResult Int
safeConvert = (CLong -> ConvertResult Int) -> CLong -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CLong -> Int) -> CLong -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int CLong where
    safeConvert :: Int -> ConvertResult CLong
safeConvert = (Int -> ConvertResult CLong) -> Int -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (Int -> CLong) -> Int -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong Int8 where
    safeConvert :: CLong -> ConvertResult Int8
safeConvert = (CLong -> ConvertResult Int8) -> CLong -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CLong -> Int8) -> CLong -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int8 CLong where
    safeConvert :: Int8 -> ConvertResult CLong
safeConvert = (Int8 -> ConvertResult CLong) -> Int8 -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (Int8 -> CLong) -> Int8 -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong Int16 where
    safeConvert :: CLong -> ConvertResult Int16
safeConvert = (CLong -> ConvertResult Int16) -> CLong -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CLong -> Int16) -> CLong -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int16 CLong where
    safeConvert :: Int16 -> ConvertResult CLong
safeConvert = (Int16 -> ConvertResult CLong) -> Int16 -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (Int16 -> CLong) -> Int16 -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong Int32 where
    safeConvert :: CLong -> ConvertResult Int32
safeConvert = (CLong -> ConvertResult Int32) -> CLong -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CLong -> Int32) -> CLong -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int32 CLong where
    safeConvert :: Int32 -> ConvertResult CLong
safeConvert = (Int32 -> ConvertResult CLong) -> Int32 -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (Int32 -> CLong) -> Int32 -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong Int64 where
    safeConvert :: CLong -> ConvertResult Int64
safeConvert = (CLong -> ConvertResult Int64) -> CLong -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CLong -> Int64) -> CLong -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int64 CLong where
    safeConvert :: Int64 -> ConvertResult CLong
safeConvert = (Int64 -> ConvertResult CLong) -> Int64 -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (Int64 -> CLong) -> Int64 -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong Word where
    safeConvert :: CLong -> ConvertResult Word
safeConvert = (CLong -> ConvertResult Word) -> CLong -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CLong -> Word) -> CLong -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word CLong where
    safeConvert :: Word -> ConvertResult CLong
safeConvert = (Word -> ConvertResult CLong) -> Word -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (Word -> CLong) -> Word -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong Word8 where
    safeConvert :: CLong -> ConvertResult Word8
safeConvert = (CLong -> ConvertResult Word8) -> CLong -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CLong -> Word8) -> CLong -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word8 CLong where
    safeConvert :: Word8 -> ConvertResult CLong
safeConvert = (Word8 -> ConvertResult CLong) -> Word8 -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (Word8 -> CLong) -> Word8 -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong Word16 where
    safeConvert :: CLong -> ConvertResult Word16
safeConvert = (CLong -> ConvertResult Word16) -> CLong -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CLong -> Word16) -> CLong -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word16 CLong where
    safeConvert :: Word16 -> ConvertResult CLong
safeConvert = (Word16 -> ConvertResult CLong) -> Word16 -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (Word16 -> CLong) -> Word16 -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong Word32 where
    safeConvert :: CLong -> ConvertResult Word32
safeConvert = (CLong -> ConvertResult Word32) -> CLong -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CLong -> Word32) -> CLong -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word32 CLong where
    safeConvert :: Word32 -> ConvertResult CLong
safeConvert = (Word32 -> ConvertResult CLong) -> Word32 -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (Word32 -> CLong) -> Word32 -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong Word64 where
    safeConvert :: CLong -> ConvertResult Word64
safeConvert = (CLong -> ConvertResult Word64) -> CLong -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CLong -> Word64) -> CLong -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word64 CLong where
    safeConvert :: Word64 -> ConvertResult CLong
safeConvert = (Word64 -> ConvertResult CLong) -> Word64 -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (Word64 -> CLong) -> Word64 -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong Int where
    safeConvert :: CULong -> ConvertResult Int
safeConvert = (CULong -> ConvertResult Int) -> CULong -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CULong -> Int) -> CULong -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int CULong where
    safeConvert :: Int -> ConvertResult CULong
safeConvert = (Int -> ConvertResult CULong) -> Int -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (Int -> CULong) -> Int -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong Int8 where
    safeConvert :: CULong -> ConvertResult Int8
safeConvert = (CULong -> ConvertResult Int8) -> CULong -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CULong -> Int8) -> CULong -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int8 CULong where
    safeConvert :: Int8 -> ConvertResult CULong
safeConvert = (Int8 -> ConvertResult CULong) -> Int8 -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (Int8 -> CULong) -> Int8 -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong Int16 where
    safeConvert :: CULong -> ConvertResult Int16
safeConvert = (CULong -> ConvertResult Int16) -> CULong -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CULong -> Int16) -> CULong -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int16 CULong where
    safeConvert :: Int16 -> ConvertResult CULong
safeConvert = (Int16 -> ConvertResult CULong) -> Int16 -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (Int16 -> CULong) -> Int16 -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong Int32 where
    safeConvert :: CULong -> ConvertResult Int32
safeConvert = (CULong -> ConvertResult Int32) -> CULong -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CULong -> Int32) -> CULong -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int32 CULong where
    safeConvert :: Int32 -> ConvertResult CULong
safeConvert = (Int32 -> ConvertResult CULong) -> Int32 -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (Int32 -> CULong) -> Int32 -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong Int64 where
    safeConvert :: CULong -> ConvertResult Int64
safeConvert = (CULong -> ConvertResult Int64) -> CULong -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CULong -> Int64) -> CULong -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int64 CULong where
    safeConvert :: Int64 -> ConvertResult CULong
safeConvert = (Int64 -> ConvertResult CULong) -> Int64 -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (Int64 -> CULong) -> Int64 -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong Word where
    safeConvert :: CULong -> ConvertResult Word
safeConvert = (CULong -> ConvertResult Word) -> CULong -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CULong -> Word) -> CULong -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word CULong where
    safeConvert :: Word -> ConvertResult CULong
safeConvert = (Word -> ConvertResult CULong) -> Word -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (Word -> CULong) -> Word -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong Word8 where
    safeConvert :: CULong -> ConvertResult Word8
safeConvert = (CULong -> ConvertResult Word8) -> CULong -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CULong -> Word8) -> CULong -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word8 CULong where
    safeConvert :: Word8 -> ConvertResult CULong
safeConvert = (Word8 -> ConvertResult CULong) -> Word8 -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (Word8 -> CULong) -> Word8 -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong Word16 where
    safeConvert :: CULong -> ConvertResult Word16
safeConvert = (CULong -> ConvertResult Word16) -> CULong -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CULong -> Word16) -> CULong -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word16 CULong where
    safeConvert :: Word16 -> ConvertResult CULong
safeConvert = (Word16 -> ConvertResult CULong) -> Word16 -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (Word16 -> CULong) -> Word16 -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong Word32 where
    safeConvert :: CULong -> ConvertResult Word32
safeConvert = (CULong -> ConvertResult Word32) -> CULong -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CULong -> Word32) -> CULong -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word32 CULong where
    safeConvert :: Word32 -> ConvertResult CULong
safeConvert = (Word32 -> ConvertResult CULong) -> Word32 -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (Word32 -> CULong) -> Word32 -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong Word64 where
    safeConvert :: CULong -> ConvertResult Word64
safeConvert = (CULong -> ConvertResult Word64) -> CULong -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CULong -> Word64) -> CULong -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word64 CULong where
    safeConvert :: Word64 -> ConvertResult CULong
safeConvert = (Word64 -> ConvertResult CULong) -> Word64 -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (Word64 -> CULong) -> Word64 -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize Int where
    safeConvert :: CSize -> ConvertResult Int
safeConvert = (CSize -> ConvertResult Int) -> CSize -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CSize -> Int) -> CSize -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int CSize where
    safeConvert :: Int -> ConvertResult CSize
safeConvert = (Int -> ConvertResult CSize) -> Int -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (Int -> CSize) -> Int -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize Int8 where
    safeConvert :: CSize -> ConvertResult Int8
safeConvert = (CSize -> ConvertResult Int8) -> CSize -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CSize -> Int8) -> CSize -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int8 CSize where
    safeConvert :: Int8 -> ConvertResult CSize
safeConvert = (Int8 -> ConvertResult CSize) -> Int8 -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (Int8 -> CSize) -> Int8 -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize Int16 where
    safeConvert :: CSize -> ConvertResult Int16
safeConvert = (CSize -> ConvertResult Int16) -> CSize -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CSize -> Int16) -> CSize -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int16 CSize where
    safeConvert :: Int16 -> ConvertResult CSize
safeConvert = (Int16 -> ConvertResult CSize) -> Int16 -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (Int16 -> CSize) -> Int16 -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize Int32 where
    safeConvert :: CSize -> ConvertResult Int32
safeConvert = (CSize -> ConvertResult Int32) -> CSize -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CSize -> Int32) -> CSize -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int32 CSize where
    safeConvert :: Int32 -> ConvertResult CSize
safeConvert = (Int32 -> ConvertResult CSize) -> Int32 -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (Int32 -> CSize) -> Int32 -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize Int64 where
    safeConvert :: CSize -> ConvertResult Int64
safeConvert = (CSize -> ConvertResult Int64) -> CSize -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CSize -> Int64) -> CSize -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int64 CSize where
    safeConvert :: Int64 -> ConvertResult CSize
safeConvert = (Int64 -> ConvertResult CSize) -> Int64 -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (Int64 -> CSize) -> Int64 -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize Word where
    safeConvert :: CSize -> ConvertResult Word
safeConvert = (CSize -> ConvertResult Word) -> CSize -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CSize -> Word) -> CSize -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word CSize where
    safeConvert :: Word -> ConvertResult CSize
safeConvert = (Word -> ConvertResult CSize) -> Word -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (Word -> CSize) -> Word -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize Word8 where
    safeConvert :: CSize -> ConvertResult Word8
safeConvert = (CSize -> ConvertResult Word8) -> CSize -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CSize -> Word8) -> CSize -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word8 CSize where
    safeConvert :: Word8 -> ConvertResult CSize
safeConvert = (Word8 -> ConvertResult CSize) -> Word8 -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (Word8 -> CSize) -> Word8 -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize Word16 where
    safeConvert :: CSize -> ConvertResult Word16
safeConvert = (CSize -> ConvertResult Word16) -> CSize -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CSize -> Word16) -> CSize -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word16 CSize where
    safeConvert :: Word16 -> ConvertResult CSize
safeConvert = (Word16 -> ConvertResult CSize) -> Word16 -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (Word16 -> CSize) -> Word16 -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize Word32 where
    safeConvert :: CSize -> ConvertResult Word32
safeConvert = (CSize -> ConvertResult Word32) -> CSize -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CSize -> Word32) -> CSize -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word32 CSize where
    safeConvert :: Word32 -> ConvertResult CSize
safeConvert = (Word32 -> ConvertResult CSize) -> Word32 -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (Word32 -> CSize) -> Word32 -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize Word64 where
    safeConvert :: CSize -> ConvertResult Word64
safeConvert = (CSize -> ConvertResult Word64) -> CSize -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CSize -> Word64) -> CSize -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word64 CSize where
    safeConvert :: Word64 -> ConvertResult CSize
safeConvert = (Word64 -> ConvertResult CSize) -> Word64 -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (Word64 -> CSize) -> Word64 -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar Int where
    safeConvert :: CWchar -> ConvertResult Int
safeConvert = (CWchar -> ConvertResult Int) -> CWchar -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CWchar -> Int) -> CWchar -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int CWchar where
    safeConvert :: Int -> ConvertResult CWchar
safeConvert = (Int -> ConvertResult CWchar) -> Int -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (Int -> CWchar) -> Int -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar Int8 where
    safeConvert :: CWchar -> ConvertResult Int8
safeConvert = (CWchar -> ConvertResult Int8) -> CWchar -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CWchar -> Int8) -> CWchar -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int8 CWchar where
    safeConvert :: Int8 -> ConvertResult CWchar
safeConvert = (Int8 -> ConvertResult CWchar) -> Int8 -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (Int8 -> CWchar) -> Int8 -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar Int16 where
    safeConvert :: CWchar -> ConvertResult Int16
safeConvert = (CWchar -> ConvertResult Int16) -> CWchar -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CWchar -> Int16) -> CWchar -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int16 CWchar where
    safeConvert :: Int16 -> ConvertResult CWchar
safeConvert = (Int16 -> ConvertResult CWchar) -> Int16 -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (Int16 -> CWchar) -> Int16 -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar Int32 where
    safeConvert :: CWchar -> ConvertResult Int32
safeConvert = (CWchar -> ConvertResult Int32) -> CWchar -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CWchar -> Int32) -> CWchar -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int32 CWchar where
    safeConvert :: Int32 -> ConvertResult CWchar
safeConvert = (Int32 -> ConvertResult CWchar) -> Int32 -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (Int32 -> CWchar) -> Int32 -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar Int64 where
    safeConvert :: CWchar -> ConvertResult Int64
safeConvert = (CWchar -> ConvertResult Int64) -> CWchar -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CWchar -> Int64) -> CWchar -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int64 CWchar where
    safeConvert :: Int64 -> ConvertResult CWchar
safeConvert = (Int64 -> ConvertResult CWchar) -> Int64 -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (Int64 -> CWchar) -> Int64 -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar Word where
    safeConvert :: CWchar -> ConvertResult Word
safeConvert = (CWchar -> ConvertResult Word) -> CWchar -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CWchar -> Word) -> CWchar -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word CWchar where
    safeConvert :: Word -> ConvertResult CWchar
safeConvert = (Word -> ConvertResult CWchar) -> Word -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (Word -> CWchar) -> Word -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar Word8 where
    safeConvert :: CWchar -> ConvertResult Word8
safeConvert = (CWchar -> ConvertResult Word8) -> CWchar -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CWchar -> Word8) -> CWchar -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word8 CWchar where
    safeConvert :: Word8 -> ConvertResult CWchar
safeConvert = (Word8 -> ConvertResult CWchar) -> Word8 -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (Word8 -> CWchar) -> Word8 -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar Word16 where
    safeConvert :: CWchar -> ConvertResult Word16
safeConvert = (CWchar -> ConvertResult Word16) -> CWchar -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CWchar -> Word16) -> CWchar -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word16 CWchar where
    safeConvert :: Word16 -> ConvertResult CWchar
safeConvert = (Word16 -> ConvertResult CWchar) -> Word16 -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (Word16 -> CWchar) -> Word16 -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar Word32 where
    safeConvert :: CWchar -> ConvertResult Word32
safeConvert = (CWchar -> ConvertResult Word32) -> CWchar -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CWchar -> Word32) -> CWchar -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word32 CWchar where
    safeConvert :: Word32 -> ConvertResult CWchar
safeConvert = (Word32 -> ConvertResult CWchar) -> Word32 -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (Word32 -> CWchar) -> Word32 -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar Word64 where
    safeConvert :: CWchar -> ConvertResult Word64
safeConvert = (CWchar -> ConvertResult Word64) -> CWchar -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CWchar -> Word64) -> CWchar -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word64 CWchar where
    safeConvert :: Word64 -> ConvertResult CWchar
safeConvert = (Word64 -> ConvertResult CWchar) -> Word64 -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (Word64 -> CWchar) -> Word64 -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong Int where
    safeConvert :: CLLong -> ConvertResult Int
safeConvert = (CLLong -> ConvertResult Int) -> CLLong -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CLLong -> Int) -> CLLong -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int CLLong where
    safeConvert :: Int -> ConvertResult CLLong
safeConvert = (Int -> ConvertResult CLLong) -> Int -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (Int -> CLLong) -> Int -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong Int8 where
    safeConvert :: CLLong -> ConvertResult Int8
safeConvert = (CLLong -> ConvertResult Int8) -> CLLong -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CLLong -> Int8) -> CLLong -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int8 CLLong where
    safeConvert :: Int8 -> ConvertResult CLLong
safeConvert = (Int8 -> ConvertResult CLLong) -> Int8 -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (Int8 -> CLLong) -> Int8 -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong Int16 where
    safeConvert :: CLLong -> ConvertResult Int16
safeConvert = (CLLong -> ConvertResult Int16) -> CLLong -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CLLong -> Int16) -> CLLong -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int16 CLLong where
    safeConvert :: Int16 -> ConvertResult CLLong
safeConvert = (Int16 -> ConvertResult CLLong) -> Int16 -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (Int16 -> CLLong) -> Int16 -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong Int32 where
    safeConvert :: CLLong -> ConvertResult Int32
safeConvert = (CLLong -> ConvertResult Int32) -> CLLong -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CLLong -> Int32) -> CLLong -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int32 CLLong where
    safeConvert :: Int32 -> ConvertResult CLLong
safeConvert = (Int32 -> ConvertResult CLLong) -> Int32 -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (Int32 -> CLLong) -> Int32 -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong Int64 where
    safeConvert :: CLLong -> ConvertResult Int64
safeConvert = (CLLong -> ConvertResult Int64) -> CLLong -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CLLong -> Int64) -> CLLong -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int64 CLLong where
    safeConvert :: Int64 -> ConvertResult CLLong
safeConvert = (Int64 -> ConvertResult CLLong) -> Int64 -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (Int64 -> CLLong) -> Int64 -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong Word where
    safeConvert :: CLLong -> ConvertResult Word
safeConvert = (CLLong -> ConvertResult Word) -> CLLong -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CLLong -> Word) -> CLLong -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word CLLong where
    safeConvert :: Word -> ConvertResult CLLong
safeConvert = (Word -> ConvertResult CLLong) -> Word -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (Word -> CLLong) -> Word -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong Word8 where
    safeConvert :: CLLong -> ConvertResult Word8
safeConvert = (CLLong -> ConvertResult Word8) -> CLLong -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CLLong -> Word8) -> CLLong -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word8 CLLong where
    safeConvert :: Word8 -> ConvertResult CLLong
safeConvert = (Word8 -> ConvertResult CLLong) -> Word8 -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (Word8 -> CLLong) -> Word8 -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong Word16 where
    safeConvert :: CLLong -> ConvertResult Word16
safeConvert = (CLLong -> ConvertResult Word16) -> CLLong -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CLLong -> Word16) -> CLLong -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word16 CLLong where
    safeConvert :: Word16 -> ConvertResult CLLong
safeConvert = (Word16 -> ConvertResult CLLong) -> Word16 -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (Word16 -> CLLong) -> Word16 -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong Word32 where
    safeConvert :: CLLong -> ConvertResult Word32
safeConvert = (CLLong -> ConvertResult Word32) -> CLLong -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CLLong -> Word32) -> CLLong -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word32 CLLong where
    safeConvert :: Word32 -> ConvertResult CLLong
safeConvert = (Word32 -> ConvertResult CLLong) -> Word32 -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (Word32 -> CLLong) -> Word32 -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong Word64 where
    safeConvert :: CLLong -> ConvertResult Word64
safeConvert = (CLLong -> ConvertResult Word64) -> CLLong -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CLLong -> Word64) -> CLLong -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word64 CLLong where
    safeConvert :: Word64 -> ConvertResult CLLong
safeConvert = (Word64 -> ConvertResult CLLong) -> Word64 -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (Word64 -> CLLong) -> Word64 -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong Int where
    safeConvert :: CULLong -> ConvertResult Int
safeConvert = (CULLong -> ConvertResult Int) -> CULLong -> ConvertResult Int
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int -> ConvertResult Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ConvertResult Int)
-> (CULLong -> Int) -> CULLong -> ConvertResult Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int CULLong where
    safeConvert :: Int -> ConvertResult CULLong
safeConvert = (Int -> ConvertResult CULLong) -> Int -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (Int -> CULLong) -> Int -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong Int8 where
    safeConvert :: CULLong -> ConvertResult Int8
safeConvert = (CULLong -> ConvertResult Int8) -> CULLong -> ConvertResult Int8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int8 -> ConvertResult Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8 -> ConvertResult Int8)
-> (CULLong -> Int8) -> CULLong -> ConvertResult Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int8 CULLong where
    safeConvert :: Int8 -> ConvertResult CULLong
safeConvert = (Int8 -> ConvertResult CULLong) -> Int8 -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (Int8 -> CULLong) -> Int8 -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong Int16 where
    safeConvert :: CULLong -> ConvertResult Int16
safeConvert = (CULLong -> ConvertResult Int16) -> CULLong -> ConvertResult Int16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int16 -> ConvertResult Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16 -> ConvertResult Int16)
-> (CULLong -> Int16) -> CULLong -> ConvertResult Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int16 CULLong where
    safeConvert :: Int16 -> ConvertResult CULLong
safeConvert = (Int16 -> ConvertResult CULLong) -> Int16 -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (Int16 -> CULLong) -> Int16 -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong Int32 where
    safeConvert :: CULLong -> ConvertResult Int32
safeConvert = (CULLong -> ConvertResult Int32) -> CULLong -> ConvertResult Int32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int32 -> ConvertResult Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> ConvertResult Int32)
-> (CULLong -> Int32) -> CULLong -> ConvertResult Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int32 CULLong where
    safeConvert :: Int32 -> ConvertResult CULLong
safeConvert = (Int32 -> ConvertResult CULLong) -> Int32 -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (Int32 -> CULLong) -> Int32 -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong Int64 where
    safeConvert :: CULLong -> ConvertResult Int64
safeConvert = (CULLong -> ConvertResult Int64) -> CULLong -> ConvertResult Int64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Int64 -> ConvertResult Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> ConvertResult Int64)
-> (CULLong -> Int64) -> CULLong -> ConvertResult Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Int64 CULLong where
    safeConvert :: Int64 -> ConvertResult CULLong
safeConvert = (Int64 -> ConvertResult CULLong) -> Int64 -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (Int64 -> CULLong) -> Int64 -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong Word where
    safeConvert :: CULLong -> ConvertResult Word
safeConvert = (CULLong -> ConvertResult Word) -> CULLong -> ConvertResult Word
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word -> ConvertResult Word
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> ConvertResult Word)
-> (CULLong -> Word) -> CULLong -> ConvertResult Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word CULLong where
    safeConvert :: Word -> ConvertResult CULLong
safeConvert = (Word -> ConvertResult CULLong) -> Word -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (Word -> CULLong) -> Word -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong Word8 where
    safeConvert :: CULLong -> ConvertResult Word8
safeConvert = (CULLong -> ConvertResult Word8) -> CULLong -> ConvertResult Word8
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word8 -> ConvertResult Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> ConvertResult Word8)
-> (CULLong -> Word8) -> CULLong -> ConvertResult Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word8 CULLong where
    safeConvert :: Word8 -> ConvertResult CULLong
safeConvert = (Word8 -> ConvertResult CULLong) -> Word8 -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (Word8 -> CULLong) -> Word8 -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong Word16 where
    safeConvert :: CULLong -> ConvertResult Word16
safeConvert = (CULLong -> ConvertResult Word16)
-> CULLong -> ConvertResult Word16
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word16 -> ConvertResult Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> ConvertResult Word16)
-> (CULLong -> Word16) -> CULLong -> ConvertResult Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word16 CULLong where
    safeConvert :: Word16 -> ConvertResult CULLong
safeConvert = (Word16 -> ConvertResult CULLong)
-> Word16 -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (Word16 -> CULLong) -> Word16 -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong Word32 where
    safeConvert :: CULLong -> ConvertResult Word32
safeConvert = (CULLong -> ConvertResult Word32)
-> CULLong -> ConvertResult Word32
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word32 -> ConvertResult Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ConvertResult Word32)
-> (CULLong -> Word32) -> CULLong -> ConvertResult Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word32 CULLong where
    safeConvert :: Word32 -> ConvertResult CULLong
safeConvert = (Word32 -> ConvertResult CULLong)
-> Word32 -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (Word32 -> CULLong) -> Word32 -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong Word64 where
    safeConvert :: CULLong -> ConvertResult Word64
safeConvert = (CULLong -> ConvertResult Word64)
-> CULLong -> ConvertResult Word64
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Word64 -> ConvertResult Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> ConvertResult Word64)
-> (CULLong -> Word64) -> CULLong -> ConvertResult Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Word64 CULLong where
    safeConvert :: Word64 -> ConvertResult CULLong
safeConvert = (Word64 -> ConvertResult CULLong)
-> Word64 -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (Word64 -> CULLong) -> Word64 -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

-- Section 4
instance Convertible CChar CSChar where
    safeConvert :: CChar -> ConvertResult CSChar
safeConvert = (CChar -> ConvertResult CSChar) -> CChar -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (CChar -> CSChar) -> CChar -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar CUChar where
    safeConvert :: CChar -> ConvertResult CUChar
safeConvert = (CChar -> ConvertResult CUChar) -> CChar -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (CChar -> CUChar) -> CChar -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar CShort where
    safeConvert :: CChar -> ConvertResult CShort
safeConvert = (CChar -> ConvertResult CShort) -> CChar -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (CChar -> CShort) -> CChar -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar CUShort where
    safeConvert :: CChar -> ConvertResult CUShort
safeConvert = (CChar -> ConvertResult CUShort) -> CChar -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (CChar -> CUShort) -> CChar -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar CInt where
    safeConvert :: CChar -> ConvertResult CInt
safeConvert = (CChar -> ConvertResult CInt) -> CChar -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (CChar -> CInt) -> CChar -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar CUInt where
    safeConvert :: CChar -> ConvertResult CUInt
safeConvert = (CChar -> ConvertResult CUInt) -> CChar -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (CChar -> CUInt) -> CChar -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar CLong where
    safeConvert :: CChar -> ConvertResult CLong
safeConvert = (CChar -> ConvertResult CLong) -> CChar -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (CChar -> CLong) -> CChar -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar CULong where
    safeConvert :: CChar -> ConvertResult CULong
safeConvert = (CChar -> ConvertResult CULong) -> CChar -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (CChar -> CULong) -> CChar -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar CSize where
    safeConvert :: CChar -> ConvertResult CSize
safeConvert = (CChar -> ConvertResult CSize) -> CChar -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (CChar -> CSize) -> CChar -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar CWchar where
    safeConvert :: CChar -> ConvertResult CWchar
safeConvert = (CChar -> ConvertResult CWchar) -> CChar -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (CChar -> CWchar) -> CChar -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar CLLong where
    safeConvert :: CChar -> ConvertResult CLLong
safeConvert = (CChar -> ConvertResult CLLong) -> CChar -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (CChar -> CLLong) -> CChar -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CChar CULLong where
    safeConvert :: CChar -> ConvertResult CULLong
safeConvert = (CChar -> ConvertResult CULLong) -> CChar -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (CChar -> CULLong) -> CChar -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar CChar where
    safeConvert :: CSChar -> ConvertResult CChar
safeConvert = (CSChar -> ConvertResult CChar) -> CSChar -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (CSChar -> CChar) -> CSChar -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar CUChar where
    safeConvert :: CSChar -> ConvertResult CUChar
safeConvert = (CSChar -> ConvertResult CUChar) -> CSChar -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (CSChar -> CUChar) -> CSChar -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar CShort where
    safeConvert :: CSChar -> ConvertResult CShort
safeConvert = (CSChar -> ConvertResult CShort) -> CSChar -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (CSChar -> CShort) -> CSChar -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar CUShort where
    safeConvert :: CSChar -> ConvertResult CUShort
safeConvert = (CSChar -> ConvertResult CUShort)
-> CSChar -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (CSChar -> CUShort) -> CSChar -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar CInt where
    safeConvert :: CSChar -> ConvertResult CInt
safeConvert = (CSChar -> ConvertResult CInt) -> CSChar -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (CSChar -> CInt) -> CSChar -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar CUInt where
    safeConvert :: CSChar -> ConvertResult CUInt
safeConvert = (CSChar -> ConvertResult CUInt) -> CSChar -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (CSChar -> CUInt) -> CSChar -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar CLong where
    safeConvert :: CSChar -> ConvertResult CLong
safeConvert = (CSChar -> ConvertResult CLong) -> CSChar -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (CSChar -> CLong) -> CSChar -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar CULong where
    safeConvert :: CSChar -> ConvertResult CULong
safeConvert = (CSChar -> ConvertResult CULong) -> CSChar -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (CSChar -> CULong) -> CSChar -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar CSize where
    safeConvert :: CSChar -> ConvertResult CSize
safeConvert = (CSChar -> ConvertResult CSize) -> CSChar -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (CSChar -> CSize) -> CSChar -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar CWchar where
    safeConvert :: CSChar -> ConvertResult CWchar
safeConvert = (CSChar -> ConvertResult CWchar) -> CSChar -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (CSChar -> CWchar) -> CSChar -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar CLLong where
    safeConvert :: CSChar -> ConvertResult CLLong
safeConvert = (CSChar -> ConvertResult CLLong) -> CSChar -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (CSChar -> CLLong) -> CSChar -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar CULLong where
    safeConvert :: CSChar -> ConvertResult CULLong
safeConvert = (CSChar -> ConvertResult CULLong)
-> CSChar -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (CSChar -> CULLong) -> CSChar -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar CChar where
    safeConvert :: CUChar -> ConvertResult CChar
safeConvert = (CUChar -> ConvertResult CChar) -> CUChar -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (CUChar -> CChar) -> CUChar -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar CSChar where
    safeConvert :: CUChar -> ConvertResult CSChar
safeConvert = (CUChar -> ConvertResult CSChar) -> CUChar -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (CUChar -> CSChar) -> CUChar -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar CShort where
    safeConvert :: CUChar -> ConvertResult CShort
safeConvert = (CUChar -> ConvertResult CShort) -> CUChar -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (CUChar -> CShort) -> CUChar -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar CUShort where
    safeConvert :: CUChar -> ConvertResult CUShort
safeConvert = (CUChar -> ConvertResult CUShort)
-> CUChar -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (CUChar -> CUShort) -> CUChar -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar CInt where
    safeConvert :: CUChar -> ConvertResult CInt
safeConvert = (CUChar -> ConvertResult CInt) -> CUChar -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (CUChar -> CInt) -> CUChar -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar CUInt where
    safeConvert :: CUChar -> ConvertResult CUInt
safeConvert = (CUChar -> ConvertResult CUInt) -> CUChar -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (CUChar -> CUInt) -> CUChar -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar CLong where
    safeConvert :: CUChar -> ConvertResult CLong
safeConvert = (CUChar -> ConvertResult CLong) -> CUChar -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (CUChar -> CLong) -> CUChar -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar CULong where
    safeConvert :: CUChar -> ConvertResult CULong
safeConvert = (CUChar -> ConvertResult CULong) -> CUChar -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (CUChar -> CULong) -> CUChar -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar CSize where
    safeConvert :: CUChar -> ConvertResult CSize
safeConvert = (CUChar -> ConvertResult CSize) -> CUChar -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (CUChar -> CSize) -> CUChar -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar CWchar where
    safeConvert :: CUChar -> ConvertResult CWchar
safeConvert = (CUChar -> ConvertResult CWchar) -> CUChar -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (CUChar -> CWchar) -> CUChar -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar CLLong where
    safeConvert :: CUChar -> ConvertResult CLLong
safeConvert = (CUChar -> ConvertResult CLLong) -> CUChar -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (CUChar -> CLLong) -> CUChar -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar CULLong where
    safeConvert :: CUChar -> ConvertResult CULLong
safeConvert = (CUChar -> ConvertResult CULLong)
-> CUChar -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (CUChar -> CULLong) -> CUChar -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort CChar where
    safeConvert :: CShort -> ConvertResult CChar
safeConvert = (CShort -> ConvertResult CChar) -> CShort -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (CShort -> CChar) -> CShort -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort CSChar where
    safeConvert :: CShort -> ConvertResult CSChar
safeConvert = (CShort -> ConvertResult CSChar) -> CShort -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (CShort -> CSChar) -> CShort -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort CUChar where
    safeConvert :: CShort -> ConvertResult CUChar
safeConvert = (CShort -> ConvertResult CUChar) -> CShort -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (CShort -> CUChar) -> CShort -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort CUShort where
    safeConvert :: CShort -> ConvertResult CUShort
safeConvert = (CShort -> ConvertResult CUShort)
-> CShort -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (CShort -> CUShort) -> CShort -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort CInt where
    safeConvert :: CShort -> ConvertResult CInt
safeConvert = (CShort -> ConvertResult CInt) -> CShort -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (CShort -> CInt) -> CShort -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort CUInt where
    safeConvert :: CShort -> ConvertResult CUInt
safeConvert = (CShort -> ConvertResult CUInt) -> CShort -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (CShort -> CUInt) -> CShort -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort CLong where
    safeConvert :: CShort -> ConvertResult CLong
safeConvert = (CShort -> ConvertResult CLong) -> CShort -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (CShort -> CLong) -> CShort -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort CULong where
    safeConvert :: CShort -> ConvertResult CULong
safeConvert = (CShort -> ConvertResult CULong) -> CShort -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (CShort -> CULong) -> CShort -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort CSize where
    safeConvert :: CShort -> ConvertResult CSize
safeConvert = (CShort -> ConvertResult CSize) -> CShort -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (CShort -> CSize) -> CShort -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort CWchar where
    safeConvert :: CShort -> ConvertResult CWchar
safeConvert = (CShort -> ConvertResult CWchar) -> CShort -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (CShort -> CWchar) -> CShort -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort CLLong where
    safeConvert :: CShort -> ConvertResult CLLong
safeConvert = (CShort -> ConvertResult CLLong) -> CShort -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (CShort -> CLLong) -> CShort -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort CULLong where
    safeConvert :: CShort -> ConvertResult CULLong
safeConvert = (CShort -> ConvertResult CULLong)
-> CShort -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (CShort -> CULLong) -> CShort -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort CChar where
    safeConvert :: CUShort -> ConvertResult CChar
safeConvert = (CUShort -> ConvertResult CChar) -> CUShort -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (CUShort -> CChar) -> CUShort -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort CSChar where
    safeConvert :: CUShort -> ConvertResult CSChar
safeConvert = (CUShort -> ConvertResult CSChar)
-> CUShort -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (CUShort -> CSChar) -> CUShort -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort CUChar where
    safeConvert :: CUShort -> ConvertResult CUChar
safeConvert = (CUShort -> ConvertResult CUChar)
-> CUShort -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (CUShort -> CUChar) -> CUShort -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort CShort where
    safeConvert :: CUShort -> ConvertResult CShort
safeConvert = (CUShort -> ConvertResult CShort)
-> CUShort -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (CUShort -> CShort) -> CUShort -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort CInt where
    safeConvert :: CUShort -> ConvertResult CInt
safeConvert = (CUShort -> ConvertResult CInt) -> CUShort -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (CUShort -> CInt) -> CUShort -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort CUInt where
    safeConvert :: CUShort -> ConvertResult CUInt
safeConvert = (CUShort -> ConvertResult CUInt) -> CUShort -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (CUShort -> CUInt) -> CUShort -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort CLong where
    safeConvert :: CUShort -> ConvertResult CLong
safeConvert = (CUShort -> ConvertResult CLong) -> CUShort -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (CUShort -> CLong) -> CUShort -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort CULong where
    safeConvert :: CUShort -> ConvertResult CULong
safeConvert = (CUShort -> ConvertResult CULong)
-> CUShort -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (CUShort -> CULong) -> CUShort -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort CSize where
    safeConvert :: CUShort -> ConvertResult CSize
safeConvert = (CUShort -> ConvertResult CSize) -> CUShort -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (CUShort -> CSize) -> CUShort -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort CWchar where
    safeConvert :: CUShort -> ConvertResult CWchar
safeConvert = (CUShort -> ConvertResult CWchar)
-> CUShort -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (CUShort -> CWchar) -> CUShort -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort CLLong where
    safeConvert :: CUShort -> ConvertResult CLLong
safeConvert = (CUShort -> ConvertResult CLLong)
-> CUShort -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (CUShort -> CLLong) -> CUShort -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort CULLong where
    safeConvert :: CUShort -> ConvertResult CULLong
safeConvert = (CUShort -> ConvertResult CULLong)
-> CUShort -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (CUShort -> CULLong) -> CUShort -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt CChar where
    safeConvert :: CInt -> ConvertResult CChar
safeConvert = (CInt -> ConvertResult CChar) -> CInt -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (CInt -> CChar) -> CInt -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt CSChar where
    safeConvert :: CInt -> ConvertResult CSChar
safeConvert = (CInt -> ConvertResult CSChar) -> CInt -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (CInt -> CSChar) -> CInt -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt CUChar where
    safeConvert :: CInt -> ConvertResult CUChar
safeConvert = (CInt -> ConvertResult CUChar) -> CInt -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (CInt -> CUChar) -> CInt -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt CShort where
    safeConvert :: CInt -> ConvertResult CShort
safeConvert = (CInt -> ConvertResult CShort) -> CInt -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (CInt -> CShort) -> CInt -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt CUShort where
    safeConvert :: CInt -> ConvertResult CUShort
safeConvert = (CInt -> ConvertResult CUShort) -> CInt -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (CInt -> CUShort) -> CInt -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt CUInt where
    safeConvert :: CInt -> ConvertResult CUInt
safeConvert = (CInt -> ConvertResult CUInt) -> CInt -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (CInt -> CUInt) -> CInt -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt CLong where
    safeConvert :: CInt -> ConvertResult CLong
safeConvert = (CInt -> ConvertResult CLong) -> CInt -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (CInt -> CLong) -> CInt -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt CULong where
    safeConvert :: CInt -> ConvertResult CULong
safeConvert = (CInt -> ConvertResult CULong) -> CInt -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (CInt -> CULong) -> CInt -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt CSize where
    safeConvert :: CInt -> ConvertResult CSize
safeConvert = (CInt -> ConvertResult CSize) -> CInt -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (CInt -> CSize) -> CInt -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt CWchar where
    safeConvert :: CInt -> ConvertResult CWchar
safeConvert = (CInt -> ConvertResult CWchar) -> CInt -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (CInt -> CWchar) -> CInt -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt CLLong where
    safeConvert :: CInt -> ConvertResult CLLong
safeConvert = (CInt -> ConvertResult CLLong) -> CInt -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (CInt -> CLLong) -> CInt -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt CULLong where
    safeConvert :: CInt -> ConvertResult CULLong
safeConvert = (CInt -> ConvertResult CULLong) -> CInt -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (CInt -> CULLong) -> CInt -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt CChar where
    safeConvert :: CUInt -> ConvertResult CChar
safeConvert = (CUInt -> ConvertResult CChar) -> CUInt -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (CUInt -> CChar) -> CUInt -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt CSChar where
    safeConvert :: CUInt -> ConvertResult CSChar
safeConvert = (CUInt -> ConvertResult CSChar) -> CUInt -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (CUInt -> CSChar) -> CUInt -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt CUChar where
    safeConvert :: CUInt -> ConvertResult CUChar
safeConvert = (CUInt -> ConvertResult CUChar) -> CUInt -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (CUInt -> CUChar) -> CUInt -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt CShort where
    safeConvert :: CUInt -> ConvertResult CShort
safeConvert = (CUInt -> ConvertResult CShort) -> CUInt -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (CUInt -> CShort) -> CUInt -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt CUShort where
    safeConvert :: CUInt -> ConvertResult CUShort
safeConvert = (CUInt -> ConvertResult CUShort) -> CUInt -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (CUInt -> CUShort) -> CUInt -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt CInt where
    safeConvert :: CUInt -> ConvertResult CInt
safeConvert = (CUInt -> ConvertResult CInt) -> CUInt -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (CUInt -> CInt) -> CUInt -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt CLong where
    safeConvert :: CUInt -> ConvertResult CLong
safeConvert = (CUInt -> ConvertResult CLong) -> CUInt -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (CUInt -> CLong) -> CUInt -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt CULong where
    safeConvert :: CUInt -> ConvertResult CULong
safeConvert = (CUInt -> ConvertResult CULong) -> CUInt -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (CUInt -> CULong) -> CUInt -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt CSize where
    safeConvert :: CUInt -> ConvertResult CSize
safeConvert = (CUInt -> ConvertResult CSize) -> CUInt -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (CUInt -> CSize) -> CUInt -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt CWchar where
    safeConvert :: CUInt -> ConvertResult CWchar
safeConvert = (CUInt -> ConvertResult CWchar) -> CUInt -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (CUInt -> CWchar) -> CUInt -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt CLLong where
    safeConvert :: CUInt -> ConvertResult CLLong
safeConvert = (CUInt -> ConvertResult CLLong) -> CUInt -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (CUInt -> CLLong) -> CUInt -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt CULLong where
    safeConvert :: CUInt -> ConvertResult CULLong
safeConvert = (CUInt -> ConvertResult CULLong) -> CUInt -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (CUInt -> CULLong) -> CUInt -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong CChar where
    safeConvert :: CLong -> ConvertResult CChar
safeConvert = (CLong -> ConvertResult CChar) -> CLong -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (CLong -> CChar) -> CLong -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong CSChar where
    safeConvert :: CLong -> ConvertResult CSChar
safeConvert = (CLong -> ConvertResult CSChar) -> CLong -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (CLong -> CSChar) -> CLong -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong CUChar where
    safeConvert :: CLong -> ConvertResult CUChar
safeConvert = (CLong -> ConvertResult CUChar) -> CLong -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (CLong -> CUChar) -> CLong -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong CShort where
    safeConvert :: CLong -> ConvertResult CShort
safeConvert = (CLong -> ConvertResult CShort) -> CLong -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (CLong -> CShort) -> CLong -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong CUShort where
    safeConvert :: CLong -> ConvertResult CUShort
safeConvert = (CLong -> ConvertResult CUShort) -> CLong -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (CLong -> CUShort) -> CLong -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong CInt where
    safeConvert :: CLong -> ConvertResult CInt
safeConvert = (CLong -> ConvertResult CInt) -> CLong -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (CLong -> CInt) -> CLong -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong CUInt where
    safeConvert :: CLong -> ConvertResult CUInt
safeConvert = (CLong -> ConvertResult CUInt) -> CLong -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (CLong -> CUInt) -> CLong -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong CULong where
    safeConvert :: CLong -> ConvertResult CULong
safeConvert = (CLong -> ConvertResult CULong) -> CLong -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (CLong -> CULong) -> CLong -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong CSize where
    safeConvert :: CLong -> ConvertResult CSize
safeConvert = (CLong -> ConvertResult CSize) -> CLong -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (CLong -> CSize) -> CLong -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong CWchar where
    safeConvert :: CLong -> ConvertResult CWchar
safeConvert = (CLong -> ConvertResult CWchar) -> CLong -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (CLong -> CWchar) -> CLong -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong CLLong where
    safeConvert :: CLong -> ConvertResult CLLong
safeConvert = (CLong -> ConvertResult CLLong) -> CLong -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (CLong -> CLLong) -> CLong -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong CULLong where
    safeConvert :: CLong -> ConvertResult CULLong
safeConvert = (CLong -> ConvertResult CULLong) -> CLong -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (CLong -> CULLong) -> CLong -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong CChar where
    safeConvert :: CULong -> ConvertResult CChar
safeConvert = (CULong -> ConvertResult CChar) -> CULong -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (CULong -> CChar) -> CULong -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong CSChar where
    safeConvert :: CULong -> ConvertResult CSChar
safeConvert = (CULong -> ConvertResult CSChar) -> CULong -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (CULong -> CSChar) -> CULong -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong CUChar where
    safeConvert :: CULong -> ConvertResult CUChar
safeConvert = (CULong -> ConvertResult CUChar) -> CULong -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (CULong -> CUChar) -> CULong -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong CShort where
    safeConvert :: CULong -> ConvertResult CShort
safeConvert = (CULong -> ConvertResult CShort) -> CULong -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (CULong -> CShort) -> CULong -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong CUShort where
    safeConvert :: CULong -> ConvertResult CUShort
safeConvert = (CULong -> ConvertResult CUShort)
-> CULong -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (CULong -> CUShort) -> CULong -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong CInt where
    safeConvert :: CULong -> ConvertResult CInt
safeConvert = (CULong -> ConvertResult CInt) -> CULong -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (CULong -> CInt) -> CULong -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong CUInt where
    safeConvert :: CULong -> ConvertResult CUInt
safeConvert = (CULong -> ConvertResult CUInt) -> CULong -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (CULong -> CUInt) -> CULong -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong CLong where
    safeConvert :: CULong -> ConvertResult CLong
safeConvert = (CULong -> ConvertResult CLong) -> CULong -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (CULong -> CLong) -> CULong -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong CSize where
    safeConvert :: CULong -> ConvertResult CSize
safeConvert = (CULong -> ConvertResult CSize) -> CULong -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (CULong -> CSize) -> CULong -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong CWchar where
    safeConvert :: CULong -> ConvertResult CWchar
safeConvert = (CULong -> ConvertResult CWchar) -> CULong -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (CULong -> CWchar) -> CULong -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong CLLong where
    safeConvert :: CULong -> ConvertResult CLLong
safeConvert = (CULong -> ConvertResult CLLong) -> CULong -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (CULong -> CLLong) -> CULong -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong CULLong where
    safeConvert :: CULong -> ConvertResult CULLong
safeConvert = (CULong -> ConvertResult CULLong)
-> CULong -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (CULong -> CULLong) -> CULong -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize CChar where
    safeConvert :: CSize -> ConvertResult CChar
safeConvert = (CSize -> ConvertResult CChar) -> CSize -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (CSize -> CChar) -> CSize -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize CSChar where
    safeConvert :: CSize -> ConvertResult CSChar
safeConvert = (CSize -> ConvertResult CSChar) -> CSize -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (CSize -> CSChar) -> CSize -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize CUChar where
    safeConvert :: CSize -> ConvertResult CUChar
safeConvert = (CSize -> ConvertResult CUChar) -> CSize -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (CSize -> CUChar) -> CSize -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize CShort where
    safeConvert :: CSize -> ConvertResult CShort
safeConvert = (CSize -> ConvertResult CShort) -> CSize -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (CSize -> CShort) -> CSize -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize CUShort where
    safeConvert :: CSize -> ConvertResult CUShort
safeConvert = (CSize -> ConvertResult CUShort) -> CSize -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (CSize -> CUShort) -> CSize -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize CInt where
    safeConvert :: CSize -> ConvertResult CInt
safeConvert = (CSize -> ConvertResult CInt) -> CSize -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (CSize -> CInt) -> CSize -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize CUInt where
    safeConvert :: CSize -> ConvertResult CUInt
safeConvert = (CSize -> ConvertResult CUInt) -> CSize -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (CSize -> CUInt) -> CSize -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize CLong where
    safeConvert :: CSize -> ConvertResult CLong
safeConvert = (CSize -> ConvertResult CLong) -> CSize -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (CSize -> CLong) -> CSize -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize CULong where
    safeConvert :: CSize -> ConvertResult CULong
safeConvert = (CSize -> ConvertResult CULong) -> CSize -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (CSize -> CULong) -> CSize -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize CWchar where
    safeConvert :: CSize -> ConvertResult CWchar
safeConvert = (CSize -> ConvertResult CWchar) -> CSize -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (CSize -> CWchar) -> CSize -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize CLLong where
    safeConvert :: CSize -> ConvertResult CLLong
safeConvert = (CSize -> ConvertResult CLLong) -> CSize -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (CSize -> CLLong) -> CSize -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize CULLong where
    safeConvert :: CSize -> ConvertResult CULLong
safeConvert = (CSize -> ConvertResult CULLong) -> CSize -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (CSize -> CULLong) -> CSize -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar CChar where
    safeConvert :: CWchar -> ConvertResult CChar
safeConvert = (CWchar -> ConvertResult CChar) -> CWchar -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (CWchar -> CChar) -> CWchar -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar CSChar where
    safeConvert :: CWchar -> ConvertResult CSChar
safeConvert = (CWchar -> ConvertResult CSChar) -> CWchar -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (CWchar -> CSChar) -> CWchar -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar CUChar where
    safeConvert :: CWchar -> ConvertResult CUChar
safeConvert = (CWchar -> ConvertResult CUChar) -> CWchar -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (CWchar -> CUChar) -> CWchar -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar CShort where
    safeConvert :: CWchar -> ConvertResult CShort
safeConvert = (CWchar -> ConvertResult CShort) -> CWchar -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (CWchar -> CShort) -> CWchar -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar CUShort where
    safeConvert :: CWchar -> ConvertResult CUShort
safeConvert = (CWchar -> ConvertResult CUShort)
-> CWchar -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (CWchar -> CUShort) -> CWchar -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar CInt where
    safeConvert :: CWchar -> ConvertResult CInt
safeConvert = (CWchar -> ConvertResult CInt) -> CWchar -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (CWchar -> CInt) -> CWchar -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar CUInt where
    safeConvert :: CWchar -> ConvertResult CUInt
safeConvert = (CWchar -> ConvertResult CUInt) -> CWchar -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (CWchar -> CUInt) -> CWchar -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar CLong where
    safeConvert :: CWchar -> ConvertResult CLong
safeConvert = (CWchar -> ConvertResult CLong) -> CWchar -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (CWchar -> CLong) -> CWchar -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar CULong where
    safeConvert :: CWchar -> ConvertResult CULong
safeConvert = (CWchar -> ConvertResult CULong) -> CWchar -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (CWchar -> CULong) -> CWchar -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar CSize where
    safeConvert :: CWchar -> ConvertResult CSize
safeConvert = (CWchar -> ConvertResult CSize) -> CWchar -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (CWchar -> CSize) -> CWchar -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar CLLong where
    safeConvert :: CWchar -> ConvertResult CLLong
safeConvert = (CWchar -> ConvertResult CLLong) -> CWchar -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (CWchar -> CLLong) -> CWchar -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar CULLong where
    safeConvert :: CWchar -> ConvertResult CULLong
safeConvert = (CWchar -> ConvertResult CULLong)
-> CWchar -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (CWchar -> CULLong) -> CWchar -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong CChar where
    safeConvert :: CLLong -> ConvertResult CChar
safeConvert = (CLLong -> ConvertResult CChar) -> CLLong -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (CLLong -> CChar) -> CLLong -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong CSChar where
    safeConvert :: CLLong -> ConvertResult CSChar
safeConvert = (CLLong -> ConvertResult CSChar) -> CLLong -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (CLLong -> CSChar) -> CLLong -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong CUChar where
    safeConvert :: CLLong -> ConvertResult CUChar
safeConvert = (CLLong -> ConvertResult CUChar) -> CLLong -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (CLLong -> CUChar) -> CLLong -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong CShort where
    safeConvert :: CLLong -> ConvertResult CShort
safeConvert = (CLLong -> ConvertResult CShort) -> CLLong -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (CLLong -> CShort) -> CLLong -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong CUShort where
    safeConvert :: CLLong -> ConvertResult CUShort
safeConvert = (CLLong -> ConvertResult CUShort)
-> CLLong -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (CLLong -> CUShort) -> CLLong -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong CInt where
    safeConvert :: CLLong -> ConvertResult CInt
safeConvert = (CLLong -> ConvertResult CInt) -> CLLong -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (CLLong -> CInt) -> CLLong -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong CUInt where
    safeConvert :: CLLong -> ConvertResult CUInt
safeConvert = (CLLong -> ConvertResult CUInt) -> CLLong -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (CLLong -> CUInt) -> CLLong -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong CLong where
    safeConvert :: CLLong -> ConvertResult CLong
safeConvert = (CLLong -> ConvertResult CLong) -> CLLong -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (CLLong -> CLong) -> CLLong -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong CULong where
    safeConvert :: CLLong -> ConvertResult CULong
safeConvert = (CLLong -> ConvertResult CULong) -> CLLong -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (CLLong -> CULong) -> CLLong -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong CSize where
    safeConvert :: CLLong -> ConvertResult CSize
safeConvert = (CLLong -> ConvertResult CSize) -> CLLong -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (CLLong -> CSize) -> CLLong -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong CWchar where
    safeConvert :: CLLong -> ConvertResult CWchar
safeConvert = (CLLong -> ConvertResult CWchar) -> CLLong -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (CLLong -> CWchar) -> CLLong -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong CULLong where
    safeConvert :: CLLong -> ConvertResult CULLong
safeConvert = (CLLong -> ConvertResult CULLong)
-> CLLong -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (CLLong -> CULLong) -> CLLong -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong CChar where
    safeConvert :: CULLong -> ConvertResult CChar
safeConvert = (CULLong -> ConvertResult CChar) -> CULLong -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (CULLong -> CChar) -> CULLong -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong CSChar where
    safeConvert :: CULLong -> ConvertResult CSChar
safeConvert = (CULLong -> ConvertResult CSChar)
-> CULLong -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (CULLong -> CSChar) -> CULLong -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong CUChar where
    safeConvert :: CULLong -> ConvertResult CUChar
safeConvert = (CULLong -> ConvertResult CUChar)
-> CULLong -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (CULLong -> CUChar) -> CULLong -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong CShort where
    safeConvert :: CULLong -> ConvertResult CShort
safeConvert = (CULLong -> ConvertResult CShort)
-> CULLong -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (CULLong -> CShort) -> CULLong -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong CUShort where
    safeConvert :: CULLong -> ConvertResult CUShort
safeConvert = (CULLong -> ConvertResult CUShort)
-> CULLong -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (CULLong -> CUShort) -> CULLong -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong CInt where
    safeConvert :: CULLong -> ConvertResult CInt
safeConvert = (CULLong -> ConvertResult CInt) -> CULLong -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (CULLong -> CInt) -> CULLong -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong CUInt where
    safeConvert :: CULLong -> ConvertResult CUInt
safeConvert = (CULLong -> ConvertResult CUInt) -> CULLong -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (CULLong -> CUInt) -> CULLong -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong CLong where
    safeConvert :: CULLong -> ConvertResult CLong
safeConvert = (CULLong -> ConvertResult CLong) -> CULLong -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (CULLong -> CLong) -> CULLong -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong CULong where
    safeConvert :: CULLong -> ConvertResult CULong
safeConvert = (CULLong -> ConvertResult CULong)
-> CULLong -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (CULLong -> CULong) -> CULLong -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong CSize where
    safeConvert :: CULLong -> ConvertResult CSize
safeConvert = (CULLong -> ConvertResult CSize) -> CULLong -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (CULLong -> CSize) -> CULLong -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong CWchar where
    safeConvert :: CULLong -> ConvertResult CWchar
safeConvert = (CULLong -> ConvertResult CWchar)
-> CULLong -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (CULLong -> CWchar) -> CULLong -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong CLLong where
    safeConvert :: CULLong -> ConvertResult CLLong
safeConvert = (CULLong -> ConvertResult CLLong)
-> CULLong -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (CULLong -> CLLong) -> CULLong -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

-- Section 5
instance Convertible CFloat CDouble where
    safeConvert :: CFloat -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (CFloat -> CDouble) -> CFloat -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance Convertible CDouble CFloat where
    safeConvert :: CDouble -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (CDouble -> CFloat) -> CDouble -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- Section 6
instance Convertible CFloat Integer where
    safeConvert :: CFloat -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CFloat -> Integer) -> CFloat -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate
instance Convertible Integer CFloat where
    safeConvert :: Integer -> ConvertResult CFloat
safeConvert = CFloat -> ConvertResult CFloat
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> ConvertResult CFloat)
-> (Integer -> CFloat) -> Integer -> ConvertResult CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Convertible CDouble Integer where
    safeConvert :: CDouble -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CDouble -> Integer) -> CDouble -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate
instance Convertible Integer CDouble where
    safeConvert :: Integer -> ConvertResult CDouble
safeConvert = CDouble -> ConvertResult CDouble
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> ConvertResult CDouble)
-> (Integer -> CDouble) -> Integer -> ConvertResult CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CDouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- Section 7
instance Convertible CChar Integer where
    safeConvert :: CChar -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CChar -> Integer) -> CChar -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Convertible Integer CChar where
    safeConvert :: Integer -> ConvertResult CChar
safeConvert = (Integer -> ConvertResult CChar) -> Integer -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (Integer -> CChar) -> Integer -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSChar Integer where
    safeConvert :: CSChar -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CSChar -> Integer) -> CSChar -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Convertible Integer CSChar where
    safeConvert :: Integer -> ConvertResult CSChar
safeConvert = (Integer -> ConvertResult CSChar)
-> Integer -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (Integer -> CSChar) -> Integer -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUChar Integer where
    safeConvert :: CUChar -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CUChar -> Integer) -> CUChar -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Convertible Integer CUChar where
    safeConvert :: Integer -> ConvertResult CUChar
safeConvert = (Integer -> ConvertResult CUChar)
-> Integer -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (Integer -> CUChar) -> Integer -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CShort Integer where
    safeConvert :: CShort -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CShort -> Integer) -> CShort -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Convertible Integer CShort where
    safeConvert :: Integer -> ConvertResult CShort
safeConvert = (Integer -> ConvertResult CShort)
-> Integer -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (Integer -> CShort) -> Integer -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUShort Integer where
    safeConvert :: CUShort -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CUShort -> Integer) -> CUShort -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Convertible Integer CUShort where
    safeConvert :: Integer -> ConvertResult CUShort
safeConvert = (Integer -> ConvertResult CUShort)
-> Integer -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (Integer -> CUShort) -> Integer -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CInt Integer where
    safeConvert :: CInt -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CInt -> Integer) -> CInt -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Convertible Integer CInt where
    safeConvert :: Integer -> ConvertResult CInt
safeConvert = (Integer -> ConvertResult CInt) -> Integer -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (Integer -> CInt) -> Integer -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CUInt Integer where
    safeConvert :: CUInt -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CUInt -> Integer) -> CUInt -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Convertible Integer CUInt where
    safeConvert :: Integer -> ConvertResult CUInt
safeConvert = (Integer -> ConvertResult CUInt) -> Integer -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (Integer -> CUInt) -> Integer -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLong Integer where
    safeConvert :: CLong -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CLong -> Integer) -> CLong -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Convertible Integer CLong where
    safeConvert :: Integer -> ConvertResult CLong
safeConvert = (Integer -> ConvertResult CLong) -> Integer -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (Integer -> CLong) -> Integer -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULong Integer where
    safeConvert :: CULong -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CULong -> Integer) -> CULong -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Convertible Integer CULong where
    safeConvert :: Integer -> ConvertResult CULong
safeConvert = (Integer -> ConvertResult CULong)
-> Integer -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (Integer -> CULong) -> Integer -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CSize Integer where
    safeConvert :: CSize -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CSize -> Integer) -> CSize -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Convertible Integer CSize where
    safeConvert :: Integer -> ConvertResult CSize
safeConvert = (Integer -> ConvertResult CSize) -> Integer -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (Integer -> CSize) -> Integer -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CWchar Integer where
    safeConvert :: CWchar -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CWchar -> Integer) -> CWchar -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Convertible Integer CWchar where
    safeConvert :: Integer -> ConvertResult CWchar
safeConvert = (Integer -> ConvertResult CWchar)
-> Integer -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (Integer -> CWchar) -> Integer -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CLLong Integer where
    safeConvert :: CLLong -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CLLong -> Integer) -> CLLong -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Convertible Integer CLLong where
    safeConvert :: Integer -> ConvertResult CLLong
safeConvert = (Integer -> ConvertResult CLLong)
-> Integer -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (Integer -> CLLong) -> Integer -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

instance Convertible CULLong Integer where
    safeConvert :: CULLong -> ConvertResult Integer
safeConvert = Integer -> ConvertResult Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ConvertResult Integer)
-> (CULLong -> Integer) -> CULLong -> ConvertResult Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Convertible Integer CULLong where
    safeConvert :: Integer -> ConvertResult CULLong
safeConvert = (Integer -> ConvertResult CULLong)
-> Integer -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (Integer -> CULLong) -> Integer -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

-- Section 8o
instance Convertible CChar Char where
    safeConvert :: CChar -> ConvertResult Char
safeConvert = (CChar -> ConvertResult Char) -> CChar -> ConvertResult Char
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Char -> ConvertResult Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ConvertResult Char)
-> (CChar -> Char) -> CChar -> ConvertResult Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CChar -> Int) -> CChar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Char CChar where
    safeConvert :: Char -> ConvertResult CChar
safeConvert = (Char -> ConvertResult CChar) -> Char -> ConvertResult CChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CChar -> ConvertResult CChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CChar -> ConvertResult CChar)
-> (Char -> CChar) -> Char -> ConvertResult CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CChar) -> (Char -> Int) -> Char -> CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)

instance Convertible CSChar Char where
    safeConvert :: CSChar -> ConvertResult Char
safeConvert = (CSChar -> ConvertResult Char) -> CSChar -> ConvertResult Char
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Char -> ConvertResult Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ConvertResult Char)
-> (CSChar -> Char) -> CSChar -> ConvertResult Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CSChar -> Int) -> CSChar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSChar -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Char CSChar where
    safeConvert :: Char -> ConvertResult CSChar
safeConvert = (Char -> ConvertResult CSChar) -> Char -> ConvertResult CSChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSChar -> ConvertResult CSChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CSChar -> ConvertResult CSChar)
-> (Char -> CSChar) -> Char -> ConvertResult CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSChar) -> (Char -> Int) -> Char -> CSChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)

instance Convertible CUChar Char where
    safeConvert :: CUChar -> ConvertResult Char
safeConvert = (CUChar -> ConvertResult Char) -> CUChar -> ConvertResult Char
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Char -> ConvertResult Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ConvertResult Char)
-> (CUChar -> Char) -> CUChar -> ConvertResult Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CUChar -> Int) -> CUChar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUChar -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Char CUChar where
    safeConvert :: Char -> ConvertResult CUChar
safeConvert = (Char -> ConvertResult CUChar) -> Char -> ConvertResult CUChar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUChar -> ConvertResult CUChar
forall (m :: * -> *) a. Monad m => a -> m a
return (CUChar -> ConvertResult CUChar)
-> (Char -> CUChar) -> Char -> ConvertResult CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CUChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUChar) -> (Char -> Int) -> Char -> CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)

instance Convertible CShort Char where
    safeConvert :: CShort -> ConvertResult Char
safeConvert = (CShort -> ConvertResult Char) -> CShort -> ConvertResult Char
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Char -> ConvertResult Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ConvertResult Char)
-> (CShort -> Char) -> CShort -> ConvertResult Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CShort -> Int) -> CShort -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Char CShort where
    safeConvert :: Char -> ConvertResult CShort
safeConvert = (Char -> ConvertResult CShort) -> Char -> ConvertResult CShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CShort -> ConvertResult CShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CShort -> ConvertResult CShort)
-> (Char -> CShort) -> Char -> ConvertResult CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CShort) -> (Char -> Int) -> Char -> CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)

instance Convertible CUShort Char where
    safeConvert :: CUShort -> ConvertResult Char
safeConvert = (CUShort -> ConvertResult Char) -> CUShort -> ConvertResult Char
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Char -> ConvertResult Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ConvertResult Char)
-> (CUShort -> Char) -> CUShort -> ConvertResult Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CUShort -> Int) -> CUShort -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Char CUShort where
    safeConvert :: Char -> ConvertResult CUShort
safeConvert = (Char -> ConvertResult CUShort) -> Char -> ConvertResult CUShort
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUShort -> ConvertResult CUShort
forall (m :: * -> *) a. Monad m => a -> m a
return (CUShort -> ConvertResult CUShort)
-> (Char -> CUShort) -> Char -> ConvertResult CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUShort) -> (Char -> Int) -> Char -> CUShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)

instance Convertible CInt Char where
    safeConvert :: CInt -> ConvertResult Char
safeConvert = (CInt -> ConvertResult Char) -> CInt -> ConvertResult Char
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Char -> ConvertResult Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ConvertResult Char)
-> (CInt -> Char) -> CInt -> ConvertResult Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CInt -> Int) -> CInt -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Char CInt where
    safeConvert :: Char -> ConvertResult CInt
safeConvert = (Char -> ConvertResult CInt) -> Char -> ConvertResult CInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CInt -> ConvertResult CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ConvertResult CInt)
-> (Char -> CInt) -> Char -> ConvertResult CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Char -> Int) -> Char -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)

instance Convertible CUInt Char where
    safeConvert :: CUInt -> ConvertResult Char
safeConvert = (CUInt -> ConvertResult Char) -> CUInt -> ConvertResult Char
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Char -> ConvertResult Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ConvertResult Char)
-> (CUInt -> Char) -> CUInt -> ConvertResult Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CUInt -> Int) -> CUInt -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Char CUInt where
    safeConvert :: Char -> ConvertResult CUInt
safeConvert = (Char -> ConvertResult CUInt) -> Char -> ConvertResult CUInt
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CUInt -> ConvertResult CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> ConvertResult CUInt)
-> (Char -> CUInt) -> Char -> ConvertResult CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Char -> Int) -> Char -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)

instance Convertible CLong Char where
    safeConvert :: CLong -> ConvertResult Char
safeConvert = (CLong -> ConvertResult Char) -> CLong -> ConvertResult Char
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Char -> ConvertResult Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ConvertResult Char)
-> (CLong -> Char) -> CLong -> ConvertResult Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CLong -> Int) -> CLong -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Char CLong where
    safeConvert :: Char -> ConvertResult CLong
safeConvert = (Char -> ConvertResult CLong) -> Char -> ConvertResult CLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLong -> ConvertResult CLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> ConvertResult CLong)
-> (Char -> CLong) -> Char -> ConvertResult CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CLong) -> (Char -> Int) -> Char -> CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)

instance Convertible CULong Char where
    safeConvert :: CULong -> ConvertResult Char
safeConvert = (CULong -> ConvertResult Char) -> CULong -> ConvertResult Char
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Char -> ConvertResult Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ConvertResult Char)
-> (CULong -> Char) -> CULong -> ConvertResult Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CULong -> Int) -> CULong -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Char CULong where
    safeConvert :: Char -> ConvertResult CULong
safeConvert = (Char -> ConvertResult CULong) -> Char -> ConvertResult CULong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULong -> ConvertResult CULong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> ConvertResult CULong)
-> (Char -> CULong) -> Char -> ConvertResult CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CULong) -> (Char -> Int) -> Char -> CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)

instance Convertible CSize Char where
    safeConvert :: CSize -> ConvertResult Char
safeConvert = (CSize -> ConvertResult Char) -> CSize -> ConvertResult Char
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Char -> ConvertResult Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ConvertResult Char)
-> (CSize -> Char) -> CSize -> ConvertResult Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CSize -> Int) -> CSize -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Char CSize where
    safeConvert :: Char -> ConvertResult CSize
safeConvert = (Char -> ConvertResult CSize) -> Char -> ConvertResult CSize
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CSize -> ConvertResult CSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> ConvertResult CSize)
-> (Char -> CSize) -> Char -> ConvertResult CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> (Char -> Int) -> Char -> CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)

instance Convertible CWchar Char where
    safeConvert :: CWchar -> ConvertResult Char
safeConvert = (CWchar -> ConvertResult Char) -> CWchar -> ConvertResult Char
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Char -> ConvertResult Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ConvertResult Char)
-> (CWchar -> Char) -> CWchar -> ConvertResult Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CWchar -> Int) -> CWchar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Char CWchar where
    safeConvert :: Char -> ConvertResult CWchar
safeConvert = (Char -> ConvertResult CWchar) -> Char -> ConvertResult CWchar
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CWchar -> ConvertResult CWchar
forall (m :: * -> *) a. Monad m => a -> m a
return (CWchar -> ConvertResult CWchar)
-> (Char -> CWchar) -> Char -> ConvertResult CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CWchar
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CWchar) -> (Char -> Int) -> Char -> CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)

instance Convertible CLLong Char where
    safeConvert :: CLLong -> ConvertResult Char
safeConvert = (CLLong -> ConvertResult Char) -> CLLong -> ConvertResult Char
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Char -> ConvertResult Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ConvertResult Char)
-> (CLLong -> Char) -> CLLong -> ConvertResult Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CLLong -> Int) -> CLLong -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Char CLLong where
    safeConvert :: Char -> ConvertResult CLLong
safeConvert = (Char -> ConvertResult CLLong) -> Char -> ConvertResult CLLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CLLong -> ConvertResult CLLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> ConvertResult CLLong)
-> (Char -> CLLong) -> Char -> ConvertResult CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CLLong) -> (Char -> Int) -> Char -> CLLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)

instance Convertible CULLong Char where
    safeConvert :: CULLong -> ConvertResult Char
safeConvert = (CULLong -> ConvertResult Char) -> CULLong -> ConvertResult Char
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (Char -> ConvertResult Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> ConvertResult Char)
-> (CULLong -> Char) -> CULLong -> ConvertResult Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CULLong -> Int) -> CULLong -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
instance Convertible Char CULLong where
    safeConvert :: Char -> ConvertResult CULLong
safeConvert = (Char -> ConvertResult CULLong) -> Char -> ConvertResult CULLong
forall b a.
(Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (CULLong -> ConvertResult CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> ConvertResult CULLong)
-> (Char -> CULLong) -> Char -> ConvertResult CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CULLong) -> (Char -> Int) -> Char -> CULLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)