From 12bb30d4eef1112f83fe7d9e7beb1edff314f057 Mon Sep 17 00:00:00 2001
From: Taylor Fausak <taylor@fausak.me>
Date: Sat, 17 Apr 2021 16:31:16 +0000
Subject: [PATCH] Add conversions from integral types into floating point

---
 src/lib/Witch/Instances.hs |  96 +++++++++++++++++++++++++++
 src/test/Main.hs           | 131 +++++++++++++++++++++++++++++++++++++
 2 files changed, 227 insertions(+)

diff --git a/src/lib/Witch/Instances.hs b/src/lib/Witch/Instances.hs
index 822c19a..c70da6c 100644
--- a/src/lib/Witch/Instances.hs
+++ b/src/lib/Witch/Instances.hs
@@ -59,6 +59,12 @@ instance TryCast.TryCast Int.Int8 Word where
 instance TryCast.TryCast Int.Int8 Natural.Natural where
   tryCast = maybeTryCast fromNonNegativeIntegral
 
+instance Cast.Cast Int.Int8 Float where
+  cast = fromIntegral
+
+instance Cast.Cast Int.Int8 Double where
+  cast = fromIntegral
+
 -- Int16
 
 instance TryCast.TryCast Int.Int16 Int.Int8 where
@@ -94,6 +100,12 @@ instance TryCast.TryCast Int.Int16 Word where
 instance TryCast.TryCast Int.Int16 Natural.Natural where
   tryCast = maybeTryCast fromNonNegativeIntegral
 
+instance Cast.Cast Int.Int16 Float where
+  cast = fromIntegral
+
+instance Cast.Cast Int.Int16 Double where
+  cast = fromIntegral
+
 -- Int32
 
 instance TryCast.TryCast Int.Int32 Int.Int8 where
@@ -129,6 +141,13 @@ instance TryCast.TryCast Int.Int32 Word where
 instance TryCast.TryCast Int.Int32 Natural.Natural where
   tryCast = maybeTryCast fromNonNegativeIntegral
 
+instance TryCast.TryCast Int.Int32 Float where
+  tryCast = maybeTryCast $ \s ->
+    if -16777216 <= s && s <= 16777216 then Just $ fromIntegral s else Nothing
+
+instance Cast.Cast Int.Int32 Double where
+  cast = fromIntegral
+
 -- Int64
 
 instance TryCast.TryCast Int.Int64 Int.Int8 where
@@ -164,6 +183,16 @@ instance TryCast.TryCast Int.Int64 Word where
 instance TryCast.TryCast Int.Int64 Natural.Natural where
   tryCast = maybeTryCast fromNonNegativeIntegral
 
+instance TryCast.TryCast Int.Int64 Float where
+  tryCast = maybeTryCast $ \s ->
+    if -16777216 <= s && s <= 16777216 then Just $ fromIntegral s else Nothing
+
+instance TryCast.TryCast Int.Int64 Double where
+  tryCast = maybeTryCast $ \s ->
+    if -9007199254740992 <= s && s <= 9007199254740992
+      then Just $ fromIntegral s
+      else Nothing
+
 -- Int
 
 instance TryCast.TryCast Int Int.Int8 where
@@ -199,6 +228,18 @@ instance TryCast.TryCast Int Word where
 instance TryCast.TryCast Int Natural.Natural where
   tryCast = maybeTryCast fromNonNegativeIntegral
 
+instance TryCast.TryCast Int Float where
+  tryCast = maybeTryCast $ \s ->
+    if -16777216 <= s && s <= 16777216 then Just $ fromIntegral s else Nothing
+
+instance TryCast.TryCast Int Double where
+  tryCast = maybeTryCast $ \s ->
+    if toInteger (maxBound :: Int) <= 9007199254740992
+      then Just $ fromIntegral s
+      else if -9007199254740992 <= s && s <= 9007199254740992
+        then Just $ fromIntegral s
+        else Nothing
+
 -- Integer
 
 instance TryCast.TryCast Integer Int.Int8 where
@@ -239,6 +280,16 @@ instance TryCast.TryCast Integer Natural.Natural where
   tryCast =
     maybeTryCast $ \s -> if s < 0 then Nothing else Just $ fromInteger s
 
+instance TryCast.TryCast Integer Float where
+  tryCast = maybeTryCast $ \s ->
+    if -16777216 <= s && s <= 16777216 then Just $ fromIntegral s else Nothing
+
+instance TryCast.TryCast Integer Double where
+  tryCast = maybeTryCast $ \s ->
+    if -9007199254740992 <= s && s <= 9007199254740992
+      then Just $ fromIntegral s
+      else Nothing
+
 -- Word8
 
 instance Cast.Cast Word.Word8 Word.Word16 where
