Add instances for converting from double to integral types

src/lib/Witch/Instances.hs

@@ -594,6 +594,55 @@ instance TryCast.TryCast Float Rational where
   tryCast = maybeTryCast $ \s ->
     if isNaN s || isInfinite s then Nothing else Just $ toRational s
 
+instance Cast.Cast Float Double where
+  cast = realToFrac
+
+-- Double
+
+instance TryCast.TryCast Double Int.Int8 where
+  tryCast = tryCastVia @Integer
+
+instance TryCast.TryCast Double Int.Int16 where
+  tryCast = tryCastVia @Integer
+
+instance TryCast.TryCast Double Int.Int32 where
+  tryCast = tryCastVia @Integer
+
+instance TryCast.TryCast Double Int.Int64 where
+  tryCast = tryCastVia @Integer
+
+instance TryCast.TryCast Double Int where
+  tryCast = tryCastVia @Integer
+
+instance TryCast.TryCast Double Integer where
+  tryCast s = case tryCastVia @Rational s of
+    Left e -> Left e
+    Right t -> if -9007199254740991 <= t && t <= 9007199254740991
+      then Right t
+      else Left $ TryCastException.TryCastException s
+
+instance TryCast.TryCast Double Word.Word8 where
+  tryCast = tryCastVia @Integer
+
+instance TryCast.TryCast Double Word.Word16 where
+  tryCast = tryCastVia @Integer
+
+instance TryCast.TryCast Double Word.Word32 where
+  tryCast = tryCastVia @Integer
+
+instance TryCast.TryCast Double Word.Word64 where
+  tryCast = tryCastVia @Integer
+
+instance TryCast.TryCast Double Word where
+  tryCast = tryCastVia @Integer
+
+instance TryCast.TryCast Double Natural.Natural where
+  tryCast = tryCastVia @Integer
+
+instance TryCast.TryCast Double Rational where
+  tryCast = maybeTryCast $ \s ->
+    if isNaN s || isInfinite s then Nothing else Just $ toRational s
+
 -- Ratio
 
 instance Integral a => Cast.Cast a (Ratio.Ratio a) where

src/test/Main.hs

@@ -447,7 +447,7 @@ main = hspec . describe "Witch" $ do
       test $ tryCast @Int @Float (-16777216) `shouldSatisfy` isLeft
 
     describe "TryCast Int Double" $ do
-      when (toInteger (maxBound :: Int) <= 9007199254740991) untested
+      when (toInteger (maxBound :: Int) < 9007199254740991) untested
       test $ tryCast @Int @Double 0 `shouldBe` Right 0
       test $ tryCast @Int @Double 9007199254740991 `shouldBe` Right 9007199254740991
       test $ tryCast @Int @Double 9007199254740992 `shouldSatisfy` isLeft
@@ -862,7 +862,7 @@ main = hspec . describe "Witch" $ do
       test $ tryCast @Word @Float 16777216 `shouldSatisfy` isLeft
 
     describe "TryCast Word Double" $ do
-      when (toInteger (maxBound :: Word) <= 9007199254740991) untested
+      when (toInteger (maxBound :: Word) < 9007199254740991) untested
       test $ tryCast @Word @Double 0 `shouldBe` Right 0
       test $ tryCast @Word @Double 9007199254740991 `shouldBe` Right 9007199254740991
       test $ tryCast @Word @Double 9007199254740992 `shouldSatisfy` isLeft
@@ -1053,11 +1053,147 @@ main = hspec . describe "Witch" $ do
 
     describe "TryCast Float Rational" $ do
       test $ tryCast @Float @Rational 0 `shouldBe` Right 0
