{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Witch.Instances where

import qualified Data.Bits as Bits
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LazyByteString
import qualified Data.ByteString.Short as ShortByteString
import qualified Data.Complex as Complex
import qualified Data.Fixed as Fixed
import qualified Data.Foldable as Foldable
import qualified Data.Int as Int
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import qualified Data.Ratio as Ratio
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Encoding as LazyText
import qualified Data.Word as Word
import qualified Numeric.Natural as Natural
import qualified Witch.Cast as Cast
import qualified Witch.TryCast as TryCast
import qualified Witch.TryCastException as TryCastException
import qualified Witch.Utility as Utility

-- Int8

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int8 Int.Int16 where
  cast :: Int8 -> Int16
cast = Int8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int8 Int.Int32 where
  cast :: Int8 -> Int32
cast = Int8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int8 Int.Int64 where
  cast :: Int8 -> Int64
cast = Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int8 Int where
  cast :: Int8 -> Int
cast = Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int8 Integer where
  cast :: Int8 -> Integer
cast = Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int8 Word.Word8 where
  tryCast :: Int8 -> Either (TryCastException Int8 Word8) Word8
tryCast = (Int8 -> Maybe Word8)
-> Int8 -> Either (TryCastException Int8 Word8) Word8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int8 -> Maybe Word8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int8 Word.Word16 where
  tryCast :: Int8 -> Either (TryCastException Int8 Word16) Word16
tryCast = (Int8 -> Maybe Word16)
-> Int8 -> Either (TryCastException Int8 Word16) Word16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int8 -> Maybe Word16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int8 Word.Word32 where
  tryCast :: Int8 -> Either (TryCastException Int8 Word32) Word32
tryCast = (Int8 -> Maybe Word32)
-> Int8 -> Either (TryCastException Int8 Word32) Word32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int8 -> Maybe Word32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int8 Word.Word64 where
  tryCast :: Int8 -> Either (TryCastException Int8 Word64) Word64
tryCast = (Int8 -> Maybe Word64)
-> Int8 -> Either (TryCastException Int8 Word64) Word64
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int8 -> Maybe Word64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int8 Word where
  tryCast :: Int8 -> Either (TryCastException Int8 Word) Word
tryCast = (Int8 -> Maybe Word)
-> Int8 -> Either (TryCastException Int8 Word) Word
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int8 -> Maybe Word
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral' when the input is non-negative.
instance TryCast.TryCast Int.Int8 Natural.Natural where
  tryCast :: Int8 -> Either (TryCastException Int8 Natural) Natural
tryCast = (Int8 -> Maybe Natural)
-> Int8 -> Either (TryCastException Int8 Natural) Natural
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int8 -> Maybe Natural
forall s t. (Integral s, Num t) => s -> Maybe t
fromNonNegativeIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int8 Float where
  cast :: Int8 -> Float
cast = Int8 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int8 Double where
  cast :: Int8 -> Double
cast = Int8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- Int16

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int16 Int.Int8 where
  tryCast :: Int16 -> Either (TryCastException Int16 Int8) Int8
tryCast = (Int16 -> Maybe Int8)
-> Int16 -> Either (TryCastException Int16 Int8) Int8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int16 -> Maybe Int8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int16 Int.Int32 where
  cast :: Int16 -> Int32
cast = Int16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int16 Int.Int64 where
  cast :: Int16 -> Int64
cast = Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int16 Int where
  cast :: Int16 -> Int
cast = Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int16 Integer where
  cast :: Int16 -> Integer
cast = Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int16 Word.Word8 where
  tryCast :: Int16 -> Either (TryCastException Int16 Word8) Word8
tryCast = (Int16 -> Maybe Word8)
-> Int16 -> Either (TryCastException Int16 Word8) Word8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int16 -> Maybe Word8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int16 Word.Word16 where
  tryCast :: Int16 -> Either (TryCastException Int16 Word16) Word16
tryCast = (Int16 -> Maybe Word16)
-> Int16 -> Either (TryCastException Int16 Word16) Word16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int16 -> Maybe Word16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int16 Word.Word32 where
  tryCast :: Int16 -> Either (TryCastException Int16 Word32) Word32
tryCast = (Int16 -> Maybe Word32)
-> Int16 -> Either (TryCastException Int16 Word32) Word32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int16 -> Maybe Word32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int16 Word.Word64 where
  tryCast :: Int16 -> Either (TryCastException Int16 Word64) Word64
tryCast = (Int16 -> Maybe Word64)
-> Int16 -> Either (TryCastException Int16 Word64) Word64
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int16 -> Maybe Word64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int16 Word where
  tryCast :: Int16 -> Either (TryCastException Int16 Word) Word
tryCast = (Int16 -> Maybe Word)
-> Int16 -> Either (TryCastException Int16 Word) Word
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int16 -> Maybe Word
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral' when the input is non-negative.
instance TryCast.TryCast Int.Int16 Natural.Natural where
  tryCast :: Int16 -> Either (TryCastException Int16 Natural) Natural
tryCast = (Int16 -> Maybe Natural)
-> Int16 -> Either (TryCastException Int16 Natural) Natural
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int16 -> Maybe Natural
forall s t. (Integral s, Num t) => s -> Maybe t
fromNonNegativeIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int16 Float where
  cast :: Int16 -> Float
cast = Int16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int16 Double where
  cast :: Int16 -> Double
cast = Int16 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- Int32

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int32 Int.Int8 where
  tryCast :: Int32 -> Either (TryCastException Int32 Int8) Int8
tryCast = (Int32 -> Maybe Int8)
-> Int32 -> Either (TryCastException Int32 Int8) Int8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int32 -> Maybe Int8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int32 Int.Int16 where
  tryCast :: Int32 -> Either (TryCastException Int32 Int16) Int16
tryCast = (Int32 -> Maybe Int16)
-> Int32 -> Either (TryCastException Int32 Int16) Int16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int32 -> Maybe Int16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int32 Int.Int64 where
  cast :: Int32 -> Int64
cast = Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int32 Int where
  tryCast :: Int32 -> Either (TryCastException Int32 Int) Int
tryCast = (Int32 -> Maybe Int)
-> Int32 -> Either (TryCastException Int32 Int) Int
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int32 -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int32 Integer where
  cast :: Int32 -> Integer
cast = Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int32 Word.Word8 where
  tryCast :: Int32 -> Either (TryCastException Int32 Word8) Word8
tryCast = (Int32 -> Maybe Word8)
-> Int32 -> Either (TryCastException Int32 Word8) Word8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int32 -> Maybe Word8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int32 Word.Word16 where
  tryCast :: Int32 -> Either (TryCastException Int32 Word16) Word16
tryCast = (Int32 -> Maybe Word16)
-> Int32 -> Either (TryCastException Int32 Word16) Word16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int32 -> Maybe Word16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int32 Word.Word32 where
  tryCast :: Int32 -> Either (TryCastException Int32 Word32) Word32
tryCast = (Int32 -> Maybe Word32)
-> Int32 -> Either (TryCastException Int32 Word32) Word32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int32 -> Maybe Word32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int32 Word.Word64 where
  tryCast :: Int32 -> Either (TryCastException Int32 Word64) Word64
tryCast = (Int32 -> Maybe Word64)
-> Int32 -> Either (TryCastException Int32 Word64) Word64
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int32 -> Maybe Word64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int32 Word where
  tryCast :: Int32 -> Either (TryCastException Int32 Word) Word
tryCast = (Int32 -> Maybe Word)
-> Int32 -> Either (TryCastException Int32 Word) Word
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int32 -> Maybe Word
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral' when the input is non-negative.
instance TryCast.TryCast Int.Int32 Natural.Natural where
  tryCast :: Int32 -> Either (TryCastException Int32 Natural) Natural
tryCast = (Int32 -> Maybe Natural)
-> Int32 -> Either (TryCastException Int32 Natural) Natural
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int32 -> Maybe Natural
forall s t. (Integral s, Num t) => s -> Maybe t
fromNonNegativeIntegral

-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215
-- inclusive.
instance TryCast.TryCast Int.Int32 Float where
  tryCast :: Int32 -> Either (TryCastException Int32 Float) Float
tryCast = (Int32 -> Maybe Float)
-> Int32 -> Either (TryCastException Int32 Float) Float
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast ((Int32 -> Maybe Float)
 -> Int32 -> Either (TryCastException Int32 Float) Float)
-> (Int32 -> Maybe Float)
-> Int32
-> Either (TryCastException Int32 Float) Float
forall a b. (a -> b) -> a -> b
$ \Int32
s -> if -Int32
forall a. Num a => a
maxFloat Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
s Bool -> Bool -> Bool
&& Int32
s Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
forall a. Num a => a
maxFloat
    then Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ Int32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
s
    else Maybe Float
forall a. Maybe a
Nothing

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int32 Double where
  cast :: Int32 -> Double
cast = Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- Int64

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int64 Int.Int8 where
  tryCast :: Int64 -> Either (TryCastException Int64 Int8) Int8
tryCast = (Int64 -> Maybe Int8)
-> Int64 -> Either (TryCastException Int64 Int8) Int8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int64 -> Maybe Int8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int64 Int.Int16 where
  tryCast :: Int64 -> Either (TryCastException Int64 Int16) Int16
tryCast = (Int64 -> Maybe Int16)
-> Int64 -> Either (TryCastException Int64 Int16) Int16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int64 -> Maybe Int16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int64 Int.Int32 where
  tryCast :: Int64 -> Either (TryCastException Int64 Int32) Int32
tryCast = (Int64 -> Maybe Int32)
-> Int64 -> Either (TryCastException Int64 Int32) Int32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int64 -> Maybe Int32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int64 Int where
  tryCast :: Int64 -> Either (TryCastException Int64 Int) Int
tryCast = (Int64 -> Maybe Int)
-> Int64 -> Either (TryCastException Int64 Int) Int
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int64 -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Int.Int64 Integer where
  cast :: Int64 -> Integer
cast = Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int64 Word.Word8 where
  tryCast :: Int64 -> Either (TryCastException Int64 Word8) Word8
tryCast = (Int64 -> Maybe Word8)
-> Int64 -> Either (TryCastException Int64 Word8) Word8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int64 -> Maybe Word8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int64 Word.Word16 where
  tryCast :: Int64 -> Either (TryCastException Int64 Word16) Word16
tryCast = (Int64 -> Maybe Word16)
-> Int64 -> Either (TryCastException Int64 Word16) Word16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int64 -> Maybe Word16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int64 Word.Word32 where
  tryCast :: Int64 -> Either (TryCastException Int64 Word32) Word32
tryCast = (Int64 -> Maybe Word32)
-> Int64 -> Either (TryCastException Int64 Word32) Word32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int64 -> Maybe Word32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int64 Word.Word64 where
  tryCast :: Int64 -> Either (TryCastException Int64 Word64) Word64
tryCast = (Int64 -> Maybe Word64)
-> Int64 -> Either (TryCastException Int64 Word64) Word64
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int64 -> Maybe Word64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int.Int64 Word where
  tryCast :: Int64 -> Either (TryCastException Int64 Word) Word
tryCast = (Int64 -> Maybe Word)
-> Int64 -> Either (TryCastException Int64 Word) Word
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int64 -> Maybe Word
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral' when the input is non-negative.
instance TryCast.TryCast Int.Int64 Natural.Natural where
  tryCast :: Int64 -> Either (TryCastException Int64 Natural) Natural
tryCast = (Int64 -> Maybe Natural)
-> Int64 -> Either (TryCastException Int64 Natural) Natural
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int64 -> Maybe Natural
forall s t. (Integral s, Num t) => s -> Maybe t
fromNonNegativeIntegral

-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215
-- inclusive.
instance TryCast.TryCast Int.Int64 Float where
  tryCast :: Int64 -> Either (TryCastException Int64 Float) Float
tryCast = (Int64 -> Maybe Float)
-> Int64 -> Either (TryCastException Int64 Float) Float
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast ((Int64 -> Maybe Float)
 -> Int64 -> Either (TryCastException Int64 Float) Float)
-> (Int64 -> Maybe Float)
-> Int64
-> Either (TryCastException Int64 Float) Float
forall a b. (a -> b) -> a -> b
$ \Int64
s -> if -Int64
forall a. Num a => a
maxFloat Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
s Bool -> Bool -> Bool
&& Int64
s Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
forall a. Num a => a
maxFloat
    then Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ Int64 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s
    else Maybe Float
forall a. Maybe a
Nothing

-- | Uses 'fromIntegral' when the input is between -9,007,199,254,740,991 and
-- 9,007,199,254,740,991 inclusive.
instance TryCast.TryCast Int.Int64 Double where
  tryCast :: Int64 -> Either (TryCastException Int64 Double) Double
tryCast = (Int64 -> Maybe Double)
-> Int64 -> Either (TryCastException Int64 Double) Double
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast ((Int64 -> Maybe Double)
 -> Int64 -> Either (TryCastException Int64 Double) Double)
-> (Int64 -> Maybe Double)
-> Int64
-> Either (TryCastException Int64 Double) Double
forall a b. (a -> b) -> a -> b
$ \Int64
s -> if -Int64
forall a. Num a => a
maxDouble Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
s Bool -> Bool -> Bool
&& Int64
s Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
forall a. Num a => a
maxDouble
    then Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s
    else Maybe Double
forall a. Maybe a
Nothing

-- Int

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int Int.Int8 where
  tryCast :: Int -> Either (TryCastException Int Int8) Int8
tryCast = (Int -> Maybe Int8)
-> Int -> Either (TryCastException Int Int8) Int8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int -> Maybe Int8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int Int.Int16 where
  tryCast :: Int -> Either (TryCastException Int Int16) Int16
tryCast = (Int -> Maybe Int16)
-> Int -> Either (TryCastException Int Int16) Int16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int -> Maybe Int16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int Int.Int32 where
  tryCast :: Int -> Either (TryCastException Int Int32) Int32
tryCast = (Int -> Maybe Int32)
-> Int -> Either (TryCastException Int Int32) Int32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int -> Maybe Int32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Int Int.Int64 where
  cast :: Int -> Int64
cast = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Int Integer where
  cast :: Int -> Integer
cast = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int Word.Word8 where
  tryCast :: Int -> Either (TryCastException Int Word8) Word8
tryCast = (Int -> Maybe Word8)
-> Int -> Either (TryCastException Int Word8) Word8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int -> Maybe Word8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int Word.Word16 where
  tryCast :: Int -> Either (TryCastException Int Word16) Word16
tryCast = (Int -> Maybe Word16)
-> Int -> Either (TryCastException Int Word16) Word16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int -> Maybe Word16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int Word.Word32 where
  tryCast :: Int -> Either (TryCastException Int Word32) Word32
tryCast = (Int -> Maybe Word32)
-> Int -> Either (TryCastException Int Word32) Word32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int -> Maybe Word32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int Word.Word64 where
  tryCast :: Int -> Either (TryCastException Int Word64) Word64
tryCast = (Int -> Maybe Word64)
-> Int -> Either (TryCastException Int Word64) Word64
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int -> Maybe Word64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Int Word where
  tryCast :: Int -> Either (TryCastException Int Word) Word
tryCast = (Int -> Maybe Word)
-> Int -> Either (TryCastException Int Word) Word
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int -> Maybe Word
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral' when the input is non-negative.
instance TryCast.TryCast Int Natural.Natural where
  tryCast :: Int -> Either (TryCastException Int Natural) Natural
tryCast = (Int -> Maybe Natural)
-> Int -> Either (TryCastException Int Natural) Natural
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Int -> Maybe Natural
forall s t. (Integral s, Num t) => s -> Maybe t
fromNonNegativeIntegral

-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215
-- inclusive.
instance TryCast.TryCast Int Float where
  tryCast :: Int -> Either (TryCastException Int Float) Float
tryCast = (Int -> Maybe Float)
-> Int -> Either (TryCastException Int Float) Float
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast ((Int -> Maybe Float)
 -> Int -> Either (TryCastException Int Float) Float)
-> (Int -> Maybe Float)
-> Int
-> Either (TryCastException Int Float) Float
forall a b. (a -> b) -> a -> b
$ \Int
s -> if -Int
forall a. Num a => a
maxFloat Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
s Bool -> Bool -> Bool
&& Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
forall a. Num a => a
maxFloat
    then Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s
    else Maybe Float
forall a. Maybe a
Nothing

-- | Uses 'fromIntegral' when the input is between -9,007,199,254,740,991 and
-- 9,007,199,254,740,991 inclusive.
instance TryCast.TryCast Int Double where
  tryCast :: Int -> Either (TryCastException Int Double) Double
tryCast = (Int -> Maybe Double)
-> Int -> Either (TryCastException Int Double) Double
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast ((Int -> Maybe Double)
 -> Int -> Either (TryCastException Int Double) Double)
-> (Int -> Maybe Double)
-> Int
-> Either (TryCastException Int Double) Double
forall a b. (a -> b) -> a -> b
$ \Int
s ->
    if (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
forall a. Num a => a
maxDouble)
        Bool -> Bool -> Bool
|| (-Int
forall a. Num a => a
maxDouble Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
s Bool -> Bool -> Bool
&& Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
forall a. Num a => a
maxDouble)
      then Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s
      else Maybe Double
forall a. Maybe a
Nothing

-- Integer

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Integer Int.Int8 where
  tryCast :: Integer -> Either (TryCastException Integer Int8) Int8
tryCast = (Integer -> Maybe Int8)
-> Integer -> Either (TryCastException Integer Int8) Int8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Integer -> Maybe Int8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Integer Int.Int16 where
  tryCast :: Integer -> Either (TryCastException Integer Int16) Int16
tryCast = (Integer -> Maybe Int16)
-> Integer -> Either (TryCastException Integer Int16) Int16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Integer -> Maybe Int16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Integer Int.Int32 where
  tryCast :: Integer -> Either (TryCastException Integer Int32) Int32
tryCast = (Integer -> Maybe Int32)
-> Integer -> Either (TryCastException Integer Int32) Int32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Integer -> Maybe Int32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Integer Int.Int64 where
  tryCast :: Integer -> Either (TryCastException Integer Int64) Int64
tryCast = (Integer -> Maybe Int64)
-> Integer -> Either (TryCastException Integer Int64) Int64
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Integer -> Maybe Int64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Integer Int where
  tryCast :: Integer -> Either (TryCastException Integer Int) Int
tryCast = (Integer -> Maybe Int)
-> Integer -> Either (TryCastException Integer Int) Int
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Integer -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Integer Word.Word8 where
  tryCast :: Integer -> Either (TryCastException Integer Word8) Word8
tryCast = (Integer -> Maybe Word8)
-> Integer -> Either (TryCastException Integer Word8) Word8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Integer -> Maybe Word8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Integer Word.Word16 where
  tryCast :: Integer -> Either (TryCastException Integer Word16) Word16
tryCast = (Integer -> Maybe Word16)
-> Integer -> Either (TryCastException Integer Word16) Word16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Integer -> Maybe Word16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Integer Word.Word32 where
  tryCast :: Integer -> Either (TryCastException Integer Word32) Word32
tryCast = (Integer -> Maybe Word32)
-> Integer -> Either (TryCastException Integer Word32) Word32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Integer -> Maybe Word32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Integer Word.Word64 where
  tryCast :: Integer -> Either (TryCastException Integer Word64) Word64
tryCast = (Integer -> Maybe Word64)
-> Integer -> Either (TryCastException Integer Word64) Word64
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Integer -> Maybe Word64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Integer Word where
  tryCast :: Integer -> Either (TryCastException Integer Word) Word
tryCast = (Integer -> Maybe Word)
-> Integer -> Either (TryCastException Integer Word) Word
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Integer -> Maybe Word
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromInteger' when the input is non-negative.
instance TryCast.TryCast Integer Natural.Natural where
  -- This should use @maybeTryCast fromNonNegativeIntegral@, but that causes a
  -- bug in GHC 9.0.1. By inlining @fromNonNegativeIntegral@ and replacing
  -- @fromIntegral@ with @fromInteger@, we can work around the bug.
  -- https://mail.haskell.org/pipermail/haskell-cafe/2021-March/133540.html
  tryCast :: Integer -> Either (TryCastException Integer Natural) Natural
tryCast =
    (Integer -> Maybe Natural)
-> Integer -> Either (TryCastException Integer Natural) Natural
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast ((Integer -> Maybe Natural)
 -> Integer -> Either (TryCastException Integer Natural) Natural)
-> (Integer -> Maybe Natural)
-> Integer
-> Either (TryCastException Integer Natural) Natural
forall a b. (a -> b) -> a -> b
$ \Integer
s -> if Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Maybe Natural
forall a. Maybe a
Nothing else Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Natural -> Maybe Natural) -> Natural -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
s