@@ -274,6 +325,12 @@ instance Cast.Cast Word.Word8 Int where
 instance Cast.Cast Word.Word8 Integer where
   cast = fromIntegral
 
+instance Cast.Cast Word.Word8 Float where
+  cast = fromIntegral
+
+instance Cast.Cast Word.Word8 Double where
+  cast = fromIntegral
+
 -- Word16
 
 instance TryCast.TryCast Word.Word16 Word.Word8 where
@@ -309,6 +366,12 @@ instance Cast.Cast Word.Word16 Int where
 instance Cast.Cast Word.Word16 Integer where
   cast = fromIntegral
 
+instance Cast.Cast Word.Word16 Float where
+  cast = fromIntegral
+
+instance Cast.Cast Word.Word16 Double where
+  cast = fromIntegral
+
 -- Word32
 
 instance TryCast.TryCast Word.Word32 Word.Word8 where
@@ -344,6 +407,13 @@ instance TryCast.TryCast Word.Word32 Int where
 instance Cast.Cast Word.Word32 Integer where
   cast = fromIntegral
 
+instance TryCast.TryCast Word.Word32 Float where
+  tryCast = maybeTryCast $ \s ->
+    if s <= 16777216 then Just $ fromIntegral s else Nothing
+
+instance Cast.Cast Word.Word32 Double where
+  cast = fromIntegral
+
 -- Word64
 
 instance TryCast.TryCast Word.Word64 Word.Word8 where
@@ -379,6 +449,14 @@ instance TryCast.TryCast Word.Word64 Int where
 instance Cast.Cast Word.Word64 Integer where
   cast = fromIntegral
 
+instance TryCast.TryCast Word.Word64 Float where
+  tryCast = maybeTryCast $ \s ->
+    if s <= 16777216 then Just $ fromIntegral s else Nothing
+
+instance TryCast.TryCast Word.Word64 Double where
+  tryCast = maybeTryCast $ \s ->
+    if s <= 9007199254740992 then Just $ fromIntegral s else Nothing
+
 -- Word
 
 instance TryCast.TryCast Word Word.Word8 where
@@ -414,6 +492,16 @@ instance TryCast.TryCast Word Int where
 instance Cast.Cast Word Integer where
   cast = fromIntegral
 
+instance TryCast.TryCast Word Float where
+  tryCast = maybeTryCast $ \s ->
+    if s <= 16777216 then Just $ fromIntegral s else Nothing
+
+instance TryCast.TryCast Word Double where
+  tryCast = maybeTryCast $ \s ->
+    if toInteger (maxBound :: Word) <= 9007199254740992
+      then Just $ fromIntegral s
+      else if s <= 9007199254740992 then Just $ fromIntegral s else Nothing
+
 -- Natural
 
 instance TryCast.TryCast Natural.Natural Word.Word8 where
@@ -449,6 +537,14 @@ instance TryCast.TryCast Natural.Natural Int where
 instance Cast.Cast Natural.Natural Integer where
   cast = fromIntegral
 
+instance TryCast.TryCast Natural.Natural Float where
+  tryCast = maybeTryCast $ \s ->
+    if s <= 16777216 then Just $ fromIntegral s else Nothing
+
+instance TryCast.TryCast Natural.Natural Double where
+  tryCast = maybeTryCast $ \s ->
+    if s <= 9007199254740992 then Just $ fromIntegral s else Nothing
+
 -- Ratio
 
 instance Integral a => Cast.Cast a (Ratio.Ratio a) where
diff --git a/src/test/Main.hs b/src/test/Main.hs
index 6431e55..f0c97f4 100644
--- a/src/test/Main.hs
+++ b/src/test/Main.hs
@@ -103,6 +103,16 @@ tests =
     , tryCast @Int8 @Natural 127 ~?= Right 127
     , tryCast @Int8 @Natural (-1) ~?& isLeft
     ]
+  , "Cast Int8 Float" ~:
+    [ cast @Int8 @Float 0 ~?= 0
+    , cast @Int8 @Float 127 ~?= 127
+    , cast @Int8 @Float (-128) ~?= (-128)
+    ]
+  , "Cast Int8 Double" ~:
+    [ cast @Int8 @Double 0 ~?= 0
+    , cast @Int8 @Double 127 ~?= 127
+    , cast @Int8 @Double (-128) ~?= (-128)
+    ]
 
   -- Int16
 
@@ -164,6 +174,16 @@ tests =
     , tryCast @Int16 @Natural 32767 ~?= Right 32767
     , tryCast @Int16 @Natural (-1) ~?& isLeft
     ]
