├── Setup.lhs ├── testsrc ├── runtests.hs ├── TestMap.hs ├── TestNum.hs └── TestTime.hs ├── .github └── workflows │ └── bump.yml ├── Data ├── Convertible │ ├── Instances │ │ ├── Map.hs │ │ ├── Text.hs │ │ ├── Time.hs │ │ ├── Num.hs │ │ └── C.hs │ ├── Instances.hs │ ├── Utils.hs │ └── Base.hs └── Convertible.hs ├── LICENSE ├── utils └── genCinstances.hs └── convertible.cabal /Setup.lhs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | 5 | > main = defaultMain 6 | 7 | -------------------------------------------------------------------------------- /testsrc/runtests.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified TestNum 4 | import qualified TestMap 5 | import qualified TestTime 6 | 7 | main :: IO () 8 | main = do 9 | sequence_ TestNum.allt 10 | sequence_ TestMap.allt 11 | sequence_ TestTime.allt 12 | -------------------------------------------------------------------------------- /.github/workflows/bump.yml: -------------------------------------------------------------------------------- 1 | name: Create dependency bump PR 2 | on: 3 | # allows manual triggering from https://github.com/../../actions/workflows/bump.yml 4 | workflow_dispatch: 5 | # runs weekly on Thursday at 8:00 6 | schedule: 7 | - cron: '0 8 * * 4' 8 | 9 | permissions: 10 | contents: write 11 | pull-requests: write 12 | 13 | jobs: 14 | bump: 15 | runs-on: ubuntu-latest 16 | steps: 17 | - uses: nomeata/haskell-bounds-bump-action@main 18 | -------------------------------------------------------------------------------- /testsrc/TestMap.hs: -------------------------------------------------------------------------------- 1 | {- 2 | Copyright (C) 2009-2011 John Goerzen 3 | 4 | All rights reserved. 5 | 6 | For license and copyright information, see the file LICENSE 7 | -} 8 | 9 | module TestMap where 10 | import Data.Convertible 11 | import Test.QuickCheck ((===), Property, Testable, quickCheck) 12 | import qualified Data.Map as Map 13 | 14 | -- | [(Int, Int)] -> Map 15 | propListMap :: [(Int, Int)] -> Property 16 | propListMap x = safeConvert x === Right (Map.fromList x) 17 | 18 | -- | Map -> [(Int, Int)] 19 | propMapList :: Map.Map Int Int -> Property 20 | propMapList x = safeConvert x === Right (Map.toList x) 21 | 22 | q :: Testable prop => String -> prop -> IO () 23 | q testLabel prop = do 24 | putStrLn testLabel 25 | quickCheck prop 26 | 27 | allt :: [IO ()] 28 | allt = [q "[(Int, Int)] -> Map" propListMap, 29 | q "Map -> [(Int, Int)]" propMapList] 30 | -------------------------------------------------------------------------------- /Data/Convertible/Instances/Map.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Data.Convertible.Instances.Map 3 | Copyright : Copyright (C) 2009-2011 John Goerzen 4 | License : BSD3 5 | 6 | Maintainer : John Goerzen 7 | Stability : provisional 8 | Portability: portable 9 | 10 | Instances to convert between Map and association list. 11 | 12 | Copyright (C) 2009-2011 John Goerzen 13 | 14 | All rights reserved. 15 | 16 | For license and copyright information, see the file LICENSE 17 | 18 | -} 19 | 20 | module Data.Convertible.Instances.Map() 21 | where 22 | 23 | import Data.Convertible.Base 24 | 25 | import qualified Data.Map as Map 26 | 27 | instance Ord k => Convertible [(k, a)] (Map.Map k a) where 28 | safeConvert = return . Map.fromList 29 | instance Convertible (Map.Map k a) [(k, a)] where 30 | safeConvert = return . Map.toList 31 | -------------------------------------------------------------------------------- /Data/Convertible/Instances.hs: -------------------------------------------------------------------------------- 1 | {- 2 | Copyright (C) 2009-2011 John Goerzen 3 | 4 | All rights reserved. 5 | 6 | For license and copyright information, see the file LICENSE 7 | 8 | -} 9 | 10 | {- | 11 | Module : Data.Convertible.Instances 12 | Copyright : Copyright (C) 2009-2011 John Goerzen 13 | License : BSD3 14 | 15 | Maintainer : John Goerzen 16 | Stability : provisional 17 | Portability: portable 18 | 19 | Collection of ready-made 'Data.Convertible.Convertible' instances. See 20 | each individual module for more docs: 21 | 22 | "Data.Convertible.Instances.C" 23 | 24 | "Data.Convertible.Instances.Map" 25 | 26 | "Data.Convertible.Instances.Num" 27 | 28 | "Data.Convertible.Instances.Time" 29 | 30 | You can find a list of these instances at 'Data.Convertible.Base.Convertible'. 31 | -} 32 | 33 | module Data.Convertible.Instances( 34 | ) where 35 | 36 | import Data.Convertible.Instances.C() 37 | import Data.Convertible.Instances.Map() 38 | import Data.Convertible.Instances.Num() 39 | import Data.Convertible.Instances.Text() 40 | import Data.Convertible.Instances.Time() 41 | -------------------------------------------------------------------------------- /Data/Convertible.hs: -------------------------------------------------------------------------------- 1 | {- 2 | Copyright (C) 2009-2011 John Goerzen 3 | 4 | All rights reserved. 5 | 6 | For license and copyright information, see the file LICENSE 7 | 8 | -} 9 | 10 | {- | 11 | Module : Data.Convertible.Base 12 | Copyright : Copyright (C) 2009-2011 John Goerzen 13 | License : BSD3 14 | 15 | Maintainer : John Goerzen 16 | Stability : provisional 17 | Portability: portable 18 | 19 | This is a library to provide a uniform interface for safe conversions between 20 | different types of data. To get started reading about it, consult: 21 | 22 | "Data.Convertible.Base" for information about the conversions themselves 23 | 24 | "Data.Convertible.Utils" for helpful tools for people writing 'Convertible' instances 25 | 26 | "Data.Convertible.Instances" for a large collection of ready-built 'Convertible' instances 27 | 28 | You can import these modules individually, or this module will export the entire library 29 | for you. 30 | -} 31 | 32 | module Data.Convertible ( 33 | module Data.Convertible.Base, 34 | module Data.Convertible.Utils 35 | ) 36 | where 37 | import Data.Convertible.Base 38 | import Data.Convertible.Utils 39 | import Data.Convertible.Instances () 40 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2009 - 2011 John Goerzen 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, this 11 | list of conditions and the following disclaimer in the documentation and/or 12 | other materials provided with the distribution. 13 | 14 | * Neither the name of John Goerzen nor the names of the 15 | contributors may be used to endorse or promote products derived from this 16 | software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 19 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 24 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 25 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 26 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /Data/Convertible/Utils.hs: -------------------------------------------------------------------------------- 1 | {- 2 | Copyright (C) 2009-2011 John Goerzen 3 | 4 | All rights reserved. 5 | 6 | For license and copyright information, see the file LICENSE 7 | 8 | -} 9 | 10 | {- | 11 | Module : Data.Convertible.Utils 12 | Copyright : Copyright (C) 2009-2011 John Goerzen 13 | License : BSD3 14 | 15 | Maintainer : John Goerzen 16 | Stability : provisional 17 | Portability: portable 18 | 19 | -} 20 | 21 | module Data.Convertible.Utils(boundedConversion, 22 | convertVia 23 | ) 24 | where 25 | import Data.Convertible.Base 26 | import Data.Typeable 27 | 28 | {- | Utility function to perform bounds checking as part of a conversion. 29 | 30 | Does this be examining the bounds of the destination type, converting to the type of 31 | the source via 'safeConvert', comparing to the source value. Results in an error 32 | if the conversion is out of bounds. -} 33 | boundedConversion :: (Bounded b, Show a, Show b, Convertible a Integer, 34 | Convertible b Integer, 35 | Typeable a, Typeable b) => 36 | (a -> ConvertResult b) -- ^ Function to do the conversion 37 | -> a -- ^ Input data 38 | -> ConvertResult b -- ^ Result 39 | boundedConversion func inp = 40 | do result <- func inp 41 | let smallest = asTypeOf minBound result 42 | let biggest = asTypeOf maxBound result 43 | let smallest' = convert smallest :: Integer 44 | let biggest' = convert biggest :: Integer 45 | let inp' = convert inp :: Integer 46 | if inp' < smallest' || inp' > biggest' 47 | then convError ("Input value outside of bounds: " ++ show (smallest, biggest)) 48 | inp 49 | else return result 50 | 51 | {- | Useful for defining conversions that are implemented in terms of other 52 | conversions via an intermediary type. Instead of: 53 | 54 | >instance Convertible CalendarTime POSIXTime where 55 | > safeConvert a = do r <- safeConvert a 56 | > safeConvert (r :: ClockTime) 57 | 58 | we can now write: 59 | 60 | >instance Convertible CalendarTime POSIXTime where 61 | > safeConvert = convertVia (undefined::ClockTime) 62 | 63 | which does the same thing -- converts a CalendarTime to a ClockTime, then a 64 | ClockTime to a POSIXTime, both using existing 'Convertible' instances. 65 | -} 66 | convertVia :: (Convertible a b, Convertible b c) => 67 | b -- ^ Dummy data to establish intermediate type - can be undefined 68 | -> a -- ^ Input value 69 | -> ConvertResult c -- ^ Result 70 | convertVia dummy inp = 71 | do r1 <- safeConvert inp 72 | safeConvert (asTypeOf r1 dummy) 73 | -------------------------------------------------------------------------------- /utils/genCinstances.hs: -------------------------------------------------------------------------------- 1 | cint = ["CChar", "CSChar", "CUChar", "CShort", "CUShort", "CInt", "CUInt", "CLong", 2 | "CULong", "CSize", "CWchar", "CLLong", "CULLong"] 3 | cfloat = ["CFloat", "CDouble", "CLDouble"] 4 | hsint = ["Int", "Int8", "Int16", "Int32", "Int64", "Word", "Word8", "Word16", "Word32", 5 | "Word64"] 6 | hsfloat = ["Double", "Float", "Rational"] 7 | 8 | printFP (f, i) = 9 | "instance Convertible " ++ f ++ " " ++ i ++ " where \n\ 10 | \ safeConvert = boundedConversion (return . truncate)\n\ 11 | \instance Convertible " ++ i ++ " " ++ f ++ " where \n\ 12 | \ safeConvert = return . fromIntegral\n" 13 | 14 | printIntegerF f = 15 | "instance Convertible " ++ f ++ " Integer where\n\ 16 | \ safeConvert = return . truncate\n\ 17 | \instance Convertible Integer " ++ f ++ " where\n\ 18 | \ safeConvert = return . fromIntegral\n" 19 | 20 | printIntegerI i = 21 | "instance Convertible " ++ i ++ " Integer where\n\ 22 | \ safeConvert = return . fromIntegral\n\ 23 | \instance Convertible Integer " ++ i ++ " where\n\ 24 | \ safeConvert = boundedConversion (return . fromIntegral)\n" 25 | 26 | printCharI i = 27 | "instance Convertible " ++ i ++ " Char where\n\ 28 | \ safeConvert = boundedConversion (return . toEnum . fromIntegral)\n\ 29 | \instance Convertible Char " ++ i ++ " where\n\ 30 | \ safeConvert = boundedConversion (return . fromIntegral . fromEnum)\n" 31 | 32 | printFP1 (f1, f2) = 33 | "instance Convertible " ++ f1 ++ " " ++ f2 ++ " where\n\ 34 | \ safeConvert = return . realToFrac\n" 35 | 36 | printFPFP (f1, f2) = printFP1 (f1, f2) ++ printFP1 (f2, f1) 37 | 38 | printInt (i1, i2) = 39 | "instance Convertible " ++ i1 ++ " " ++ i2 ++ " where\n\ 40 | \ safeConvert = boundedConversion (return . fromIntegral)\n" 41 | 42 | printIntInt (i1, i2) = printInt (i1, i2) ++ printInt (i2, i1) 43 | 44 | main = do putStrLn "-- Section 1" 45 | mapM_ (putStrLn . printFP) (concatMap (\x -> map (\y -> (x, y)) hsint) cfloat) 46 | putStrLn "-- Section 2" 47 | mapM_ (putStrLn . printFPFP) (concatMap (\x -> map (\y -> (x, y)) hsfloat) cfloat) 48 | putStrLn "-- Section 3" 49 | mapM_ (putStrLn . printIntInt) (concatMap (\x -> map (\y -> (x, y)) hsint) cint) 50 | putStrLn "-- Section 4" 51 | mapM_ (putStrLn . printInt) . filter (\(a, b) -> a /= b) $ 52 | (concatMap (\x -> map (\y -> (x, y)) cint) cint) 53 | putStrLn "-- Section 5" 54 | mapM_ (putStrLn . printFP1) . filter (\(a, b) -> a /= b) $ 55 | (concatMap (\x -> map (\y -> (x, y)) cfloat) cfloat) 56 | putStrLn "-- Section 6" 57 | mapM_ (putStrLn . printIntegerF) cfloat 58 | putStrLn "-- Section 7" 59 | mapM_ (putStrLn . printIntegerI) cint 60 | putStrLn "-- Section 8o" 61 | mapM_ (putStrLn . printCharI) cint 62 | 63 | 64 | 65 | 66 | -------------------------------------------------------------------------------- /convertible.cabal: -------------------------------------------------------------------------------- 1 | Name: convertible 2 | Version: 1.1.1.1 3 | License: BSD3 4 | Maintainer: Janus Troelsen 5 | Author: John Goerzen 6 | Copyright: Copyright (c) 2009-2011 John Goerzen 7 | license-file: LICENSE 8 | extra-source-files: LICENSE, utils/genCinstances.hs 9 | homepage: http://hackage.haskell.org/package/convertible 10 | bug-reports: https://github.com/hdbc/convertible/issues 11 | 12 | 13 | Category: Data 14 | synopsis: Typeclasses and instances for converting between types 15 | Description: convertible provides a typeclass with a single function 16 | that is designed to help convert between different types: numeric 17 | values, dates and times, and the like. The conversions perform bounds 18 | checking and return a pure Either value. This means that you need 19 | not remember which specific function performs the conversion you 20 | desire. 21 | . 22 | Also included in the package are optional instances that provide 23 | conversion for various numeric and time types, as well as utilities 24 | for writing your own instances. 25 | . 26 | Finally, there is a function that will raise an exception on 27 | bounds-checking violation, or return a bare value otherwise, 28 | implemented in terms of the safer function described above. 29 | . 30 | Convertible is also used by HDBC 2.0 for handling marshalling of 31 | data to and from databases. 32 | . 33 | Convertible is backed by an extensive test suite and passes tests 34 | on GHC and Hugs. 35 | Stability: Stable 36 | Build-Type: Simple 37 | 38 | Cabal-Version: >=1.10 39 | 40 | source-repository head 41 | type: git 42 | location: git://github.com/hdbc/convertible.git 43 | 44 | library 45 | Default-Language: Haskell2010 46 | Build-Depends: base>=3 && <5, 47 | old-time, 48 | time>=1.1.3, 49 | bytestring >= 0.10.2, 50 | containers, 51 | mtl, 52 | text >= 0.8 53 | 54 | GHC-Options: -Wall -fno-warn-orphans -Wcpp-undef -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -Winvalid-haddock -Wunused-packages -Wmissing-export-lists 55 | 56 | Exposed-Modules: Data.Convertible, 57 | Data.Convertible.Base, 58 | Data.Convertible.Utils, 59 | Data.Convertible.Instances, 60 | Data.Convertible.Instances.C, 61 | Data.Convertible.Instances.Map, 62 | Data.Convertible.Instances.Num, 63 | Data.Convertible.Instances.Text, 64 | Data.Convertible.Instances.Time 65 | 66 | Default-Extensions: 67 | ExistentialQuantification, MultiParamTypeClasses, 68 | UndecidableInstances, FlexibleInstances, 69 | FlexibleContexts, TypeSynonymInstances 70 | Other-Extensions: CPP 71 | 72 | test-suite runtests 73 | Default-Language: Haskell2010 74 | Type: exitcode-stdio-1.0 75 | Build-Depends: base, convertible, containers, QuickCheck >= 2.8, time>=1.1.3, old-time 76 | Main-Is: runtests.hs 77 | Hs-Source-Dirs: testsrc 78 | GHC-Options: -Wall -Wno-orphans -Wcpp-undef -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -Winvalid-haddock -Wunused-packages 79 | Default-Extensions: 80 | ExistentialQuantification, MultiParamTypeClasses, 81 | UndecidableInstances, FlexibleInstances, 82 | FlexibleContexts, TypeSynonymInstances, CPP 83 | Other-Modules: TestNum, TestTime, TestMap 84 | -------------------------------------------------------------------------------- /Data/Convertible/Base.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {- 3 | Copyright (C) 2009-2011 John Goerzen 4 | 5 | All rights reserved. 6 | 7 | For license and copyright information, see the file LICENSE 8 | 9 | -} 10 | 11 | {- | 12 | Module : Data.Convertible.Base 13 | Copyright : Copyright (C) 2009-2011 John Goerzen 14 | License : BSD3 15 | 16 | Maintainer : John Goerzen 17 | Stability : provisional 18 | Portability: portable 19 | 20 | -} 21 | 22 | module Data.Convertible.Base( -- * The conversion process 23 | convert, 24 | Convertible(..), 25 | -- * Handling the results 26 | ConvertResult, 27 | ConvertError(..), 28 | convError, 29 | prettyConvertError 30 | ) 31 | where 32 | #if !MIN_VERSION_mtl(2,3,0) 33 | import Control.Monad.Error 34 | #endif 35 | import Data.Typeable 36 | 37 | {- | The result of a safe conversion via 'safeConvert'. -} 38 | type ConvertResult a = Either ConvertError a 39 | 40 | ---------------------------------------------------------------------- 41 | -- Conversions 42 | ---------------------------------------------------------------------- 43 | 44 | {- | A typeclass that represents something that can be converted. 45 | A @Convertible a b@ instance represents an @a@ that can be converted to a @b@. -} 46 | class Convertible a b where 47 | {- | Convert @a@ to @b@, returning Right on success and Left on error. 48 | For a simpler interface, see 'convert'. -} 49 | safeConvert :: a -> ConvertResult b 50 | 51 | {- 52 | {- | Any type can be converted to itself. -} 53 | instance Convertible a a where 54 | safeConvert x = return x 55 | -} 56 | 57 | {- 58 | {- | Lists of any convertible type can be converted. -} 59 | instance Convertible a b => Convertible [a] [b] where 60 | safeConvert = mapM safeConvert 61 | -} 62 | 63 | {- | Convert from one type of data to another. Raises an exception if there is 64 | an error with the conversion. For a function that does not raise an exception 65 | in that case, see 'safeConvert'. -} 66 | convert :: Convertible a b => a -> b 67 | convert x = 68 | case safeConvert x of 69 | Left e -> error (prettyConvertError e) 70 | Right r -> r 71 | 72 | {- 73 | instance Convertible Int Double where 74 | safeConvert = return . fromIntegral 75 | instance Convertible Double Int where 76 | safeConvert = return . truncate -- could do bounds checking here 77 | instance Convertible Integer Double where 78 | safeConvert = return . fromIntegral 79 | instance Convertible Double Integer where 80 | safeConvert = return . truncate 81 | -} 82 | 83 | ---------------------------------------------------------------------- 84 | -- Error Handling 85 | ---------------------------------------------------------------------- 86 | 87 | {- | How we indicate that there was an error. -} 88 | data ConvertError = ConvertError { 89 | convSourceValue :: String, 90 | convSourceType :: String, 91 | convDestType :: String, 92 | convErrorMessage :: String} 93 | deriving (Eq, Read, Show) 94 | 95 | #if !MIN_VERSION_mtl(2,3,0) 96 | instance Error ConvertError where 97 | strMsg x = ConvertError "(unknown)" "(unknown)" "(unknown)" x 98 | #endif 99 | 100 | convError' :: (Show a, Typeable a, Typeable b) => 101 | String -> a -> b -> ConvertResult b 102 | convError' msg inpval retval = 103 | Left $ ConvertError { 104 | convSourceValue = show inpval, 105 | convSourceType = show . typeOf $ inpval, 106 | convDestType = show . typeOf $ retval, 107 | convErrorMessage = msg} 108 | 109 | convError :: (Show a, Typeable a, Typeable b) => 110 | String -> a -> ConvertResult b 111 | convError msg inpval = 112 | convError' msg inpval undefined 113 | 114 | prettyConvertError :: ConvertError -> String 115 | prettyConvertError (ConvertError sv st dt em) = 116 | "Convertible: error converting source data " ++ sv ++ " of type " ++ st 117 | ++ " to type " ++ dt ++ ": " ++ em 118 | 119 | -------------------------------------------------------------------------------- /testsrc/TestNum.hs: -------------------------------------------------------------------------------- 1 | {- 2 | Copyright (C) 2009-2011 John Goerzen 3 | 4 | All rights reserved. 5 | 6 | For license and copyright information, see the file LICENSE 7 | -} 8 | 9 | module TestNum where 10 | import Data.Convertible 11 | import Test.QuickCheck ((===), (==>), Property, Testable, quickCheck) 12 | import Data.Word (Word8) 13 | 14 | -- | Int -> Integer 15 | prop_int_to_integer :: Int -> Property 16 | prop_int_to_integer x = 17 | safeConvert x === Right (fromIntegral x :: Integer) 18 | 19 | -- | Integer -> Int (safe bounds) 20 | prop_integer_to_int_pass :: Integer -> Property 21 | prop_integer_to_int_pass x = 22 | (x <= fromIntegral (maxBound :: Int)) && 23 | (x >= fromIntegral (minBound :: Int)) ==> 24 | safeConvert x === Right (fromIntegral x :: Int) 25 | 26 | -- | Integer -> Word8 (general) 27 | prop_integer_to_word8 :: Integer -> Property 28 | prop_integer_to_word8 x = 29 | safeConvert x === if x >= fromIntegral (minBound :: Word8) && 30 | x <= fromIntegral (maxBound :: Word8) 31 | then Right (fromIntegral x :: Word8) 32 | else Left $ ConvertError (show x) "Integer" "Word8" "Input value outside of bounds: (0,255)" 33 | 34 | -- | Integer -> Word8 (safe bounds) 35 | prop_integer_to_word8_safe :: Integer -> Property 36 | prop_integer_to_word8_safe x = 37 | x <= fromIntegral (maxBound :: Word8) && 38 | x >= fromIntegral (minBound :: Word8) ==> 39 | safeConvert x === Right (fromIntegral x :: Word8) 40 | 41 | -- | Integer -> Word8 (unsafe bounds) 42 | prop_integer_to_word8_unsafe :: Integer -> Property 43 | prop_integer_to_word8_unsafe x = 44 | x < fromIntegral (minBound :: Word8) || 45 | x > fromIntegral (maxBound :: Word8) ==> 46 | (safeConvert x :: ConvertResult Word8) === Left (ConvertError (show x) "Integer" "Word8" "Input value outside of bounds: (0,255)") 47 | 48 | -- | Double -> Word8 (general) 49 | prop_double_to_word8 :: Double -> Property 50 | prop_double_to_word8 x = 51 | safeConvert x === if truncate x >= toInteger (minBound :: Word8) && 52 | truncate x <= toInteger (maxBound :: Word8) 53 | then Right (truncate x :: Word8) 54 | else Left $ ConvertError (show x) "Double" "Word8" "Input value outside of bounds: (0,255)" 55 | 56 | -- | Double -> Word8 (safe bounds) 57 | prop_double_to_word8_safe :: Double -> Property 58 | prop_double_to_word8_safe x = 59 | x <= fromIntegral (maxBound :: Word8) && 60 | x >= fromIntegral (minBound :: Word8) ==> 61 | safeConvert x === Right (truncate x :: Word8) 62 | 63 | -- | Double -> Word8 (unsafe bounds) 64 | prop_double_to_word8_unsafe :: Double -> Property 65 | prop_double_to_word8_unsafe x = 66 | truncate x < toInteger (minBound :: Word8) || 67 | truncate x > toInteger (maxBound :: Word8) ==> 68 | (safeConvert x :: ConvertResult Word8) === Left (ConvertError (show x) "Double" "Word8" "Input value outside of bounds: (0,255)") 69 | 70 | -- | Int -> Double 71 | propIntDouble :: Int -> Property 72 | propIntDouble x = 73 | safeConvert x === Right (fromIntegral x :: Double) 74 | 75 | -- | Int -> Char 76 | propIntChar :: Int -> Property 77 | propIntChar x = 78 | safeConvert x === if x >= fromEnum (minBound :: Char) && 79 | x <= fromEnum (maxBound :: Char) 80 | then Right (toEnum x :: Char) 81 | else Left $ ConvertError (show x) "Int" "Char" "Input value outside of bounds: ('\\NUL','\\1114111')" 82 | 83 | -- | Char -> Int 84 | propCharInt :: Char -> Property 85 | propCharInt c = 86 | safeConvert c === Right (fromEnum c :: Int) 87 | 88 | -- | identity Int -> Integer -> Int 89 | propIntIntegerInt :: Int -> Property 90 | propIntIntegerInt x = 91 | Right x === do r1 <- safeConvert x :: ConvertResult Integer 92 | safeConvert r1 :: ConvertResult Int 93 | 94 | -- | identity Double -> Rational -> Double 95 | propDoubleRationalDouble :: Double -> Property 96 | propDoubleRationalDouble x = 97 | Right x === do r1 <- safeConvert x :: ConvertResult Rational 98 | safeConvert r1 :: ConvertResult Double 99 | 100 | q :: Testable prop => String -> prop -> IO () 101 | q testLabel prop = do 102 | putStrLn testLabel 103 | quickCheck prop 104 | 105 | allt :: [IO ()] 106 | allt = [q "Int -> Integer" prop_int_to_integer, 107 | q "Integer -> Int (safe bounds)" prop_integer_to_int_pass, 108 | q "Integer -> Word8 (general)" prop_integer_to_word8, 109 | q "Integer -> Word8 (safe bounds)" prop_integer_to_word8_safe, 110 | q "Integer -> Word8 (unsafe bounds)" prop_integer_to_word8_unsafe, 111 | q "Double -> Word8 (general)" prop_double_to_word8, 112 | q "Double -> Word8 (safe bounds)" prop_double_to_word8_safe, 113 | q "Double -> Word8 (unsafe bounds)" prop_double_to_word8_unsafe, 114 | q "Int -> Double" propIntDouble, 115 | q "Int -> Char" propIntChar, 116 | q "Char -> Int" propCharInt, 117 | q "identity Int -> Integer -> Int" propIntIntegerInt, 118 | q "identity Double -> Rational -> Double" propDoubleRationalDouble 119 | ] 120 | -------------------------------------------------------------------------------- /Data/Convertible/Instances/Text.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | {- | 4 | Module : Data.Convertible.Instances.Text 5 | Copyright : Copyright (C) 2011 MailRank, Inc. 6 | License : LGPL 7 | 8 | Maintainer : John Goerzen 9 | Stability : provisional 10 | Portability: portable 11 | 12 | Text instances for Convertible. 13 | 14 | Copyright (C) 2011 MailRank, Inc. 15 | 16 | All rights reserved. 17 | 18 | For license and copyright information, see the file COPYRIGHT 19 | 20 | These instances perform conversion between text-like types such as 21 | Text, ByteString, and the like. 22 | 23 | The instances do /not/ include conversions between ByteString and 24 | Text or String, since such conversions cannot safely be performed 25 | without knowing the encoding of the ByteString. 26 | -} 27 | 28 | module Data.Convertible.Instances.Text() 29 | where 30 | 31 | import Data.Convertible.Base 32 | import qualified Data.Text as TS 33 | import qualified Data.Text.Encoding as TE 34 | import qualified Data.Text.Lazy as TL 35 | import qualified Data.Text.Lazy.Builder as TLB 36 | import qualified Data.Text.Lazy.Encoding as TLE 37 | import qualified Data.ByteString as BS 38 | import qualified Data.ByteString.Lazy as BL 39 | import qualified Data.ByteString.Builder as BB 40 | import Data.Word (Word8) 41 | import Data.Foldable 42 | 43 | 44 | 45 | instance Convertible TS.Text [Char] where 46 | {-# INLINE safeConvert #-} 47 | safeConvert = Right . TS.unpack 48 | 49 | instance Convertible TS.Text TL.Text where 50 | {-# INLINE safeConvert #-} 51 | safeConvert = Right . TL.fromStrict 52 | 53 | instance Convertible TS.Text TLB.Builder where 54 | {-# INLINE safeConvert #-} 55 | safeConvert = Right . TLB.fromText 56 | 57 | instance Convertible TS.Text BS.ByteString where 58 | {-# INLINE safeConvert #-} 59 | safeConvert = Right . TE.encodeUtf8 60 | 61 | instance Convertible TS.Text BL.ByteString where 62 | {-# INLINE safeConvert #-} 63 | safeConvert = Right . BL.fromStrict . TE.encodeUtf8 64 | 65 | instance Convertible TS.Text BB.Builder where 66 | {-# INLINE safeConvert #-} 67 | #if MIN_VERSION_text(1,2,0) 68 | safeConvert = Right . TE.encodeUtf8Builder 69 | #else 70 | safeConvert = safeConvert . TE.encodeUtf8 71 | #endif 72 | 73 | 74 | 75 | instance Convertible TL.Text [Char] where 76 | {-# INLINE safeConvert #-} 77 | safeConvert = Right . TL.unpack 78 | 79 | instance Convertible TL.Text TS.Text where 80 | {-# INLINE safeConvert #-} 81 | safeConvert = Right . TL.toStrict 82 | 83 | instance Convertible TL.Text TLB.Builder where 84 | {-# INLINE safeConvert #-} 85 | safeConvert = Right . TLB.fromLazyText 86 | 87 | instance Convertible TL.Text BS.ByteString where 88 | {-# INLINE safeConvert #-} 89 | safeConvert = safeConvert . TLE.encodeUtf8 90 | 91 | instance Convertible TL.Text BL.ByteString where 92 | {-# INLINE safeConvert #-} 93 | safeConvert = Right . TLE.encodeUtf8 94 | 95 | instance Convertible TL.Text BB.Builder where 96 | {-# INLINE safeConvert #-} 97 | #if MIN_VERSION_text(1,2,0) 98 | safeConvert = Right . TLE.encodeUtf8Builder 99 | #else 100 | safeConvert = safeConvert . TLE.encodeUtf8 101 | #endif 102 | 103 | 104 | 105 | instance Convertible TLB.Builder [Char] where 106 | {-# INLINE safeConvert #-} 107 | safeConvert = safeConvert . TLB.toLazyText 108 | 109 | instance Convertible TLB.Builder TS.Text where 110 | {-# INLINE safeConvert #-} 111 | safeConvert = safeConvert . TLB.toLazyText 112 | 113 | instance Convertible TLB.Builder TL.Text where 114 | {-# INLINE safeConvert #-} 115 | safeConvert = Right . TLB.toLazyText 116 | 117 | instance Convertible TLB.Builder BS.ByteString where 118 | {-# INLINE safeConvert #-} 119 | safeConvert = safeConvert . TLB.toLazyText 120 | 121 | instance Convertible TLB.Builder BL.ByteString where 122 | {-# INLINE safeConvert #-} 123 | safeConvert = safeConvert . TLB.toLazyText 124 | 125 | instance Convertible TLB.Builder BB.Builder where 126 | {-# INLINE safeConvert #-} 127 | safeConvert = safeConvert . TLB.toLazyText 128 | 129 | 130 | 131 | instance Convertible BS.ByteString [Word8] where 132 | {-# INLINE safeConvert #-} 133 | safeConvert = Right . BS.unpack 134 | 135 | instance Convertible BS.ByteString TS.Text where 136 | {-# INLINE safeConvert #-} 137 | safeConvert = Right . TE.decodeUtf8 138 | 139 | instance Convertible BS.ByteString TL.Text where 140 | {-# INLINE safeConvert #-} 141 | safeConvert = fmap TL.fromStrict . safeConvert 142 | 143 | instance Convertible BS.ByteString TLB.Builder where 144 | {-# INLINE safeConvert #-} 145 | safeConvert = fmap TLB.fromText . safeConvert 146 | 147 | instance Convertible BS.ByteString BL.ByteString where 148 | {-# INLINE safeConvert #-} 149 | safeConvert = Right . BL.fromStrict 150 | 151 | instance Convertible BS.ByteString BB.Builder where 152 | {-# INLINE safeConvert #-} 153 | safeConvert = Right . BB.byteString 154 | 155 | 156 | 157 | instance Convertible BL.ByteString [Word8] where 158 | {-# INLINE safeConvert #-} 159 | safeConvert = Right . BL.unpack 160 | 161 | instance Convertible BL.ByteString TS.Text where 162 | {-# INLINE safeConvert #-} 163 | safeConvert = fmap TL.toStrict . safeConvert 164 | 165 | instance Convertible BL.ByteString TL.Text where 166 | {-# INLINE safeConvert #-} 167 | safeConvert = Right . TLE.decodeUtf8 168 | 169 | instance Convertible BL.ByteString TLB.Builder where 170 | {-# INLINE safeConvert #-} 171 | safeConvert = fmap TLB.fromLazyText . safeConvert 172 | 173 | instance Convertible BL.ByteString BS.ByteString where 174 | {-# INLINE safeConvert #-} 175 | safeConvert = Right . BL.toStrict 176 | 177 | instance Convertible BL.ByteString BB.Builder where 178 | {-# INLINE safeConvert #-} 179 | safeConvert = Right . BB.lazyByteString 180 | 181 | 182 | 183 | instance Convertible [Char] TS.Text where 184 | {-# INLINE safeConvert #-} 185 | safeConvert = Right . TS.pack 186 | 187 | instance Convertible [Char] TL.Text where 188 | {-# INLINE safeConvert #-} 189 | safeConvert = Right . TL.pack 190 | 191 | instance Convertible [Char] TLB.Builder where 192 | {-# INLINE safeConvert #-} 193 | safeConvert = Right . TLB.fromString 194 | 195 | 196 | 197 | instance Convertible [Word8] BS.ByteString where 198 | {-# INLINE safeConvert #-} 199 | safeConvert = Right . BS.pack 200 | 201 | instance Convertible [Word8] BL.ByteString where 202 | {-# INLINE safeConvert #-} 203 | safeConvert = Right . BL.pack 204 | 205 | instance Convertible [Word8] BB.Builder where 206 | {-# INLINE safeConvert #-} 207 | safeConvert = Right . foldMap BB.word8 208 | 209 | 210 | 211 | instance Convertible Char TS.Text where 212 | {-# INLINE safeConvert #-} 213 | safeConvert = Right . TS.singleton 214 | 215 | instance Convertible Char TL.Text where 216 | {-# INLINE safeConvert #-} 217 | safeConvert = Right . TL.singleton 218 | 219 | instance Convertible Char TLB.Builder where 220 | {-# INLINE safeConvert #-} 221 | safeConvert = Right . TLB.singleton 222 | 223 | 224 | 225 | instance Convertible Word8 BS.ByteString where 226 | {-# INLINE safeConvert #-} 227 | safeConvert = Right . BS.singleton 228 | 229 | instance Convertible Word8 BL.ByteString where 230 | {-# INLINE safeConvert #-} 231 | safeConvert = Right . BL.singleton 232 | 233 | instance Convertible Word8 BB.Builder where 234 | {-# INLINE safeConvert #-} 235 | safeConvert = Right . BB.word8 236 | -------------------------------------------------------------------------------- /testsrc/TestTime.hs: -------------------------------------------------------------------------------- 1 | {- 2 | Copyright (C) 2009-2011 John Goerzen 3 | 4 | All rights reserved. 5 | 6 | For license and copyright information, see the file LICENSE 7 | -} 8 | 9 | module TestTime where 10 | import Data.Convertible 11 | import Test.QuickCheck ((===), Arbitrary, Property, Testable, arbitrary, choose, quickCheck, sized) 12 | import qualified System.Time as ST 13 | import Data.Time 14 | import Data.Time.Clock.POSIX 15 | import Data.Ratio 16 | import Foreign.C.Types 17 | 18 | instance Arbitrary ST.ClockTime where 19 | arbitrary = do r1 <- arbitrary 20 | r2 <- sized $ \n -> choose (0, 1000000000000 - 1) 21 | return (ST.TOD r1 r2) 22 | -- coarbitrary (ST.TOD a b) = coarbitrary a . coarbitrary b 23 | 24 | instance Arbitrary ST.CalendarTime where 25 | arbitrary = do r <- arbitrary 26 | return $ convert (r::POSIXTime) 27 | 28 | instance Arbitrary NominalDiffTime where 29 | arbitrary = do r <- arbitrary 30 | return $ convert (r::ST.ClockTime) 31 | 32 | instance Arbitrary UTCTime where 33 | arbitrary = do r <- arbitrary 34 | return $ convert (r::POSIXTime) 35 | 36 | instance Arbitrary ZonedTime where 37 | arbitrary = do r <- arbitrary 38 | return $ convert (r::POSIXTime) 39 | 40 | instance Eq ZonedTime where 41 | a == b = zonedTimeToUTC a == zonedTimeToUTC b 42 | 43 | propCltCalt :: ST.ClockTime -> Property 44 | propCltCalt x = 45 | safeConvert x === Right (ST.toUTCTime x) 46 | 47 | propCltCaltClt :: ST.ClockTime -> Property 48 | propCltCaltClt x = 49 | Right x === do r1 <- safeConvert x :: ConvertResult ST.CalendarTime 50 | safeConvert r1 51 | 52 | propCltPT :: ST.ClockTime -> Property 53 | propCltPT x@(ST.TOD y z) = 54 | safeConvert x === Right (r::POSIXTime) 55 | where r = fromRational $ fromInteger y + fromRational (z % 1000000000000) 56 | 57 | propPTClt :: POSIXTime -> Property 58 | propPTClt x = 59 | safeConvert x === Right (r::ST.ClockTime) 60 | where r = ST.TOD rsecs rpico 61 | rsecs = floor x 62 | rpico = truncate $ abs $ 1000000000000 * (x - fromIntegral rsecs) 63 | 64 | propCaltPT :: ST.CalendarTime -> Property 65 | propCaltPT x = 66 | safeConvert x === expected 67 | where expected = do r <- safeConvert x 68 | safeConvert (r :: ST.ClockTime) :: ConvertResult POSIXTime 69 | 70 | propCltPTClt :: ST.ClockTime -> Property 71 | propCltPTClt x = 72 | Right (toTOD x) === case do r1 <- safeConvert x :: ConvertResult POSIXTime 73 | safeConvert r1 74 | of Left x -> Left x 75 | Right y -> Right $ toTOD y 76 | where toTOD (ST.TOD x y) = (x, y) 77 | {- 78 | Right x @=? do r1 <- (safeConvert x)::ConvertResult POSIXTime 79 | safeConvert r1 80 | -} 81 | 82 | propPTZTPT :: POSIXTime -> Property 83 | propPTZTPT x = 84 | Right x === do r1 <- safeConvert x 85 | safeConvert (r1 :: ZonedTime) 86 | 87 | propPTCltPT :: POSIXTime -> Property 88 | propPTCltPT x = 89 | Right x === do r1 <- safeConvert x :: ConvertResult ST.ClockTime 90 | safeConvert r1 91 | 92 | propPTCalPT :: POSIXTime -> Property 93 | propPTCalPT x = 94 | Right x === do r1 <- safeConvert x 95 | safeConvert (r1::ST.CalendarTime) 96 | 97 | propUTCCaltUTC :: UTCTime -> Property 98 | propUTCCaltUTC x = 99 | Right x === do r1 <- safeConvert x 100 | safeConvert (r1::ST.CalendarTime) 101 | 102 | propPTUTC :: POSIXTime -> Property 103 | propPTUTC x = 104 | safeConvert x === Right (posixSecondsToUTCTime x) 105 | propUTCPT :: UTCTime -> Property 106 | propUTCPT x = 107 | safeConvert x === Right (utcTimeToPOSIXSeconds x) 108 | 109 | propCltUTC :: ST.ClockTime -> Property 110 | propCltUTC x = 111 | safeConvert x === Right (posixSecondsToUTCTime . convert $ x) 112 | 113 | propZTCTeqZTCaltCt :: ZonedTime -> Property 114 | propZTCTeqZTCaltCt x = 115 | route1 === route2 116 | where route1 = safeConvert x :: ConvertResult ST.ClockTime 117 | route2 = do calt <- safeConvert x 118 | safeConvert (calt :: ST.CalendarTime) 119 | 120 | propCaltZTCalt :: ST.ClockTime -> Property 121 | propCaltZTCalt x = 122 | Right x === do zt <- safeConvert calt :: ConvertResult ZonedTime 123 | calt' <- safeConvert zt :: ConvertResult ST.CalendarTime 124 | return (ST.toClockTime calt') 125 | where calt = ST.toUTCTime x 126 | 127 | propCaltZTCalt2 :: ST.CalendarTime -> Property 128 | propCaltZTCalt2 x = 129 | Right x === do zt <- safeConvert x 130 | safeConvert (zt :: ZonedTime) 131 | 132 | propZTCaltCtZT :: ZonedTime -> Property 133 | propZTCaltCtZT x = 134 | Right x === do calt <- safeConvert x 135 | ct <- safeConvert (calt :: ST.CalendarTime) 136 | safeConvert (ct :: ST.ClockTime) 137 | 138 | propZTCtCaltZT :: ZonedTime -> Property 139 | propZTCtCaltZT x = 140 | Right x === do ct <- safeConvert x 141 | calt <- safeConvert (ct :: ST.ClockTime) 142 | safeConvert (calt :: ST.CalendarTime) 143 | 144 | propZTCaltZT :: ZonedTime -> Property 145 | propZTCaltZT x = 146 | Right x === do calt <- safeConvert x 147 | safeConvert (calt :: ST.CalendarTime) 148 | 149 | propZTCtCaltCtZT :: ZonedTime -> Property 150 | propZTCtCaltCtZT x = 151 | Right x === do ct <- safeConvert x 152 | calt <- safeConvert (ct :: ST.ClockTime) 153 | ct' <- safeConvert (calt :: ST.CalendarTime) 154 | safeConvert (ct' :: ST.ClockTime) 155 | 156 | propUTCZT :: UTCTime -> Bool 157 | propUTCZT x = 158 | x == zonedTimeToUTC (convert x) 159 | 160 | propUTCZTUTC :: UTCTime -> Property 161 | propUTCZTUTC x = 162 | Right x === do r1 <- safeConvert x :: ConvertResult ZonedTime 163 | safeConvert r1 164 | 165 | propNdtTdNdt :: NominalDiffTime -> Property 166 | propNdtTdNdt x = 167 | Right x === do r1 <- safeConvert x :: ConvertResult ST.TimeDiff 168 | safeConvert r1 169 | 170 | propPTCPT :: POSIXTime -> Property 171 | propPTCPT x = 172 | Right testval === do r1 <- safeConvert testval 173 | safeConvert (r1 :: CTime) 174 | where 175 | testval :: POSIXTime 176 | testval = convert (truncate x :: Integer) -- CTime doesn't support picosecs 177 | 178 | q :: Testable prop => String -> prop -> IO () 179 | q testLabel prop = do 180 | putStrLn testLabel 181 | quickCheck prop 182 | 183 | allt :: [IO ()] 184 | allt = [q "ClockTime -> CalendarTime" propCltCalt, 185 | q "ClockTime -> CalendarTime -> ClockTime" propCltCaltClt, 186 | q "ClockTime -> POSIXTime" propCltPT, 187 | q "POSIXTime -> ClockTime" propPTClt, 188 | q "CalendarTime -> POSIXTime" propCaltPT, 189 | q "identity ClockTime -> POSIXTime -> ClockTime" propCltPTClt, 190 | q "identity POSIXTime -> ClockTime -> POSIXTime" propPTCltPT, 191 | q "identity POSIXTime -> ZonedTime -> POSIXTime" propPTZTPT, 192 | q "identity POSIXTime -> CalendarTime -> POSIXTime" propPTCalPT, 193 | q "identity UTCTime -> CalendarTime -> UTCTime" propUTCCaltUTC, 194 | q "POSIXTime -> UTCTime" propPTUTC, 195 | q "UTCTime -> POSIXTime" propUTCPT, 196 | q "ClockTime -> UTCTime" propCltUTC, 197 | q "ZonedTime -> ClockTime == ZonedTime -> CalendarTime -> ClockTime" propZTCTeqZTCaltCt, 198 | q "identity CalendarTime -> ZonedTime -> CalendarTime" propCaltZTCalt, 199 | q "identity CalendarTime -> ZonedTime -> CalenderTime, test 2" propCaltZTCalt2, 200 | q "identity ZonedTime -> CalendarTime -> ZonedTime" propZTCaltZT, 201 | q "ZonedTime -> CalendarTime -> ClockTime -> ZonedTime" propZTCaltCtZT, 202 | q "ZonedTime -> ClockTime -> CalendarTime -> ZonedTime" propZTCtCaltZT, 203 | q "ZonedTime -> ColckTime -> CalendarTime -> ClockTime -> ZonedTime" propZTCtCaltCtZT, 204 | q "UTCTime -> ZonedTime" propUTCZT, 205 | q "UTCTime -> ZonedTime -> UTCTime" propUTCZTUTC, 206 | q "identity NominalDiffTime -> TimeDiff -> NominalDiffTime" propNdtTdNdt, 207 | q "identity POSIXTime -> CTime -> POSIXTime" propPTCPT 208 | ] 209 | -------------------------------------------------------------------------------- /Data/Convertible/Instances/Time.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Data.Convertible.Instances.Time 3 | Copyright : Copyright (C) 2009-2011 John Goerzen 4 | License : BSD3 5 | 6 | Maintainer : John Goerzen 7 | Stability : provisional 8 | Portability: portable 9 | 10 | Instances to convert between various time structures, both old- and new-style. 11 | 12 | At present, this module does not do full input validation. That is, it is possible 13 | to get an exception rather than a Left result from these functions if your input is 14 | invalid, particularly when converting from the old-style System.Time structures. 15 | 16 | Copyright (C) 2009-2011 John Goerzen 17 | 18 | All rights reserved. 19 | 20 | For license and copyright information, see the file LICENSE 21 | 22 | -} 23 | 24 | module Data.Convertible.Instances.Time() 25 | where 26 | 27 | import Data.Convertible.Base 28 | import Data.Convertible.Utils 29 | import Data.Convertible.Instances.Num() 30 | import qualified System.Time as ST 31 | import Data.Time 32 | import Data.Time.Clock.POSIX 33 | import Data.Time.Calendar.OrdinalDate 34 | import Data.Ratio 35 | import Foreign.C.Types 36 | 37 | ---------------------------------------------------------------------- 38 | -- Intra-System.Time stuff 39 | ---------------------------------------------------------------------- 40 | 41 | instance Convertible ST.ClockTime ST.CalendarTime where 42 | safeConvert = return . ST.toUTCTime 43 | 44 | instance Convertible ST.CalendarTime ST.ClockTime where 45 | safeConvert = return . ST.toClockTime 46 | 47 | instance Convertible ST.ClockTime Integer where 48 | safeConvert (ST.TOD x _) = return x 49 | 50 | instance Convertible Integer ST.ClockTime where 51 | safeConvert x = return $ ST.TOD x 0 52 | 53 | ---------------------------------------------------------------------- 54 | -- Intra-Data.Time stuff 55 | ---------------------------------------------------------------------- 56 | 57 | ------------------------------ POSIX and UTC times 58 | {- Covered under Real a 59 | instance Convertible Rational POSIXTime where 60 | safeConvert = return . fromRational 61 | -} 62 | 63 | instance Convertible Rational POSIXTime where 64 | safeConvert = return . fromRational 65 | instance Convertible Integer POSIXTime where 66 | safeConvert = return . fromInteger 67 | instance Convertible Int POSIXTime where 68 | safeConvert = return . fromIntegral 69 | instance Convertible Double POSIXTime where 70 | safeConvert = return . realToFrac 71 | 72 | instance Convertible POSIXTime Integer where 73 | safeConvert = return . truncate 74 | instance Convertible POSIXTime Rational where 75 | safeConvert = return . toRational 76 | instance Convertible POSIXTime Double where 77 | safeConvert = return . realToFrac 78 | instance Convertible POSIXTime Int where 79 | safeConvert = boundedConversion (return . truncate) 80 | 81 | instance Convertible POSIXTime UTCTime where 82 | safeConvert = return . posixSecondsToUTCTime 83 | instance Convertible UTCTime POSIXTime where 84 | safeConvert = return . utcTimeToPOSIXSeconds 85 | 86 | instance Convertible Rational UTCTime where 87 | safeConvert a = posixSecondsToUTCTime <$> safeConvert a 88 | instance Convertible Integer UTCTime where 89 | safeConvert a = posixSecondsToUTCTime <$> safeConvert a 90 | instance Convertible Int UTCTime where 91 | safeConvert a = posixSecondsToUTCTime <$> safeConvert a 92 | instance Convertible Double UTCTime where 93 | safeConvert a = posixSecondsToUTCTime <$> safeConvert a 94 | 95 | instance Convertible UTCTime Rational where 96 | safeConvert = safeConvert . utcTimeToPOSIXSeconds 97 | instance Convertible UTCTime Integer where 98 | safeConvert = safeConvert . utcTimeToPOSIXSeconds 99 | instance Convertible UTCTime Double where 100 | safeConvert = safeConvert . utcTimeToPOSIXSeconds 101 | instance Convertible UTCTime Int where 102 | safeConvert = boundedConversion (safeConvert . utcTimeToPOSIXSeconds) 103 | 104 | ------------------------------ LocalTime stuff 105 | 106 | instance Convertible UTCTime ZonedTime where 107 | safeConvert = return . utcToZonedTime utc 108 | instance Convertible POSIXTime ZonedTime where 109 | safeConvert = return . utcToZonedTime utc . posixSecondsToUTCTime 110 | instance Convertible ZonedTime UTCTime where 111 | safeConvert = return . zonedTimeToUTC 112 | instance Convertible ZonedTime POSIXTime where 113 | safeConvert = return . utcTimeToPOSIXSeconds . zonedTimeToUTC 114 | 115 | {- Too obvious? 116 | instance Convertible LocalTime Day where 117 | safeConvert = return . localDay 118 | instance Convertible LocalTime TimeOfDay where 119 | safeConvert = return . localTimeOfDay 120 | -} 121 | 122 | ---------------------------------------------------------------------- 123 | -- Conversions between old and new time 124 | ---------------------------------------------------------------------- 125 | instance Convertible ST.CalendarTime ZonedTime where 126 | safeConvert ct = return $ ZonedTime { 127 | zonedTimeToLocalTime = LocalTime { 128 | localDay = fromGregorian (fromIntegral $ ST.ctYear ct) 129 | (1 + fromEnum (ST.ctMonth ct)) 130 | (ST.ctDay ct), 131 | localTimeOfDay = TimeOfDay { 132 | todHour = ST.ctHour ct, 133 | todMin = ST.ctMin ct, 134 | todSec = fromIntegral (ST.ctSec ct) + 135 | fromRational (ST.ctPicosec ct % 1000000000000) 136 | } 137 | }, 138 | zonedTimeZone = TimeZone { 139 | timeZoneMinutes = ST.ctTZ ct `div` 60, 140 | timeZoneSummerOnly = ST.ctIsDST ct, 141 | timeZoneName = ST.ctTZName ct} 142 | } 143 | 144 | instance Convertible ST.CalendarTime POSIXTime where 145 | safeConvert = convertVia (undefined::ST.ClockTime) 146 | instance Convertible ST.CalendarTime UTCTime where 147 | safeConvert = convertVia (undefined::POSIXTime) 148 | 149 | instance Convertible ST.ClockTime POSIXTime where 150 | safeConvert (ST.TOD x y) = return $ fromRational $ 151 | fromInteger x + fromRational (y % 1000000000000) 152 | instance Convertible ST.ClockTime UTCTime where 153 | safeConvert = convertVia (undefined::POSIXTime) 154 | instance Convertible ST.ClockTime ZonedTime where 155 | safeConvert = convertVia (undefined::UTCTime) 156 | instance Convertible ZonedTime ST.ClockTime where 157 | safeConvert = convertVia (undefined::POSIXTime) 158 | 159 | instance Convertible POSIXTime ST.ClockTime where 160 | safeConvert x = return $ ST.TOD rsecs rpico 161 | where rsecs = floor x 162 | rpico = truncate $ abs $ 1000000000000 * (x - fromIntegral rsecs) 163 | instance Convertible UTCTime ST.ClockTime where 164 | safeConvert = safeConvert . utcTimeToPOSIXSeconds 165 | 166 | instance Convertible ZonedTime ST.CalendarTime where 167 | safeConvert zt = return $ ST.CalendarTime { 168 | ST.ctYear = fromIntegral year, 169 | ST.ctMonth = toEnum (month - 1), 170 | ST.ctDay = day, 171 | ST.ctHour = todHour ltod, 172 | ST.ctMin = todMin ltod, 173 | ST.ctSec = secs, 174 | ST.ctPicosec = pico, 175 | ST.ctWDay = toEnum . snd . sundayStartWeek . localDay . zonedTimeToLocalTime $ zt, 176 | ST.ctYDay = (snd . toOrdinalDate . localDay . zonedTimeToLocalTime $ zt) - 1, 177 | ST.ctTZName = timeZoneName . zonedTimeZone $ zt, 178 | ST.ctTZ = (timeZoneMinutes . zonedTimeZone $ zt) * 60, 179 | ST.ctIsDST = timeZoneSummerOnly . zonedTimeZone $ zt 180 | } 181 | where (year, month, day) = toGregorian . localDay . zonedTimeToLocalTime $ zt 182 | ltod = localTimeOfDay . zonedTimeToLocalTime $ zt 183 | secs = (truncate . todSec $ ltod)::Int 184 | picoRational = toRational (todSec ltod) - toRational secs 185 | pico = truncate (picoRational * 1000000000000) 186 | instance Convertible POSIXTime ST.CalendarTime where 187 | safeConvert = convertVia (undefined::ZonedTime) 188 | instance Convertible UTCTime ST.CalendarTime where 189 | safeConvert = safeConvert . utcTimeToPOSIXSeconds 190 | 191 | instance Convertible ST.TimeDiff NominalDiffTime where 192 | {- This is a clever hack. We convert the TimeDiff to a ClockTime, applying 193 | it as a diff vs. the epoch. Converting this ClockTime to a POSIXTime yiels 194 | the NominalDiffTime we want, since a POSIXTime is a NominalDiffTime vs. the 195 | epoch. -} 196 | safeConvert td = safeConvert clockTime 197 | where clockTime = ST.addToClockTime td (ST.TOD 0 0) 198 | instance Convertible NominalDiffTime ST.TimeDiff where 199 | {- Similar clever hack as above. -} 200 | safeConvert ndt = 201 | do clockt <- safeConvert ndt 202 | return (ST.diffClockTimes clockt (ST.TOD 0 0)) 203 | 204 | instance Convertible Integer ST.TimeDiff where 205 | safeConvert = convertVia (undefined::NominalDiffTime) 206 | instance Convertible Double ST.TimeDiff where 207 | safeConvert = convertVia (undefined::NominalDiffTime) 208 | instance Convertible ST.TimeDiff Integer where 209 | safeConvert = convertVia (undefined :: NominalDiffTime) 210 | instance Convertible ST.TimeDiff Rational where 211 | safeConvert = convertVia (undefined :: NominalDiffTime) 212 | instance Convertible ST.TimeDiff Double where 213 | safeConvert = convertVia (undefined :: NominalDiffTime) 214 | 215 | ---------------------------------------------------------------------- 216 | -- Foreign.C Types 217 | ---------------------------------------------------------------------- 218 | 219 | instance Convertible CTime POSIXTime where 220 | safeConvert = return . realToFrac 221 | instance Convertible POSIXTime CTime where 222 | safeConvert = return . fromInteger . truncate 223 | 224 | instance Convertible CTime Integer where 225 | safeConvert = return . truncate . toRational 226 | instance Convertible Integer CTime where 227 | safeConvert = return . fromInteger 228 | 229 | instance Convertible CTime Double where 230 | safeConvert = return . realToFrac 231 | instance Convertible Double CTime where 232 | safeConvert = return . fromInteger . truncate 233 | 234 | instance Convertible CTime Int where 235 | safeConvert x = do r1 <- safeConvert x 236 | boundedConversion (return . fromInteger) r1 237 | instance Convertible Int CTime where 238 | safeConvert = safeConvert . toInteger 239 | 240 | instance Convertible CTime UTCTime where 241 | safeConvert = convertVia (undefined :: POSIXTime) 242 | instance Convertible UTCTime CTime where 243 | safeConvert = convertVia (undefined :: POSIXTime) 244 | 245 | instance Convertible CTime ST.ClockTime where 246 | safeConvert = convertVia (undefined :: POSIXTime) 247 | instance Convertible ST.ClockTime CTime where 248 | safeConvert = convertVia (undefined :: POSIXTime) 249 | 250 | instance Convertible CTime ST.CalendarTime where 251 | safeConvert = convertVia (undefined::POSIXTime) 252 | instance Convertible ST.CalendarTime CTime where 253 | safeConvert = convertVia (undefined::POSIXTime) 254 | 255 | instance Convertible CTime ZonedTime where 256 | safeConvert = convertVia (undefined::POSIXTime) 257 | instance Convertible ZonedTime CTime where 258 | safeConvert = convertVia (undefined::POSIXTime) 259 | -------------------------------------------------------------------------------- /Data/Convertible/Instances/Num.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Data.Convertible.Instances.Num 3 | Copyright : Copyright (C) 2009-2011 John Goerzen 4 | License : BSD3 5 | 6 | Maintainer : John Goerzen 7 | Stability : provisional 8 | Portability: portable 9 | 10 | Numeric instances for Convertible. 11 | 12 | Copyright (C) 2009-2011 John Goerzen 13 | 14 | All rights reserved. 15 | 16 | For license and copyright information, see the file LICENSE 17 | 18 | These instances perform conversion between numeric types such as Double, Int, Integer, 19 | Rational, and the like. Here are some notes about the conversion process: 20 | 21 | Conversions from floating-point types such as Double to integral types are done via the 22 | 'truncate' function. This is a somewhat arbitrary decision; if you need different 23 | behavior, you will have to write your own instance or manually perform the conversion. 24 | 25 | All conversions perform bounds checking. If a value is too large for its destination 26 | type, you will get a 'ConvertError' informing you of this. Note that this behavior 27 | differs from functions in the Haskell standard libraries, which will perform the 28 | conversion without error, but give you garbage in the end. 29 | 30 | Conversions do not perform precision checking; loss of precision is implied with certain 31 | conversions (for instance, Double to Float) and this is not an error. 32 | -} 33 | 34 | module Data.Convertible.Instances.Num() 35 | where 36 | 37 | import Data.Convertible.Base 38 | import Data.Convertible.Utils 39 | import Data.Int 40 | import Data.Word 41 | 42 | ------------------------------------------------------------ 43 | 44 | {- The following instances generated by this code: 45 | 46 | fp = ["Double", "Float", "Rational"] 47 | int = ["Int", "Int8", "Int16", "Int32", "Int64", "Word", "Word8", "Word16", "Word32", 48 | "Word64"] 49 | allItems l1 l2 = concatMap (\x -> map (\y -> (x, y)) int) fp 50 | work = allItems fp int 51 | printIt (f, i) = 52 | "instance Convertible " ++ f ++ " " ++ i ++ " where \n\ 53 | \ safeConvert = boundedConversion (return . truncate)\n\ 54 | \instance Convertible " ++ i ++ " " ++ f ++ " where \n\ 55 | \ safeConvert = return . fromIntegral\n" 56 | 57 | main = mapM_ (putStrLn . printIt) work 58 | -} 59 | 60 | instance Convertible Double Int where 61 | safeConvert = boundedConversion (return . truncate) 62 | instance Convertible Int Double where 63 | safeConvert = return . fromIntegral 64 | 65 | instance Convertible Double Int8 where 66 | safeConvert = boundedConversion (return . truncate) 67 | instance Convertible Int8 Double where 68 | safeConvert = return . fromIntegral 69 | 70 | instance Convertible Double Int16 where 71 | safeConvert = boundedConversion (return . truncate) 72 | instance Convertible Int16 Double where 73 | safeConvert = return . fromIntegral 74 | 75 | instance Convertible Double Int32 where 76 | safeConvert = boundedConversion (return . truncate) 77 | instance Convertible Int32 Double where 78 | safeConvert = return . fromIntegral 79 | 80 | instance Convertible Double Int64 where 81 | safeConvert = boundedConversion (return . truncate) 82 | instance Convertible Int64 Double where 83 | safeConvert = return . fromIntegral 84 | 85 | instance Convertible Double Word where 86 | safeConvert = boundedConversion (return . truncate) 87 | instance Convertible Word Double where 88 | safeConvert = return . fromIntegral 89 | 90 | instance Convertible Double Word8 where 91 | safeConvert = boundedConversion (return . truncate) 92 | instance Convertible Word8 Double where 93 | safeConvert = return . fromIntegral 94 | 95 | instance Convertible Double Word16 where 96 | safeConvert = boundedConversion (return . truncate) 97 | instance Convertible Word16 Double where 98 | safeConvert = return . fromIntegral 99 | 100 | instance Convertible Double Word32 where 101 | safeConvert = boundedConversion (return . truncate) 102 | instance Convertible Word32 Double where 103 | safeConvert = return . fromIntegral 104 | 105 | instance Convertible Double Word64 where 106 | safeConvert = boundedConversion (return . truncate) 107 | instance Convertible Word64 Double where 108 | safeConvert = return . fromIntegral 109 | 110 | instance Convertible Float Int where 111 | safeConvert = boundedConversion (return . truncate) 112 | instance Convertible Int Float where 113 | safeConvert = return . fromIntegral 114 | 115 | instance Convertible Float Int8 where 116 | safeConvert = boundedConversion (return . truncate) 117 | instance Convertible Int8 Float where 118 | safeConvert = return . fromIntegral 119 | 120 | instance Convertible Float Int16 where 121 | safeConvert = boundedConversion (return . truncate) 122 | instance Convertible Int16 Float where 123 | safeConvert = return . fromIntegral 124 | 125 | instance Convertible Float Int32 where 126 | safeConvert = boundedConversion (return . truncate) 127 | instance Convertible Int32 Float where 128 | safeConvert = return . fromIntegral 129 | 130 | instance Convertible Float Int64 where 131 | safeConvert = boundedConversion (return . truncate) 132 | instance Convertible Int64 Float where 133 | safeConvert = return . fromIntegral 134 | 135 | instance Convertible Float Word where 136 | safeConvert = boundedConversion (return . truncate) 137 | instance Convertible Word Float where 138 | safeConvert = return . fromIntegral 139 | 140 | instance Convertible Float Word8 where 141 | safeConvert = boundedConversion (return . truncate) 142 | instance Convertible Word8 Float where 143 | safeConvert = return . fromIntegral 144 | 145 | instance Convertible Float Word16 where 146 | safeConvert = boundedConversion (return . truncate) 147 | instance Convertible Word16 Float where 148 | safeConvert = return . fromIntegral 149 | 150 | instance Convertible Float Word32 where 151 | safeConvert = boundedConversion (return . truncate) 152 | instance Convertible Word32 Float where 153 | safeConvert = return . fromIntegral 154 | 155 | instance Convertible Float Word64 where 156 | safeConvert = boundedConversion (return . truncate) 157 | instance Convertible Word64 Float where 158 | safeConvert = return . fromIntegral 159 | 160 | instance Convertible Rational Int where 161 | safeConvert = boundedConversion (return . truncate) 162 | instance Convertible Int Rational where 163 | safeConvert = return . fromIntegral 164 | 165 | instance Convertible Rational Int8 where 166 | safeConvert = boundedConversion (return . truncate) 167 | instance Convertible Int8 Rational where 168 | safeConvert = return . fromIntegral 169 | 170 | instance Convertible Rational Int16 where 171 | safeConvert = boundedConversion (return . truncate) 172 | instance Convertible Int16 Rational where 173 | safeConvert = return . fromIntegral 174 | 175 | instance Convertible Rational Int32 where 176 | safeConvert = boundedConversion (return . truncate) 177 | instance Convertible Int32 Rational where 178 | safeConvert = return . fromIntegral 179 | 180 | instance Convertible Rational Int64 where 181 | safeConvert = boundedConversion (return . truncate) 182 | instance Convertible Int64 Rational where 183 | safeConvert = return . fromIntegral 184 | 185 | instance Convertible Rational Word where 186 | safeConvert = boundedConversion (return . truncate) 187 | instance Convertible Word Rational where 188 | safeConvert = return . fromIntegral 189 | 190 | instance Convertible Rational Word8 where 191 | safeConvert = boundedConversion (return . truncate) 192 | instance Convertible Word8 Rational where 193 | safeConvert = return . fromIntegral 194 | 195 | instance Convertible Rational Word16 where 196 | safeConvert = boundedConversion (return . truncate) 197 | instance Convertible Word16 Rational where 198 | safeConvert = return . fromIntegral 199 | 200 | instance Convertible Rational Word32 where 201 | safeConvert = boundedConversion (return . truncate) 202 | instance Convertible Word32 Rational where 203 | safeConvert = return . fromIntegral 204 | 205 | instance Convertible Rational Word64 where 206 | safeConvert = boundedConversion (return . truncate) 207 | instance Convertible Word64 Rational where 208 | safeConvert = return . fromIntegral 209 | 210 | 211 | ------------------------------------------------------------ 212 | {- The following instances generated by this code: 213 | 214 | int = ["Int", "Int8", "Int16", "Int32", "Int64", "Word", "Word8", "Word16", "Word32", 215 | "Word64"] 216 | allItems l1 l2 = concatMap (\x -> map (\y -> (x, y)) l1) l2 217 | work = filter (\(a, b) -> a /= b) (allItems int int) 218 | printIt (f, i) = 219 | "instance Convertible " ++ f ++ " " ++ i ++ " where \n\ 220 | \ safeConvert = boundedConversion (return . fromIntegral)\n" 221 | 222 | printInteger i = 223 | "instance Convertible Integer " ++ i ++ " where \n\ 224 | \ safeConvert = boundedConversion (return . fromIntegral)\n\ 225 | \instance Convertible " ++ i ++ " Integer where \n\ 226 | \ safeConvert = return . fromIntegral\n\n" 227 | 228 | main = do mapM_ (putStrLn . printIt) work 229 | mapM_ (putStrLn . printInteger) int 230 | -} 231 | 232 | instance Convertible Int Int8 where 233 | safeConvert = boundedConversion (return . fromIntegral) 234 | 235 | instance Convertible Int Int16 where 236 | safeConvert = boundedConversion (return . fromIntegral) 237 | 238 | instance Convertible Int Int32 where 239 | safeConvert = boundedConversion (return . fromIntegral) 240 | 241 | instance Convertible Int Int64 where 242 | safeConvert = boundedConversion (return . fromIntegral) 243 | 244 | instance Convertible Int Word where 245 | safeConvert = boundedConversion (return . fromIntegral) 246 | 247 | instance Convertible Int Word8 where 248 | safeConvert = boundedConversion (return . fromIntegral) 249 | 250 | instance Convertible Int Word16 where 251 | safeConvert = boundedConversion (return . fromIntegral) 252 | 253 | instance Convertible Int Word32 where 254 | safeConvert = boundedConversion (return . fromIntegral) 255 | 256 | instance Convertible Int Word64 where 257 | safeConvert = boundedConversion (return . fromIntegral) 258 | 259 | instance Convertible Int8 Int where 260 | safeConvert = boundedConversion (return . fromIntegral) 261 | 262 | instance Convertible Int8 Int16 where 263 | safeConvert = boundedConversion (return . fromIntegral) 264 | 265 | instance Convertible Int8 Int32 where 266 | safeConvert = boundedConversion (return . fromIntegral) 267 | 268 | instance Convertible Int8 Int64 where 269 | safeConvert = boundedConversion (return . fromIntegral) 270 | 271 | instance Convertible Int8 Word where 272 | safeConvert = boundedConversion (return . fromIntegral) 273 | 274 | instance Convertible Int8 Word8 where 275 | safeConvert = boundedConversion (return . fromIntegral) 276 | 277 | instance Convertible Int8 Word16 where 278 | safeConvert = boundedConversion (return . fromIntegral) 279 | 280 | instance Convertible Int8 Word32 where 281 | safeConvert = boundedConversion (return . fromIntegral) 282 | 283 | instance Convertible Int8 Word64 where 284 | safeConvert = boundedConversion (return . fromIntegral) 285 | 286 | instance Convertible Int16 Int where 287 | safeConvert = boundedConversion (return . fromIntegral) 288 | 289 | instance Convertible Int16 Int8 where 290 | safeConvert = boundedConversion (return . fromIntegral) 291 | 292 | instance Convertible Int16 Int32 where 293 | safeConvert = boundedConversion (return . fromIntegral) 294 | 295 | instance Convertible Int16 Int64 where 296 | safeConvert = boundedConversion (return . fromIntegral) 297 | 298 | instance Convertible Int16 Word where 299 | safeConvert = boundedConversion (return . fromIntegral) 300 | 301 | instance Convertible Int16 Word8 where 302 | safeConvert = boundedConversion (return . fromIntegral) 303 | 304 | instance Convertible Int16 Word16 where 305 | safeConvert = boundedConversion (return . fromIntegral) 306 | 307 | instance Convertible Int16 Word32 where 308 | safeConvert = boundedConversion (return . fromIntegral) 309 | 310 | instance Convertible Int16 Word64 where 311 | safeConvert = boundedConversion (return . fromIntegral) 312 | 313 | instance Convertible Int32 Int where 314 | safeConvert = boundedConversion (return . fromIntegral) 315 | 316 | instance Convertible Int32 Int8 where 317 | safeConvert = boundedConversion (return . fromIntegral) 318 | 319 | instance Convertible Int32 Int16 where 320 | safeConvert = boundedConversion (return . fromIntegral) 321 | 322 | instance Convertible Int32 Int64 where 323 | safeConvert = boundedConversion (return . fromIntegral) 324 | 325 | instance Convertible Int32 Word where 326 | safeConvert = boundedConversion (return . fromIntegral) 327 | 328 | instance Convertible Int32 Word8 where 329 | safeConvert = boundedConversion (return . fromIntegral) 330 | 331 | instance Convertible Int32 Word16 where 332 | safeConvert = boundedConversion (return . fromIntegral) 333 | 334 | instance Convertible Int32 Word32 where 335 | safeConvert = boundedConversion (return . fromIntegral) 336 | 337 | instance Convertible Int32 Word64 where 338 | safeConvert = boundedConversion (return . fromIntegral) 339 | 340 | instance Convertible Int64 Int where 341 | safeConvert = boundedConversion (return . fromIntegral) 342 | 343 | instance Convertible Int64 Int8 where 344 | safeConvert = boundedConversion (return . fromIntegral) 345 | 346 | instance Convertible Int64 Int16 where 347 | safeConvert = boundedConversion (return . fromIntegral) 348 | 349 | instance Convertible Int64 Int32 where 350 | safeConvert = boundedConversion (return . fromIntegral) 351 | 352 | instance Convertible Int64 Word where 353 | safeConvert = boundedConversion (return . fromIntegral) 354 | 355 | instance Convertible Int64 Word8 where 356 | safeConvert = boundedConversion (return . fromIntegral) 357 | 358 | instance Convertible Int64 Word16 where 359 | safeConvert = boundedConversion (return . fromIntegral) 360 | 361 | instance Convertible Int64 Word32 where 362 | safeConvert = boundedConversion (return . fromIntegral) 363 | 364 | instance Convertible Int64 Word64 where 365 | safeConvert = boundedConversion (return . fromIntegral) 366 | 367 | instance Convertible Word Int where 368 | safeConvert = boundedConversion (return . fromIntegral) 369 | 370 | instance Convertible Word Int8 where 371 | safeConvert = boundedConversion (return . fromIntegral) 372 | 373 | instance Convertible Word Int16 where 374 | safeConvert = boundedConversion (return . fromIntegral) 375 | 376 | instance Convertible Word Int32 where 377 | safeConvert = boundedConversion (return . fromIntegral) 378 | 379 | instance Convertible Word Int64 where 380 | safeConvert = boundedConversion (return . fromIntegral) 381 | 382 | instance Convertible Word Word8 where 383 | safeConvert = boundedConversion (return . fromIntegral) 384 | 385 | instance Convertible Word Word16 where 386 | safeConvert = boundedConversion (return . fromIntegral) 387 | 388 | instance Convertible Word Word32 where 389 | safeConvert = boundedConversion (return . fromIntegral) 390 | 391 | instance Convertible Word Word64 where 392 | safeConvert = boundedConversion (return . fromIntegral) 393 | 394 | instance Convertible Word8 Int where 395 | safeConvert = boundedConversion (return . fromIntegral) 396 | 397 | instance Convertible Word8 Int8 where 398 | safeConvert = boundedConversion (return . fromIntegral) 399 | 400 | instance Convertible Word8 Int16 where 401 | safeConvert = boundedConversion (return . fromIntegral) 402 | 403 | instance Convertible Word8 Int32 where 404 | safeConvert = boundedConversion (return . fromIntegral) 405 | 406 | instance Convertible Word8 Int64 where 407 | safeConvert = boundedConversion (return . fromIntegral) 408 | 409 | instance Convertible Word8 Word where 410 | safeConvert = boundedConversion (return . fromIntegral) 411 | 412 | instance Convertible Word8 Word16 where 413 | safeConvert = boundedConversion (return . fromIntegral) 414 | 415 | instance Convertible Word8 Word32 where 416 | safeConvert = boundedConversion (return . fromIntegral) 417 | 418 | instance Convertible Word8 Word64 where 419 | safeConvert = boundedConversion (return . fromIntegral) 420 | 421 | instance Convertible Word16 Int where 422 | safeConvert = boundedConversion (return . fromIntegral) 423 | 424 | instance Convertible Word16 Int8 where 425 | safeConvert = boundedConversion (return . fromIntegral) 426 | 427 | instance Convertible Word16 Int16 where 428 | safeConvert = boundedConversion (return . fromIntegral) 429 | 430 | instance Convertible Word16 Int32 where 431 | safeConvert = boundedConversion (return . fromIntegral) 432 | 433 | instance Convertible Word16 Int64 where 434 | safeConvert = boundedConversion (return . fromIntegral) 435 | 436 | instance Convertible Word16 Word where 437 | safeConvert = boundedConversion (return . fromIntegral) 438 | 439 | instance Convertible Word16 Word8 where 440 | safeConvert = boundedConversion (return . fromIntegral) 441 | 442 | instance Convertible Word16 Word32 where 443 | safeConvert = boundedConversion (return . fromIntegral) 444 | 445 | instance Convertible Word16 Word64 where 446 | safeConvert = boundedConversion (return . fromIntegral) 447 | 448 | instance Convertible Word32 Int where 449 | safeConvert = boundedConversion (return . fromIntegral) 450 | 451 | instance Convertible Word32 Int8 where 452 | safeConvert = boundedConversion (return . fromIntegral) 453 | 454 | instance Convertible Word32 Int16 where 455 | safeConvert = boundedConversion (return . fromIntegral) 456 | 457 | instance Convertible Word32 Int32 where 458 | safeConvert = boundedConversion (return . fromIntegral) 459 | 460 | instance Convertible Word32 Int64 where 461 | safeConvert = boundedConversion (return . fromIntegral) 462 | 463 | instance Convertible Word32 Word where 464 | safeConvert = boundedConversion (return . fromIntegral) 465 | 466 | instance Convertible Word32 Word8 where 467 | safeConvert = boundedConversion (return . fromIntegral) 468 | 469 | instance Convertible Word32 Word16 where 470 | safeConvert = boundedConversion (return . fromIntegral) 471 | 472 | instance Convertible Word32 Word64 where 473 | safeConvert = boundedConversion (return . fromIntegral) 474 | 475 | instance Convertible Word64 Int where 476 | safeConvert = boundedConversion (return . fromIntegral) 477 | 478 | instance Convertible Word64 Int8 where 479 | safeConvert = boundedConversion (return . fromIntegral) 480 | 481 | instance Convertible Word64 Int16 where 482 | safeConvert = boundedConversion (return . fromIntegral) 483 | 484 | instance Convertible Word64 Int32 where 485 | safeConvert = boundedConversion (return . fromIntegral) 486 | 487 | instance Convertible Word64 Int64 where 488 | safeConvert = boundedConversion (return . fromIntegral) 489 | 490 | instance Convertible Word64 Word where 491 | safeConvert = boundedConversion (return . fromIntegral) 492 | 493 | instance Convertible Word64 Word8 where 494 | safeConvert = boundedConversion (return . fromIntegral) 495 | 496 | instance Convertible Word64 Word16 where 497 | safeConvert = boundedConversion (return . fromIntegral) 498 | 499 | instance Convertible Word64 Word32 where 500 | safeConvert = boundedConversion (return . fromIntegral) 501 | 502 | instance Convertible Integer Int where 503 | safeConvert = boundedConversion (return . fromIntegral) 504 | instance Convertible Int Integer where 505 | safeConvert = return . fromIntegral 506 | 507 | 508 | instance Convertible Integer Int8 where 509 | safeConvert = boundedConversion (return . fromIntegral) 510 | instance Convertible Int8 Integer where 511 | safeConvert = return . fromIntegral 512 | 513 | 514 | instance Convertible Integer Int16 where 515 | safeConvert = boundedConversion (return . fromIntegral) 516 | instance Convertible Int16 Integer where 517 | safeConvert = return . fromIntegral 518 | 519 | 520 | instance Convertible Integer Int32 where 521 | safeConvert = boundedConversion (return . fromIntegral) 522 | instance Convertible Int32 Integer where 523 | safeConvert = return . fromIntegral 524 | 525 | 526 | instance Convertible Integer Int64 where 527 | safeConvert = boundedConversion (return . fromIntegral) 528 | instance Convertible Int64 Integer where 529 | safeConvert = return . fromIntegral 530 | 531 | 532 | instance Convertible Integer Word where 533 | safeConvert = boundedConversion (return . fromIntegral) 534 | instance Convertible Word Integer where 535 | safeConvert = return . fromIntegral 536 | 537 | 538 | instance Convertible Integer Word8 where 539 | safeConvert = boundedConversion (return . fromIntegral) 540 | instance Convertible Word8 Integer where 541 | safeConvert = return . fromIntegral 542 | 543 | 544 | instance Convertible Integer Word16 where 545 | safeConvert = boundedConversion (return . fromIntegral) 546 | instance Convertible Word16 Integer where 547 | safeConvert = return . fromIntegral 548 | 549 | 550 | instance Convertible Integer Word32 where 551 | safeConvert = boundedConversion (return . fromIntegral) 552 | instance Convertible Word32 Integer where 553 | safeConvert = return . fromIntegral 554 | 555 | 556 | instance Convertible Integer Word64 where 557 | safeConvert = boundedConversion (return . fromIntegral) 558 | instance Convertible Word64 Integer where 559 | safeConvert = return . fromIntegral 560 | 561 | 562 | ------------------------------------------------------------ 563 | 564 | instance Convertible Integer Double where 565 | safeConvert = return . fromIntegral 566 | instance Convertible Integer Float where 567 | safeConvert = return . fromIntegral 568 | instance Convertible Integer Rational where 569 | safeConvert = return . fromIntegral 570 | instance Convertible Double Integer where 571 | safeConvert = return . truncate 572 | instance Convertible Float Integer where 573 | safeConvert = return . truncate 574 | instance Convertible Rational Integer where 575 | safeConvert = return . truncate 576 | 577 | instance Convertible Float Double where 578 | safeConvert = return . realToFrac 579 | instance Convertible Double Float where 580 | safeConvert = return . realToFrac 581 | instance Convertible Float Rational where 582 | safeConvert = return . toRational 583 | instance Convertible Rational Float where 584 | safeConvert = return . fromRational 585 | instance Convertible Double Rational where 586 | safeConvert = return . toRational 587 | instance Convertible Rational Double where 588 | safeConvert = return . fromRational 589 | 590 | ------------------------------------------------------------ 591 | instance Convertible Char Integer where 592 | safeConvert = return . fromIntegral . fromEnum 593 | instance Convertible Integer Char where 594 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 595 | 596 | ------------------------------------------------------------ 597 | {- These instances generated by: 598 | 599 | int = ["Int", "Int8", "Int16", "Int32", "Int64", "Word", "Word8", "Word16", "Word32", 600 | "Word64"] 601 | printIt i = 602 | "instance Convertible Char " ++ i ++ " where \n\ 603 | \ safeConvert = boundedConversion (return . fromIntegral . fromEnum)\n\ 604 | \instance Convertible " ++ i ++ " Char where \n\ 605 | \ safeConvert = boundedConversion (return . toEnum . fromIntegral)\n\n" 606 | 607 | main = do mapM_ (putStrLn . printIt) int 608 | -} 609 | 610 | instance Convertible Char Int where 611 | safeConvert = boundedConversion (return . fromEnum) 612 | instance Convertible Int Char where 613 | safeConvert = boundedConversion (return . toEnum) 614 | 615 | 616 | instance Convertible Char Int8 where 617 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 618 | instance Convertible Int8 Char where 619 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 620 | 621 | 622 | instance Convertible Char Int16 where 623 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 624 | instance Convertible Int16 Char where 625 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 626 | 627 | 628 | instance Convertible Char Int32 where 629 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 630 | instance Convertible Int32 Char where 631 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 632 | 633 | 634 | instance Convertible Char Int64 where 635 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 636 | instance Convertible Int64 Char where 637 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 638 | 639 | 640 | instance Convertible Char Word where 641 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 642 | instance Convertible Word Char where 643 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 644 | 645 | 646 | instance Convertible Char Word8 where 647 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 648 | instance Convertible Word8 Char where 649 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 650 | 651 | 652 | instance Convertible Char Word16 where 653 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 654 | instance Convertible Word16 Char where 655 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 656 | 657 | 658 | instance Convertible Char Word32 where 659 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 660 | instance Convertible Word32 Char where 661 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 662 | 663 | 664 | instance Convertible Char Word64 where 665 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 666 | instance Convertible Word64 Char where 667 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 668 | 669 | 670 | instance Convertible Integer Integer where 671 | safeConvert = return 672 | -------------------------------------------------------------------------------- /Data/Convertible/Instances/C.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Data.Convertible.Instances.C 3 | Copyright : Copyright (C) 2009-2011 John Goerzen 4 | License : BSD3 5 | 6 | Maintainer : John Goerzen 7 | Stability : provisional 8 | Portability: portable 9 | 10 | Numeric instances for Convertible for C types. See comments in 11 | "Data.Convertible.Instances.Num". 12 | 13 | Copyright (C) 2009-2011 John Goerzen 14 | 15 | All rights reserved. 16 | 17 | For license and copyright information, see the file LICENSE 18 | -} 19 | module Data.Convertible.Instances.C() 20 | where 21 | 22 | import Data.Convertible.Base 23 | import Data.Convertible.Utils 24 | import Data.Convertible.Instances.Num() 25 | import Data.Int 26 | import Data.Word 27 | import Foreign.C.Types 28 | 29 | -- remainder of this file generated by utils/genCinstances.hs 30 | 31 | -- Section 1 32 | instance Convertible CFloat Int where 33 | safeConvert = boundedConversion (return . truncate) 34 | instance Convertible Int CFloat where 35 | safeConvert = return . fromIntegral 36 | 37 | instance Convertible CFloat Int8 where 38 | safeConvert = boundedConversion (return . truncate) 39 | instance Convertible Int8 CFloat where 40 | safeConvert = return . fromIntegral 41 | 42 | instance Convertible CFloat Int16 where 43 | safeConvert = boundedConversion (return . truncate) 44 | instance Convertible Int16 CFloat where 45 | safeConvert = return . fromIntegral 46 | 47 | instance Convertible CFloat Int32 where 48 | safeConvert = boundedConversion (return . truncate) 49 | instance Convertible Int32 CFloat where 50 | safeConvert = return . fromIntegral 51 | 52 | instance Convertible CFloat Int64 where 53 | safeConvert = boundedConversion (return . truncate) 54 | instance Convertible Int64 CFloat where 55 | safeConvert = return . fromIntegral 56 | 57 | instance Convertible CFloat Word where 58 | safeConvert = boundedConversion (return . truncate) 59 | instance Convertible Word CFloat where 60 | safeConvert = return . fromIntegral 61 | 62 | instance Convertible CFloat Word8 where 63 | safeConvert = boundedConversion (return . truncate) 64 | instance Convertible Word8 CFloat where 65 | safeConvert = return . fromIntegral 66 | 67 | instance Convertible CFloat Word16 where 68 | safeConvert = boundedConversion (return . truncate) 69 | instance Convertible Word16 CFloat where 70 | safeConvert = return . fromIntegral 71 | 72 | instance Convertible CFloat Word32 where 73 | safeConvert = boundedConversion (return . truncate) 74 | instance Convertible Word32 CFloat where 75 | safeConvert = return . fromIntegral 76 | 77 | instance Convertible CFloat Word64 where 78 | safeConvert = boundedConversion (return . truncate) 79 | instance Convertible Word64 CFloat where 80 | safeConvert = return . fromIntegral 81 | 82 | instance Convertible CDouble Int where 83 | safeConvert = boundedConversion (return . truncate) 84 | instance Convertible Int CDouble where 85 | safeConvert = return . fromIntegral 86 | 87 | instance Convertible CDouble Int8 where 88 | safeConvert = boundedConversion (return . truncate) 89 | instance Convertible Int8 CDouble where 90 | safeConvert = return . fromIntegral 91 | 92 | instance Convertible CDouble Int16 where 93 | safeConvert = boundedConversion (return . truncate) 94 | instance Convertible Int16 CDouble where 95 | safeConvert = return . fromIntegral 96 | 97 | instance Convertible CDouble Int32 where 98 | safeConvert = boundedConversion (return . truncate) 99 | instance Convertible Int32 CDouble where 100 | safeConvert = return . fromIntegral 101 | 102 | instance Convertible CDouble Int64 where 103 | safeConvert = boundedConversion (return . truncate) 104 | instance Convertible Int64 CDouble where 105 | safeConvert = return . fromIntegral 106 | 107 | instance Convertible CDouble Word where 108 | safeConvert = boundedConversion (return . truncate) 109 | instance Convertible Word CDouble where 110 | safeConvert = return . fromIntegral 111 | 112 | instance Convertible CDouble Word8 where 113 | safeConvert = boundedConversion (return . truncate) 114 | instance Convertible Word8 CDouble where 115 | safeConvert = return . fromIntegral 116 | 117 | instance Convertible CDouble Word16 where 118 | safeConvert = boundedConversion (return . truncate) 119 | instance Convertible Word16 CDouble where 120 | safeConvert = return . fromIntegral 121 | 122 | instance Convertible CDouble Word32 where 123 | safeConvert = boundedConversion (return . truncate) 124 | instance Convertible Word32 CDouble where 125 | safeConvert = return . fromIntegral 126 | 127 | instance Convertible CDouble Word64 where 128 | safeConvert = boundedConversion (return . truncate) 129 | instance Convertible Word64 CDouble where 130 | safeConvert = return . fromIntegral 131 | 132 | -- Section 2 133 | instance Convertible CFloat Double where 134 | safeConvert = return . realToFrac 135 | instance Convertible Double CFloat where 136 | safeConvert = return . realToFrac 137 | 138 | instance Convertible CFloat Float where 139 | safeConvert = return . realToFrac 140 | instance Convertible Float CFloat where 141 | safeConvert = return . realToFrac 142 | 143 | instance Convertible CFloat Rational where 144 | safeConvert = return . realToFrac 145 | instance Convertible Rational CFloat where 146 | safeConvert = return . realToFrac 147 | 148 | instance Convertible CDouble Double where 149 | safeConvert = return . realToFrac 150 | instance Convertible Double CDouble where 151 | safeConvert = return . realToFrac 152 | 153 | instance Convertible CDouble Float where 154 | safeConvert = return . realToFrac 155 | instance Convertible Float CDouble where 156 | safeConvert = return . realToFrac 157 | 158 | instance Convertible CDouble Rational where 159 | safeConvert = return . realToFrac 160 | instance Convertible Rational CDouble where 161 | safeConvert = return . realToFrac 162 | 163 | -- Section 3 164 | instance Convertible CChar Int where 165 | safeConvert = boundedConversion (return . fromIntegral) 166 | instance Convertible Int CChar where 167 | safeConvert = boundedConversion (return . fromIntegral) 168 | 169 | instance Convertible CChar Int8 where 170 | safeConvert = boundedConversion (return . fromIntegral) 171 | instance Convertible Int8 CChar where 172 | safeConvert = boundedConversion (return . fromIntegral) 173 | 174 | instance Convertible CChar Int16 where 175 | safeConvert = boundedConversion (return . fromIntegral) 176 | instance Convertible Int16 CChar where 177 | safeConvert = boundedConversion (return . fromIntegral) 178 | 179 | instance Convertible CChar Int32 where 180 | safeConvert = boundedConversion (return . fromIntegral) 181 | instance Convertible Int32 CChar where 182 | safeConvert = boundedConversion (return . fromIntegral) 183 | 184 | instance Convertible CChar Int64 where 185 | safeConvert = boundedConversion (return . fromIntegral) 186 | instance Convertible Int64 CChar where 187 | safeConvert = boundedConversion (return . fromIntegral) 188 | 189 | instance Convertible CChar Word where 190 | safeConvert = boundedConversion (return . fromIntegral) 191 | instance Convertible Word CChar where 192 | safeConvert = boundedConversion (return . fromIntegral) 193 | 194 | instance Convertible CChar Word8 where 195 | safeConvert = boundedConversion (return . fromIntegral) 196 | instance Convertible Word8 CChar where 197 | safeConvert = boundedConversion (return . fromIntegral) 198 | 199 | instance Convertible CChar Word16 where 200 | safeConvert = boundedConversion (return . fromIntegral) 201 | instance Convertible Word16 CChar where 202 | safeConvert = boundedConversion (return . fromIntegral) 203 | 204 | instance Convertible CChar Word32 where 205 | safeConvert = boundedConversion (return . fromIntegral) 206 | instance Convertible Word32 CChar where 207 | safeConvert = boundedConversion (return . fromIntegral) 208 | 209 | instance Convertible CChar Word64 where 210 | safeConvert = boundedConversion (return . fromIntegral) 211 | instance Convertible Word64 CChar where 212 | safeConvert = boundedConversion (return . fromIntegral) 213 | 214 | instance Convertible CSChar Int where 215 | safeConvert = boundedConversion (return . fromIntegral) 216 | instance Convertible Int CSChar where 217 | safeConvert = boundedConversion (return . fromIntegral) 218 | 219 | instance Convertible CSChar Int8 where 220 | safeConvert = boundedConversion (return . fromIntegral) 221 | instance Convertible Int8 CSChar where 222 | safeConvert = boundedConversion (return . fromIntegral) 223 | 224 | instance Convertible CSChar Int16 where 225 | safeConvert = boundedConversion (return . fromIntegral) 226 | instance Convertible Int16 CSChar where 227 | safeConvert = boundedConversion (return . fromIntegral) 228 | 229 | instance Convertible CSChar Int32 where 230 | safeConvert = boundedConversion (return . fromIntegral) 231 | instance Convertible Int32 CSChar where 232 | safeConvert = boundedConversion (return . fromIntegral) 233 | 234 | instance Convertible CSChar Int64 where 235 | safeConvert = boundedConversion (return . fromIntegral) 236 | instance Convertible Int64 CSChar where 237 | safeConvert = boundedConversion (return . fromIntegral) 238 | 239 | instance Convertible CSChar Word where 240 | safeConvert = boundedConversion (return . fromIntegral) 241 | instance Convertible Word CSChar where 242 | safeConvert = boundedConversion (return . fromIntegral) 243 | 244 | instance Convertible CSChar Word8 where 245 | safeConvert = boundedConversion (return . fromIntegral) 246 | instance Convertible Word8 CSChar where 247 | safeConvert = boundedConversion (return . fromIntegral) 248 | 249 | instance Convertible CSChar Word16 where 250 | safeConvert = boundedConversion (return . fromIntegral) 251 | instance Convertible Word16 CSChar where 252 | safeConvert = boundedConversion (return . fromIntegral) 253 | 254 | instance Convertible CSChar Word32 where 255 | safeConvert = boundedConversion (return . fromIntegral) 256 | instance Convertible Word32 CSChar where 257 | safeConvert = boundedConversion (return . fromIntegral) 258 | 259 | instance Convertible CSChar Word64 where 260 | safeConvert = boundedConversion (return . fromIntegral) 261 | instance Convertible Word64 CSChar where 262 | safeConvert = boundedConversion (return . fromIntegral) 263 | 264 | instance Convertible CUChar Int where 265 | safeConvert = boundedConversion (return . fromIntegral) 266 | instance Convertible Int CUChar where 267 | safeConvert = boundedConversion (return . fromIntegral) 268 | 269 | instance Convertible CUChar Int8 where 270 | safeConvert = boundedConversion (return . fromIntegral) 271 | instance Convertible Int8 CUChar where 272 | safeConvert = boundedConversion (return . fromIntegral) 273 | 274 | instance Convertible CUChar Int16 where 275 | safeConvert = boundedConversion (return . fromIntegral) 276 | instance Convertible Int16 CUChar where 277 | safeConvert = boundedConversion (return . fromIntegral) 278 | 279 | instance Convertible CUChar Int32 where 280 | safeConvert = boundedConversion (return . fromIntegral) 281 | instance Convertible Int32 CUChar where 282 | safeConvert = boundedConversion (return . fromIntegral) 283 | 284 | instance Convertible CUChar Int64 where 285 | safeConvert = boundedConversion (return . fromIntegral) 286 | instance Convertible Int64 CUChar where 287 | safeConvert = boundedConversion (return . fromIntegral) 288 | 289 | instance Convertible CUChar Word where 290 | safeConvert = boundedConversion (return . fromIntegral) 291 | instance Convertible Word CUChar where 292 | safeConvert = boundedConversion (return . fromIntegral) 293 | 294 | instance Convertible CUChar Word8 where 295 | safeConvert = boundedConversion (return . fromIntegral) 296 | instance Convertible Word8 CUChar where 297 | safeConvert = boundedConversion (return . fromIntegral) 298 | 299 | instance Convertible CUChar Word16 where 300 | safeConvert = boundedConversion (return . fromIntegral) 301 | instance Convertible Word16 CUChar where 302 | safeConvert = boundedConversion (return . fromIntegral) 303 | 304 | instance Convertible CUChar Word32 where 305 | safeConvert = boundedConversion (return . fromIntegral) 306 | instance Convertible Word32 CUChar where 307 | safeConvert = boundedConversion (return . fromIntegral) 308 | 309 | instance Convertible CUChar Word64 where 310 | safeConvert = boundedConversion (return . fromIntegral) 311 | instance Convertible Word64 CUChar where 312 | safeConvert = boundedConversion (return . fromIntegral) 313 | 314 | instance Convertible CShort Int where 315 | safeConvert = boundedConversion (return . fromIntegral) 316 | instance Convertible Int CShort where 317 | safeConvert = boundedConversion (return . fromIntegral) 318 | 319 | instance Convertible CShort Int8 where 320 | safeConvert = boundedConversion (return . fromIntegral) 321 | instance Convertible Int8 CShort where 322 | safeConvert = boundedConversion (return . fromIntegral) 323 | 324 | instance Convertible CShort Int16 where 325 | safeConvert = boundedConversion (return . fromIntegral) 326 | instance Convertible Int16 CShort where 327 | safeConvert = boundedConversion (return . fromIntegral) 328 | 329 | instance Convertible CShort Int32 where 330 | safeConvert = boundedConversion (return . fromIntegral) 331 | instance Convertible Int32 CShort where 332 | safeConvert = boundedConversion (return . fromIntegral) 333 | 334 | instance Convertible CShort Int64 where 335 | safeConvert = boundedConversion (return . fromIntegral) 336 | instance Convertible Int64 CShort where 337 | safeConvert = boundedConversion (return . fromIntegral) 338 | 339 | instance Convertible CShort Word where 340 | safeConvert = boundedConversion (return . fromIntegral) 341 | instance Convertible Word CShort where 342 | safeConvert = boundedConversion (return . fromIntegral) 343 | 344 | instance Convertible CShort Word8 where 345 | safeConvert = boundedConversion (return . fromIntegral) 346 | instance Convertible Word8 CShort where 347 | safeConvert = boundedConversion (return . fromIntegral) 348 | 349 | instance Convertible CShort Word16 where 350 | safeConvert = boundedConversion (return . fromIntegral) 351 | instance Convertible Word16 CShort where 352 | safeConvert = boundedConversion (return . fromIntegral) 353 | 354 | instance Convertible CShort Word32 where 355 | safeConvert = boundedConversion (return . fromIntegral) 356 | instance Convertible Word32 CShort where 357 | safeConvert = boundedConversion (return . fromIntegral) 358 | 359 | instance Convertible CShort Word64 where 360 | safeConvert = boundedConversion (return . fromIntegral) 361 | instance Convertible Word64 CShort where 362 | safeConvert = boundedConversion (return . fromIntegral) 363 | 364 | instance Convertible CUShort Int where 365 | safeConvert = boundedConversion (return . fromIntegral) 366 | instance Convertible Int CUShort where 367 | safeConvert = boundedConversion (return . fromIntegral) 368 | 369 | instance Convertible CUShort Int8 where 370 | safeConvert = boundedConversion (return . fromIntegral) 371 | instance Convertible Int8 CUShort where 372 | safeConvert = boundedConversion (return . fromIntegral) 373 | 374 | instance Convertible CUShort Int16 where 375 | safeConvert = boundedConversion (return . fromIntegral) 376 | instance Convertible Int16 CUShort where 377 | safeConvert = boundedConversion (return . fromIntegral) 378 | 379 | instance Convertible CUShort Int32 where 380 | safeConvert = boundedConversion (return . fromIntegral) 381 | instance Convertible Int32 CUShort where 382 | safeConvert = boundedConversion (return . fromIntegral) 383 | 384 | instance Convertible CUShort Int64 where 385 | safeConvert = boundedConversion (return . fromIntegral) 386 | instance Convertible Int64 CUShort where 387 | safeConvert = boundedConversion (return . fromIntegral) 388 | 389 | instance Convertible CUShort Word where 390 | safeConvert = boundedConversion (return . fromIntegral) 391 | instance Convertible Word CUShort where 392 | safeConvert = boundedConversion (return . fromIntegral) 393 | 394 | instance Convertible CUShort Word8 where 395 | safeConvert = boundedConversion (return . fromIntegral) 396 | instance Convertible Word8 CUShort where 397 | safeConvert = boundedConversion (return . fromIntegral) 398 | 399 | instance Convertible CUShort Word16 where 400 | safeConvert = boundedConversion (return . fromIntegral) 401 | instance Convertible Word16 CUShort where 402 | safeConvert = boundedConversion (return . fromIntegral) 403 | 404 | instance Convertible CUShort Word32 where 405 | safeConvert = boundedConversion (return . fromIntegral) 406 | instance Convertible Word32 CUShort where 407 | safeConvert = boundedConversion (return . fromIntegral) 408 | 409 | instance Convertible CUShort Word64 where 410 | safeConvert = boundedConversion (return . fromIntegral) 411 | instance Convertible Word64 CUShort where 412 | safeConvert = boundedConversion (return . fromIntegral) 413 | 414 | instance Convertible CInt Int where 415 | safeConvert = boundedConversion (return . fromIntegral) 416 | instance Convertible Int CInt where 417 | safeConvert = boundedConversion (return . fromIntegral) 418 | 419 | instance Convertible CInt Int8 where 420 | safeConvert = boundedConversion (return . fromIntegral) 421 | instance Convertible Int8 CInt where 422 | safeConvert = boundedConversion (return . fromIntegral) 423 | 424 | instance Convertible CInt Int16 where 425 | safeConvert = boundedConversion (return . fromIntegral) 426 | instance Convertible Int16 CInt where 427 | safeConvert = boundedConversion (return . fromIntegral) 428 | 429 | instance Convertible CInt Int32 where 430 | safeConvert = boundedConversion (return . fromIntegral) 431 | instance Convertible Int32 CInt where 432 | safeConvert = boundedConversion (return . fromIntegral) 433 | 434 | instance Convertible CInt Int64 where 435 | safeConvert = boundedConversion (return . fromIntegral) 436 | instance Convertible Int64 CInt where 437 | safeConvert = boundedConversion (return . fromIntegral) 438 | 439 | instance Convertible CInt Word where 440 | safeConvert = boundedConversion (return . fromIntegral) 441 | instance Convertible Word CInt where 442 | safeConvert = boundedConversion (return . fromIntegral) 443 | 444 | instance Convertible CInt Word8 where 445 | safeConvert = boundedConversion (return . fromIntegral) 446 | instance Convertible Word8 CInt where 447 | safeConvert = boundedConversion (return . fromIntegral) 448 | 449 | instance Convertible CInt Word16 where 450 | safeConvert = boundedConversion (return . fromIntegral) 451 | instance Convertible Word16 CInt where 452 | safeConvert = boundedConversion (return . fromIntegral) 453 | 454 | instance Convertible CInt Word32 where 455 | safeConvert = boundedConversion (return . fromIntegral) 456 | instance Convertible Word32 CInt where 457 | safeConvert = boundedConversion (return . fromIntegral) 458 | 459 | instance Convertible CInt Word64 where 460 | safeConvert = boundedConversion (return . fromIntegral) 461 | instance Convertible Word64 CInt where 462 | safeConvert = boundedConversion (return . fromIntegral) 463 | 464 | instance Convertible CUInt Int where 465 | safeConvert = boundedConversion (return . fromIntegral) 466 | instance Convertible Int CUInt where 467 | safeConvert = boundedConversion (return . fromIntegral) 468 | 469 | instance Convertible CUInt Int8 where 470 | safeConvert = boundedConversion (return . fromIntegral) 471 | instance Convertible Int8 CUInt where 472 | safeConvert = boundedConversion (return . fromIntegral) 473 | 474 | instance Convertible CUInt Int16 where 475 | safeConvert = boundedConversion (return . fromIntegral) 476 | instance Convertible Int16 CUInt where 477 | safeConvert = boundedConversion (return . fromIntegral) 478 | 479 | instance Convertible CUInt Int32 where 480 | safeConvert = boundedConversion (return . fromIntegral) 481 | instance Convertible Int32 CUInt where 482 | safeConvert = boundedConversion (return . fromIntegral) 483 | 484 | instance Convertible CUInt Int64 where 485 | safeConvert = boundedConversion (return . fromIntegral) 486 | instance Convertible Int64 CUInt where 487 | safeConvert = boundedConversion (return . fromIntegral) 488 | 489 | instance Convertible CUInt Word where 490 | safeConvert = boundedConversion (return . fromIntegral) 491 | instance Convertible Word CUInt where 492 | safeConvert = boundedConversion (return . fromIntegral) 493 | 494 | instance Convertible CUInt Word8 where 495 | safeConvert = boundedConversion (return . fromIntegral) 496 | instance Convertible Word8 CUInt where 497 | safeConvert = boundedConversion (return . fromIntegral) 498 | 499 | instance Convertible CUInt Word16 where 500 | safeConvert = boundedConversion (return . fromIntegral) 501 | instance Convertible Word16 CUInt where 502 | safeConvert = boundedConversion (return . fromIntegral) 503 | 504 | instance Convertible CUInt Word32 where 505 | safeConvert = boundedConversion (return . fromIntegral) 506 | instance Convertible Word32 CUInt where 507 | safeConvert = boundedConversion (return . fromIntegral) 508 | 509 | instance Convertible CUInt Word64 where 510 | safeConvert = boundedConversion (return . fromIntegral) 511 | instance Convertible Word64 CUInt where 512 | safeConvert = boundedConversion (return . fromIntegral) 513 | 514 | instance Convertible CLong Int where 515 | safeConvert = boundedConversion (return . fromIntegral) 516 | instance Convertible Int CLong where 517 | safeConvert = boundedConversion (return . fromIntegral) 518 | 519 | instance Convertible CLong Int8 where 520 | safeConvert = boundedConversion (return . fromIntegral) 521 | instance Convertible Int8 CLong where 522 | safeConvert = boundedConversion (return . fromIntegral) 523 | 524 | instance Convertible CLong Int16 where 525 | safeConvert = boundedConversion (return . fromIntegral) 526 | instance Convertible Int16 CLong where 527 | safeConvert = boundedConversion (return . fromIntegral) 528 | 529 | instance Convertible CLong Int32 where 530 | safeConvert = boundedConversion (return . fromIntegral) 531 | instance Convertible Int32 CLong where 532 | safeConvert = boundedConversion (return . fromIntegral) 533 | 534 | instance Convertible CLong Int64 where 535 | safeConvert = boundedConversion (return . fromIntegral) 536 | instance Convertible Int64 CLong where 537 | safeConvert = boundedConversion (return . fromIntegral) 538 | 539 | instance Convertible CLong Word where 540 | safeConvert = boundedConversion (return . fromIntegral) 541 | instance Convertible Word CLong where 542 | safeConvert = boundedConversion (return . fromIntegral) 543 | 544 | instance Convertible CLong Word8 where 545 | safeConvert = boundedConversion (return . fromIntegral) 546 | instance Convertible Word8 CLong where 547 | safeConvert = boundedConversion (return . fromIntegral) 548 | 549 | instance Convertible CLong Word16 where 550 | safeConvert = boundedConversion (return . fromIntegral) 551 | instance Convertible Word16 CLong where 552 | safeConvert = boundedConversion (return . fromIntegral) 553 | 554 | instance Convertible CLong Word32 where 555 | safeConvert = boundedConversion (return . fromIntegral) 556 | instance Convertible Word32 CLong where 557 | safeConvert = boundedConversion (return . fromIntegral) 558 | 559 | instance Convertible CLong Word64 where 560 | safeConvert = boundedConversion (return . fromIntegral) 561 | instance Convertible Word64 CLong where 562 | safeConvert = boundedConversion (return . fromIntegral) 563 | 564 | instance Convertible CULong Int where 565 | safeConvert = boundedConversion (return . fromIntegral) 566 | instance Convertible Int CULong where 567 | safeConvert = boundedConversion (return . fromIntegral) 568 | 569 | instance Convertible CULong Int8 where 570 | safeConvert = boundedConversion (return . fromIntegral) 571 | instance Convertible Int8 CULong where 572 | safeConvert = boundedConversion (return . fromIntegral) 573 | 574 | instance Convertible CULong Int16 where 575 | safeConvert = boundedConversion (return . fromIntegral) 576 | instance Convertible Int16 CULong where 577 | safeConvert = boundedConversion (return . fromIntegral) 578 | 579 | instance Convertible CULong Int32 where 580 | safeConvert = boundedConversion (return . fromIntegral) 581 | instance Convertible Int32 CULong where 582 | safeConvert = boundedConversion (return . fromIntegral) 583 | 584 | instance Convertible CULong Int64 where 585 | safeConvert = boundedConversion (return . fromIntegral) 586 | instance Convertible Int64 CULong where 587 | safeConvert = boundedConversion (return . fromIntegral) 588 | 589 | instance Convertible CULong Word where 590 | safeConvert = boundedConversion (return . fromIntegral) 591 | instance Convertible Word CULong where 592 | safeConvert = boundedConversion (return . fromIntegral) 593 | 594 | instance Convertible CULong Word8 where 595 | safeConvert = boundedConversion (return . fromIntegral) 596 | instance Convertible Word8 CULong where 597 | safeConvert = boundedConversion (return . fromIntegral) 598 | 599 | instance Convertible CULong Word16 where 600 | safeConvert = boundedConversion (return . fromIntegral) 601 | instance Convertible Word16 CULong where 602 | safeConvert = boundedConversion (return . fromIntegral) 603 | 604 | instance Convertible CULong Word32 where 605 | safeConvert = boundedConversion (return . fromIntegral) 606 | instance Convertible Word32 CULong where 607 | safeConvert = boundedConversion (return . fromIntegral) 608 | 609 | instance Convertible CULong Word64 where 610 | safeConvert = boundedConversion (return . fromIntegral) 611 | instance Convertible Word64 CULong where 612 | safeConvert = boundedConversion (return . fromIntegral) 613 | 614 | instance Convertible CSize Int where 615 | safeConvert = boundedConversion (return . fromIntegral) 616 | instance Convertible Int CSize where 617 | safeConvert = boundedConversion (return . fromIntegral) 618 | 619 | instance Convertible CSize Int8 where 620 | safeConvert = boundedConversion (return . fromIntegral) 621 | instance Convertible Int8 CSize where 622 | safeConvert = boundedConversion (return . fromIntegral) 623 | 624 | instance Convertible CSize Int16 where 625 | safeConvert = boundedConversion (return . fromIntegral) 626 | instance Convertible Int16 CSize where 627 | safeConvert = boundedConversion (return . fromIntegral) 628 | 629 | instance Convertible CSize Int32 where 630 | safeConvert = boundedConversion (return . fromIntegral) 631 | instance Convertible Int32 CSize where 632 | safeConvert = boundedConversion (return . fromIntegral) 633 | 634 | instance Convertible CSize Int64 where 635 | safeConvert = boundedConversion (return . fromIntegral) 636 | instance Convertible Int64 CSize where 637 | safeConvert = boundedConversion (return . fromIntegral) 638 | 639 | instance Convertible CSize Word where 640 | safeConvert = boundedConversion (return . fromIntegral) 641 | instance Convertible Word CSize where 642 | safeConvert = boundedConversion (return . fromIntegral) 643 | 644 | instance Convertible CSize Word8 where 645 | safeConvert = boundedConversion (return . fromIntegral) 646 | instance Convertible Word8 CSize where 647 | safeConvert = boundedConversion (return . fromIntegral) 648 | 649 | instance Convertible CSize Word16 where 650 | safeConvert = boundedConversion (return . fromIntegral) 651 | instance Convertible Word16 CSize where 652 | safeConvert = boundedConversion (return . fromIntegral) 653 | 654 | instance Convertible CSize Word32 where 655 | safeConvert = boundedConversion (return . fromIntegral) 656 | instance Convertible Word32 CSize where 657 | safeConvert = boundedConversion (return . fromIntegral) 658 | 659 | instance Convertible CSize Word64 where 660 | safeConvert = boundedConversion (return . fromIntegral) 661 | instance Convertible Word64 CSize where 662 | safeConvert = boundedConversion (return . fromIntegral) 663 | 664 | instance Convertible CWchar Int where 665 | safeConvert = boundedConversion (return . fromIntegral) 666 | instance Convertible Int CWchar where 667 | safeConvert = boundedConversion (return . fromIntegral) 668 | 669 | instance Convertible CWchar Int8 where 670 | safeConvert = boundedConversion (return . fromIntegral) 671 | instance Convertible Int8 CWchar where 672 | safeConvert = boundedConversion (return . fromIntegral) 673 | 674 | instance Convertible CWchar Int16 where 675 | safeConvert = boundedConversion (return . fromIntegral) 676 | instance Convertible Int16 CWchar where 677 | safeConvert = boundedConversion (return . fromIntegral) 678 | 679 | instance Convertible CWchar Int32 where 680 | safeConvert = boundedConversion (return . fromIntegral) 681 | instance Convertible Int32 CWchar where 682 | safeConvert = boundedConversion (return . fromIntegral) 683 | 684 | instance Convertible CWchar Int64 where 685 | safeConvert = boundedConversion (return . fromIntegral) 686 | instance Convertible Int64 CWchar where 687 | safeConvert = boundedConversion (return . fromIntegral) 688 | 689 | instance Convertible CWchar Word where 690 | safeConvert = boundedConversion (return . fromIntegral) 691 | instance Convertible Word CWchar where 692 | safeConvert = boundedConversion (return . fromIntegral) 693 | 694 | instance Convertible CWchar Word8 where 695 | safeConvert = boundedConversion (return . fromIntegral) 696 | instance Convertible Word8 CWchar where 697 | safeConvert = boundedConversion (return . fromIntegral) 698 | 699 | instance Convertible CWchar Word16 where 700 | safeConvert = boundedConversion (return . fromIntegral) 701 | instance Convertible Word16 CWchar where 702 | safeConvert = boundedConversion (return . fromIntegral) 703 | 704 | instance Convertible CWchar Word32 where 705 | safeConvert = boundedConversion (return . fromIntegral) 706 | instance Convertible Word32 CWchar where 707 | safeConvert = boundedConversion (return . fromIntegral) 708 | 709 | instance Convertible CWchar Word64 where 710 | safeConvert = boundedConversion (return . fromIntegral) 711 | instance Convertible Word64 CWchar where 712 | safeConvert = boundedConversion (return . fromIntegral) 713 | 714 | instance Convertible CLLong Int where 715 | safeConvert = boundedConversion (return . fromIntegral) 716 | instance Convertible Int CLLong where 717 | safeConvert = boundedConversion (return . fromIntegral) 718 | 719 | instance Convertible CLLong Int8 where 720 | safeConvert = boundedConversion (return . fromIntegral) 721 | instance Convertible Int8 CLLong where 722 | safeConvert = boundedConversion (return . fromIntegral) 723 | 724 | instance Convertible CLLong Int16 where 725 | safeConvert = boundedConversion (return . fromIntegral) 726 | instance Convertible Int16 CLLong where 727 | safeConvert = boundedConversion (return . fromIntegral) 728 | 729 | instance Convertible CLLong Int32 where 730 | safeConvert = boundedConversion (return . fromIntegral) 731 | instance Convertible Int32 CLLong where 732 | safeConvert = boundedConversion (return . fromIntegral) 733 | 734 | instance Convertible CLLong Int64 where 735 | safeConvert = boundedConversion (return . fromIntegral) 736 | instance Convertible Int64 CLLong where 737 | safeConvert = boundedConversion (return . fromIntegral) 738 | 739 | instance Convertible CLLong Word where 740 | safeConvert = boundedConversion (return . fromIntegral) 741 | instance Convertible Word CLLong where 742 | safeConvert = boundedConversion (return . fromIntegral) 743 | 744 | instance Convertible CLLong Word8 where 745 | safeConvert = boundedConversion (return . fromIntegral) 746 | instance Convertible Word8 CLLong where 747 | safeConvert = boundedConversion (return . fromIntegral) 748 | 749 | instance Convertible CLLong Word16 where 750 | safeConvert = boundedConversion (return . fromIntegral) 751 | instance Convertible Word16 CLLong where 752 | safeConvert = boundedConversion (return . fromIntegral) 753 | 754 | instance Convertible CLLong Word32 where 755 | safeConvert = boundedConversion (return . fromIntegral) 756 | instance Convertible Word32 CLLong where 757 | safeConvert = boundedConversion (return . fromIntegral) 758 | 759 | instance Convertible CLLong Word64 where 760 | safeConvert = boundedConversion (return . fromIntegral) 761 | instance Convertible Word64 CLLong where 762 | safeConvert = boundedConversion (return . fromIntegral) 763 | 764 | instance Convertible CULLong Int where 765 | safeConvert = boundedConversion (return . fromIntegral) 766 | instance Convertible Int CULLong where 767 | safeConvert = boundedConversion (return . fromIntegral) 768 | 769 | instance Convertible CULLong Int8 where 770 | safeConvert = boundedConversion (return . fromIntegral) 771 | instance Convertible Int8 CULLong where 772 | safeConvert = boundedConversion (return . fromIntegral) 773 | 774 | instance Convertible CULLong Int16 where 775 | safeConvert = boundedConversion (return . fromIntegral) 776 | instance Convertible Int16 CULLong where 777 | safeConvert = boundedConversion (return . fromIntegral) 778 | 779 | instance Convertible CULLong Int32 where 780 | safeConvert = boundedConversion (return . fromIntegral) 781 | instance Convertible Int32 CULLong where 782 | safeConvert = boundedConversion (return . fromIntegral) 783 | 784 | instance Convertible CULLong Int64 where 785 | safeConvert = boundedConversion (return . fromIntegral) 786 | instance Convertible Int64 CULLong where 787 | safeConvert = boundedConversion (return . fromIntegral) 788 | 789 | instance Convertible CULLong Word where 790 | safeConvert = boundedConversion (return . fromIntegral) 791 | instance Convertible Word CULLong where 792 | safeConvert = boundedConversion (return . fromIntegral) 793 | 794 | instance Convertible CULLong Word8 where 795 | safeConvert = boundedConversion (return . fromIntegral) 796 | instance Convertible Word8 CULLong where 797 | safeConvert = boundedConversion (return . fromIntegral) 798 | 799 | instance Convertible CULLong Word16 where 800 | safeConvert = boundedConversion (return . fromIntegral) 801 | instance Convertible Word16 CULLong where 802 | safeConvert = boundedConversion (return . fromIntegral) 803 | 804 | instance Convertible CULLong Word32 where 805 | safeConvert = boundedConversion (return . fromIntegral) 806 | instance Convertible Word32 CULLong where 807 | safeConvert = boundedConversion (return . fromIntegral) 808 | 809 | instance Convertible CULLong Word64 where 810 | safeConvert = boundedConversion (return . fromIntegral) 811 | instance Convertible Word64 CULLong where 812 | safeConvert = boundedConversion (return . fromIntegral) 813 | 814 | -- Section 4 815 | instance Convertible CChar CSChar where 816 | safeConvert = boundedConversion (return . fromIntegral) 817 | 818 | instance Convertible CChar CUChar where 819 | safeConvert = boundedConversion (return . fromIntegral) 820 | 821 | instance Convertible CChar CShort where 822 | safeConvert = boundedConversion (return . fromIntegral) 823 | 824 | instance Convertible CChar CUShort where 825 | safeConvert = boundedConversion (return . fromIntegral) 826 | 827 | instance Convertible CChar CInt where 828 | safeConvert = boundedConversion (return . fromIntegral) 829 | 830 | instance Convertible CChar CUInt where 831 | safeConvert = boundedConversion (return . fromIntegral) 832 | 833 | instance Convertible CChar CLong where 834 | safeConvert = boundedConversion (return . fromIntegral) 835 | 836 | instance Convertible CChar CULong where 837 | safeConvert = boundedConversion (return . fromIntegral) 838 | 839 | instance Convertible CChar CSize where 840 | safeConvert = boundedConversion (return . fromIntegral) 841 | 842 | instance Convertible CChar CWchar where 843 | safeConvert = boundedConversion (return . fromIntegral) 844 | 845 | instance Convertible CChar CLLong where 846 | safeConvert = boundedConversion (return . fromIntegral) 847 | 848 | instance Convertible CChar CULLong where 849 | safeConvert = boundedConversion (return . fromIntegral) 850 | 851 | instance Convertible CSChar CChar where 852 | safeConvert = boundedConversion (return . fromIntegral) 853 | 854 | instance Convertible CSChar CUChar where 855 | safeConvert = boundedConversion (return . fromIntegral) 856 | 857 | instance Convertible CSChar CShort where 858 | safeConvert = boundedConversion (return . fromIntegral) 859 | 860 | instance Convertible CSChar CUShort where 861 | safeConvert = boundedConversion (return . fromIntegral) 862 | 863 | instance Convertible CSChar CInt where 864 | safeConvert = boundedConversion (return . fromIntegral) 865 | 866 | instance Convertible CSChar CUInt where 867 | safeConvert = boundedConversion (return . fromIntegral) 868 | 869 | instance Convertible CSChar CLong where 870 | safeConvert = boundedConversion (return . fromIntegral) 871 | 872 | instance Convertible CSChar CULong where 873 | safeConvert = boundedConversion (return . fromIntegral) 874 | 875 | instance Convertible CSChar CSize where 876 | safeConvert = boundedConversion (return . fromIntegral) 877 | 878 | instance Convertible CSChar CWchar where 879 | safeConvert = boundedConversion (return . fromIntegral) 880 | 881 | instance Convertible CSChar CLLong where 882 | safeConvert = boundedConversion (return . fromIntegral) 883 | 884 | instance Convertible CSChar CULLong where 885 | safeConvert = boundedConversion (return . fromIntegral) 886 | 887 | instance Convertible CUChar CChar where 888 | safeConvert = boundedConversion (return . fromIntegral) 889 | 890 | instance Convertible CUChar CSChar where 891 | safeConvert = boundedConversion (return . fromIntegral) 892 | 893 | instance Convertible CUChar CShort where 894 | safeConvert = boundedConversion (return . fromIntegral) 895 | 896 | instance Convertible CUChar CUShort where 897 | safeConvert = boundedConversion (return . fromIntegral) 898 | 899 | instance Convertible CUChar CInt where 900 | safeConvert = boundedConversion (return . fromIntegral) 901 | 902 | instance Convertible CUChar CUInt where 903 | safeConvert = boundedConversion (return . fromIntegral) 904 | 905 | instance Convertible CUChar CLong where 906 | safeConvert = boundedConversion (return . fromIntegral) 907 | 908 | instance Convertible CUChar CULong where 909 | safeConvert = boundedConversion (return . fromIntegral) 910 | 911 | instance Convertible CUChar CSize where 912 | safeConvert = boundedConversion (return . fromIntegral) 913 | 914 | instance Convertible CUChar CWchar where 915 | safeConvert = boundedConversion (return . fromIntegral) 916 | 917 | instance Convertible CUChar CLLong where 918 | safeConvert = boundedConversion (return . fromIntegral) 919 | 920 | instance Convertible CUChar CULLong where 921 | safeConvert = boundedConversion (return . fromIntegral) 922 | 923 | instance Convertible CShort CChar where 924 | safeConvert = boundedConversion (return . fromIntegral) 925 | 926 | instance Convertible CShort CSChar where 927 | safeConvert = boundedConversion (return . fromIntegral) 928 | 929 | instance Convertible CShort CUChar where 930 | safeConvert = boundedConversion (return . fromIntegral) 931 | 932 | instance Convertible CShort CUShort where 933 | safeConvert = boundedConversion (return . fromIntegral) 934 | 935 | instance Convertible CShort CInt where 936 | safeConvert = boundedConversion (return . fromIntegral) 937 | 938 | instance Convertible CShort CUInt where 939 | safeConvert = boundedConversion (return . fromIntegral) 940 | 941 | instance Convertible CShort CLong where 942 | safeConvert = boundedConversion (return . fromIntegral) 943 | 944 | instance Convertible CShort CULong where 945 | safeConvert = boundedConversion (return . fromIntegral) 946 | 947 | instance Convertible CShort CSize where 948 | safeConvert = boundedConversion (return . fromIntegral) 949 | 950 | instance Convertible CShort CWchar where 951 | safeConvert = boundedConversion (return . fromIntegral) 952 | 953 | instance Convertible CShort CLLong where 954 | safeConvert = boundedConversion (return . fromIntegral) 955 | 956 | instance Convertible CShort CULLong where 957 | safeConvert = boundedConversion (return . fromIntegral) 958 | 959 | instance Convertible CUShort CChar where 960 | safeConvert = boundedConversion (return . fromIntegral) 961 | 962 | instance Convertible CUShort CSChar where 963 | safeConvert = boundedConversion (return . fromIntegral) 964 | 965 | instance Convertible CUShort CUChar where 966 | safeConvert = boundedConversion (return . fromIntegral) 967 | 968 | instance Convertible CUShort CShort where 969 | safeConvert = boundedConversion (return . fromIntegral) 970 | 971 | instance Convertible CUShort CInt where 972 | safeConvert = boundedConversion (return . fromIntegral) 973 | 974 | instance Convertible CUShort CUInt where 975 | safeConvert = boundedConversion (return . fromIntegral) 976 | 977 | instance Convertible CUShort CLong where 978 | safeConvert = boundedConversion (return . fromIntegral) 979 | 980 | instance Convertible CUShort CULong where 981 | safeConvert = boundedConversion (return . fromIntegral) 982 | 983 | instance Convertible CUShort CSize where 984 | safeConvert = boundedConversion (return . fromIntegral) 985 | 986 | instance Convertible CUShort CWchar where 987 | safeConvert = boundedConversion (return . fromIntegral) 988 | 989 | instance Convertible CUShort CLLong where 990 | safeConvert = boundedConversion (return . fromIntegral) 991 | 992 | instance Convertible CUShort CULLong where 993 | safeConvert = boundedConversion (return . fromIntegral) 994 | 995 | instance Convertible CInt CChar where 996 | safeConvert = boundedConversion (return . fromIntegral) 997 | 998 | instance Convertible CInt CSChar where 999 | safeConvert = boundedConversion (return . fromIntegral) 1000 | 1001 | instance Convertible CInt CUChar where 1002 | safeConvert = boundedConversion (return . fromIntegral) 1003 | 1004 | instance Convertible CInt CShort where 1005 | safeConvert = boundedConversion (return . fromIntegral) 1006 | 1007 | instance Convertible CInt CUShort where 1008 | safeConvert = boundedConversion (return . fromIntegral) 1009 | 1010 | instance Convertible CInt CUInt where 1011 | safeConvert = boundedConversion (return . fromIntegral) 1012 | 1013 | instance Convertible CInt CLong where 1014 | safeConvert = boundedConversion (return . fromIntegral) 1015 | 1016 | instance Convertible CInt CULong where 1017 | safeConvert = boundedConversion (return . fromIntegral) 1018 | 1019 | instance Convertible CInt CSize where 1020 | safeConvert = boundedConversion (return . fromIntegral) 1021 | 1022 | instance Convertible CInt CWchar where 1023 | safeConvert = boundedConversion (return . fromIntegral) 1024 | 1025 | instance Convertible CInt CLLong where 1026 | safeConvert = boundedConversion (return . fromIntegral) 1027 | 1028 | instance Convertible CInt CULLong where 1029 | safeConvert = boundedConversion (return . fromIntegral) 1030 | 1031 | instance Convertible CUInt CChar where 1032 | safeConvert = boundedConversion (return . fromIntegral) 1033 | 1034 | instance Convertible CUInt CSChar where 1035 | safeConvert = boundedConversion (return . fromIntegral) 1036 | 1037 | instance Convertible CUInt CUChar where 1038 | safeConvert = boundedConversion (return . fromIntegral) 1039 | 1040 | instance Convertible CUInt CShort where 1041 | safeConvert = boundedConversion (return . fromIntegral) 1042 | 1043 | instance Convertible CUInt CUShort where 1044 | safeConvert = boundedConversion (return . fromIntegral) 1045 | 1046 | instance Convertible CUInt CInt where 1047 | safeConvert = boundedConversion (return . fromIntegral) 1048 | 1049 | instance Convertible CUInt CLong where 1050 | safeConvert = boundedConversion (return . fromIntegral) 1051 | 1052 | instance Convertible CUInt CULong where 1053 | safeConvert = boundedConversion (return . fromIntegral) 1054 | 1055 | instance Convertible CUInt CSize where 1056 | safeConvert = boundedConversion (return . fromIntegral) 1057 | 1058 | instance Convertible CUInt CWchar where 1059 | safeConvert = boundedConversion (return . fromIntegral) 1060 | 1061 | instance Convertible CUInt CLLong where 1062 | safeConvert = boundedConversion (return . fromIntegral) 1063 | 1064 | instance Convertible CUInt CULLong where 1065 | safeConvert = boundedConversion (return . fromIntegral) 1066 | 1067 | instance Convertible CLong CChar where 1068 | safeConvert = boundedConversion (return . fromIntegral) 1069 | 1070 | instance Convertible CLong CSChar where 1071 | safeConvert = boundedConversion (return . fromIntegral) 1072 | 1073 | instance Convertible CLong CUChar where 1074 | safeConvert = boundedConversion (return . fromIntegral) 1075 | 1076 | instance Convertible CLong CShort where 1077 | safeConvert = boundedConversion (return . fromIntegral) 1078 | 1079 | instance Convertible CLong CUShort where 1080 | safeConvert = boundedConversion (return . fromIntegral) 1081 | 1082 | instance Convertible CLong CInt where 1083 | safeConvert = boundedConversion (return . fromIntegral) 1084 | 1085 | instance Convertible CLong CUInt where 1086 | safeConvert = boundedConversion (return . fromIntegral) 1087 | 1088 | instance Convertible CLong CULong where 1089 | safeConvert = boundedConversion (return . fromIntegral) 1090 | 1091 | instance Convertible CLong CSize where 1092 | safeConvert = boundedConversion (return . fromIntegral) 1093 | 1094 | instance Convertible CLong CWchar where 1095 | safeConvert = boundedConversion (return . fromIntegral) 1096 | 1097 | instance Convertible CLong CLLong where 1098 | safeConvert = boundedConversion (return . fromIntegral) 1099 | 1100 | instance Convertible CLong CULLong where 1101 | safeConvert = boundedConversion (return . fromIntegral) 1102 | 1103 | instance Convertible CULong CChar where 1104 | safeConvert = boundedConversion (return . fromIntegral) 1105 | 1106 | instance Convertible CULong CSChar where 1107 | safeConvert = boundedConversion (return . fromIntegral) 1108 | 1109 | instance Convertible CULong CUChar where 1110 | safeConvert = boundedConversion (return . fromIntegral) 1111 | 1112 | instance Convertible CULong CShort where 1113 | safeConvert = boundedConversion (return . fromIntegral) 1114 | 1115 | instance Convertible CULong CUShort where 1116 | safeConvert = boundedConversion (return . fromIntegral) 1117 | 1118 | instance Convertible CULong CInt where 1119 | safeConvert = boundedConversion (return . fromIntegral) 1120 | 1121 | instance Convertible CULong CUInt where 1122 | safeConvert = boundedConversion (return . fromIntegral) 1123 | 1124 | instance Convertible CULong CLong where 1125 | safeConvert = boundedConversion (return . fromIntegral) 1126 | 1127 | instance Convertible CULong CSize where 1128 | safeConvert = boundedConversion (return . fromIntegral) 1129 | 1130 | instance Convertible CULong CWchar where 1131 | safeConvert = boundedConversion (return . fromIntegral) 1132 | 1133 | instance Convertible CULong CLLong where 1134 | safeConvert = boundedConversion (return . fromIntegral) 1135 | 1136 | instance Convertible CULong CULLong where 1137 | safeConvert = boundedConversion (return . fromIntegral) 1138 | 1139 | instance Convertible CSize CChar where 1140 | safeConvert = boundedConversion (return . fromIntegral) 1141 | 1142 | instance Convertible CSize CSChar where 1143 | safeConvert = boundedConversion (return . fromIntegral) 1144 | 1145 | instance Convertible CSize CUChar where 1146 | safeConvert = boundedConversion (return . fromIntegral) 1147 | 1148 | instance Convertible CSize CShort where 1149 | safeConvert = boundedConversion (return . fromIntegral) 1150 | 1151 | instance Convertible CSize CUShort where 1152 | safeConvert = boundedConversion (return . fromIntegral) 1153 | 1154 | instance Convertible CSize CInt where 1155 | safeConvert = boundedConversion (return . fromIntegral) 1156 | 1157 | instance Convertible CSize CUInt where 1158 | safeConvert = boundedConversion (return . fromIntegral) 1159 | 1160 | instance Convertible CSize CLong where 1161 | safeConvert = boundedConversion (return . fromIntegral) 1162 | 1163 | instance Convertible CSize CULong where 1164 | safeConvert = boundedConversion (return . fromIntegral) 1165 | 1166 | instance Convertible CSize CWchar where 1167 | safeConvert = boundedConversion (return . fromIntegral) 1168 | 1169 | instance Convertible CSize CLLong where 1170 | safeConvert = boundedConversion (return . fromIntegral) 1171 | 1172 | instance Convertible CSize CULLong where 1173 | safeConvert = boundedConversion (return . fromIntegral) 1174 | 1175 | instance Convertible CWchar CChar where 1176 | safeConvert = boundedConversion (return . fromIntegral) 1177 | 1178 | instance Convertible CWchar CSChar where 1179 | safeConvert = boundedConversion (return . fromIntegral) 1180 | 1181 | instance Convertible CWchar CUChar where 1182 | safeConvert = boundedConversion (return . fromIntegral) 1183 | 1184 | instance Convertible CWchar CShort where 1185 | safeConvert = boundedConversion (return . fromIntegral) 1186 | 1187 | instance Convertible CWchar CUShort where 1188 | safeConvert = boundedConversion (return . fromIntegral) 1189 | 1190 | instance Convertible CWchar CInt where 1191 | safeConvert = boundedConversion (return . fromIntegral) 1192 | 1193 | instance Convertible CWchar CUInt where 1194 | safeConvert = boundedConversion (return . fromIntegral) 1195 | 1196 | instance Convertible CWchar CLong where 1197 | safeConvert = boundedConversion (return . fromIntegral) 1198 | 1199 | instance Convertible CWchar CULong where 1200 | safeConvert = boundedConversion (return . fromIntegral) 1201 | 1202 | instance Convertible CWchar CSize where 1203 | safeConvert = boundedConversion (return . fromIntegral) 1204 | 1205 | instance Convertible CWchar CLLong where 1206 | safeConvert = boundedConversion (return . fromIntegral) 1207 | 1208 | instance Convertible CWchar CULLong where 1209 | safeConvert = boundedConversion (return . fromIntegral) 1210 | 1211 | instance Convertible CLLong CChar where 1212 | safeConvert = boundedConversion (return . fromIntegral) 1213 | 1214 | instance Convertible CLLong CSChar where 1215 | safeConvert = boundedConversion (return . fromIntegral) 1216 | 1217 | instance Convertible CLLong CUChar where 1218 | safeConvert = boundedConversion (return . fromIntegral) 1219 | 1220 | instance Convertible CLLong CShort where 1221 | safeConvert = boundedConversion (return . fromIntegral) 1222 | 1223 | instance Convertible CLLong CUShort where 1224 | safeConvert = boundedConversion (return . fromIntegral) 1225 | 1226 | instance Convertible CLLong CInt where 1227 | safeConvert = boundedConversion (return . fromIntegral) 1228 | 1229 | instance Convertible CLLong CUInt where 1230 | safeConvert = boundedConversion (return . fromIntegral) 1231 | 1232 | instance Convertible CLLong CLong where 1233 | safeConvert = boundedConversion (return . fromIntegral) 1234 | 1235 | instance Convertible CLLong CULong where 1236 | safeConvert = boundedConversion (return . fromIntegral) 1237 | 1238 | instance Convertible CLLong CSize where 1239 | safeConvert = boundedConversion (return . fromIntegral) 1240 | 1241 | instance Convertible CLLong CWchar where 1242 | safeConvert = boundedConversion (return . fromIntegral) 1243 | 1244 | instance Convertible CLLong CULLong where 1245 | safeConvert = boundedConversion (return . fromIntegral) 1246 | 1247 | instance Convertible CULLong CChar where 1248 | safeConvert = boundedConversion (return . fromIntegral) 1249 | 1250 | instance Convertible CULLong CSChar where 1251 | safeConvert = boundedConversion (return . fromIntegral) 1252 | 1253 | instance Convertible CULLong CUChar where 1254 | safeConvert = boundedConversion (return . fromIntegral) 1255 | 1256 | instance Convertible CULLong CShort where 1257 | safeConvert = boundedConversion (return . fromIntegral) 1258 | 1259 | instance Convertible CULLong CUShort where 1260 | safeConvert = boundedConversion (return . fromIntegral) 1261 | 1262 | instance Convertible CULLong CInt where 1263 | safeConvert = boundedConversion (return . fromIntegral) 1264 | 1265 | instance Convertible CULLong CUInt where 1266 | safeConvert = boundedConversion (return . fromIntegral) 1267 | 1268 | instance Convertible CULLong CLong where 1269 | safeConvert = boundedConversion (return . fromIntegral) 1270 | 1271 | instance Convertible CULLong CULong where 1272 | safeConvert = boundedConversion (return . fromIntegral) 1273 | 1274 | instance Convertible CULLong CSize where 1275 | safeConvert = boundedConversion (return . fromIntegral) 1276 | 1277 | instance Convertible CULLong CWchar where 1278 | safeConvert = boundedConversion (return . fromIntegral) 1279 | 1280 | instance Convertible CULLong CLLong where 1281 | safeConvert = boundedConversion (return . fromIntegral) 1282 | 1283 | -- Section 5 1284 | instance Convertible CFloat CDouble where 1285 | safeConvert = return . realToFrac 1286 | 1287 | instance Convertible CDouble CFloat where 1288 | safeConvert = return . realToFrac 1289 | 1290 | -- Section 6 1291 | instance Convertible CFloat Integer where 1292 | safeConvert = return . truncate 1293 | instance Convertible Integer CFloat where 1294 | safeConvert = return . fromIntegral 1295 | 1296 | instance Convertible CDouble Integer where 1297 | safeConvert = return . truncate 1298 | instance Convertible Integer CDouble where 1299 | safeConvert = return . fromIntegral 1300 | 1301 | -- Section 7 1302 | instance Convertible CChar Integer where 1303 | safeConvert = return . fromIntegral 1304 | instance Convertible Integer CChar where 1305 | safeConvert = boundedConversion (return . fromIntegral) 1306 | 1307 | instance Convertible CSChar Integer where 1308 | safeConvert = return . fromIntegral 1309 | instance Convertible Integer CSChar where 1310 | safeConvert = boundedConversion (return . fromIntegral) 1311 | 1312 | instance Convertible CUChar Integer where 1313 | safeConvert = return . fromIntegral 1314 | instance Convertible Integer CUChar where 1315 | safeConvert = boundedConversion (return . fromIntegral) 1316 | 1317 | instance Convertible CShort Integer where 1318 | safeConvert = return . fromIntegral 1319 | instance Convertible Integer CShort where 1320 | safeConvert = boundedConversion (return . fromIntegral) 1321 | 1322 | instance Convertible CUShort Integer where 1323 | safeConvert = return . fromIntegral 1324 | instance Convertible Integer CUShort where 1325 | safeConvert = boundedConversion (return . fromIntegral) 1326 | 1327 | instance Convertible CInt Integer where 1328 | safeConvert = return . fromIntegral 1329 | instance Convertible Integer CInt where 1330 | safeConvert = boundedConversion (return . fromIntegral) 1331 | 1332 | instance Convertible CUInt Integer where 1333 | safeConvert = return . fromIntegral 1334 | instance Convertible Integer CUInt where 1335 | safeConvert = boundedConversion (return . fromIntegral) 1336 | 1337 | instance Convertible CLong Integer where 1338 | safeConvert = return . fromIntegral 1339 | instance Convertible Integer CLong where 1340 | safeConvert = boundedConversion (return . fromIntegral) 1341 | 1342 | instance Convertible CULong Integer where 1343 | safeConvert = return . fromIntegral 1344 | instance Convertible Integer CULong where 1345 | safeConvert = boundedConversion (return . fromIntegral) 1346 | 1347 | instance Convertible CSize Integer where 1348 | safeConvert = return . fromIntegral 1349 | instance Convertible Integer CSize where 1350 | safeConvert = boundedConversion (return . fromIntegral) 1351 | 1352 | instance Convertible CWchar Integer where 1353 | safeConvert = return . fromIntegral 1354 | instance Convertible Integer CWchar where 1355 | safeConvert = boundedConversion (return . fromIntegral) 1356 | 1357 | instance Convertible CLLong Integer where 1358 | safeConvert = return . fromIntegral 1359 | instance Convertible Integer CLLong where 1360 | safeConvert = boundedConversion (return . fromIntegral) 1361 | 1362 | instance Convertible CULLong Integer where 1363 | safeConvert = return . fromIntegral 1364 | instance Convertible Integer CULLong where 1365 | safeConvert = boundedConversion (return . fromIntegral) 1366 | 1367 | -- Section 8o 1368 | instance Convertible CChar Char where 1369 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 1370 | instance Convertible Char CChar where 1371 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 1372 | 1373 | instance Convertible CSChar Char where 1374 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 1375 | instance Convertible Char CSChar where 1376 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 1377 | 1378 | instance Convertible CUChar Char where 1379 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 1380 | instance Convertible Char CUChar where 1381 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 1382 | 1383 | instance Convertible CShort Char where 1384 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 1385 | instance Convertible Char CShort where 1386 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 1387 | 1388 | instance Convertible CUShort Char where 1389 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 1390 | instance Convertible Char CUShort where 1391 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 1392 | 1393 | instance Convertible CInt Char where 1394 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 1395 | instance Convertible Char CInt where 1396 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 1397 | 1398 | instance Convertible CUInt Char where 1399 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 1400 | instance Convertible Char CUInt where 1401 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 1402 | 1403 | instance Convertible CLong Char where 1404 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 1405 | instance Convertible Char CLong where 1406 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 1407 | 1408 | instance Convertible CULong Char where 1409 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 1410 | instance Convertible Char CULong where 1411 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 1412 | 1413 | instance Convertible CSize Char where 1414 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 1415 | instance Convertible Char CSize where 1416 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 1417 | 1418 | instance Convertible CWchar Char where 1419 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 1420 | instance Convertible Char CWchar where 1421 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 1422 | 1423 | instance Convertible CLLong Char where 1424 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 1425 | instance Convertible Char CLLong where 1426 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 1427 | 1428 | instance Convertible CULLong Char where 1429 | safeConvert = boundedConversion (return . toEnum . fromIntegral) 1430 | instance Convertible Char CULLong where 1431 | safeConvert = boundedConversion (return . fromIntegral . fromEnum) 1432 | 1433 | --------------------------------------------------------------------------------