{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{- |
   Module     : Data.Convertible.Instances.Num
   Copyright  : Copyright (C) 2009 John Goerzen
   License    : LGPL

   Maintainer : Michael Snoyman <michael@snoyman.com>
   Stability  : provisional
   Portability: portable

Numeric instances for Convertible.

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

All rights reserved.

For license and copyright information, see the file COPYRIGHT

These instances perform conversion between numeric types such as Double, Int, Integer,
Rational, and the like.  Here are some notes about the conversion process:

Conversions from floating-point types such as Double to integral types are dune via the
'truncate' function.  This is a somewhat arbitrary decision; if you need different
behavior, you will have to write your own instance or manually perform the conversion.

All conversions perform bounds checking.  If a value is too large for its destination
type, you will get a 'ConvertError' informing you of this.  Note that this behavior
differs from functions in the Haskell standard libraries, which will perform the
conversion without error, but give you garbage in the end.

Conversions do not perform precision checking; loss of precision is implied with certain
conversions (for instance, Double to Float) and this is not an error.
-}

module Data.Convertible.Instances.Num()
where

import Data.Convertible.Base
import Data.Convertible.Utils
import Data.Int
import Data.Word

------------------------------------------------------------

instance ConvertSuccess Char Integer where
    convertSuccess = fromIntegral . fromEnum
instance ConvertAttempt Char Integer where
    convertAttempt = return . convertSuccess

$(deriveAttempts
    [ (''Double, ''Integer)
    , (''Float, ''Integer)
    , (''Rational, ''Integer)
    , (''Int, ''Integer)
    , (''Int8, ''Integer)
    , (''Int16, ''Integer)
    , (''Int32, ''Integer)
    , (''Int64, ''Integer)
    , (''Word, ''Integer)
    , (''Word8, ''Integer)
    , (''Word16, ''Integer)
    , (''Word32, ''Integer)
    , (''Word64, ''Integer)
    , (''Integer, ''Double)
    , (''Integer, ''Float)
    , (''Integer, ''Rational)
    , (''Int, ''Double)
    , (''Int8, ''Double)
    , (''Int16, ''Double)
    , (''Int32, ''Double)
    , (''Int64, ''Double)
    , (''Word, ''Double)
    , (''Word8, ''Double)
    , (''Word16, ''Double)
    , (''Word32, ''Double)
    , (''Word64, ''Double)
    , (''Int, ''Float)
    , (''Int8, ''Float)
    , (''Int16, ''Float)
    , (''Int32, ''Float)
    , (''Int64, ''Float)
    , (''Word, ''Float)
    , (''Word8, ''Float)
    , (''Word16, ''Float)
    , (''Word32, ''Float)
    , (''Word64, ''Float)
    , (''Int, ''Rational)
    , (''Int8, ''Rational)
    , (''Int16, ''Rational)
    , (''Int32, ''Rational)
    , (''Int64, ''Rational)
    , (''Word, ''Rational)
    , (''Word8, ''Rational)
    , (''Word16, ''Rational)
    , (''Word32, ''Rational)
    , (''Word64, ''Rational)
    , (''Double, ''Float)
    , (''Double, ''Rational)
    , (''Float, ''Double)
    , (''Float, ''Rational)
    , (''Rational, ''Double)
    , (''Rational, ''Float)
    ])

{- The following instances generated by util/genNumInstances.hs

-}

instance ConvertAttempt Integer Int where
    convertAttempt = boundedConversion (return . fromIntegral)
instance ConvertSuccess Int Integer where
    convertSuccess = fromIntegral

instance ConvertAttempt Integer Int8 where
    convertAttempt = boundedConversion (return . fromIntegral)
instance ConvertSuccess Int8 Integer where
    convertSuccess = fromIntegral

instance ConvertAttempt Integer Int16 where
    convertAttempt = boundedConversion (return . fromIntegral)
instance ConvertSuccess Int16 Integer where
    convertSuccess = fromIntegral

instance ConvertAttempt Integer Int32 where
    convertAttempt = boundedConversion (return . fromIntegral)
instance ConvertSuccess Int32 Integer where
    convertSuccess = fromIntegral

instance ConvertAttempt Integer Int64 where
    convertAttempt = boundedConversion (return . fromIntegral)
instance ConvertSuccess Int64 Integer where
    convertSuccess = fromIntegral

instance ConvertAttempt Integer Word where
    convertAttempt = boundedConversion (return . fromIntegral)
instance ConvertSuccess Word Integer where
    convertSuccess = fromIntegral

instance ConvertAttempt Integer Word8 where
    convertAttempt = boundedConversion (return . fromIntegral)
instance ConvertSuccess Word8 Integer where
    convertSuccess = fromIntegral

instance ConvertAttempt Integer Word16 where
    convertAttempt = boundedConversion (return . fromIntegral)
instance ConvertSuccess Word16 Integer where
    convertSuccess = fromIntegral

instance ConvertAttempt Integer Word32 where
    convertAttempt = boundedConversion (return . fromIntegral)
instance ConvertSuccess Word32 Integer where
    convertSuccess = fromIntegral

instance ConvertAttempt Integer Word64 where
    convertAttempt = boundedConversion (return . fromIntegral)
instance ConvertSuccess Word64 Integer where
    convertSuccess = fromIntegral

instance ConvertAttempt Int Int8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int Int16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int Int32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int Int64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int Word where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int Word8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int Word16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int Word32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int Word64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int8 Int where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int8 Int16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int8 Int32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int8 Int64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int8 Word where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int8 Word8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int8 Word16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int8 Word32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int8 Word64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int16 Int where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int16 Int8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int16 Int32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int16 Int64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int16 Word where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int16 Word8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int16 Word16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int16 Word32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int16 Word64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int32 Int where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int32 Int8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int32 Int16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int32 Int64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int32 Word where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int32 Word8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int32 Word16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int32 Word32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int32 Word64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int64 Int where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int64 Int8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int64 Int16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int64 Int32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int64 Word where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int64 Word8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int64 Word16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int64 Word32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Int64 Word64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word Int where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word Int8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word Int16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word Int32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word Int64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word Word8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word Word16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word Word32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word Word64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word8 Int where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word8 Int8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word8 Int16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word8 Int32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word8 Int64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word8 Word where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word8 Word16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word8 Word32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word8 Word64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word16 Int where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word16 Int8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word16 Int16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word16 Int32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word16 Int64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word16 Word where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word16 Word8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word16 Word32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word16 Word64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word32 Int where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word32 Int8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word32 Int16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word32 Int32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word32 Int64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word32 Word where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word32 Word8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word32 Word16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word32 Word64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word64 Int where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word64 Int8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word64 Int16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word64 Int32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word64 Int64 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word64 Word where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word64 Word8 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word64 Word16 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertAttempt Word64 Word32 where
    convertAttempt = boundedConversion (return . fromIntegral)

instance ConvertSuccess Integer Double where
    convertSuccess = fromIntegral
instance ConvertSuccess Double Integer where
    convertSuccess = truncate

instance ConvertSuccess Integer Float where
    convertSuccess = fromIntegral
instance ConvertSuccess Float Integer where
    convertSuccess = truncate

instance ConvertSuccess Integer Rational where
    convertSuccess = fromIntegral
instance ConvertSuccess Rational Integer where
    convertSuccess = truncate

instance ConvertAttempt Double Int where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int Double where
    convertSuccess = fromIntegral

instance ConvertAttempt Double Int8 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int8 Double where
    convertSuccess = fromIntegral

instance ConvertAttempt Double Int16 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int16 Double where
    convertSuccess = fromIntegral

instance ConvertAttempt Double Int32 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int32 Double where
    convertSuccess = fromIntegral

instance ConvertAttempt Double Int64 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int64 Double where
    convertSuccess = fromIntegral

instance ConvertAttempt Double Word where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word Double where
    convertSuccess = fromIntegral

instance ConvertAttempt Double Word8 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word8 Double where
    convertSuccess = fromIntegral

instance ConvertAttempt Double Word16 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word16 Double where
    convertSuccess = fromIntegral

instance ConvertAttempt Double Word32 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word32 Double where
    convertSuccess = fromIntegral

instance ConvertAttempt Double Word64 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word64 Double where
    convertSuccess = fromIntegral

instance ConvertAttempt Float Int where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int Float where
    convertSuccess = fromIntegral

instance ConvertAttempt Float Int8 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int8 Float where
    convertSuccess = fromIntegral

instance ConvertAttempt Float Int16 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int16 Float where
    convertSuccess = fromIntegral

instance ConvertAttempt Float Int32 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int32 Float where
    convertSuccess = fromIntegral

instance ConvertAttempt Float Int64 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int64 Float where
    convertSuccess = fromIntegral

instance ConvertAttempt Float Word where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word Float where
    convertSuccess = fromIntegral

instance ConvertAttempt Float Word8 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word8 Float where
    convertSuccess = fromIntegral

instance ConvertAttempt Float Word16 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word16 Float where
    convertSuccess = fromIntegral

instance ConvertAttempt Float Word32 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word32 Float where
    convertSuccess = fromIntegral

instance ConvertAttempt Float Word64 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word64 Float where
    convertSuccess = fromIntegral

instance ConvertAttempt Rational Int where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int Rational where
    convertSuccess = fromIntegral

instance ConvertAttempt Rational Int8 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int8 Rational where
    convertSuccess = fromIntegral

instance ConvertAttempt Rational Int16 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int16 Rational where
    convertSuccess = fromIntegral

instance ConvertAttempt Rational Int32 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int32 Rational where
    convertSuccess = fromIntegral

instance ConvertAttempt Rational Int64 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Int64 Rational where
    convertSuccess = fromIntegral

instance ConvertAttempt Rational Word where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word Rational where
    convertSuccess = fromIntegral

instance ConvertAttempt Rational Word8 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word8 Rational where
    convertSuccess = fromIntegral

instance ConvertAttempt Rational Word16 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word16 Rational where
    convertSuccess = fromIntegral

instance ConvertAttempt Rational Word32 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word32 Rational where
    convertSuccess = fromIntegral

instance ConvertAttempt Rational Word64 where
    convertAttempt = boundedConversion (return . truncate)
instance ConvertSuccess Word64 Rational where
    convertSuccess = fromIntegral

instance ConvertSuccess Double Float where
    convertSuccess = realToFrac

instance ConvertSuccess Double Rational where
    convertSuccess = toRational

instance ConvertSuccess Float Double where
    convertSuccess = realToFrac

instance ConvertSuccess Float Rational where
    convertSuccess = toRational

instance ConvertSuccess Rational Double where
    convertSuccess = realToFrac

instance ConvertSuccess Rational Float where
    convertSuccess = realToFrac

instance ConvertAttempt Char Int where
    convertAttempt = boundedConversion (return . fromIntegral . fromEnum)
instance ConvertAttempt Int Char where
    convertAttempt = boundedConversion (return . toEnum . fromIntegral)

instance ConvertAttempt Char Int8 where
    convertAttempt = boundedConversion (return . fromIntegral . fromEnum)
instance ConvertAttempt Int8 Char where
    convertAttempt = boundedConversion (return . toEnum . fromIntegral)

instance ConvertAttempt Char Int16 where
    convertAttempt = boundedConversion (return . fromIntegral . fromEnum)
instance ConvertAttempt Int16 Char where
    convertAttempt = boundedConversion (return . toEnum . fromIntegral)

instance ConvertAttempt Char Int32 where
    convertAttempt = boundedConversion (return . fromIntegral . fromEnum)
instance ConvertAttempt Int32 Char where
    convertAttempt = boundedConversion (return . toEnum . fromIntegral)

instance ConvertAttempt Char Int64 where
    convertAttempt = boundedConversion (return . fromIntegral . fromEnum)
instance ConvertAttempt Int64 Char where
    convertAttempt = boundedConversion (return . toEnum . fromIntegral)

instance ConvertAttempt Char Word where
    convertAttempt = boundedConversion (return . fromIntegral . fromEnum)
instance ConvertAttempt Word Char where
    convertAttempt = boundedConversion (return . toEnum . fromIntegral)

instance ConvertAttempt Char Word8 where
    convertAttempt = boundedConversion (return . fromIntegral . fromEnum)
instance ConvertAttempt Word8 Char where
    convertAttempt = boundedConversion (return . toEnum . fromIntegral)

instance ConvertAttempt Char Word16 where
    convertAttempt = boundedConversion (return . fromIntegral . fromEnum)
instance ConvertAttempt Word16 Char where
    convertAttempt = boundedConversion (return . toEnum . fromIntegral)

instance ConvertAttempt Char Word32 where
    convertAttempt = boundedConversion (return . fromIntegral . fromEnum)
instance ConvertAttempt Word32 Char where
    convertAttempt = boundedConversion (return . toEnum . fromIntegral)

instance ConvertAttempt Char Word64 where
    convertAttempt = boundedConversion (return . fromIntegral . fromEnum)
instance ConvertAttempt Word64 Char where
    convertAttempt = boundedConversion (return . toEnum . fromIntegral)