-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215
-- inclusive.
instance TryCast.TryCast Integer Float where
  tryCast :: Integer -> Either (TryCastException Integer Float) Float
tryCast = (Integer -> Maybe Float)
-> Integer -> Either (TryCastException Integer Float) Float
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast ((Integer -> Maybe Float)
 -> Integer -> Either (TryCastException Integer Float) Float)
-> (Integer -> Maybe Float)
-> Integer
-> Either (TryCastException Integer Float) Float
forall a b. (a -> b) -> a -> b
$ \Integer
s -> if -Integer
forall a. Num a => a
maxFloat Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
s Bool -> Bool -> Bool
&& Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
forall a. Num a => a
maxFloat
    then Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
s
    else Maybe Float
forall a. Maybe a
Nothing

-- | Uses 'fromIntegral' when the input is between -9,007,199,254,740,991 and
-- 9,007,199,254,740,991 inclusive.
instance TryCast.TryCast Integer Double where
  tryCast :: Integer -> Either (TryCastException Integer Double) Double
tryCast = (Integer -> Maybe Double)
-> Integer -> Either (TryCastException Integer Double) Double
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast ((Integer -> Maybe Double)
 -> Integer -> Either (TryCastException Integer Double) Double)
-> (Integer -> Maybe Double)
-> Integer
-> Either (TryCastException Integer Double) Double
forall a b. (a -> b) -> a -> b
$ \Integer
s -> if -Integer
forall a. Num a => a
maxDouble Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
s Bool -> Bool -> Bool
&& Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
forall a. Num a => a
maxDouble
    then Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