+  , "Cast Int16 Float" ~:
+    [ cast @Int16 @Float 0 ~?= 0
+    , cast @Int16 @Float 32767 ~?= 32767
+    , cast @Int16 @Float (-32768) ~?= (-32768)
+    ]
+  , "Cast Int16 Double" ~:
+    [ cast @Int16 @Double 0 ~?= 0
+    , cast @Int16 @Double 32767 ~?= 32767
+    , cast @Int16 @Double (-32768) ~?= (-32768)
+    ]
 
   -- Int32
 
@@ -230,6 +250,18 @@ tests =
     , tryCast @Int32 @Natural 2147483647 ~?= Right 2147483647
     , tryCast @Int32 @Natural (-1) ~?& isLeft
     ]
+  , "TryCast Int32 Float" ~:
+    [ tryCast @Int32 @Float 0 ~?= Right 0
+    , tryCast @Int32 @Float 16777216 ~?= Right 16777216
+    , tryCast @Int32 @Float 16777217 ~?& isLeft
+    , tryCast @Int32 @Float (-16777216) ~?= Right (-16777216)
+    , tryCast @Int32 @Float (-16777217) ~?& isLeft
+    ]
+  , "Cast Int32 Double" ~:
+    [ cast @Int32 @Double 0 ~?= 0
+    , cast @Int32 @Double 2147483647 ~?= 2147483647
+    , cast @Int32 @Double (-2147483648) ~?= (-2147483648)
+    ]
 
   -- Int64
 
@@ -298,6 +330,20 @@ tests =
     , tryCast @Int64 @Natural 9223372036854775807 ~?= Right 9223372036854775807
     , tryCast @Int64 @Natural (-1) ~?& isLeft
     ]
+  , "TryCast Int64 Float" ~:
+    [ tryCast @Int64 @Float 0 ~?= Right 0
+    , tryCast @Int64 @Float 16777216 ~?= Right 16777216
+    , tryCast @Int64 @Float 16777217 ~?& isLeft
+    , tryCast @Int64 @Float (-16777216) ~?= Right (-16777216)
+    , tryCast @Int64 @Float (-16777217) ~?& isLeft
+    ]
+  , "TryCast Int64 Double" ~:
+    [ tryCast @Int64 @Double 0 ~?= Right 0
+    , tryCast @Int64 @Double 9007199254740992 ~?= Right 9007199254740992
+    , tryCast @Int64 @Double 9007199254740993 ~?& isLeft
+    , tryCast @Int64 @Double (-9007199254740992) ~?= Right (-9007199254740992)
+    , tryCast @Int64 @Double (-9007199254740993) ~?& isLeft
+    ]
 
   -- Int
 
@@ -367,6 +413,21 @@ tests =
     , tryCast @Int @Natural maxBound ~?= Right (fromIntegral (maxBound :: Int))
     , tryCast @Int @Natural (-1) ~?& isLeft
     ]
+  , "TryCast Int Float" ~:
+    [ tryCast @Int @Float 0 ~?= Right 0
+    , tryCast @Int @Float 16777216 ~?= Right 16777216
+    , tryCast @Int @Float 16777217 ~?& isLeft
+    , tryCast @Int @Float (-16777216) ~?= Right (-16777216)
+    , tryCast @Int @Float (-16777217) ~?& isLeft
+    ]
+  , "TryCast Int Double" ~:
+    if toInteger (maxBound :: Int) <= 9007199254740992 then untested else
+    [ tryCast @Int @Double 0 ~?= Right 0
+    , tryCast @Int @Double 9007199254740992 ~?= Right 9007199254740992
+    , tryCast @Int @Double 9007199254740993 ~?& isLeft
+    , tryCast @Int @Double (-9007199254740992) ~?= Right (-9007199254740992)
+    , tryCast @Int @Double (-9007199254740993) ~?& isLeft
+    ]
 
   -- Integer
 
@@ -446,6 +507,20 @@ tests =
     , tryCast @Integer @Natural 18446744073709551616 ~?= Right 18446744073709551616
     , tryCast @Integer @Natural (-1) ~?& isLeft
     ]
+  , "TryCast Integer Float" ~:
+    [ tryCast @Integer @Float 0 ~?= Right 0
+    , tryCast @Integer @Float 16777216 ~?= Right 16777216
+    , tryCast @Integer @Float 16777217 ~?& isLeft
+    , tryCast @Integer @Float (-16777216) ~?= Right (-16777216)
+    , tryCast @Integer @Float (-16777217) ~?& isLeft
+    ]
+  , "TryCast Integer Double" ~:
+    [ tryCast @Integer @Double 0 ~?= Right 0
+    , tryCast @Integer @Double 9007199254740992 ~?= Right 9007199254740992
+    , tryCast @Integer @Double 9007199254740993 ~?& isLeft
+    , tryCast @Integer @Double (-9007199254740992) ~?= Right (-9007199254740992)
+    , tryCast @Integer @Double (-9007199254740993) ~?& isLeft
+    ]
 
   -- Word8
 