-      -- TODO
+      test $ tryCast @Float @Rational (-0) `shouldBe` Right 0
+      test $ tryCast @Float @Rational 0.5 `shouldBe` Right 0.5
+      test $ tryCast @Float @Rational (-0.5) `shouldBe` Right (-0.5)
+      test $ tryCast @Float @Rational 16777215 `shouldBe` Right 16777215
+      test $ tryCast @Float @Rational (-16777215) `shouldBe` Right (-16777215)
+      test $ tryCast @Float @Rational 16777216 `shouldBe` Right 16777216
+      test $ tryCast @Float @Rational (-16777216) `shouldBe` Right (-16777216)
       test $ tryCast @Float @Rational (0 / 0) `shouldSatisfy` isLeft
       test $ tryCast @Float @Rational (1 / 0) `shouldSatisfy` isLeft
       test $ tryCast @Float @Rational (-1 / 0) `shouldSatisfy` isLeft
 
+    describe "Cast Float Double" $ do
+      test $ cast @Float @Double 0 `shouldBe` 0
+      test $ cast @Float @Double 0.5 `shouldBe` 0.5
+      test $ cast @Float @Double (-0.5) `shouldBe` (-0.5)
+
+    -- Float
+
+    describe "TryCast Double Int8" $ do
+      test $ tryCast @Double @Int8 0 `shouldBe` Right 0
+      test $ tryCast @Double @Int8 127 `shouldBe` Right 127
+      test $ tryCast @Double @Int8 128 `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int8 (-128) `shouldBe` Right (-128)
+      test $ tryCast @Double @Int8 (-129) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int8 (0 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int8 (1 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int8 (-1 / 0) `shouldSatisfy` isLeft
+
+    describe "TryCast Double Int16" $ do
+      test $ tryCast @Double @Int16 0 `shouldBe` Right 0
+      test $ tryCast @Double @Int16 32767 `shouldBe` Right 32767
+      test $ tryCast @Double @Int16 32768 `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int16 (-32768) `shouldBe` Right (-32768)
+      test $ tryCast @Double @Int16 (-32769) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int16 (0 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int16 (1 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int16 (-1 / 0) `shouldSatisfy` isLeft
+
+    describe "TryCast Double Int32" $ do
+      test $ tryCast @Double @Int32 0 `shouldBe` Right 0
+      test $ tryCast @Double @Int32 2147483647 `shouldBe` Right 2147483647
+      test $ tryCast @Double @Int32 2147483648 `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int32 (-2147483648) `shouldBe` Right (-2147483648)
+      test $ tryCast @Double @Int32 (-2147483649) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int32 (0 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int32 (1 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int32 (-1 / 0) `shouldSatisfy` isLeft
+
+    describe "TryCast Double Int64" $ do
+      test $ tryCast @Double @Int64 0 `shouldBe` Right 0
+      test $ tryCast @Double @Int64 9007199254740991 `shouldBe` Right 9007199254740991
+      test $ tryCast @Double @Int64 9007199254740992 `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int64 (-9007199254740991) `shouldBe` Right (-9007199254740991)
+      test $ tryCast @Double @Int64 (-9007199254740992) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int64 (0 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int64 (1 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int64 (-1 / 0) `shouldSatisfy` isLeft
+
+    describe "TryCast Double Int" $ do
+      when (toInteger (maxBound :: Int) < 9007199254740991) untested
+      test $ tryCast @Double @Int 0 `shouldBe` Right 0
+      test $ tryCast @Double @Int 9007199254740991 `shouldBe` Right 9007199254740991
+      test $ tryCast @Double @Int 9007199254740992 `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int (-9007199254740991) `shouldBe` Right (-9007199254740991)
+      test $ tryCast @Double @Int (-9007199254740992) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int (0 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int (1 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Int (-1 / 0) `shouldSatisfy` isLeft
+
+    describe "TryCast Double Integer" $ do
+      test $ tryCast @Double @Integer 0 `shouldBe` Right 0
+      test $ tryCast @Double @Integer 9007199254740991 `shouldBe` Right 9007199254740991
+      test $ tryCast @Double @Integer 9007199254740992 `shouldSatisfy` isLeft
+      test $ tryCast @Double @Integer (-9007199254740991) `shouldBe` Right (-9007199254740991)
+      test $ tryCast @Double @Integer (-9007199254740992) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Integer (0 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Integer (1 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Integer (-1 / 0) `shouldSatisfy` isLeft
+
+    describe "TryCast Double Word8" $ do
+      test $ tryCast @Double @Word8 0 `shouldBe` Right 0
+      test $ tryCast @Double @Word8 255 `shouldBe` Right 255
+      test $ tryCast @Double @Word8 256 `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word8 (0 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word8 (1 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word8 (-1 / 0) `shouldSatisfy` isLeft
+
+    describe "TryCast Double Word16" $ do
+      test $ tryCast @Double @Word16 0 `shouldBe` Right 0
+      test $ tryCast @Double @Word16 65535 `shouldBe` Right 65535
+      test $ tryCast @Double @Word16 65536 `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word16 (0 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word16 (1 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word16 (-1 / 0) `shouldSatisfy` isLeft
+
+    describe "TryCast Double Word32" $ do
+      test $ tryCast @Double @Word32 0 `shouldBe` Right 0
+      test $ tryCast @Double @Word32 4294967295 `shouldBe` Right 4294967295
+      test $ tryCast @Double @Word32 4294967296 `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word32 (0 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word32 (1 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word32 (-1 / 0) `shouldSatisfy` isLeft
+
+    describe "TryCast Double Word64" $ do
+      test $ tryCast @Double @Word64 0 `shouldBe` Right 0
+      test $ tryCast @Double @Word64 9007199254740991 `shouldBe` Right 9007199254740991
+      test $ tryCast @Double @Word64 9007199254740992 `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word64 (0 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word64 (1 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word64 (-1 / 0) `shouldSatisfy` isLeft
+
+    describe "TryCast Double Word" $ do
+      when (toInteger (maxBound :: Word) < 9007199254740991) untested
+      test $ tryCast @Double @Word 0 `shouldBe` Right 0
+      test $ tryCast @Double @Word 9007199254740991 `shouldBe` Right 9007199254740991
+      test $ tryCast @Double @Word 9007199254740992 `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word (0 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word (1 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Word (-1 / 0) `shouldSatisfy` isLeft
+
+    describe "TryCast Double Natural" $ do
+      test $ tryCast @Double @Natural 0 `shouldBe` Right 0
+      test $ tryCast @Double @Natural 9007199254740991 `shouldBe` Right 9007199254740991
+      test $ tryCast @Double @Natural 9007199254740992 `shouldSatisfy` isLeft
+      test $ tryCast @Double @Natural (0 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Natural (1 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Natural (-1 / 0) `shouldSatisfy` isLeft
+
+    describe "TryCast Double Rational" $ do
+      test $ tryCast @Double @Rational 0 `shouldBe` Right 0
+      test $ tryCast @Double @Rational (-0) `shouldBe` Right 0
+      test $ tryCast @Double @Rational 0.5 `shouldBe` Right 0.5
+      test $ tryCast @Double @Rational (-0.5) `shouldBe` Right (-0.5)
+      test $ tryCast @Double @Rational 9007199254740991 `shouldBe` Right 9007199254740991
+      test $ tryCast @Double @Rational (-9007199254740991) `shouldBe` Right (-9007199254740991)
+      test $ tryCast @Double @Rational 9007199254740992 `shouldBe` Right 9007199254740992
+      test $ tryCast @Double @Rational (-9007199254740992) `shouldBe` Right (-9007199254740992)
+      test $ tryCast @Double @Rational (0 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Rational (1 / 0) `shouldSatisfy` isLeft
+      test $ tryCast @Double @Rational (-1 / 0) `shouldSatisfy` isLeft
+
     -- NonEmpty
 
     describe "TryCast [a] (NonEmpty a)" $ do