s
    else Maybe Double
forall a. Maybe a
Nothing

-- Word8

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word8 Word.Word16 where
  cast :: Word8 -> Word16
cast = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word8 Word.Word32 where
  cast :: Word8 -> Word32
cast = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word8 Word.Word64 where
  cast :: Word8 -> Word64
cast = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word8 Word where
  cast :: Word8 -> Word
cast = Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word8 Natural.Natural where
  cast :: Word8 -> Natural
cast = Word8 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word8 Int.Int8 where
  tryCast :: Word8 -> Either (TryCastException Word8 Int8) Int8
tryCast = (Word8 -> Maybe Int8)
-> Word8 -> Either (TryCastException Word8 Int8) Int8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word8 -> Maybe Int8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word8 Int.Int16 where
  cast :: Word8 -> Int16
cast = Word8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word8 Int.Int32 where
  cast :: Word8 -> Int32
cast = Word8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word8 Int.Int64 where
  cast :: Word8 -> Int64
cast = Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word8 Int where
  cast :: Word8 -> Int
cast = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word8 Integer where
  cast :: Word8 -> Integer
cast = Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word8 Float where
  cast :: Word8 -> Float
cast = Word8 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word8 Double where
  cast :: Word8 -> Double
cast = Word8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- Word16

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word16 Word.Word8 where
  tryCast :: Word16 -> Either (TryCastException Word16 Word8) Word8