@@ -494,6 +569,14 @@ tests =
     [ cast @Word8 @Integer 0 ~?= 0
     , cast @Word8 @Integer 255 ~?= 255
     ]
+  , "Cast Word8 Float" ~:
+    [ cast @Word8 @Float 0 ~?= 0
+    , cast @Word8 @Float 255 ~?= 255
+    ]
+  , "Cast Word8 Double" ~:
+    [ cast @Word8 @Double 0 ~?= 0
+    , cast @Word8 @Double 255 ~?= 255
+    ]
 
   -- Word16
 
@@ -544,6 +627,14 @@ tests =
     [ cast @Word16 @Integer 0 ~?= 0
     , cast @Word16 @Integer 65535 ~?= 65535
     ]
+  , "Cast Word16 Float" ~:
+    [ cast @Word16 @Float 0 ~?= 0
+    , cast @Word16 @Float 65535 ~?= 65535
+    ]
+  , "Cast Word16 Double" ~:
+    [ cast @Word16 @Double 0 ~?= 0
+    , cast @Word16 @Double 65535 ~?= 65535
+    ]
 
   -- Word32
 
@@ -598,6 +689,15 @@ tests =
     [ cast @Word32 @Integer 0 ~?= 0
     , cast @Word32 @Integer 4294967295 ~?= 4294967295
     ]
+  , "TryCast Word32 Float" ~:
+    [ tryCast @Word32 @Float 0 ~?= Right 0
+    , tryCast @Word32 @Float 16777216 ~?= Right 16777216
+    , tryCast @Word32 @Float 16777217 ~?& isLeft
+    ]
+  , "Cast Word32 Double" ~:
+    [ cast @Word32 @Double 0 ~?= 0
+    , cast @Word32 @Double 4294967295 ~?= 4294967295
+    ]
 
   -- Word64
 
@@ -656,6 +756,16 @@ tests =
     [ cast @Word64 @Integer 0 ~?= 0
     , cast @Word64 @Integer 18446744073709551615 ~?= 18446744073709551615
     ]
+  , "TryCast Word64 Float" ~:
+    [ tryCast @Word64 @Float 0 ~?= Right 0
+    , tryCast @Word64 @Float 16777216 ~?= Right 16777216
+    , tryCast @Word64 @Float 16777217 ~?& isLeft
+    ]
+  , "TryCast Word64 Double" ~:
+    [ tryCast @Word64 @Double 0 ~?= Right 0
+    , tryCast @Word64 @Double 9007199254740992 ~?= Right 9007199254740992
+    , tryCast @Word64 @Double 9007199254740993 ~?& isLeft
+    ]
 
   -- Word
 
@@ -716,6 +826,17 @@ tests =
     [ cast @Word @Integer 0 ~?= 0
     , cast @Word @Integer maxBound ~?= fromIntegral (maxBound :: Word)
     ]
+  , "TryCast Word Float" ~:
+    [ tryCast @Word @Float 0 ~?= Right 0
+    , tryCast @Word @Float 16777216 ~?= Right 16777216
+    , tryCast @Word @Float 16777217 ~?& isLeft
+    ]
+  , "TryCast Word Double" ~:
+    if toInteger (maxBound :: Word) <= 9007199254740992 then untested else
+    [ tryCast @Word @Double 0 ~?= Right 0
+    , tryCast @Word @Double 9007199254740992 ~?= Right 9007199254740992
+    , tryCast @Word @Double 9007199254740993 ~?& isLeft
+    ]
 
   -- Natural
 
@@ -777,6 +898,16 @@ tests =
     [ cast @Natural @Integer 0 ~?= 0
     , cast @Natural @Integer 9223372036854775808 ~?= 9223372036854775808
     ]
+  , "TryCast Natural Float" ~:
+    [ tryCast @Natural @Float 0 ~?= Right 0
+    , tryCast @Natural @Float 16777216 ~?= Right 16777216
+    , tryCast @Natural @Float 16777217 ~?& isLeft
+    ]
+  , "TryCast Natural Double" ~:
+    [ tryCast @Natural @Double 0 ~?= Right 0
+    , tryCast @Natural @Double 9007199254740992 ~?= Right 9007199254740992
+    , tryCast @Natural @Double 9007199254740993 ~?& isLeft
+    ]
 
   -- Ratio