diff --git a/src/lib/Witch/Instances.hs b/src/lib/Witch/Instances.hs index 5d2506b..7647744 100644 --- a/src/lib/Witch/Instances.hs +++ b/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 diff --git a/src/test/Main.hs b/src/test/Main.hs index 6dc9ce6..d27a378 100644 --- a/src/test/Main.hs +++ b/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