tryCast = (Word16 -> Maybe Word8)
-> Word16 -> Either (TryCastException Word16 Word8) Word8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word16 -> Maybe Word8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word16 Word.Word32 where
  cast :: Word16 -> Word32
cast = Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word16 Word.Word64 where
  cast :: Word16 -> Word64
cast = Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word16 Word where
  cast :: Word16 -> Word
cast = Word16 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word16 Natural.Natural where
  cast :: Word16 -> Natural
cast = Word16 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word16 Int.Int8 where
  tryCast :: Word16 -> Either (TryCastException Word16 Int8) Int8
tryCast = (Word16 -> Maybe Int8)
-> Word16 -> Either (TryCastException Word16 Int8) Int8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word16 -> Maybe Int8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word16 Int.Int16 where
  tryCast :: Word16 -> Either (TryCastException Word16 Int16) Int16
tryCast = (Word16 -> Maybe Int16)
-> Word16 -> Either (TryCastException Word16 Int16) Int16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word16 -> Maybe Int16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word16 Int.Int32 where
  cast :: Word16 -> Int32
cast = Word16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word16 Int.Int64 where
  cast :: Word16 -> Int64
cast = Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word16 Int where
  cast :: Word16 -> Int
cast = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word16 Integer where
  cast :: Word16 -> Integer
cast = Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word16 Float where
  cast :: Word16 -> Float
cast = Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word16 Double where
  cast :: Word16 -> Double
cast = Word16 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- Word32

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word32 Word.Word8 where
  tryCast :: Word32 -> Either (TryCastException Word32 Word8) Word8
tryCast = (Word32 -> Maybe Word8)
-> Word32 -> Either (TryCastException Word32 Word8) Word8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word32 -> Maybe Word8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word32 Word.Word16 where
  tryCast :: Word32 -> Either (TryCastException Word32 Word16) Word16
tryCast = (Word32 -> Maybe Word16)
-> Word32 -> Either (TryCastException Word32 Word16) Word16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word32 -> Maybe Word16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word32 Word.Word64 where
  cast :: Word32 -> Word64
cast = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word32 Word where
  tryCast :: Word32 -> Either (TryCastException Word32 Word) Word
tryCast = (Word32 -> Maybe Word)
-> Word32 -> Either (TryCastException Word32 Word) Word
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word32 -> Maybe Word
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word32 Natural.Natural where
  cast :: Word32 -> Natural
cast = Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word32 Int.Int8 where
  tryCast :: Word32 -> Either (TryCastException Word32 Int8) Int8
tryCast = (Word32 -> Maybe Int8)
-> Word32 -> Either (TryCastException Word32 Int8) Int8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word32 -> Maybe Int8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word32 Int.Int16 where
  tryCast :: Word32 -> Either (TryCastException Word32 Int16) Int16
tryCast = (Word32 -> Maybe Int16)
-> Word32 -> Either (TryCastException Word32 Int16) Int16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word32 -> Maybe Int16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word32 Int.Int32 where
  tryCast :: Word32 -> Either (TryCastException Word32 Int32) Int32
tryCast = (Word32 -> Maybe Int32)
-> Word32 -> Either (TryCastException Word32 Int32) Int32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word32 -> Maybe Int32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word32 Int.Int64 where
  cast :: Word32 -> Int64
cast = Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word32 Int where
  tryCast :: Word32 -> Either (TryCastException Word32 Int) Int
tryCast = (Word32 -> Maybe Int)
-> Word32 -> Either (TryCastException Word32 Int) Int
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word32 -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word32 Integer where
  cast :: Word32 -> Integer
cast = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215
-- inclusive.
instance TryCast.TryCast Word.Word32 Float where
  tryCast :: Word32 -> Either (TryCastException Word32 Float) Float
tryCast = (Word32 -> Maybe Float)
-> Word32 -> Either (TryCastException Word32 Float) Float
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast
    ((Word32 -> Maybe Float)
 -> Word32 -> Either (TryCastException Word32 Float) Float)
-> (Word32 -> Maybe Float)
-> Word32
-> Either (TryCastException Word32 Float) Float
forall a b. (a -> b) -> a -> b
$ \Word32
s -> if Word32
s Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
forall a. Num a => a
maxFloat then Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
s else Maybe Float
forall a. Maybe a
Nothing

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word32 Double where
  cast :: Word32 -> Double
cast = Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- Word64

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word64 Word.Word8 where
  tryCast :: Word64 -> Either (TryCastException Word64 Word8) Word8
tryCast = (Word64 -> Maybe Word8)
-> Word64 -> Either (TryCastException Word64 Word8) Word8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word64 -> Maybe Word8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word64 Word.Word16 where
  tryCast :: Word64 -> Either (TryCastException Word64 Word16) Word16
tryCast = (Word64 -> Maybe Word16)
-> Word64 -> Either (TryCastException Word64 Word16) Word16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word64 -> Maybe Word16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word64 Word.Word32 where
  tryCast :: Word64 -> Either (TryCastException Word64 Word32) Word32
tryCast = (Word64 -> Maybe Word32)
-> Word64 -> Either (TryCastException Word64 Word32) Word32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word64 -> Maybe Word32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word64 Word where
  tryCast :: Word64 -> Either (TryCastException Word64 Word) Word
tryCast = (Word64 -> Maybe Word)
-> Word64 -> Either (TryCastException Word64 Word) Word
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word64 -> Maybe Word
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word64 Natural.Natural where
  cast :: Word64 -> Natural
cast = Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word64 Int.Int8 where
  tryCast :: Word64 -> Either (TryCastException Word64 Int8) Int8
tryCast = (Word64 -> Maybe Int8)
-> Word64 -> Either (TryCastException Word64 Int8) Int8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word64 -> Maybe Int8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word64 Int.Int16 where
  tryCast :: Word64 -> Either (TryCastException Word64 Int16) Int16
tryCast = (Word64 -> Maybe Int16)
-> Word64 -> Either (TryCastException Word64 Int16) Int16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word64 -> Maybe Int16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word64 Int.Int32 where
  tryCast :: Word64 -> Either (TryCastException Word64 Int32) Int32
tryCast = (Word64 -> Maybe Int32)
-> Word64 -> Either (TryCastException Word64 Int32) Int32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word64 -> Maybe Int32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word64 Int.Int64 where
  tryCast :: Word64 -> Either (TryCastException Word64 Int64) Int64
tryCast = (Word64 -> Maybe Int64)
-> Word64 -> Either (TryCastException Word64 Int64) Int64
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word64 -> Maybe Int64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word.Word64 Int where
  tryCast :: Word64 -> Either (TryCastException Word64 Int) Int
tryCast = (Word64 -> Maybe Int)
-> Word64 -> Either (TryCastException Word64 Int) Int
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word64 -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Word.Word64 Integer where
  cast :: Word64 -> Integer
cast = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215
-- inclusive.
instance TryCast.TryCast Word.Word64 Float where
  tryCast :: Word64 -> Either (TryCastException Word64 Float) Float
tryCast = (Word64 -> Maybe Float)
-> Word64 -> Either (TryCastException Word64 Float) Float
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast
    ((Word64 -> Maybe Float)
 -> Word64 -> Either (TryCastException Word64 Float) Float)
-> (Word64 -> Maybe Float)
-> Word64
-> Either (TryCastException Word64 Float) Float
forall a b. (a -> b) -> a -> b
$ \Word64
s -> if Word64
s Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
forall a. Num a => a
maxFloat then Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ Word64 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
s else Maybe Float
forall a. Maybe a
Nothing

-- | Uses 'fromIntegral' when the input is between -9,007,199,254,740,991 and
-- 9,007,199,254,740,991 inclusive.
instance TryCast.TryCast Word.Word64 Double where
  tryCast :: Word64 -> Either (TryCastException Word64 Double) Double
tryCast = (Word64 -> Maybe Double)
-> Word64 -> Either (TryCastException Word64 Double) Double
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast
    ((Word64 -> Maybe Double)
 -> Word64 -> Either (TryCastException Word64 Double) Double)
-> (Word64 -> Maybe Double)
-> Word64
-> Either (TryCastException Word64 Double) Double
forall a b. (a -> b) -> a -> b
$ \Word64
s -> if Word64
s Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
forall a. Num a => a
maxDouble then Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
s else Maybe Double
forall a. Maybe a
Nothing

-- Word

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word Word.Word8 where
  tryCast :: Word -> Either (TryCastException Word Word8) Word8
tryCast = (Word -> Maybe Word8)
-> Word -> Either (TryCastException Word Word8) Word8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word -> Maybe Word8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word Word.Word16 where
  tryCast :: Word -> Either (TryCastException Word Word16) Word16
tryCast = (Word -> Maybe Word16)
-> Word -> Either (TryCastException Word Word16) Word16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word -> Maybe Word16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word Word.Word32 where
  tryCast :: Word -> Either (TryCastException Word Word32) Word32
tryCast = (Word -> Maybe Word32)
-> Word -> Either (TryCastException Word Word32) Word32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word -> Maybe Word32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Word Word.Word64 where
  cast :: Word -> Word64
cast = Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral'.
instance Cast.Cast Word Natural.Natural where
  cast :: Word -> Natural
cast = Word -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word Int.Int8 where
  tryCast :: Word -> Either (TryCastException Word Int8) Int8
tryCast = (Word -> Maybe Int8)
-> Word -> Either (TryCastException Word Int8) Int8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word -> Maybe Int8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word Int.Int16 where
  tryCast :: Word -> Either (TryCastException Word Int16) Int16
tryCast = (Word -> Maybe Int16)
-> Word -> Either (TryCastException Word Int16) Int16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word -> Maybe Int16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word Int.Int32 where
  tryCast :: Word -> Either (TryCastException Word Int32) Int32
tryCast = (Word -> Maybe Int32)
-> Word -> Either (TryCastException Word Int32) Int32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word -> Maybe Int32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word Int.Int64 where
  tryCast :: Word -> Either (TryCastException Word Int64) Int64
tryCast = (Word -> Maybe Int64)
-> Word -> Either (TryCastException Word Int64) Int64
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word -> Maybe Int64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Word Int where
  tryCast :: Word -> Either (TryCastException Word Int) Int
tryCast = (Word -> Maybe Int)
-> Word -> Either (TryCastException Word Int) Int
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Word -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Word Integer where
  cast :: Word -> Integer
cast = Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215
-- inclusive.
instance TryCast.TryCast Word Float where
  tryCast :: Word -> Either (TryCastException Word Float) Float
tryCast = (Word -> Maybe Float)
-> Word -> Either (TryCastException Word Float) Float
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast
    ((Word -> Maybe Float)
 -> Word -> Either (TryCastException Word Float) Float)
-> (Word -> Maybe Float)
-> Word
-> Either (TryCastException Word Float) Float
forall a b. (a -> b) -> a -> b
$ \Word
s -> if Word
s Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
forall a. Num a => a
maxFloat then Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ Word -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s else Maybe Float
forall a. Maybe a
Nothing

-- | Uses 'fromIntegral' when the input is between -9,007,199,254,740,991 and
-- 9,007,199,254,740,991 inclusive.
instance TryCast.TryCast Word Double where
  tryCast :: Word -> Either (TryCastException Word Double) Double
tryCast = (Word -> Maybe Double)
-> Word -> Either (TryCastException Word Double) Double
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast ((Word -> Maybe Double)
 -> Word -> Either (TryCastException Word Double) Double)
-> (Word -> Maybe Double)
-> Word
-> Either (TryCastException Word Double) Double
forall a b. (a -> b) -> a -> b
$ \Word
s ->
    if (Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word
forall a. Bounded a => a
maxBound :: Word) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
forall a. Num a => a
maxDouble) Bool -> Bool -> Bool
|| (Word
s Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
forall a. Num a => a
maxDouble)
      then Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Word -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s
      else Maybe Double
forall a. Maybe a
Nothing

-- Natural

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Natural.Natural Word.Word8 where
  tryCast :: Natural -> Either (TryCastException Natural Word8) Word8
tryCast = (Natural -> Maybe Word8)
-> Natural -> Either (TryCastException Natural Word8) Word8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Natural -> Maybe Word8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Natural.Natural Word.Word16 where
  tryCast :: Natural -> Either (TryCastException Natural Word16) Word16
tryCast = (Natural -> Maybe Word16)
-> Natural -> Either (TryCastException Natural Word16) Word16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Natural -> Maybe Word16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Natural.Natural Word.Word32 where
  tryCast :: Natural -> Either (TryCastException Natural Word32) Word32
tryCast = (Natural -> Maybe Word32)
-> Natural -> Either (TryCastException Natural Word32) Word32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Natural -> Maybe Word32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Natural.Natural Word.Word64 where
  tryCast :: Natural -> Either (TryCastException Natural Word64) Word64
tryCast = (Natural -> Maybe Word64)
-> Natural -> Either (TryCastException Natural Word64) Word64
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Natural -> Maybe Word64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Natural.Natural Word where
  tryCast :: Natural -> Either (TryCastException Natural Word) Word
tryCast = (Natural -> Maybe Word)
-> Natural -> Either (TryCastException Natural Word) Word
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Natural -> Maybe Word
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Natural.Natural Int.Int8 where
  tryCast :: Natural -> Either (TryCastException Natural Int8) Int8
tryCast = (Natural -> Maybe Int8)
-> Natural -> Either (TryCastException Natural Int8) Int8
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Natural -> Maybe Int8
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Natural.Natural Int.Int16 where
  tryCast :: Natural -> Either (TryCastException Natural Int16) Int16
tryCast = (Natural -> Maybe Int16)
-> Natural -> Either (TryCastException Natural Int16) Int16
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Natural -> Maybe Int16
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Natural.Natural Int.Int32 where
  tryCast :: Natural -> Either (TryCastException Natural Int32) Int32
tryCast = (Natural -> Maybe Int32)
-> Natural -> Either (TryCastException Natural Int32) Int32
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Natural -> Maybe Int32
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Natural.Natural Int.Int64 where
  tryCast :: Natural -> Either (TryCastException Natural Int64) Int64
tryCast = (Natural -> Maybe Int64)
-> Natural -> Either (TryCastException Natural Int64) Int64
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Natural -> Maybe Int64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'Bits.toIntegralSized'.
instance TryCast.TryCast Natural.Natural Int where
  tryCast :: Natural -> Either (TryCastException Natural Int) Int
tryCast = (Natural -> Maybe Int)
-> Natural -> Either (TryCastException Natural Int) Int
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast Natural -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

-- | Uses 'fromIntegral'.
instance Cast.Cast Natural.Natural Integer where
  cast :: Natural -> Integer
cast = Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215
-- inclusive.
instance TryCast.TryCast Natural.Natural Float where
  tryCast :: Natural -> Either (TryCastException Natural Float) Float
tryCast = (Natural -> Maybe Float)
-> Natural -> Either (TryCastException Natural Float) Float
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast
    ((Natural -> Maybe Float)
 -> Natural -> Either (TryCastException Natural Float) Float)
-> (Natural -> Maybe Float)
-> Natural
-> Either (TryCastException Natural Float) Float
forall a b. (a -> b) -> a -> b
$ \Natural
s -> if Natural
s Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
forall a. Num a => a
maxFloat then Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ Natural -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
s else Maybe Float
forall a. Maybe a
Nothing

-- | Uses 'fromIntegral' when the input is between -9,007,199,254,740,991 and
-- 9,007,199,254,740,991 inclusive.
instance TryCast.TryCast Natural.Natural Double where
  tryCast :: Natural -> Either (TryCastException Natural Double) Double
tryCast = (Natural -> Maybe Double)
-> Natural -> Either (TryCastException Natural Double) Double
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast
    ((Natural -> Maybe Double)
 -> Natural -> Either (TryCastException Natural Double) Double)
-> (Natural -> Maybe Double)
-> Natural
-> Either (TryCastException Natural Double) Double
forall a b. (a -> b) -> a -> b
$ \Natural
s -> if Natural
s Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
forall a. Num a => a
maxDouble then Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Natural -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
s else Maybe Double
forall a. Maybe a
Nothing

-- Float

-- | Converts via 'Integer'.
instance TryCast.TryCast Float Int.Int8 where
  tryCast :: Float -> Either (TryCastException Float Int8) Int8
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Float Int.Int16 where
  tryCast :: Float -> Either (TryCastException Float Int16) Int16
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Float Int.Int32 where
  tryCast :: Float -> Either (TryCastException Float Int32) Int32
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Float Int.Int64 where
  tryCast :: Float -> Either (TryCastException Float Int64) Int64
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Float Int where
  tryCast :: Float -> Either (TryCastException Float Int) Int
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Rational' when the input is between -16,777,215 and
-- 16,777,215 inclusive.
instance TryCast.TryCast Float Integer where
  tryCast :: Float -> Either (TryCastException Float Integer) Integer
tryCast Float
s = case Float -> Either (TryCastException Float Integer) Integer
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Rational Float
s of
    Left TryCastException Float Integer
e -> TryCastException Float Integer
-> Either (TryCastException Float Integer) Integer
forall a b. a -> Either a b
Left TryCastException Float Integer
e
    Right Integer
t -> if -Integer
forall a. Num a => a
maxFloat Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
t Bool -> Bool -> Bool
&& Integer
t Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
forall a. Num a => a
maxFloat
      then Integer -> Either (TryCastException Float Integer) Integer
forall a b. b -> Either a b
Right Integer
t
      else TryCastException Float Integer
-> Either (TryCastException Float Integer) Integer
forall a b. a -> Either a b
Left (TryCastException Float Integer
 -> Either (TryCastException Float Integer) Integer)
-> TryCastException Float Integer
-> Either (TryCastException Float Integer) Integer
forall a b. (a -> b) -> a -> b
$ Float -> TryCastException Float Integer
forall source target. source -> TryCastException source target
TryCastException.TryCastException Float
s

-- | Converts via 'Integer'.
instance TryCast.TryCast Float Word.Word8 where
  tryCast :: Float -> Either (TryCastException Float Word8) Word8
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Float Word.Word16 where
  tryCast :: Float -> Either (TryCastException Float Word16) Word16
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Float Word.Word32 where
  tryCast :: Float -> Either (TryCastException Float Word32) Word32
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Float Word.Word64 where
  tryCast :: Float -> Either (TryCastException Float Word64) Word64
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Float Word where
  tryCast :: Float -> Either (TryCastException Float Word) Word
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Float Natural.Natural where
  tryCast :: Float -> Either (TryCastException Float Natural) Natural
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Uses 'toRational' when the input is not NaN or infinity.
instance TryCast.TryCast Float Rational where
  tryCast :: Float -> Either (TryCastException Float Rational) Rational
tryCast = (Float -> Maybe Rational)
-> Float -> Either (TryCastException Float Rational) Rational
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast
    ((Float -> Maybe Rational)
 -> Float -> Either (TryCastException Float Rational) Rational)
-> (Float -> Maybe Rational)
-> Float
-> Either (TryCastException Float Rational) Rational
forall a b. (a -> b) -> a -> b
$ \Float
s -> if Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
s Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
s then Maybe Rational
forall a. Maybe a
Nothing else Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ Float -> Rational
forall a. Real a => a -> Rational
toRational Float
s

-- | Uses 'realToFrac'.
instance Cast.Cast Float Double where
  cast :: Float -> Double
cast = Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- Double

-- | Converts via 'Integer'.
instance TryCast.TryCast Double Int.Int8 where
  tryCast :: Double -> Either (TryCastException Double Int8) Int8
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Double Int.Int16 where
  tryCast :: Double -> Either (TryCastException Double Int16) Int16
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Double Int.Int32 where
  tryCast :: Double -> Either (TryCastException Double Int32) Int32
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Double Int.Int64 where
  tryCast :: Double -> Either (TryCastException Double Int64) Int64
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Double Int where
  tryCast :: Double -> Either (TryCastException Double Int) Int
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Rational' when the input is between -9,007,199,254,740,991
-- and 9,007,199,254,740,991 inclusive.
instance TryCast.TryCast Double Integer where
  tryCast :: Double -> Either (TryCastException Double Integer) Integer
tryCast Double
s = case Double -> Either (TryCastException Double Integer) Integer
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Rational Double
s of
    Left TryCastException Double Integer
e -> TryCastException Double Integer
-> Either (TryCastException Double Integer) Integer
forall a b. a -> Either a b
Left TryCastException Double Integer
e
    Right Integer
t -> if -Integer
forall a. Num a => a
maxDouble Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
t Bool -> Bool -> Bool
&& Integer
t Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
forall a. Num a => a
maxDouble
      then Integer -> Either (TryCastException Double Integer) Integer
forall a b. b -> Either a b
Right Integer
t
      else TryCastException Double Integer
-> Either (TryCastException Double Integer) Integer
forall a b. a -> Either a b
Left (TryCastException Double Integer
 -> Either (TryCastException Double Integer) Integer)
-> TryCastException Double Integer
-> Either (TryCastException Double Integer) Integer
forall a b. (a -> b) -> a -> b
$ Double -> TryCastException Double Integer
forall source target. source -> TryCastException source target
TryCastException.TryCastException Double
s

-- | Converts via 'Integer'.
instance TryCast.TryCast Double Word.Word8 where
  tryCast :: Double -> Either (TryCastException Double Word8) Word8
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Double Word.Word16 where
  tryCast :: Double -> Either (TryCastException Double Word16) Word16
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Double Word.Word32 where
  tryCast :: Double -> Either (TryCastException Double Word32) Word32
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Double Word.Word64 where
  tryCast :: Double -> Either (TryCastException Double Word64) Word64
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Double Word where
  tryCast :: Double -> Either (TryCastException Double Word) Word
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Converts via 'Integer'.
instance TryCast.TryCast Double Natural.Natural where
  tryCast :: Double -> Either (TryCastException Double Natural) Natural
tryCast = forall source target through.
(Identity Integer ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
forall u source target through.
(Identity u ~ through, TryCast source through,
 TryCast through target) =>
source -> Either (TryCastException source target) target
Utility.tryVia @Integer

-- | Uses 'toRational' when the input is not NaN or infinity.
instance TryCast.TryCast Double Rational where
  tryCast :: Double -> Either (TryCastException Double Rational) Rational
tryCast = (Double -> Maybe Rational)
-> Double -> Either (TryCastException Double Rational) Rational
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast
    ((Double -> Maybe Rational)
 -> Double -> Either (TryCastException Double Rational) Rational)
-> (Double -> Maybe Rational)
-> Double
-> Either (TryCastException Double Rational) Rational
forall a b. (a -> b) -> a -> b
$ \Double
s -> if Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
s Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
s then Maybe Rational
forall a. Maybe a
Nothing else Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a. Real a => a -> Rational
toRational Double
s

-- | Uses 'realToFrac'. This necessarily loses some precision.
instance Cast.Cast Double Float where
  cast :: Double -> Float
cast = Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- Ratio

-- | Uses '(Ratio.%)' with a denominator of 1.
instance Integral a => Cast.Cast a (Ratio.Ratio a) where
  cast :: a -> Ratio a
cast = (a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
Ratio.% a
1)

-- | Uses 'Ratio.numerator' when the denominator is 1.
instance (Eq a, Num a) => TryCast.TryCast (Ratio.Ratio a) a where
  tryCast :: Ratio a -> Either (TryCastException (Ratio a) a) a
tryCast = (Ratio a -> Maybe a)
-> Ratio a -> Either (TryCastException (Ratio a) a) a
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast ((Ratio a -> Maybe a)
 -> Ratio a -> Either (TryCastException (Ratio a) a) a)
-> (Ratio a -> Maybe a)
-> Ratio a
-> Either (TryCastException (Ratio a) a) a
forall a b. (a -> b) -> a -> b
$ \Ratio a
s ->
    if Ratio a -> a
forall a. Ratio a -> a
Ratio.denominator Ratio a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Ratio a -> a
forall a. Ratio a -> a
Ratio.numerator Ratio a
s else Maybe a
forall a. Maybe a
Nothing

-- | Uses 'fromRational'. This necessarily loses some precision.
instance Cast.Cast Rational Float where
  cast :: Rational -> Float
cast = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational

-- | Uses 'fromRational'. This necessarily loses some precision.
instance Cast.Cast Rational Double where
  cast :: Rational -> Double
cast = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational

-- Fixed

-- | Uses 'Fixed.MkFixed'. This means @cast 2 :: Centi@ is @0.02@ rather than
-- @2.00@.
instance Cast.Cast Integer (Fixed.Fixed a) where
  cast :: Integer -> Fixed a
cast = Integer -> Fixed a
forall k (a :: k). Integer -> Fixed a
Fixed.MkFixed

-- | Uses 'Fixed.MkFixed'. This means @cast (3.00 :: Centi)@ is @300@ rather
-- than @3@.
instance Cast.Cast (Fixed.Fixed a) Integer where
  cast :: Fixed a -> Integer
cast (Fixed.MkFixed Integer
t) = Integer
t

-- Complex

-- | Uses '(Complex.:+)' with an imaginary part of 0.
instance Num a => Cast.Cast a (Complex.Complex a) where
  cast :: a -> Complex a
cast = (a -> a -> Complex a
forall a. a -> a -> Complex a
Complex.:+ a
0)

-- | Uses 'Complex.realPart' when the imaginary part is 0.
instance (Eq a, Num a) => TryCast.TryCast (Complex.Complex a) a where
  tryCast :: Complex a -> Either (TryCastException (Complex a) a) a
tryCast = (Complex a -> Maybe a)
-> Complex a -> Either (TryCastException (Complex a) a) a
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast ((Complex a -> Maybe a)
 -> Complex a -> Either (TryCastException (Complex a) a) a)
-> (Complex a -> Maybe a)
-> Complex a
-> Either (TryCastException (Complex a) a) a
forall a b. (a -> b) -> a -> b
$ \Complex a
s ->
    if Complex a -> a
forall a. Complex a -> a
Complex.imagPart Complex a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Complex a -> a
forall a. Complex a -> a
Complex.realPart Complex a
s else Maybe a
forall a. Maybe a
Nothing

-- NonEmpty

-- | Uses 'NonEmpty.nonEmpty'.
instance TryCast.TryCast [a] (NonEmpty.NonEmpty a) where
  tryCast :: [a] -> Either (TryCastException [a] (NonEmpty a)) (NonEmpty a)
tryCast = ([a] -> Maybe (NonEmpty a))
-> [a] -> Either (TryCastException [a] (NonEmpty a)) (NonEmpty a)
forall s t. (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty

-- | Uses 'NonEmpty.toList'.
instance Cast.Cast (NonEmpty.NonEmpty a) [a] where
  cast :: NonEmpty a -> [a]
cast = NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList

-- Set

-- | Uses 'Set.fromList'.
instance Ord a => Cast.Cast [a] (Set.Set a) where
  cast :: [a] -> Set a
cast = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList

-- | Uses 'Set.toAscList'.
instance Cast.Cast (Set.Set a) [a] where
  cast :: Set a -> [a]
cast = Set a -> [a]
forall a. Set a -> [a]
Set.toAscList

-- IntSet

-- | Uses 'IntSet.fromList'.
instance Cast.Cast [Int] IntSet.IntSet where
  cast :: [Int] -> IntSet
cast = [Int] -> IntSet
IntSet.fromList

-- | Uses 'IntSet.toAscList'.
instance Cast.Cast IntSet.IntSet [Int] where
  cast :: IntSet -> [Int]
cast = IntSet -> [Int]
IntSet.toAscList

-- Map

-- | Uses 'Map.fromList'. If there are duplicate keys, later values will
-- overwrite earlier ones.
instance Ord k => Cast.Cast [(k, v)] (Map.Map k v) where
  cast :: [(k, v)] -> Map k v
cast = [(k, v)] -> Map k v
forall k v. Ord k => [(k, v)] -> Map k v
Map.fromList

-- | Uses 'Map.toAscList'.
instance Cast.Cast (Map.Map k v) [(k, v)] where
  cast :: Map k v -> [(k, v)]
cast = Map k v -> [(k, v)]
forall k v. Map k v -> [(k, v)]
Map.toAscList

-- IntMap

-- | Uses 'IntMap.fromList'. If there are duplicate keys, later values will
-- overwrite earlier ones.
instance Cast.Cast [(Int, v)] (IntMap.IntMap v) where
  cast :: [(Int, v)] -> IntMap v
cast = [(Int, v)] -> IntMap v
forall v. [(Int, v)] -> IntMap v
IntMap.fromList

-- | Uses 'IntMap.toAscList'.
instance Cast.Cast (IntMap.IntMap v) [(Int, v)] where
  cast :: IntMap v -> [(Int, v)]
cast = IntMap v -> [(Int, v)]
forall v. IntMap v -> [(Int, v)]
IntMap.toAscList

-- Seq

-- | Uses 'Seq.fromList'.
instance Cast.Cast [a] (Seq.Seq a) where
  cast :: [a] -> Seq a
cast = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList

-- | Uses 'Foldable.toList'.
instance Cast.Cast (Seq.Seq a) [a] where
  cast :: Seq a -> [a]
cast = Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList

-- ByteString

-- | Uses 'ByteString.pack'.
instance Cast.Cast [Word.Word8] ByteString.ByteString where
  cast :: [Word8] -> ByteString
cast = [Word8] -> ByteString
ByteString.pack

-- | Uses 'ByteString.unpack'.
instance Cast.Cast ByteString.ByteString [Word.Word8] where
  cast :: ByteString -> [Word8]
cast = ByteString -> [Word8]
ByteString.unpack

-- | Uses 'LazyByteString.fromStrict'.
instance Cast.Cast ByteString.ByteString LazyByteString.ByteString where
  cast :: ByteString -> ByteString
cast = ByteString -> ByteString
LazyByteString.fromStrict

-- | Uses 'ShortByteString.toShort'.
instance Cast.Cast ByteString.ByteString ShortByteString.ShortByteString where
  cast :: ByteString -> ShortByteString
cast = ByteString -> ShortByteString
ShortByteString.toShort

-- | Uses 'Text.decodeUtf8''.
instance TryCast.TryCast ByteString.ByteString Text.Text where
  tryCast :: ByteString -> Either (TryCastException ByteString Text) Text
tryCast ByteString
s = case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
s of
    Left UnicodeException
_ -> TryCastException ByteString Text
-> Either (TryCastException ByteString Text) Text
forall a b. a -> Either a b
Left (TryCastException ByteString Text
 -> Either (TryCastException ByteString Text) Text)
-> TryCastException ByteString Text
-> Either (TryCastException ByteString Text) Text
forall a b. (a -> b) -> a -> b
$ ByteString -> TryCastException ByteString Text
forall source target. source -> TryCastException source target
TryCastException.TryCastException ByteString
s
    Right Text
t -> Text -> Either (TryCastException ByteString Text) Text
forall a b. b -> Either a b
Right Text
t

-- LazyByteString

-- | Uses 'LazyByteString.pack'.
instance Cast.Cast [Word.Word8] LazyByteString.ByteString where
  cast :: [Word8] -> ByteString
cast = [Word8] -> ByteString
LazyByteString.pack

-- | Uses 'LazyByteString.unpack'.
instance Cast.Cast LazyByteString.ByteString [Word.Word8] where
  cast :: ByteString -> [Word8]
cast = ByteString -> [Word8]
LazyByteString.unpack

-- | Uses 'LazyByteString.toStrict'.
instance Cast.Cast LazyByteString.ByteString ByteString.ByteString where
  cast :: ByteString -> ByteString
cast = ByteString -> ByteString
LazyByteString.toStrict

-- | Uses 'LazyText.decodeUtf8''.
instance TryCast.TryCast LazyByteString.ByteString LazyText.Text where
  tryCast :: ByteString -> Either (TryCastException ByteString Text) Text
tryCast ByteString
s = case ByteString -> Either UnicodeException Text
LazyText.decodeUtf8' ByteString
s of
    Left UnicodeException
_ -> TryCastException ByteString Text
-> Either (TryCastException ByteString Text) Text
forall a b. a -> Either a b
Left (TryCastException ByteString Text
 -> Either (TryCastException ByteString Text) Text)
-> TryCastException ByteString Text
-> Either (TryCastException ByteString Text) Text
forall a b. (a -> b) -> a -> b
$ ByteString -> TryCastException ByteString Text
forall source target. source -> TryCastException source target
TryCastException.TryCastException ByteString
s
    Right Text
t -> Text -> Either (TryCastException ByteString Text) Text
forall a b. b -> Either a b
Right Text
t

-- ShortByteString

-- | Uses 'ShortByteString.pack'.
instance Cast.Cast [Word.Word8] ShortByteString.ShortByteString where
  cast :: [Word8] -> ShortByteString
cast = [Word8] -> ShortByteString
ShortByteString.pack

-- | Uses 'ShortByteString.unpack'.
instance Cast.Cast ShortByteString.ShortByteString [Word.Word8] where
  cast :: ShortByteString -> [Word8]
cast = ShortByteString -> [Word8]
ShortByteString.unpack

-- | Uses 'ShortByteString.fromShort'.
instance Cast.Cast ShortByteString.ShortByteString ByteString.ByteString where
  cast :: ShortByteString -> ByteString
cast = ShortByteString -> ByteString
ShortByteString.fromShort

-- Text

-- | Uses 'Text.pack'. Some 'Char' values cannot be represented in 'Text.Text'
-- and will be replaced with @'\\xFFFD'@.
instance Cast.Cast String Text.Text where
  cast :: String -> Text
cast = String -> Text
Text.pack

-- | Uses 'Text.unpack'.
instance Cast.Cast Text.Text String where
  cast :: Text -> String
cast = Text -> String
Text.unpack

-- | Uses 'LazyText.fromStrict'.
instance Cast.Cast Text.Text LazyText.Text where
  cast :: Text -> Text
cast = Text -> Text
LazyText.fromStrict

-- | Uses 'Text.encodeUtf8'.
instance Cast.Cast Text.Text ByteString.ByteString where
  cast :: Text -> ByteString
cast = Text -> ByteString
Text.encodeUtf8

-- LazyText

-- | Uses 'LazyText.pack'. Some 'Char' values cannot be represented in
-- 'LazyText.Text' and will be replaced with @'\\xFFFD'@.
instance Cast.Cast String LazyText.Text where
  cast :: String -> Text
cast = String -> Text
LazyText.pack

-- | Uses 'LazyText.unpack'.
instance Cast.Cast LazyText.Text String where
  cast :: Text -> String
cast = Text -> String
LazyText.unpack

-- | Uses 'LazyText.toStrict'.
instance Cast.Cast LazyText.Text Text.Text where
  cast :: Text -> Text
cast = Text -> Text
LazyText.toStrict

-- | Uses 'LazyText.encodeUtf8'.
instance Cast.Cast LazyText.Text LazyByteString.ByteString where
  cast :: Text -> ByteString
cast = Text -> ByteString
LazyText.encodeUtf8

instance Cast.Cast (TryCastException.TryCastException s t0) (TryCastException.TryCastException s t1)

fromNonNegativeIntegral :: (Integral s, Num t) => s -> Maybe t
fromNonNegativeIntegral :: s -> Maybe t
fromNonNegativeIntegral s
x = if s
x s -> s -> Bool
forall a. Ord a => a -> a -> Bool
< s
0 then Maybe t
forall a. Maybe a
Nothing else t -> Maybe t
forall a. a -> Maybe a
Just (t -> Maybe t) -> t -> Maybe t
forall a b. (a -> b) -> a -> b
$ s -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral s
x

maybeTryCast
  :: (s -> Maybe t) -> s -> Either (TryCastException.TryCastException s t) t
maybeTryCast :: (s -> Maybe t) -> s -> Either (TryCastException s t) t
maybeTryCast s -> Maybe t
f s
s = case s -> Maybe t
f s
s of
  Maybe t
Nothing -> TryCastException s t -> Either (TryCastException s t) t
forall a b. a -> Either a b
Left (TryCastException s t -> Either (TryCastException s t) t)
-> TryCastException s t -> Either (TryCastException s t) t
forall a b. (a -> b) -> a -> b
$ s -> TryCastException s t
forall source target. source -> TryCastException source target
TryCastException.TryCastException s
s
  Just t
t -> t -> Either (TryCastException s t) t
forall a b. b -> Either a b
Right t
t

-- | The maximum integral value that can be unambiguously represented as a
-- 'Float'. Equal to 16,777,215.
maxFloat :: Num a => a
maxFloat :: a
maxFloat = a
16777215

-- | The maximum integral value that can be unambiguously represented as a
-- 'Double'. Equal to 9,007,199,254,740,991.
maxDouble :: Num a => a
maxDouble :: a
maxDouble = a
9007199254740991