diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -5,3 +5,5 @@ [![Stackage](https://www.stackage.org/package/witch/badge/nightly?label=stackage)](https://www.stackage.org/package/witch) :mage_woman: Convert values from one type into another. + +See the documentation on Hackage: . diff --git a/src/ghc-8.10/Witch/Lift.hs b/src/ghc-8.10/Witch/Lift.hs new file mode 100644 --- /dev/null +++ b/src/ghc-8.10/Witch/Lift.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE TypeFamilies #-} + +module Witch.Lift where + +import qualified Data.Typeable as Typeable +import qualified Language.Haskell.TH.Syntax as TH +import qualified Witch.Identity as Identity +import qualified Witch.TryCast as TryCast +import qualified Witch.Utility as Utility + +-- | This is like 'Utility.unsafeCast' except that it works at compile time +-- rather than runtime. +-- +-- > -- Avoid this: +-- > unsafeCast "some literal" +-- > +-- > -- Prefer this: +-- > $$(liftedCast "some literal") +liftedCast + :: forall source target + . ( TryCast.TryCast source target + , TH.Lift target + , Show source + , Typeable.Typeable source + , Typeable.Typeable target + ) + => source + -> TH.Q (TH.TExp target) +liftedCast = TH.liftTyped . Utility.unsafeCast + +-- | This is like 'Utility.unsafeFrom' except that it works at compile time +-- rather than runtime. +-- +-- > -- Avoid this: +-- > unsafeFrom @s "some literal" +-- > +-- > -- Prefer this: +-- > $$(liftedCast @s "some literal") +liftedFrom + :: forall s target source + . ( Identity.Identity s ~ source + , TryCast.TryCast source target + , TH.Lift target + , Show source + , Typeable.Typeable source + , Typeable.Typeable target + ) + => source + -> TH.Q (TH.TExp target) +liftedFrom = liftedCast + +-- | This is like 'Utility.unsafeInto' except that it works at compile time +-- rather than runtime. +-- +-- > -- Avoid this: +-- > unsafeInto @t "some literal" +-- > +-- > -- Prefer this: +-- > $$(liftedCast @t "some literal") +liftedInto + :: forall t source target + . ( Identity.Identity t ~ target + , TryCast.TryCast source target + , TH.Lift target + , Show source + , Typeable.Typeable source + , Typeable.Typeable target + ) + => source + -> TH.Q (TH.TExp target) +liftedInto = liftedCast diff --git a/src/ghc-8.8/Witch/Lift.hs b/src/ghc-8.8/Witch/Lift.hs new file mode 100644 --- /dev/null +++ b/src/ghc-8.8/Witch/Lift.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module Witch.Lift where + +import qualified Data.Typeable as Typeable +import qualified Language.Haskell.TH.Syntax as TH +import qualified Witch.Identity as Identity +import qualified Witch.TryCast as TryCast +import qualified Witch.Utility as Utility + +-- | This is like 'Utility.unsafeCast' except that it works at compile time +-- rather than runtime. +-- +-- > -- Avoid this: +-- > unsafeCast "some literal" +-- > +-- > -- Prefer this: +-- > $$(liftedCast "some literal") +liftedCast + :: forall source target + . ( TryCast.TryCast source target + , TH.Lift target + , Show source + , Typeable.Typeable source + , Typeable.Typeable target + ) + => source + -> TH.Q (TH.TExp target) +liftedCast s = TH.unsafeTExpCoerce $ TH.lift (Utility.unsafeCast s :: target) + +-- | This is like 'Utility.unsafeFrom' except that it works at compile time +-- rather than runtime. +-- +-- > -- Avoid this: +-- > unsafeFrom @s "some literal" +-- > +-- > -- Prefer this: +-- > $$(liftedCast @s "some literal") +liftedFrom + :: forall s target source + . ( Identity.Identity s ~ source + , TryCast.TryCast source target + , TH.Lift target + , Show source + , Typeable.Typeable source + , Typeable.Typeable target + ) + => source + -> TH.Q (TH.TExp target) +liftedFrom = liftedCast + +-- | This is like 'Utility.unsafeInto' except that it works at compile time +-- rather than runtime. +-- +-- > -- Avoid this: +-- > unsafeInto @t "some literal" +-- > +-- > -- Prefer this: +-- > $$(liftedCast @t "some literal") +liftedInto + :: forall t source target + . ( Identity.Identity t ~ target + , TryCast.TryCast source target + , TH.Lift target + , Show source + , Typeable.Typeable source + , Typeable.Typeable target + ) + => source + -> TH.Q (TH.TExp target) +liftedInto = liftedCast diff --git a/src/ghc-9.0/Witch/Lift.hs b/src/ghc-9.0/Witch/Lift.hs new file mode 100644 --- /dev/null +++ b/src/ghc-9.0/Witch/Lift.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE TypeFamilies #-} + +module Witch.Lift where + +import qualified Data.Typeable as Typeable +import qualified Language.Haskell.TH.Syntax as TH +import qualified Witch.Identity as Identity +import qualified Witch.TryCast as TryCast +import qualified Witch.Utility as Utility + +-- | This is like 'Utility.unsafeCast' except that it works at compile time +-- rather than runtime. +-- +-- > -- Avoid this: +-- > unsafeCast "some literal" +-- > +-- > -- Prefer this: +-- > $$(liftedCast "some literal") +liftedCast + :: forall source target m + . ( TryCast.TryCast source target + , TH.Lift target + , Show source + , Typeable.Typeable source + , Typeable.Typeable target + , TH.Quote m + ) + => source + -> TH.Code m target +liftedCast = TH.liftTyped . Utility.unsafeCast + +-- | This is like 'Utility.unsafeFrom' except that it works at compile time +-- rather than runtime. +-- +-- > -- Avoid this: +-- > unsafeFrom @s "some literal" +-- > +-- > -- Prefer this: +-- > $$(liftedCast @s "some literal") +liftedFrom + :: forall s target m source + . ( Identity.Identity s ~ source + , TryCast.TryCast source target + , TH.Lift target + , Show source + , Typeable.Typeable source + , Typeable.Typeable target + , TH.Quote m + ) + => source + -> TH.Code m target +liftedFrom = liftedCast + +-- | This is like 'Utility.unsafeInto' except that it works at compile time +-- rather than runtime. +-- +-- > -- Avoid this: +-- > unsafeInto @t "some literal" +-- > +-- > -- Prefer this: +-- > $$(liftedCast @t "some literal") +liftedInto + :: forall t source m target + . ( Identity.Identity t ~ target + , TryCast.TryCast source target + , TH.Lift target + , Show source + , Typeable.Typeable source + , Typeable.Typeable target + , TH.Quote m + ) + => source + -> TH.Code m target +liftedInto = liftedCast diff --git a/src/lib/Witch.hs b/src/lib/Witch.hs --- a/src/lib/Witch.hs +++ b/src/lib/Witch.hs @@ -1,319 +1,161 @@ -{-# language AllowAmbiguousTypes #-} -{-# language DefaultSignatures #-} -{-# language FlexibleInstances #-} -{-# language MultiParamTypeClasses #-} -{-# language ScopedTypeVariables #-} -{-# language TypeFamilies #-} - --- | This module provides the 'Cast' type class for converting values between --- various types. This aims to be a common interface for the various @xToY@ or --- @yFromX@ functions you might write instead. It is inspired by the --- @std::convert::From@ trait that the Rust programming language provides. --- --- Many Haskell libraries already provide similar functionality. Here's how --- this module compares to them: --- --- - : --- This type class is convenient because it's automatically inferred by the --- compiler, but it only works for types that have the same runtime --- representation. --- --- - : --- This type class allows for conversions to fail. --- --- - : --- This type class is essentially the same, but the @basement@ package is an --- alternative standard library that some people may not want to depend on. --- --- - : --- This type class requires conversions to be injective, as opposed to merely --- suggesting it. Also some conversions fail at runtime. --- --- - : --- This type class comes with many convenient helper functions, but some of --- the provided instances fail at runtime. --- --- - : --- This package is not available on Hackage, but otherwise is very similar to --- this one. -module Witch (Cast(cast), from, into, via) where - -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Lazy as LazyByteString -import qualified Data.Coerce as Coerce -import qualified Data.Foldable as Foldable -import qualified Data.Int as Int -import qualified Data.List.NonEmpty as NonEmpty -import qualified Data.Map as Map -import qualified Data.Sequence as Seq -import qualified Data.Set as Set -import qualified Data.Text as Text -import qualified Data.Text.Lazy as LazyText -import qualified Data.Tuple as Tuple -import qualified Data.Void as Void -import qualified Data.Word as Word -import qualified Numeric.Natural as Natural - --- | This type class represents a way to convert values from some type into --- another type. The constraint @Cast a b@ means that you can convert from a --- value of type @a@ into a value of type @b@. --- --- This is primarily intended for "zero cost" conversions like @newtype@s. For --- example if you wanted to have a type to represent someone's name, you could --- say: --- --- > newtype Name = Name String --- > instance Cast String Name --- > instance Cast Name String --- --- And then you could convert back and forth between @Name@s and @String@s: --- --- > let someString = "Taylor" --- > let someName = Name someString --- > into @Name someString -- convert from string to name --- > into @String someName -- convert from name to string --- --- This type class does not have any laws, but it does have some expectations: --- --- - Conversions should be total. A conversion should never fail or crash. --- Avoid writing instances like @Cast Int (Maybe Char)@. (It might be --- worthwhile to have a separate @TryCast@ type class for this.) --- --- - Conversions should be unambiguous. For example there are many ways to --- decode a @ByteString@ into @Text@, so you shouldn't provide an instance --- for that. --- --- - Conversions should be cheap, ideally free. For example converting from --- @String@ to @Text@ is probably fine, but converting from a UTF-8 encoded --- @ByteString@ to @Text@ is problematic. --- --- - Conversions should be lossless. In other words if you have @Cast a b@ then --- no two @a@ values should be converted to the same @b@ value. For example --- @Cast Int Integer@ is fine because every @Int@ can be mapped to a --- corresponding @Integer@, but @Cast Integer Int@ is not good because some --- @Integer@s are out of bounds and would need to be clamped. --- --- - If you have both @Cast a b@ and @Cast b a@, then @cast . cast@ should be --- the same as 'id'. In other words @a@ and @b@ are isomorphic. +-- | The Witch package is a library that allows you to confidently convert +-- values between various types. This module exports everything you need to +-- perform conversions or define your own. It is designed to be imported +-- unqualified, so getting started is as easy as: -- --- - If you have both @Cast a b@ and @Cast b c@, then it's up to you if you --- want to provide @Cast a c@. Sometimes using 'via' is ergonomic enough, --- other times you want the extra instance. (It would be nice if we could --- provide @instance (Cast a b, Cast b c) => Cast a c where cast = via \@b@.) -class Cast source target where - -- | This method implements the conversion of a value between types. In - -- practice most instances don't need an explicit implementation. At call - -- sites you'll usually want to use 'from' or 'into' instead of 'cast'. +-- >>> import Witch +module Witch + ( -- * Motivation + -- | Haskell provides many ways to convert between common types, and core + -- libraries add even more. It can be challenging to know which function to + -- use when converting from some source type @a@ to some target type @b@. It + -- can be even harder to know if that conversion is safe or if there are any + -- pitfalls to watch out for. -- - -- The default implementation of 'cast' simply calls 'Coerce.coerce', which - -- works for types that have the same runtime representation. - cast :: source -> target - default cast :: Coerce.Coercible source target => source -> target - cast = Coerce.coerce - --- This ugly hack is used to require type applications when calling 'from' and --- 'into'. See . -data Never -type family Ambiguous a where - Ambiguous Never = () - Ambiguous a = a - --- | This function converts a value from one type into another. This is --- intended to be used with the @TypeApplications@ language extension. The --- @Ambiguous@ type in the signature makes a type application required. If --- you'd prefer not to provide a type application, use 'cast' instead. --- --- As an example, here are a few ways to convert from an 'Int' into an --- 'Integer': --- --- > from @Int @Integer 123 --- > from @_ @Integer (123 :: Int) --- > from @Int @_ 123 :: Integer --- > from @Int 123 :: Integer --- --- Often the context around an expression will make the explicit type --- signatures unnecessary. If you find yourself using a partial type --- signature, consider using 'into' instead. For example: --- --- > let someInt = 123 :: Int --- > from @_ @Integer someInt -- avoid this --- > into @Integer someInt -- prefer this --- -from :: forall s target source . (Ambiguous s ~ source, Cast source target) => source -> target -from = cast - --- | This function converts a value from one type into another. This is the --- same as 'from' except that the type variables are in the opposite order. -into :: forall t source target . (Ambiguous t ~ target, Cast source target) => source -> target -into = cast - --- | This function converts a value from one type into another by going through --- some third type. This is the same as calling 'cast' (or 'from' or 'into') --- twice, but can sometimes be more convenient. --- --- Note that the type in the middle of the conversion is the first type --- variable of this function. In other words, @via \@b \@a \@c@ first converts --- from @a@ to @b@, and then from @b@ to @c@. Often both @a@ and @c@ will be --- inferred from context, which means you can just write @via \@b@. -via :: forall through source target . (Cast source through, Cast through target) => source -> target -via = cast . (\ x -> x :: through) . cast - --- | 'id' -instance Cast a a where - cast = id - --- | 'const' -instance Cast a (x -> a) where - cast = const - --- | 'pure' -instance Cast a [a] where - cast = pure - --- | 'Just' -instance Cast a (Maybe a) where - cast = Just - --- | 'Left' -instance Cast a (Either a x) where - cast = Left - --- | 'Right' -instance Cast a (Either x a) where - cast = Right - --- | 'Void.absurd' -instance Cast Void.Void x where - cast = Void.absurd - --- | 'fst' -instance Cast (a, x) a where - cast = fst - --- | 'snd' -instance Cast (x, a) a where - cast = snd - --- | 'Tuple.swap' -instance Cast (a, b) (b, a) where - cast = Tuple.swap - --- | 'NonEmpty.toList' -instance Cast (NonEmpty.NonEmpty a) [a] where - cast = NonEmpty.toList - --- | 'fromIntegral' -instance Cast Word.Word8 Word.Word16 where - cast = fromIntegral - --- | 'fromIntegral' -instance Cast Word.Word16 Word.Word32 where - cast = fromIntegral - --- | 'fromIntegral' -instance Cast Word.Word32 Word.Word64 where - cast = fromIntegral - --- | 'fromIntegral' -instance Cast Word Natural.Natural where - cast = fromIntegral - --- | 'fromIntegral' -instance Cast Natural.Natural Integer where - cast = fromIntegral - --- | 'fromIntegral' -instance Cast Int.Int8 Int.Int16 where - cast = fromIntegral - --- | 'fromIntegral' -instance Cast Int.Int16 Int.Int32 where - cast = fromIntegral - --- | 'fromIntegral' -instance Cast Int.Int32 Int.Int64 where - cast = fromIntegral - --- | 'fromIntegral' -instance Cast Int Integer where - cast = fromIntegral - --- | 'fromIntegral' -instance Cast Integer Rational where - cast = fromIntegral - --- | 'realToFrac' -instance Cast Float Double where - cast = realToFrac - --- | 'fromEnum' -instance Cast Bool Int where - cast = fromEnum - --- | 'fromEnum' -instance Cast Char Int where - cast = fromEnum - --- | 'ByteString.pack' -instance Cast [Word.Word8] ByteString.ByteString where - cast = ByteString.pack - --- | 'ByteString.unpack' -instance Cast ByteString.ByteString [Word.Word8] where - cast = ByteString.unpack - --- | 'LazyByteString.fromStrict' -instance Cast ByteString.ByteString LazyByteString.ByteString where - cast = LazyByteString.fromStrict - --- | 'LazyByteString.toStrict' -instance Cast LazyByteString.ByteString ByteString.ByteString where - cast = LazyByteString.toStrict + -- This library tries to address that problem by providing a common + -- interface for converting between types. The 'Witch.Cast.Cast' type class + -- is for conversions that cannot fail, and the 'Witch.TryCast.TryCast' type + -- class is for conversions that can fail. These type classes are inspired + -- by the [@From@](https://doc.rust-lang.org/std/convert/trait.From.html) + -- trait in Rust. --- | 'Text.pack' --- --- Note that some 'Char' values cannot be represented in 'Text' and will be --- replaced by U+FFFD. -instance Cast String Text.Text where - cast = Text.pack + -- * Alternatives + -- | Many Haskell libraries already provide similar functionality. How is + -- this library different? + -- + -- - [@Coercible@](https://hackage.haskell.org/package/base-4.15.0.0/docs/Data-Coerce.html#t:Coercible): + -- This type class is solved by the compiler, but it only works for types + -- that have the same runtime representation. This is very convenient for + -- @newtype@s, but it does not work for converting between arbitrary types + -- like @Int8@ and @Int16@. + -- + -- - [@Convertible@](https://hackage.haskell.org/package/convertible-1.1.1.0/docs/Data-Convertible-Base.html#t:Convertible): + -- This popular conversion type class is similar to what this library + -- provides. The main difference is that it does not differentiate between + -- conversions that can fail and those that cannot. + -- + -- - [@From@](https://hackage.haskell.org/package/basement-0.0.11/docs/Basement-From.html#t:From): + -- This type class is almost identical to what this library provides. + -- Unfortunately it is part of the @basement@ package, which is an + -- alternative standard library that some people may not want to depend + -- on. + -- + -- - [@Inj@](https://hackage.haskell.org/package/inj-1.0/docs/Inj.html#t:Inj): + -- This type class requires instances to be an injection, which means that + -- no two input values should map to the same output. That restriction + -- prohibits many useful instances. Also many instances throw impure + -- exceptions. + -- + -- In addition to those general-purpose type classes, there are many + -- alternatives for more specific conversions. How does this library compare + -- to those? + -- + -- - Monomorphic conversion functions like [@Data.Text.pack@](https://hackage.haskell.org/package/text-1.2.4.1/docs/Data-Text.html#v:pack) + -- are explicit but not necessarily convenient. It can be tedious to + -- manage the imports necessary to use the functions. And if you want to + -- put them in a custom prelude, you will have to come up with your own + -- names. + -- + -- - Polymorphic conversion methods like 'toEnum' are more convenient but + -- may have unwanted semantics or runtime behavior. For example the 'Enum' + -- type class is more or less tied to the 'Int' data type and frequently + -- throws impure exceptions. + -- + -- - Polymorphic conversion functions like 'fromIntegral' are very + -- convenient. Unfortunately it can be challenging to know which types + -- have the instances necessary to make the conversion possible. And even + -- if the conversion is possible, is it safe? For example converting a + -- negative 'Int' into a 'Word' will overflow, which may be surprising. --- | 'Text.unpack' -instance Cast Text.Text String where - cast = Text.unpack + -- * Instances + -- | When should you add a 'Witch.Cast.Cast' (or 'Witch.TryCast.TryCast') + -- instance for some pair of types? This is a surprisingly tricky question + -- to answer precisely. Instances are driven more by guidelines than rules. + -- + -- - Conversions must not throw impure exceptions. This means no 'undefined' + -- or anything equivalent to it. + -- + -- - Conversions should be unambiguous. If there are multiple reasonable + -- ways to convert from @a@ to @b@, then you probably should not add a + -- @Cast@ instance for them. + -- + -- - Conversions should be lossless. If you have @Cast a b@ then no two @a@ + -- values should be converted to the same @b@ value. + -- + -- - If you have both @Cast a b@ and @Cast b a@, then + -- @cast \@b \@a . cast \@a \@b@ should be the same as 'id'. In other + -- words, @a@ and @b@ are isomorphic. + -- + -- - If you have both @Cast a b@ and @Cast b c@, then you could also have + -- @Cast a c@ and it should be the same as @cast \@b \@c . cast \@a \@b@. + -- In other words, @Cast@ is transitive. + -- + -- In general if @s@ is a @t@, then you should add a 'Witch.Cast.Cast' + -- instance for it. But if @s@ merely can be a @t@, then you could add a + -- 'Witch.TryCast.TryCast' instance for it. And if it is technically + -- possible to convert from @s@ to @t@ but there are a lot of caveats, you + -- probably should not write any instances at all. --- | 'LazyText.fromStrict' -instance Cast Text.Text LazyText.Text where - cast = LazyText.fromStrict + -- * Type applications + -- | This library is designed to be used with the [@TypeApplications@](https://downloads.haskell.org/~ghc/9.0.1/docs/html/users_guide/exts/type_applications.html) + -- language extension. Although it is not required for basic functionality, + -- it is strongly encouraged. You can use 'Witch.Cast.cast', + -- 'Witch.TryCast.tryCast', 'Witch.Utility.unsafeCast', and + -- 'Witch.Lift.liftedCast' without type applications. Everything else + -- requires a type application. --- | 'LazyText.toStrict' -instance Cast LazyText.Text Text.Text where - cast = LazyText.toStrict + -- * Ambiguous types + -- | You may see @Identity@ show up in some type signatures. Anywhere you see + -- @Identity a@, you can mentally replace it with @a@. It is a type family + -- used to trick GHC into requiring type applications for certain functions. + -- If you forget to give a type application, you will see an error like + -- this: + -- + -- >>> from (1 :: Int8) :: Int16 + -- :1:1: error: + -- * Couldn't match type `Identity s0' with `Int8' + -- arising from a use of `from' + -- The type variable `s0' is ambiguous + -- * In the expression: from (1 :: Int8) :: Int16 + -- In an equation for `it': it = from (1 :: Int8) :: Int16 + -- + -- You can fix the problem by giving a type application: + -- + -- >>> from @Int8 1 :: Int16 + -- 1 --- | 'Seq.fromList' -instance Cast [a] (Seq.Seq a) where - cast = Seq.fromList + -- * Type classes + -- ** Cast + Witch.Cast.Cast(cast) + , Witch.Utility.from + , Witch.Utility.into --- | 'Foldable.toList' -instance Cast (Seq.Seq a) [a] where - cast = Foldable.toList + -- ** TryCast + , Witch.TryCast.TryCast(tryCast) + , Witch.Utility.tryFrom + , Witch.Utility.tryInto + , Witch.TryCastException.TryCastException(..) --- | 'Set.fromList' --- --- Note that this will remove duplicate elements from the list. -instance Ord a => Cast [a] (Set.Set a) where - cast = Set.fromList + -- * Utilities + , Witch.Utility.as + , Witch.Utility.over + , Witch.Utility.via + , Witch.Utility.tryVia --- | 'Set.toAscList' -instance Cast (Set.Set a) [a] where - cast = Set.toAscList + -- ** Unsafe + , Witch.Utility.unsafeCast + , Witch.Utility.unsafeFrom + , Witch.Utility.unsafeInto --- | 'Map.fromList' --- --- Note that if there are duplicate keys in the list, the one closest to the --- end will win. -instance Ord k => Cast [(k, v)] (Map.Map k v) where - cast = Map.fromList + -- ** Template Haskell + , Witch.Lift.liftedCast + , Witch.Lift.liftedFrom + , Witch.Lift.liftedInto + ) where --- | 'Map.toAscList' -instance Cast (Map.Map k v) [(k, v)] where - cast = Map.toAscList +import qualified Witch.Cast +import Witch.Instances () +import qualified Witch.Lift +import qualified Witch.TryCast +import qualified Witch.TryCastException +import qualified Witch.Utility diff --git a/src/lib/Witch/Cast.hs b/src/lib/Witch/Cast.hs new file mode 100644 --- /dev/null +++ b/src/lib/Witch/Cast.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module Witch.Cast where + +import qualified Data.Coerce as Coerce + +-- | This type class is for converting values from some @source@ type into +-- some other @target@ type. The constraint @Cast source target@ measn that +-- you can convert from a value of type @source@ into a value of type +-- @target@. +-- +-- This type class is for conversions that cannot fail. If your conversion can +-- fail, consider implementing @TryCast@ instead. +class Cast source target where + -- | This method implements the conversion of a value between types. At call + -- sites you will usually want to use @from@ or @into@ instead of this + -- method. + -- + -- The default implementation of this method simply calls 'Coerce.coerce', + -- which works for types that have the same runtime representation. This + -- means that for @newtype@s you do not need to implement this method at + -- all. For example: + -- + -- >>> newtype Name = Name String + -- >>> instance Cast Name String + -- >>> instance Cast String Name + cast :: source -> target + + default cast :: Coerce.Coercible source target => source -> target + cast = Coerce.coerce diff --git a/src/lib/Witch/Identity.hs b/src/lib/Witch/Identity.hs new file mode 100644 --- /dev/null +++ b/src/lib/Witch/Identity.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TypeFamilies #-} + +module Witch.Identity where + +-- | This is an ugly hack used to make GHC require type applications for +-- certain functions. See this Twitter thread for a discussion: +-- . +type family Identity a where + Identity Never = () + Identity a = a + +-- | Never use this type for anything! It only exists to make the 'Identity' +-- type family non-trivial. +data Never diff --git a/src/lib/Witch/Instances.hs b/src/lib/Witch/Instances.hs new file mode 100644 --- /dev/null +++ b/src/lib/Witch/Instances.hs @@ -0,0 +1,1073 @@ +{-# 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 = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int8 Int.Int32 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int8 Int.Int64 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int8 Int where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int8 Integer where + cast = fromIntegral + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int8 Word.Word8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int8 Word.Word16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int8 Word.Word32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int8 Word.Word64 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int8 Word where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral' when the input is non-negative. +instance TryCast.TryCast Int.Int8 Natural.Natural where + tryCast = maybeTryCast fromNonNegativeIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int8 Float where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int8 Double where + cast = fromIntegral + +-- Int16 + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int16 Int.Int8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int16 Int.Int32 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int16 Int.Int64 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int16 Int where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int16 Integer where + cast = fromIntegral + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int16 Word.Word8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int16 Word.Word16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int16 Word.Word32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int16 Word.Word64 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int16 Word where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral' when the input is non-negative. +instance TryCast.TryCast Int.Int16 Natural.Natural where + tryCast = maybeTryCast fromNonNegativeIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int16 Float where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int16 Double where + cast = fromIntegral + +-- Int32 + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int32 Int.Int8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int32 Int.Int16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int32 Int.Int64 where + cast = fromIntegral + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int32 Int where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int32 Integer where + cast = fromIntegral + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int32 Word.Word8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int32 Word.Word16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int32 Word.Word32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int32 Word.Word64 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int32 Word where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral' when the input is non-negative. +instance TryCast.TryCast Int.Int32 Natural.Natural where + tryCast = maybeTryCast fromNonNegativeIntegral + +-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215 +-- inclusive. +instance TryCast.TryCast Int.Int32 Float where + tryCast = maybeTryCast $ \s -> if -maxFloat <= s && s <= maxFloat + then Just $ fromIntegral s + else Nothing + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int32 Double where + cast = fromIntegral + +-- Int64 + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int64 Int.Int8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int64 Int.Int16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int64 Int.Int32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int64 Int where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int.Int64 Integer where + cast = fromIntegral + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int64 Word.Word8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int64 Word.Word16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int64 Word.Word32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int64 Word.Word64 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int.Int64 Word where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral' when the input is non-negative. +instance TryCast.TryCast Int.Int64 Natural.Natural where + tryCast = maybeTryCast fromNonNegativeIntegral + +-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215 +-- inclusive. +instance TryCast.TryCast Int.Int64 Float where + tryCast = maybeTryCast $ \s -> if -maxFloat <= s && s <= maxFloat + then Just $ fromIntegral s + else 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 = maybeTryCast $ \s -> if -maxDouble <= s && s <= maxDouble + then Just $ fromIntegral s + else Nothing + +-- Int + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int Int.Int8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int Int.Int16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int Int.Int32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int Int.Int64 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Int Integer where + cast = fromIntegral + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int Word.Word8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int Word.Word16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int Word.Word32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int Word.Word64 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Int Word where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral' when the input is non-negative. +instance TryCast.TryCast Int Natural.Natural where + tryCast = maybeTryCast fromNonNegativeIntegral + +-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215 +-- inclusive. +instance TryCast.TryCast Int Float where + tryCast = maybeTryCast $ \s -> if -maxFloat <= s && s <= maxFloat + then Just $ fromIntegral s + else 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 = maybeTryCast $ \s -> + if (toInteger (maxBound :: Int) <= maxDouble) + || (-maxDouble <= s && s <= maxDouble) + then Just $ fromIntegral s + else Nothing + +-- Integer + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Integer Int.Int8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Integer Int.Int16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Integer Int.Int32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Integer Int.Int64 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Integer Int where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Integer Word.Word8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Integer Word.Word16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Integer Word.Word32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Integer Word.Word64 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Integer Word where + tryCast = maybeTryCast 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 = + maybeTryCast $ \s -> if s < 0 then Nothing else Just $ fromInteger s + +-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215 +-- inclusive. +instance TryCast.TryCast Integer Float where + tryCast = maybeTryCast $ \s -> if -maxFloat <= s && s <= maxFloat + then Just $ fromIntegral s + else 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 = maybeTryCast $ \s -> if -maxDouble <= s && s <= maxDouble + then Just $ fromIntegral s + else Nothing + +-- Word8 + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word8 Word.Word16 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word8 Word.Word32 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word8 Word.Word64 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word8 Word where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word8 Natural.Natural where + cast = fromIntegral + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word8 Int.Int8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word8 Int.Int16 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word8 Int.Int32 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word8 Int.Int64 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word8 Int where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word8 Integer where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word8 Float where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word8 Double where + cast = fromIntegral + +-- Word16 + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word16 Word.Word8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word16 Word.Word32 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word16 Word.Word64 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word16 Word where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word16 Natural.Natural where + cast = fromIntegral + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word16 Int.Int8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word16 Int.Int16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word16 Int.Int32 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word16 Int.Int64 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word16 Int where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word16 Integer where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word16 Float where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word16 Double where + cast = fromIntegral + +-- Word32 + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word32 Word.Word8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word32 Word.Word16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word32 Word.Word64 where + cast = fromIntegral + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word32 Word where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word32 Natural.Natural where + cast = fromIntegral + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word32 Int.Int8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word32 Int.Int16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word32 Int.Int32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word32 Int.Int64 where + cast = fromIntegral + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word32 Int where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word32 Integer where + cast = fromIntegral + +-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215 +-- inclusive. +instance TryCast.TryCast Word.Word32 Float where + tryCast = maybeTryCast + $ \s -> if s <= maxFloat then Just $ fromIntegral s else Nothing + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word32 Double where + cast = fromIntegral + +-- Word64 + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word64 Word.Word8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word64 Word.Word16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word64 Word.Word32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word64 Word where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word64 Natural.Natural where + cast = fromIntegral + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word64 Int.Int8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word64 Int.Int16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word64 Int.Int32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word64 Int.Int64 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word.Word64 Int where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word.Word64 Integer where + cast = fromIntegral + +-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215 +-- inclusive. +instance TryCast.TryCast Word.Word64 Float where + tryCast = maybeTryCast + $ \s -> if s <= maxFloat then Just $ fromIntegral s else 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 = maybeTryCast + $ \s -> if s <= maxDouble then Just $ fromIntegral s else Nothing + +-- Word + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word Word.Word8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word Word.Word16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word Word.Word32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word Word.Word64 where + cast = fromIntegral + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word Natural.Natural where + cast = fromIntegral + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word Int.Int8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word Int.Int16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word Int.Int32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word Int.Int64 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Word Int where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Word Integer where + cast = fromIntegral + +-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215 +-- inclusive. +instance TryCast.TryCast Word Float where + tryCast = maybeTryCast + $ \s -> if s <= maxFloat then Just $ fromIntegral s else 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 = maybeTryCast $ \s -> + if (toInteger (maxBound :: Word) <= maxDouble) || (s <= maxDouble) + then Just $ fromIntegral s + else Nothing + +-- Natural + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Natural.Natural Word.Word8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Natural.Natural Word.Word16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Natural.Natural Word.Word32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Natural.Natural Word.Word64 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Natural.Natural Word where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Natural.Natural Int.Int8 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Natural.Natural Int.Int16 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Natural.Natural Int.Int32 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Natural.Natural Int.Int64 where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'Bits.toIntegralSized'. +instance TryCast.TryCast Natural.Natural Int where + tryCast = maybeTryCast Bits.toIntegralSized + +-- | Uses 'fromIntegral'. +instance Cast.Cast Natural.Natural Integer where + cast = fromIntegral + +-- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215 +-- inclusive. +instance TryCast.TryCast Natural.Natural Float where + tryCast = maybeTryCast + $ \s -> if s <= maxFloat then Just $ fromIntegral s else 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 = maybeTryCast + $ \s -> if s <= maxDouble then Just $ fromIntegral s else Nothing + +-- Float + +-- | Converts via 'Integer'. +instance TryCast.TryCast Float Int.Int8 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Float Int.Int16 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Float Int.Int32 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Float Int.Int64 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Float Int where + tryCast = 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 s = case Utility.tryVia @Rational s of + Left e -> Left e + Right t -> if -maxFloat <= t && t <= maxFloat + then Right t + else Left $ TryCastException.TryCastException s + +-- | Converts via 'Integer'. +instance TryCast.TryCast Float Word.Word8 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Float Word.Word16 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Float Word.Word32 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Float Word.Word64 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Float Word where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Float Natural.Natural where + tryCast = Utility.tryVia @Integer + +-- | Uses 'toRational' when the input is not NaN or infinity. +instance TryCast.TryCast Float Rational where + tryCast = maybeTryCast + $ \s -> if isNaN s || isInfinite s then Nothing else Just $ toRational s + +-- | Uses 'realToFrac'. +instance Cast.Cast Float Double where + cast = realToFrac + +-- Double + +-- | Converts via 'Integer'. +instance TryCast.TryCast Double Int.Int8 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Double Int.Int16 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Double Int.Int32 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Double Int.Int64 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Double Int where + tryCast = 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 s = case Utility.tryVia @Rational s of + Left e -> Left e + Right t -> if -maxDouble <= t && t <= maxDouble + then Right t + else Left $ TryCastException.TryCastException s + +-- | Converts via 'Integer'. +instance TryCast.TryCast Double Word.Word8 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Double Word.Word16 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Double Word.Word32 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Double Word.Word64 where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Double Word where + tryCast = Utility.tryVia @Integer + +-- | Converts via 'Integer'. +instance TryCast.TryCast Double Natural.Natural where + tryCast = Utility.tryVia @Integer + +-- | Uses 'toRational' when the input is not NaN or infinity. +instance TryCast.TryCast Double Rational where + tryCast = maybeTryCast + $ \s -> if isNaN s || isInfinite s then Nothing else Just $ toRational s + +-- | Uses 'realToFrac'. This necessarily loses some precision. +instance Cast.Cast Double Float where + cast = realToFrac + +-- Ratio + +-- | Uses '(Ratio.%)' with a denominator of 1. +instance Integral a => Cast.Cast a (Ratio.Ratio a) where + cast = (Ratio.% 1) + +-- | Uses 'Ratio.numerator' when the denominator is 1. +instance (Eq a, Num a) => TryCast.TryCast (Ratio.Ratio a) a where + tryCast = maybeTryCast $ \s -> + if Ratio.denominator s == 1 then Just $ Ratio.numerator s else Nothing + +-- | Uses 'fromRational'. This necessarily loses some precision. +instance Cast.Cast Rational Float where + cast = fromRational + +-- | Uses 'fromRational'. This necessarily loses some precision. +instance Cast.Cast Rational Double where + cast = 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 = 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.MkFixed t) = t + +-- Complex + +-- | Uses '(Complex.:+)' with an imaginary part of 0. +instance Num a => Cast.Cast a (Complex.Complex a) where + cast = (Complex.:+ 0) + +-- | Uses 'Complex.realPart' when the imaginary part is 0. +instance (Eq a, Num a) => TryCast.TryCast (Complex.Complex a) a where + tryCast = maybeTryCast $ \s -> + if Complex.imagPart s == 0 then Just $ Complex.realPart s else Nothing + +-- NonEmpty + +-- | Uses 'NonEmpty.nonEmpty'. +instance TryCast.TryCast [a] (NonEmpty.NonEmpty a) where + tryCast = maybeTryCast NonEmpty.nonEmpty + +-- | Uses 'NonEmpty.toList'. +instance Cast.Cast (NonEmpty.NonEmpty a) [a] where + cast = NonEmpty.toList + +-- Set + +-- | Uses 'Set.fromList'. +instance Ord a => Cast.Cast [a] (Set.Set a) where + cast = Set.fromList + +-- | Uses 'Set.toAscList'. +instance Cast.Cast (Set.Set a) [a] where + cast = Set.toAscList + +-- IntSet + +-- | Uses 'IntSet.fromList'. +instance Cast.Cast [Int] IntSet.IntSet where + cast = IntSet.fromList + +-- | Uses 'IntSet.toAscList'. +instance Cast.Cast IntSet.IntSet [Int] where + cast = 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 = Map.fromList + +-- | Uses 'Map.toAscList'. +instance Cast.Cast (Map.Map k v) [(k, v)] where + cast = 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 = IntMap.fromList + +-- | Uses 'IntMap.toAscList'. +instance Cast.Cast (IntMap.IntMap v) [(Int, v)] where + cast = IntMap.toAscList + +-- Seq + +-- | Uses 'Seq.fromList'. +instance Cast.Cast [a] (Seq.Seq a) where + cast = Seq.fromList + +-- | Uses 'Foldable.toList'. +instance Cast.Cast (Seq.Seq a) [a] where + cast = Foldable.toList + +-- ByteString + +-- | Uses 'ByteString.pack'. +instance Cast.Cast [Word.Word8] ByteString.ByteString where + cast = ByteString.pack + +-- | Uses 'ByteString.unpack'. +instance Cast.Cast ByteString.ByteString [Word.Word8] where + cast = ByteString.unpack + +-- | Uses 'LazyByteString.fromStrict'. +instance Cast.Cast ByteString.ByteString LazyByteString.ByteString where + cast = LazyByteString.fromStrict + +-- | Uses 'ShortByteString.toShort'. +instance Cast.Cast ByteString.ByteString ShortByteString.ShortByteString where + cast = ShortByteString.toShort + +-- | Uses 'Text.decodeUtf8''. +instance TryCast.TryCast ByteString.ByteString Text.Text where + tryCast s = case Text.decodeUtf8' s of + Left _ -> Left $ TryCastException.TryCastException s + Right t -> Right t + +-- LazyByteString + +-- | Uses 'LazyByteString.pack'. +instance Cast.Cast [Word.Word8] LazyByteString.ByteString where + cast = LazyByteString.pack + +-- | Uses 'LazyByteString.unpack'. +instance Cast.Cast LazyByteString.ByteString [Word.Word8] where + cast = LazyByteString.unpack + +-- | Uses 'LazyByteString.toStrict'. +instance Cast.Cast LazyByteString.ByteString ByteString.ByteString where + cast = LazyByteString.toStrict + +-- | Uses 'LazyText.decodeUtf8''. +instance TryCast.TryCast LazyByteString.ByteString LazyText.Text where + tryCast s = case LazyText.decodeUtf8' s of + Left _ -> Left $ TryCastException.TryCastException s + Right t -> Right t + +-- ShortByteString + +-- | Uses 'ShortByteString.pack'. +instance Cast.Cast [Word.Word8] ShortByteString.ShortByteString where + cast = ShortByteString.pack + +-- | Uses 'ShortByteString.unpack'. +instance Cast.Cast ShortByteString.ShortByteString [Word.Word8] where + cast = ShortByteString.unpack + +-- | Uses 'ShortByteString.fromShort'. +instance Cast.Cast ShortByteString.ShortByteString ByteString.ByteString where + cast = 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 = Text.pack + +-- | Uses 'Text.unpack'. +instance Cast.Cast Text.Text String where + cast = Text.unpack + +-- | Uses 'LazyText.fromStrict'. +instance Cast.Cast Text.Text LazyText.Text where + cast = LazyText.fromStrict + +-- | Uses 'Text.encodeUtf8'. +instance Cast.Cast Text.Text ByteString.ByteString where + cast = 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 = LazyText.pack + +-- | Uses 'LazyText.unpack'. +instance Cast.Cast LazyText.Text String where + cast = LazyText.unpack + +-- | Uses 'LazyText.toStrict'. +instance Cast.Cast LazyText.Text Text.Text where + cast = LazyText.toStrict + +-- | Uses 'LazyText.encodeUtf8'. +instance Cast.Cast LazyText.Text LazyByteString.ByteString where + cast = LazyText.encodeUtf8 + +fromNonNegativeIntegral :: (Integral s, Num t) => s -> Maybe t +fromNonNegativeIntegral x = if x < 0 then Nothing else Just $ fromIntegral x + +maybeTryCast + :: (s -> Maybe t) -> s -> Either (TryCastException.TryCastException s t) t +maybeTryCast f s = case f s of + Nothing -> Left $ TryCastException.TryCastException s + Just t -> Right t + +-- | The maximum integral value that can be unambiguously represented as a +-- 'Float'. Equal to 16,777,215. +maxFloat :: Num a => a +maxFloat = 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 = 9007199254740991 diff --git a/src/lib/Witch/TryCast.hs b/src/lib/Witch/TryCast.hs new file mode 100644 --- /dev/null +++ b/src/lib/Witch/TryCast.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE MultiParamTypeClasses #-} + +module Witch.TryCast where + +import qualified Witch.TryCastException as TryCastException + +-- | This type class is for converting values from some @source@ type into +-- some other @target@ type. The constraint @TryCast source target@ means that +-- you may be able to convert from a value of type @source@ into a value of +-- type @target@, but that conversion may fail at runtime. +-- +-- This type class is for conversions that can fail. If your conversion cannot +-- fail, consider implementing @Cast@ instead. +class TryCast source target where + -- | This method implements the conversion of a value between types. At call + -- sites you will usually want to use @tryFrom@ or @tryInto@ instead of this + -- method. + tryCast :: source -> Either (TryCastException.TryCastException source target) target diff --git a/src/lib/Witch/TryCastException.hs b/src/lib/Witch/TryCastException.hs new file mode 100644 --- /dev/null +++ b/src/lib/Witch/TryCastException.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Witch.TryCastException where + +import qualified Control.Exception as Exception +import qualified Data.Proxy as Proxy +import qualified Data.Typeable as Typeable + +-- | This exception is thrown when a @TryCast@ conversion fails. It has the +-- original @source@ value that caused the failure and it knows the @target@ +-- type it was trying to convert into. +newtype TryCastException source target + = TryCastException source + deriving Eq + +instance + ( Show source + , Typeable.Typeable source + , Typeable.Typeable target + ) => Show (TryCastException source target) where + showsPrec d (TryCastException x) = + showParen (d > 10) + $ showString "TryCastException {- " + . shows + (Typeable.typeRep (Proxy.Proxy :: Proxy.Proxy (source -> target))) + . showString " -} " + . showsPrec 11 x + +instance + ( Show source + , Typeable.Typeable source + , Typeable.Typeable target + ) => Exception.Exception (TryCastException source target) diff --git a/src/lib/Witch/Utility.hs b/src/lib/Witch/Utility.hs new file mode 100644 --- /dev/null +++ b/src/lib/Witch/Utility.hs @@ -0,0 +1,211 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module Witch.Utility where + +import qualified Control.Exception as Exception +import qualified Data.Typeable as Typeable +import qualified GHC.Stack as Stack +import qualified Witch.Cast as Cast +import qualified Witch.Identity as Identity +import qualified Witch.TryCast as TryCast +import qualified Witch.TryCastException as TryCastException + +-- | This is the same as 'id' except that it requires a type application. This +-- can be an ergonomic way to pin down a polymorphic type in a function +-- pipeline. For example: +-- +-- > -- Avoid this: +-- > f . (\ x -> x :: Int) . g +-- > +-- > -- Prefer this: +-- > f . as @Int . g +as :: forall s source . Identity.Identity s ~ source => source -> source +as = id + +-- | This is the same as 'Cast.cast' except that it requires a type +-- application for the @source@ type. +-- +-- > -- Avoid this: +-- > cast (x :: s) +-- > +-- > -- Prefer this: +-- > from @s x +from + :: forall s target source + . (Identity.Identity s ~ source, Cast.Cast source target) + => source + -> target +from = Cast.cast + +-- | This is the same as 'Cast.cast' except that it requires a type +-- application for the @target@ type. +-- +-- > -- Avoid this: +-- > cast x :: t +-- > +-- > -- Prefer this: +-- > into @t x +into + :: forall t source target + . (Identity.Identity t ~ target, Cast.Cast source target) + => source + -> target +into = Cast.cast + +-- | This function converts from some @source@ type into some @target@ type, +-- applies the given function, then converts back into the @source@ type. This +-- is useful when you have two types that are isomorphic but some function +-- that only works with one of them. +-- +-- > -- Avoid this: +-- > from @t . f . from @s +-- > +-- > -- Prefer this: +-- > over @t f +over + :: forall t source target + . ( Identity.Identity t ~ target + , Cast.Cast source target + , Cast.Cast target source + ) + => (target -> target) + -> source + -> source +over f = Cast.cast . f . Cast.cast + +-- | This function first converts from some @source@ type into some @through@ +-- type, and then converts that into some @target@ type. Usually this is used +-- when writing 'Cast.Cast' instances. Sometimes this can be used to work +-- around the lack of an instance that should probably exist. +-- +-- > -- Avoid this: +-- > from @u . into @u +-- > +-- > -- Prefer this: +-- > via @u +via + :: forall u source target through + . ( Identity.Identity u ~ through + , Cast.Cast source through + , Cast.Cast through target + ) + => source + -> target +via = Cast.cast . (\x -> x :: through) . Cast.cast + +-- | This is the same as 'TryCast.tryCast' except that it requires a type +-- application for the @source@ type. +-- +-- > -- Avoid this: +-- > tryCast (x :: s) +-- > +-- > -- Prefer this: +-- > tryFrom @s x +tryFrom + :: forall s target source + . (Identity.Identity s ~ source, TryCast.TryCast source target) + => source + -> Either (TryCastException.TryCastException source target) target +tryFrom = TryCast.tryCast + +-- | This is the same as 'TryCast.tryCast' except that it requires a type +-- application for the @target@ type. +-- +-- > -- Avoid this: +-- > tryCast x :: Either (TryCastException s t) t +-- > +-- > -- Prefer this: +-- > tryInto @t x +tryInto + :: forall t source target + . (Identity.Identity t ~ target, TryCast.TryCast source target) + => source + -> Either (TryCastException.TryCastException source target) target +tryInto = TryCast.tryCast + +-- | This is similar to 'via' except that it works with 'TryCast.TryCast' +-- instances instead. This function is especially convenient because juggling +-- the types in the 'TryCastException.TryCastException' can be tedious. +-- +-- > -- Avoid this: +-- > fmap (tryFrom @u) . tryInto @u +-- > +-- > -- Prefer this: +-- > tryVia @u +tryVia + :: forall u source target through + . ( Identity.Identity u ~ through + , TryCast.TryCast source through + , TryCast.TryCast through target + ) + => source + -> Either (TryCastException.TryCastException source target) target +tryVia s = case TryCast.tryCast s of + Left _ -> Left $ TryCastException.TryCastException s + Right u -> case TryCast.tryCast (u :: through) of + Left _ -> Left $ TryCastException.TryCastException s + Right t -> Right t + +-- | This function is like 'TryCast.tryCast' except that it will throw an +-- impure exception if the conversion fails. +-- +-- > -- Avoid this: +-- > either throw id . cast +-- > +-- > -- Prefer this: +-- > unsafeCast +unsafeCast + :: forall source target + . ( Stack.HasCallStack + , TryCast.TryCast source target + , Show source + , Typeable.Typeable source + , Typeable.Typeable target + ) + => source + -> target +unsafeCast = either Exception.throw id . TryCast.tryCast + +-- | This function is like 'from' except that it will throw an impure +-- exception if the conversion fails. +-- +-- > -- Avoid this: +-- > either throw id . from @s +-- > +-- > -- Prefer this: +-- > unsafeFrom @s +unsafeFrom + :: forall s target source + . ( Identity.Identity s ~ source + , Stack.HasCallStack + , TryCast.TryCast source target + , Show source + , Typeable.Typeable source + , Typeable.Typeable target + ) + => source + -> target +unsafeFrom = unsafeCast + +-- | This function is like 'into' except that it will throw an impure +-- exception if the conversion fails. +-- +-- > -- Avoid this: +-- > either throw id . into @t +-- > +-- > -- Prefer this: +-- > unsafeInto @t +unsafeInto + :: forall t source target + . ( Identity.Identity t ~ target + , Stack.HasCallStack + , TryCast.TryCast source target + , Show source + , Typeable.Typeable source + , Typeable.Typeable target + ) + => source + -> target +unsafeInto = unsafeCast diff --git a/src/test/Main.hs b/src/test/Main.hs --- a/src/test/Main.hs +++ b/src/test/Main.hs @@ -1,162 +1,1658 @@ -{-# options_ghc -Wno-orphans #-} -{-# language TypeApplications #-} - -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as LB -import qualified Data.Foldable as Foldable -import qualified Data.Int as Int -import qualified Data.List.NonEmpty as NonEmpty -import qualified Data.Map as Map -import qualified Data.Sequence as Seq -import qualified Data.Set as Set -import qualified Data.Text as T -import qualified Data.Text.Lazy as LT -import qualified Data.Tuple as Tuple -import qualified Data.Word as Word -import qualified Numeric.Natural as Natural -import qualified Test.Hspec as Hspec -import qualified Test.Hspec.QuickCheck as Hspec -import qualified Test.QuickCheck as QuickCheck -import qualified Witch - -main :: IO () -main = Hspec.hspec . Hspec.parallel $ do - - Hspec.describe "From a a" $ do - Hspec.prop "from" $ \ x -> Witch.from @Int @Int x == x - Hspec.prop "into" $ \ x -> Witch.into @Int @Int x == x - Hspec.prop "via" $ \ x -> Witch.via @Int @Int @Int x == x - - Hspec.prop "From a (x -> a)" $ \ x -> - Witch.from @Int @(() -> Int) x () == x - - Hspec.prop "From a [a]" $ \ x -> - Witch.from @Int @[Int] x == [x] - - Hspec.prop "From a (Maybe a)" $ \ x -> - Witch.from @Int @(Maybe Int) x == Just x - - Hspec.prop "From a (Either a x)" $ \ x -> - Witch.from @Int @(Either Int ()) x == Left x - - Hspec.prop "From a (Either x a)" $ \ x -> - Witch.from @Int @(Either () Int) x == Right x - - Hspec.it "From Void x" $ Hspec.pending - - Hspec.prop "From (a, x) a" $ \ x -> - Witch.from @(Int, ()) @Int (x, ()) == x - - Hspec.prop "From (x, a) a" $ \ x -> - Witch.from @((), Int) @Int ((), x) == x - - Hspec.prop "From (a, b) (b, a)" $ \ x -> - Witch.from @(Char, Int) @(Int, Char) x == Tuple.swap x - - Hspec.prop "From (NonEmpty a) [a]" $ \ x -> - Witch.from @(NonEmpty.NonEmpty Int) @[Int] x == NonEmpty.toList x - - Hspec.prop "From Word8 Word16" $ \ x -> - Witch.from @Word.Word8 @Word.Word16 x == fromIntegral x - - Hspec.prop "From Word16 Word32" $ \ x -> - Witch.from @Word.Word16 @Word.Word32 x == fromIntegral x - - Hspec.prop "From Word32 Word64" $ \ x -> - Witch.from @Word.Word32 @Word.Word64 x == fromIntegral x - - Hspec.prop "From Word Natural" $ \ x -> - Witch.from @Word @Natural.Natural x == fromIntegral x - - Hspec.prop "From Natural Integer" $ \ x -> - Witch.from @Natural.Natural @Integer x == fromIntegral x - - Hspec.prop "From Int8 Int16" $ \ x -> - Witch.from @Int.Int8 @Int.Int16 x == fromIntegral x - - Hspec.prop "From Int16 Int32" $ \ x -> - Witch.from @Int.Int16 @Int.Int32 x == fromIntegral x - - Hspec.prop "From Int32 Int64" $ \ x -> - Witch.from @Int.Int32 @Int.Int64 x == fromIntegral x - - Hspec.prop "From Int Integer" $ \ x -> - Witch.from @Int @Integer x == fromIntegral x - - Hspec.prop "From Integer Rational" $ \ x -> - Witch.from @Integer @Rational x == fromIntegral x - - Hspec.prop "From Float Double" $ \ x -> - Witch.from @Float @Double x == realToFrac x - - Hspec.prop "From Bool Int" $ \ x -> - Witch.from @Bool @Int x == fromEnum x - - Hspec.prop "From Char Int" $ \ x -> - Witch.from @Char @Int x == fromEnum x - - Hspec.prop "From [Word8] ByteString" $ \ x -> - Witch.from @[Word.Word8] @B.ByteString x == B.pack x - - Hspec.prop "From ByteString [Word8]" $ \ x -> - Witch.from @B.ByteString @[Word.Word8] x == B.unpack x - - Hspec.prop "From ByteString LazyByteString" $ \ x -> - Witch.from @B.ByteString @LB.ByteString x == LB.fromStrict x - - Hspec.prop "From LazyByteString ByteString" $ \ x -> - Witch.from @LB.ByteString @B.ByteString x == LB.toStrict x - - Hspec.prop "From String Text" $ \ x -> - Witch.from @String @T.Text x == T.pack x - - Hspec.prop "From Text String" $ \ x -> - Witch.from @T.Text @String x == T.unpack x - - Hspec.prop "From Text LazyText" $ \ x -> - Witch.from @T.Text @LT.Text x == LT.fromStrict x - - Hspec.prop "From LazyText Text" $ \ x -> - Witch.from @LT.Text @T.Text x == LT.toStrict x - - Hspec.prop "From [a] (Seq a)" $ \ x -> - Witch.from @[Int] @(Seq.Seq Int) x == Seq.fromList x - - Hspec.prop "From (Seq a) [a]" $ \ x -> - Witch.from @(Seq.Seq Int) @[Int] x == Foldable.toList x - - Hspec.prop "From [a] (Set a)" $ \ x -> - Witch.from @[Int] @(Set.Set Int) x == Set.fromList x - - Hspec.prop "From (Set a) [a]" $ \ x -> - Witch.from @(Set.Set Int) @[Int] x == Set.toAscList x - - Hspec.prop "From [(k, v)] (Map k v)" $ \ x -> - Witch.from @[(Char, Int)] @(Map.Map Char Int) x == Map.fromList x - - Hspec.prop "From (Map k v) [(k, v)]" $ \ x -> - Witch.from @(Map.Map Char Int) @[(Char, Int)] x == Map.toAscList x - -instance QuickCheck.Arbitrary Natural.Natural where - arbitrary = QuickCheck.arbitrarySizedNatural - shrink = QuickCheck.shrinkIntegral - -instance QuickCheck.Arbitrary a => QuickCheck.Arbitrary (NonEmpty.NonEmpty a) where - arbitrary = QuickCheck.applyArbitrary2 (NonEmpty.:|) - shrink = QuickCheck.genericShrink - -instance QuickCheck.Arbitrary LB.ByteString where - arbitrary = fmap LB.pack QuickCheck.arbitrary - shrink = QuickCheck.shrinkMap LB.pack LB.unpack - -instance QuickCheck.Arbitrary B.ByteString where - arbitrary = fmap B.pack QuickCheck.arbitrary - shrink = QuickCheck.shrinkMap B.pack B.unpack - -instance QuickCheck.Arbitrary T.Text where - arbitrary = fmap T.pack QuickCheck.arbitrary - shrink = QuickCheck.shrinkMap T.pack T.unpack - -instance QuickCheck.Arbitrary LT.Text where - arbitrary = fmap LT.pack QuickCheck.arbitrary - shrink = QuickCheck.shrinkMap LT.pack LT.unpack +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +import qualified Control.Exception as Exception +import qualified Control.Monad as Monad +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.Either as Either +import qualified Data.Fixed as Fixed +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.Lazy as LazyText +import qualified Data.Word as Word +import qualified Numeric.Natural as Natural +import qualified Test.Hspec as Hspec +import qualified Witch + +main :: IO () +main = Hspec.hspec . Hspec.describe "Witch" $ do + + Hspec.describe "Cast" $ do + + Hspec.describe "cast" $ do + test $ Witch.cast (1 :: Int.Int8) `Hspec.shouldBe` (1 :: Int.Int16) + + Hspec.describe "TryCast" $ do + + Hspec.describe "tryCast" $ do + test $ Witch.tryCast (1 :: Int.Int16) `Hspec.shouldBe` Right (1 :: Int.Int8) + test $ Witch.tryCast 128 `Hspec.shouldBe` Left (Witch.TryCastException @Int.Int16 @Int.Int8 128) + + Hspec.describe "Utility" $ do + + Hspec.describe "as" $ do + test $ Witch.as @Int.Int8 1 `Hspec.shouldBe` 1 + + Hspec.describe "from" $ do + test $ Witch.from @Int.Int8 1 `Hspec.shouldBe` (1 :: Int.Int16) + + Hspec.describe "into" $ do + test $ Witch.into @Int.Int16 (1 :: Int.Int8) `Hspec.shouldBe` 1 + + Hspec.describe "over" $ do + test $ Witch.over @String (<> "!") (Name "Kiki") `Hspec.shouldBe` Name "Kiki!" + + Hspec.describe "via" $ do + test $ Witch.via @Int.Int16 (1 :: Int.Int8) `Hspec.shouldBe` (1 :: Int.Int32) + + Hspec.describe "tryFrom" $ do + test $ Witch.tryFrom @Int.Int16 1 `Hspec.shouldBe` Right (1 :: Int.Int8) + + Hspec.describe "tryInto" $ do + test $ Witch.tryInto @Int.Int8 (1 :: Int.Int16) `Hspec.shouldBe` Right 1 + + Hspec.describe "unsafeCast" $ do + test $ Witch.unsafeCast (1 :: Int.Int16) `Hspec.shouldBe` (1 :: Int.Int8) + test $ Exception.evaluate (Witch.unsafeCast @Int.Int16 @Int.Int8 128) `Hspec.shouldThrow` (== Witch.TryCastException @Int.Int16 @Int.Int8 128) + + Hspec.describe "unsafeFrom" $ do + test $ Witch.unsafeFrom @Int.Int16 1 `Hspec.shouldBe` (1 :: Int.Int8) + + Hspec.describe "unsafeInto" $ do + test $ Witch.unsafeInto @Int.Int8 (1 :: Int.Int16) `Hspec.shouldBe` 1 + + Hspec.describe "Lift" $ do + + Hspec.describe "liftedCast" $ do + test $ ($$(Witch.liftedCast (1 :: Int.Int16)) :: Int.Int8) `Hspec.shouldBe` 1 + + Hspec.describe "liftedFrom" $ do + test $ ($$(Witch.liftedFrom @Int.Int16 1) :: Int.Int8) `Hspec.shouldBe` 1 + + Hspec.describe "liftedInto" $ do + test $ $$(Witch.liftedInto @Int.Int8 (1 :: Int.Int16)) `Hspec.shouldBe` 1 + + Hspec.describe "Instances" $ do + + -- Int8 + + Hspec.describe "Cast Int8 Int16" $ do + let f = Witch.cast @Int.Int8 @Int.Int16 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 127 `Hspec.shouldBe` 127 + test $ f (-128) `Hspec.shouldBe` (-128) + + Hspec.describe "Cast Int8 Int32" $ do + let f = Witch.cast @Int.Int8 @Int.Int32 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 127 `Hspec.shouldBe` 127 + test $ f (-128) `Hspec.shouldBe` (-128) + + Hspec.describe "Cast Int8 Int64" $ do + let f = Witch.cast @Int.Int8 @Int.Int64 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 127 `Hspec.shouldBe` 127 + test $ f (-128) `Hspec.shouldBe` (-128) + + Hspec.describe "Cast Int8 Int" $ do + let f = Witch.cast @Int.Int8 @Int + test $ f 0 `Hspec.shouldBe` 0 + test $ f 127 `Hspec.shouldBe` 127 + test $ f (-128) `Hspec.shouldBe` (-128) + + Hspec.describe "Cast Int8 Integer" $ do + let f = Witch.cast @Int.Int8 @Integer + test $ f 0 `Hspec.shouldBe` 0 + test $ f 127 `Hspec.shouldBe` 127 + test $ f (-128) `Hspec.shouldBe` (-128) + + Hspec.describe "TryCast Int8 Word8" $ do + let f = Witch.tryCast @Int.Int8 @Word.Word8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int8 Word16" $ do + let f = Witch.tryCast @Int.Int8 @Word.Word16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int8 Word32" $ do + let f = Witch.tryCast @Int.Int8 @Word.Word32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int8 Word64" $ do + let f = Witch.tryCast @Int.Int8 @Word.Word64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int8 Word" $ do + let f = Witch.tryCast @Int.Int8 @Word + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int8 Natural" $ do + let f = Witch.tryCast @Int.Int8 @Natural.Natural + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Int8 Float" $ do + let f = Witch.cast @Int.Int8 @Float + test $ f 0 `Hspec.shouldBe` 0 + test $ f 127 `Hspec.shouldBe` 127 + test $ f (-128) `Hspec.shouldBe` (-128) + + Hspec.describe "Cast Int8 Double" $ do + let f = Witch.cast @Int.Int8 @Double + test $ f 0 `Hspec.shouldBe` 0 + test $ f 127 `Hspec.shouldBe` 127 + test $ f (-128) `Hspec.shouldBe` (-128) + + -- Int16 + + Hspec.describe "TryCast Int16 Int8" $ do + let f = Witch.tryCast @Int.Int16 @Int.Int8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f 128 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-128) `Hspec.shouldBe` Right (-128) + test $ f (-129) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Int16 Int32" $ do + let f = Witch.cast @Int.Int16 @Int.Int32 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 32767 `Hspec.shouldBe` 32767 + test $ f (-32768) `Hspec.shouldBe` (-32768) + + Hspec.describe "Cast Int16 Int64" $ do + let f = Witch.cast @Int.Int16 @Int.Int64 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 32767 `Hspec.shouldBe` 32767 + test $ f (-32768) `Hspec.shouldBe` (-32768) + + Hspec.describe "Cast Int16 Int" $ do + let f = Witch.cast @Int.Int16 @Int + test $ f 0 `Hspec.shouldBe` 0 + test $ f 32767 `Hspec.shouldBe` 32767 + test $ f (-32768) `Hspec.shouldBe` (-32768) + + Hspec.describe "Cast Int16 Integer" $ do + let f = Witch.cast @Int.Int16 @Integer + test $ f 0 `Hspec.shouldBe` 0 + test $ f 32767 `Hspec.shouldBe` 32767 + test $ f (-32768) `Hspec.shouldBe` (-32768) + + Hspec.describe "TryCast Int16 Word8" $ do + let f = Witch.tryCast @Int.Int16 @Word.Word8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 255 `Hspec.shouldBe` Right 255 + test $ f 256 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int16 Word16" $ do + let f = Witch.tryCast @Int.Int16 @Word.Word16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int16 Word32" $ do + let f = Witch.tryCast @Int.Int16 @Word.Word32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int16 Word64" $ do + let f = Witch.tryCast @Int.Int16 @Word.Word64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int16 Word" $ do + let f = Witch.tryCast @Int.Int16 @Word + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int16 Natural" $ do + let f = Witch.tryCast @Int.Int16 @Natural.Natural + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Int16 Float" $ do + let f = Witch.cast @Int.Int16 @Float + test $ f 0 `Hspec.shouldBe` 0 + test $ f 32767 `Hspec.shouldBe` 32767 + test $ f (-32768) `Hspec.shouldBe` (-32768) + + Hspec.describe "Cast Int16 Double" $ do + let f = Witch.cast @Int.Int16 @Double + test $ f 0 `Hspec.shouldBe` 0 + test $ f 32767 `Hspec.shouldBe` 32767 + test $ f (-32768) `Hspec.shouldBe` (-32768) + + -- Int32 + + Hspec.describe "TryCast Int32 Int8" $ do + let f = Witch.tryCast @Int.Int32 @Int.Int8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f 128 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-128) `Hspec.shouldBe` Right (-128) + test $ f (-129) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int32 Int16" $ do + let f = Witch.tryCast @Int.Int32 @Int.Int16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f 32768 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-32768) `Hspec.shouldBe` Right (-32768) + test $ f (-32769) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Int32 Int64" $ do + let f = Witch.cast @Int.Int32 @Int.Int64 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 2147483647 `Hspec.shouldBe` 2147483647 + test $ f (-2147483648) `Hspec.shouldBe` (-2147483648) + + Hspec.describe "TryCast Int32 Int" $ do + Monad.when (toInteger (maxBound :: Int) < 2147483647) untested + let f = Witch.tryCast @Int.Int32 @Int + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 2147483647 `Hspec.shouldBe` Right 2147483647 + test $ f (-2147483648) `Hspec.shouldBe` Right (-2147483648) + + Hspec.describe "Cast Int32 Integer" $ do + let f = Witch.cast @Int.Int32 @Integer + test $ f 0 `Hspec.shouldBe` 0 + test $ f 2147483647 `Hspec.shouldBe` 2147483647 + test $ f (-2147483648) `Hspec.shouldBe` (-2147483648) + + Hspec.describe "TryCast Int32 Word8" $ do + let f = Witch.tryCast @Int.Int32 @Word.Word8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 255 `Hspec.shouldBe` Right 255 + test $ f 256 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int32 Word16" $ do + let f = Witch.tryCast @Int.Int32 @Word.Word16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 65535 `Hspec.shouldBe` Right 65535 + test $ f 65536 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int32 Word32" $ do + let f = Witch.tryCast @Int.Int32 @Word.Word32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 2147483647 `Hspec.shouldBe` Right 2147483647 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int32 Word64" $ do + let f = Witch.tryCast @Int.Int32 @Word.Word64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 2147483647 `Hspec.shouldBe` Right 2147483647 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int32 Word" $ do + Monad.when (toInteger (maxBound :: Word) < 2147483647) untested + let f = Witch.tryCast @Int.Int32 @Word + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 2147483647 `Hspec.shouldBe` Right 2147483647 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int32 Natural" $ do + let f = Witch.tryCast @Int.Int32 @Natural.Natural + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 2147483647 `Hspec.shouldBe` Right 2147483647 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int32 Float" $ do + let f = Witch.tryCast @Int.Int32 @Float + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-16777215) `Hspec.shouldBe` Right (-16777215) + test $ f (-16777216) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Int32 Double" $ do + let f = Witch.cast @Int.Int32 @Double + test $ f 0 `Hspec.shouldBe` 0 + test $ f 2147483647 `Hspec.shouldBe` 2147483647 + test $ f (-2147483648) `Hspec.shouldBe` (-2147483648) + + -- Int64 + + Hspec.describe "TryCast Int64 Int8" $ do + let f = Witch.tryCast @Int.Int64 @Int.Int8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f 128 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-128) `Hspec.shouldBe` Right (-128) + test $ f (-129) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int64 Int16" $ do + let f = Witch.tryCast @Int.Int64 @Int.Int16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f 32768 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-32768) `Hspec.shouldBe` Right (-32768) + test $ f (-32769) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int64 Int32" $ do + let f = Witch.tryCast @Int.Int64 @Int.Int32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 2147483647 `Hspec.shouldBe` Right 2147483647 + test $ f 2147483648 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-2147483648) `Hspec.shouldBe` Right (-2147483648) + test $ f (-2147483649) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int64 Int" $ do + Monad.when (toInteger (maxBound :: Int) < 9223372036854775807) untested + let f = Witch.tryCast @Int.Int64 @Int + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9223372036854775807 `Hspec.shouldBe` Right 9223372036854775807 + test $ f (-9223372036854775808) `Hspec.shouldBe` Right (-9223372036854775808) + + Hspec.describe "Cast Int64 Integer" $ do + let f = Witch.cast @Int.Int64 @Integer + test $ f 0 `Hspec.shouldBe` 0 + test $ f 9223372036854775807 `Hspec.shouldBe` 9223372036854775807 + test $ f (-9223372036854775808) `Hspec.shouldBe` (-9223372036854775808) + + Hspec.describe "TryCast Int64 Word8" $ do + let f = Witch.tryCast @Int.Int64 @Word.Word8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 255 `Hspec.shouldBe` Right 255 + test $ f 256 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int64 Word16" $ do + let f = Witch.tryCast @Int.Int64 @Word.Word16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 65535 `Hspec.shouldBe` Right 65535 + test $ f 65536 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int64 Word32" $ do + let f = Witch.tryCast @Int.Int64 @Word.Word32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 2147483647 `Hspec.shouldBe` Right 2147483647 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int64 Word64" $ do + let f = Witch.tryCast @Int.Int64 @Word.Word64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9223372036854775807 `Hspec.shouldBe` Right 9223372036854775807 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int64 Word" $ do + Monad.when (toInteger (maxBound :: Word) < 9223372036854775807) untested + let f = Witch.tryCast @Int.Int64 @Word + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9223372036854775807 `Hspec.shouldBe` Right 9223372036854775807 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int64 Natural" $ do + let f = Witch.tryCast @Int.Int64 @Natural.Natural + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9223372036854775807 `Hspec.shouldBe` Right 9223372036854775807 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int64 Float" $ do + let f = Witch.tryCast @Int.Int64 @Float + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-16777215) `Hspec.shouldBe` Right (-16777215) + test $ f (-16777216) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int64 Double" $ do + let f = Witch.tryCast @Int.Int64 @Double + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9007199254740991 `Hspec.shouldBe` Right 9007199254740991 + test $ f 9007199254740992 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-9007199254740991) `Hspec.shouldBe` Right (-9007199254740991) + test $ f (-9007199254740992) `Hspec.shouldSatisfy` Either.isLeft + + -- Int + + Hspec.describe "TryCast Int Int8" $ do + let f = Witch.tryCast @Int @Int.Int8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f 128 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-128) `Hspec.shouldBe` Right (-128) + test $ f (-129) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int Int16" $ do + let f = Witch.tryCast @Int @Int.Int16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f 32768 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-32768) `Hspec.shouldBe` Right (-32768) + test $ f (-32769) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int Int32" $ do + Monad.when (toInteger (maxBound :: Int) < 2147483647) untested + let f = Witch.tryCast @Int @Int.Int32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 2147483647 `Hspec.shouldBe` Right 2147483647 + test $ f 2147483648 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-2147483648) `Hspec.shouldBe` Right (-2147483648) + test $ f (-2147483649) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Int Int64" $ do + let f = Witch.cast @Int @Int.Int64 + test $ f 0 `Hspec.shouldBe` 0 + test $ f maxBound `Hspec.shouldBe` fromIntegral (maxBound :: Int) + test $ f minBound `Hspec.shouldBe` fromIntegral (minBound :: Int) + + Hspec.describe "Cast Int Integer" $ do + let f = Witch.cast @Int @Integer + test $ f 0 `Hspec.shouldBe` 0 + test $ f maxBound `Hspec.shouldBe` fromIntegral (maxBound :: Int) + test $ f minBound `Hspec.shouldBe` fromIntegral (minBound :: Int) + + Hspec.describe "TryCast Int Word8" $ do + let f = Witch.tryCast @Int @Word.Word8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 255 `Hspec.shouldBe` Right 255 + test $ f 256 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int Word16" $ do + let f = Witch.tryCast @Int @Word.Word16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 65535 `Hspec.shouldBe` Right 65535 + test $ f 65536 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int Word32" $ do + Monad.when (toInteger (maxBound :: Int) < 4294967295) untested + let f = Witch.tryCast @Int @Word.Word32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 4294967295 `Hspec.shouldBe` Right 4294967295 + test $ f 4294967296 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int Word64" $ do + let f = Witch.tryCast @Int @Word.Word64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f maxBound `Hspec.shouldBe` Right (fromIntegral (maxBound :: Int)) + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int Word" $ do + let f = Witch.tryCast @Int @Word + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f maxBound `Hspec.shouldBe` Right (fromIntegral (maxBound :: Int)) + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int Natural" $ do + let f = Witch.tryCast @Int @Natural.Natural + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f maxBound `Hspec.shouldBe` Right (fromIntegral (maxBound :: Int)) + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int Float" $ do + let f = Witch.tryCast @Int @Float + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-16777215) `Hspec.shouldBe` Right (-16777215) + test $ f (-16777216) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Int Double" $ do + Monad.when (toInteger (maxBound :: Int) < 9007199254740991) untested + let f = Witch.tryCast @Int @Double + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9007199254740991 `Hspec.shouldBe` Right 9007199254740991 + test $ f 9007199254740992 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-9007199254740991) `Hspec.shouldBe` Right (-9007199254740991) + test $ f (-9007199254740992) `Hspec.shouldSatisfy` Either.isLeft + + -- Integer + + Hspec.describe "TryCast Integer Int8" $ do + let f = Witch.tryCast @Integer @Int.Int8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f 128 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-128) `Hspec.shouldBe` Right (-128) + test $ f (-129) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Integer Int16" $ do + let f = Witch.tryCast @Integer @Int.Int16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f 32768 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-32768) `Hspec.shouldBe` Right (-32768) + test $ f (-32769) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Integer Int32" $ do + let f = Witch.tryCast @Integer @Int.Int32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 2147483647 `Hspec.shouldBe` Right 2147483647 + test $ f 2147483648 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-2147483648) `Hspec.shouldBe` Right (-2147483648) + test $ f (-2147483649) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Integer Int64" $ do + let f = Witch.tryCast @Integer @Int.Int64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9223372036854775807 `Hspec.shouldBe` Right 9223372036854775807 + test $ f 9223372036854775808 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-9223372036854775808) `Hspec.shouldBe` Right (-9223372036854775808) + test $ f (-9223372036854775809) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Integer Int" $ do + let f = Witch.tryCast @Integer @Int + test $ f 0 `Hspec.shouldBe` Right 0 + test $ let x = maxBound :: Int in f (fromIntegral x) `Hspec.shouldBe` Right x + test $ let x = toInteger (maxBound :: Int) + 1 in f x `Hspec.shouldSatisfy` Either.isLeft + test $ let x = minBound :: Int in f (fromIntegral x) `Hspec.shouldBe` Right x + test $ let x = toInteger (minBound :: Int) - 1 in f x `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Integer Word8" $ do + let f = Witch.tryCast @Integer @Word.Word8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 255 `Hspec.shouldBe` Right 255 + test $ f 256 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Integer Word16" $ do + let f = Witch.tryCast @Integer @Word.Word16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 65535 `Hspec.shouldBe` Right 65535 + test $ f 65536 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Integer Word32" $ do + let f = Witch.tryCast @Integer @Word.Word32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 4294967295 `Hspec.shouldBe` Right 4294967295 + test $ f 4294967296 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Integer Word64" $ do + let f = Witch.tryCast @Integer @Word.Word64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 18446744073709551615 `Hspec.shouldBe` Right 18446744073709551615 + test $ f 18446744073709551616 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Integer Word" $ do + let f = Witch.tryCast @Integer @Word + test $ f 0 `Hspec.shouldBe` Right 0 + test $ let x = maxBound :: Word in f (fromIntegral x) `Hspec.shouldBe` Right x + test $ let x = toInteger (maxBound :: Word) + 1 in f x `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Integer Natural" $ do + let f = Witch.tryCast @Integer @Natural.Natural + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 18446744073709551616 `Hspec.shouldBe` Right 18446744073709551616 + test $ f (-1) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Integer Float" $ do + let f = Witch.tryCast @Integer @Float + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-16777215) `Hspec.shouldBe` Right (-16777215) + test $ f (-16777216) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Integer Double" $ do + let f = Witch.tryCast @Integer @Double + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9007199254740991 `Hspec.shouldBe` Right 9007199254740991 + test $ f 9007199254740992 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-9007199254740991) `Hspec.shouldBe` Right (-9007199254740991) + test $ f (-9007199254740992) `Hspec.shouldSatisfy` Either.isLeft + + -- Word8 + + Hspec.describe "Cast Word8 Word16" $ do + let f = Witch.cast @Word.Word8 @Word.Word16 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 255 `Hspec.shouldBe` 255 + + Hspec.describe "Cast Word8 Word32" $ do + let f = Witch.cast @Word.Word8 @Word.Word32 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 255 `Hspec.shouldBe` 255 + + Hspec.describe "Cast Word8 Word64" $ do + let f = Witch.cast @Word.Word8 @Word.Word64 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 255 `Hspec.shouldBe` 255 + + Hspec.describe "Cast Word8 Word" $ do + let f = Witch.cast @Word.Word8 @Word + test $ f 0 `Hspec.shouldBe` 0 + test $ f 255 `Hspec.shouldBe` 255 + + Hspec.describe "Cast Word8 Natural" $ do + let f = Witch.cast @Word.Word8 @Natural.Natural + test $ f 0 `Hspec.shouldBe` 0 + test $ f 255 `Hspec.shouldBe` 255 + + Hspec.describe "TryCast Word8 Int8" $ do + let f = Witch.tryCast @Word.Word8 @Int.Int8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f 128 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Word8 Int16" $ do + let f = Witch.cast @Word.Word8 @Int.Int16 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 255 `Hspec.shouldBe` 255 + + Hspec.describe "Cast Word8 Int32" $ do + let f = Witch.cast @Word.Word8 @Int.Int32 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 255 `Hspec.shouldBe` 255 + + Hspec.describe "Cast Word8 Int64" $ do + let f = Witch.cast @Word.Word8 @Int.Int64 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 255 `Hspec.shouldBe` 255 + + Hspec.describe "Cast Word8 Int" $ do + let f = Witch.cast @Word.Word8 @Int + test $ f 0 `Hspec.shouldBe` 0 + test $ f 255 `Hspec.shouldBe` 255 + + Hspec.describe "Cast Word8 Integer" $ do + let f = Witch.cast @Word.Word8 @Integer + test $ f 0 `Hspec.shouldBe` 0 + test $ f 255 `Hspec.shouldBe` 255 + + Hspec.describe "Cast Word8 Float" $ do + let f = Witch.cast @Word.Word8 @Float + test $ f 0 `Hspec.shouldBe` 0 + test $ f 255 `Hspec.shouldBe` 255 + + Hspec.describe "Cast Word8 Double" $ do + let f = Witch.cast @Word.Word8 @Double + test $ f 0 `Hspec.shouldBe` 0 + test $ f 255 `Hspec.shouldBe` 255 + + -- Word16 + + Hspec.describe "TryCast Word16 Word8" $ do + let f = Witch.tryCast @Word.Word16 @Word.Word8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 255 `Hspec.shouldBe` Right 255 + test $ f 256 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Word16 Word32" $ do + let f = Witch.cast @Word.Word16 @Word.Word32 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 65535 `Hspec.shouldBe` 65535 + + Hspec.describe "Cast Word16 Word64" $ do + let f = Witch.cast @Word.Word16 @Word.Word64 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 65535 `Hspec.shouldBe` 65535 + + Hspec.describe "Cast Word16 Word" $ do + let f = Witch.cast @Word.Word16 @Word + test $ f 0 `Hspec.shouldBe` 0 + test $ f 65535 `Hspec.shouldBe` 65535 + + Hspec.describe "Cast Word16 Natural" $ do + let f = Witch.cast @Word.Word16 @Natural.Natural + test $ f 0 `Hspec.shouldBe` 0 + test $ f 65535 `Hspec.shouldBe` 65535 + + Hspec.describe "TryCast Word16 Int8" $ do + let f = Witch.tryCast @Word.Word16 @Int.Int8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f 128 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word16 Int16" $ do + let f = Witch.tryCast @Word.Word16 @Int.Int16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f 32768 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Word16 Int32" $ do + let f = Witch.cast @Word.Word16 @Int.Int32 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 65535 `Hspec.shouldBe` 65535 + + Hspec.describe "Cast Word16 Int64" $ do + let f = Witch.cast @Word.Word16 @Int.Int64 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 65535 `Hspec.shouldBe` 65535 + + Hspec.describe "Cast Word16 Int" $ do + let f = Witch.cast @Word.Word16 @Int + test $ f 0 `Hspec.shouldBe` 0 + test $ f 65535 `Hspec.shouldBe` 65535 + + Hspec.describe "Cast Word16 Integer" $ do + let f = Witch.cast @Word.Word16 @Integer + test $ f 0 `Hspec.shouldBe` 0 + test $ f 65535 `Hspec.shouldBe` 65535 + + Hspec.describe "Cast Word16 Float" $ do + let f = Witch.cast @Word.Word16 @Float + test $ f 0 `Hspec.shouldBe` 0 + test $ f 65535 `Hspec.shouldBe` 65535 + + Hspec.describe "Cast Word16 Double" $ do + let f = Witch.cast @Word.Word16 @Double + test $ f 0 `Hspec.shouldBe` 0 + test $ f 65535 `Hspec.shouldBe` 65535 + + -- Word32 + + Hspec.describe "TryCast Word32 Word8" $ do + let f = Witch.tryCast @Word.Word32 @Word.Word8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 255 `Hspec.shouldBe` Right 255 + test $ f 256 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word32 Word16" $ do + let f = Witch.tryCast @Word.Word32 @Word.Word16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 65535 `Hspec.shouldBe` Right 65535 + test $ f 65536 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Word32 Word64" $ do + let f = Witch.cast @Word.Word32 @Word.Word64 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 4294967295 `Hspec.shouldBe` 4294967295 + + Hspec.describe "TryCast Word32 Word" $ do + Monad.when (toInteger (maxBound :: Word) < 4294967295) untested + let f = Witch.tryCast @Word.Word32 @Word + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 4294967295 `Hspec.shouldBe` Right 4294967295 + + Hspec.describe "Cast Word32 Natural" $ do + let f = Witch.cast @Word.Word32 @Natural.Natural + test $ f 0 `Hspec.shouldBe` 0 + test $ f 4294967295 `Hspec.shouldBe` 4294967295 + + Hspec.describe "TryCast Word32 Int8" $ do + let f = Witch.tryCast @Word.Word32 @Int.Int8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f 128 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word32 Int16" $ do + let f = Witch.tryCast @Word.Word32 @Int.Int16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f 32768 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word32 Int32" $ do + let f = Witch.tryCast @Word.Word32 @Int.Int32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 2147483647 `Hspec.shouldBe` Right 2147483647 + test $ f 2147483648 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Word32 Int64" $ do + let f = Witch.cast @Word.Word32 @Int.Int64 + test $ f 0 `Hspec.shouldBe` 0 + test $ f 4294967295 `Hspec.shouldBe` 4294967295 + + Hspec.describe "TryCast Word32 Int" $ do + Monad.when (toInteger (maxBound :: Int) < 4294967295) untested + let f = Witch.tryCast @Word.Word32 @Int + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 4294967295 `Hspec.shouldBe` Right 4294967295 + + Hspec.describe "Cast Word32 Integer" $ do + let f = Witch.cast @Word.Word32 @Integer + test $ f 0 `Hspec.shouldBe` 0 + test $ f 4294967295 `Hspec.shouldBe` 4294967295 + + Hspec.describe "TryCast Word32 Float" $ do + let f = Witch.tryCast @Word.Word32 @Float + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Word32 Double" $ do + let f = Witch.cast @Word.Word32 @Double + test $ f 0 `Hspec.shouldBe` 0 + test $ f 4294967295 `Hspec.shouldBe` 4294967295 + + -- Word64 + + Hspec.describe "TryCast Word64 Word8" $ do + let f = Witch.tryCast @Word.Word64 @Word.Word8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 255 `Hspec.shouldBe` Right 255 + test $ f 256 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word64 Word16" $ do + let f = Witch.tryCast @Word.Word64 @Word.Word16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 65535 `Hspec.shouldBe` Right 65535 + test $ f 65536 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word64 Word32" $ do + let f = Witch.tryCast @Word.Word64 @Word.Word32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 4294967295 `Hspec.shouldBe` Right 4294967295 + test $ f 4294967296 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word64 Word" $ do + Monad.when (toInteger (maxBound :: Word) < 18446744073709551615) untested + let f = Witch.tryCast @Word.Word64 @Word + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 18446744073709551615 `Hspec.shouldBe` Right 18446744073709551615 + + Hspec.describe "Cast Word64 Natural" $ do + let f = Witch.cast @Word.Word64 @Natural.Natural + test $ f 0 `Hspec.shouldBe` 0 + test $ f 18446744073709551615 `Hspec.shouldBe` 18446744073709551615 + + Hspec.describe "TryCast Word64 Int8" $ do + let f = Witch.tryCast @Word.Word64 @Int.Int8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f 128 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word64 Int16" $ do + let f = Witch.tryCast @Word.Word64 @Int.Int16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f 32768 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word64 Int32" $ do + let f = Witch.tryCast @Word.Word64 @Int.Int32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 2147483647 `Hspec.shouldBe` Right 2147483647 + test $ f 2147483648 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word64 Int64" $ do + let f = Witch.tryCast @Word.Word64 @Int.Int64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9223372036854775807 `Hspec.shouldBe` Right 9223372036854775807 + test $ f 9223372036854775808 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word64 Int" $ do + let f = Witch.tryCast @Word.Word64 @Int + test $ f 0 `Hspec.shouldBe` Right 0 + test $ let x = maxBound :: Int in Witch.tryCast @Word.Word64 @Int (fromIntegral x) `Hspec.shouldBe` Right x + test $ let x = fromIntegral (maxBound :: Int) + 1 :: Word.Word64 in Witch.tryCast @Word.Word64 @Int x `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Word64 Integer" $ do + let f = Witch.cast @Word.Word64 @Integer + test $ f 0 `Hspec.shouldBe` 0 + test $ f 18446744073709551615 `Hspec.shouldBe` 18446744073709551615 + + Hspec.describe "TryCast Word64 Float" $ do + let f = Witch.tryCast @Word.Word64 @Float + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word64 Double" $ do + let f = Witch.tryCast @Word.Word64 @Double + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9007199254740991 `Hspec.shouldBe` Right 9007199254740991 + test $ f 9007199254740992 `Hspec.shouldSatisfy` Either.isLeft + + -- Word + + Hspec.describe "TryCast Word Word8" $ do + let f = Witch.tryCast @Word @Word.Word8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 255 `Hspec.shouldBe` Right 255 + test $ f 256 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word Word16" $ do + let f = Witch.tryCast @Word @Word.Word16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 65535 `Hspec.shouldBe` Right 65535 + test $ f 65536 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word Word32" $ do + Monad.when (toInteger (maxBound :: Word) < 4294967295) untested + let f = Witch.tryCast @Word @Word.Word32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 4294967295 `Hspec.shouldBe` Right 4294967295 + test $ f 4294967296 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Word Word64" $ do + let f = Witch.cast @Word @Word.Word64 + test $ f 0 `Hspec.shouldBe` 0 + test $ f maxBound `Hspec.shouldBe` fromIntegral (maxBound :: Word) + + Hspec.describe "Cast Word Natural" $ do + let f = Witch.cast @Word @Natural.Natural + test $ f 0 `Hspec.shouldBe` 0 + test $ f maxBound `Hspec.shouldBe` fromIntegral (maxBound :: Word) + + Hspec.describe "TryCast Word Int8" $ do + let f = Witch.tryCast @Word @Int.Int8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f 128 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word Int16" $ do + let f = Witch.tryCast @Word @Int.Int16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f 32768 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word Int32" $ do + Monad.when (toInteger (maxBound :: Word) < 2147483647) untested + let f = Witch.tryCast @Word @Int.Int32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 2147483647 `Hspec.shouldBe` Right 2147483647 + test $ f 2147483648 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word Int64" $ do + Monad.when (toInteger (maxBound :: Word) < 9223372036854775807) untested + let f = Witch.tryCast @Word @Int.Int64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9223372036854775807 `Hspec.shouldBe` Right 9223372036854775807 + test $ f 9223372036854775808 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word Int" $ do + let f = Witch.tryCast @Word @Int + test $ f 0 `Hspec.shouldBe` Right 0 + test $ let x = maxBound :: Int in Witch.tryCast @Word @Int (fromIntegral x) `Hspec.shouldBe` Right x + test $ let x = fromIntegral (maxBound :: Int) + 1 :: Word in Witch.tryCast @Word @Int x `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Word Integer" $ do + let f = Witch.cast @Word @Integer + test $ f 0 `Hspec.shouldBe` 0 + test $ f maxBound `Hspec.shouldBe` fromIntegral (maxBound :: Word) + + Hspec.describe "TryCast Word Float" $ do + let f = Witch.tryCast @Word @Float + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Word Double" $ do + Monad.when (toInteger (maxBound :: Word) < 9007199254740991) untested + let f = Witch.tryCast @Word @Double + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9007199254740991 `Hspec.shouldBe` Right 9007199254740991 + test $ f 9007199254740992 `Hspec.shouldSatisfy` Either.isLeft + + -- Natural + + Hspec.describe "TryCast Natural Word8" $ do + let f = Witch.tryCast @Natural.Natural @Word.Word8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 255 `Hspec.shouldBe` Right 255 + test $ f 256 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Natural Word16" $ do + let f = Witch.tryCast @Natural.Natural @Word.Word16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 65535 `Hspec.shouldBe` Right 65535 + test $ f 65536 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Natural Word32" $ do + let f = Witch.tryCast @Natural.Natural @Word.Word32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 4294967295 `Hspec.shouldBe` Right 4294967295 + test $ f 4294967296 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Natural Word64" $ do + let f = Witch.tryCast @Natural.Natural @Word.Word64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 18446744073709551615 `Hspec.shouldBe` Right 18446744073709551615 + test $ f 18446744073709551616 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Natural Word" $ do + let f = Witch.tryCast @Natural.Natural @Word + test $ f 0 `Hspec.shouldBe` Right 0 + test $ let x = maxBound :: Word in Witch.tryCast @Natural.Natural @Word (fromIntegral x) `Hspec.shouldBe` Right x + test $ let x = fromIntegral (maxBound :: Word) + 1 :: Natural.Natural in Witch.tryCast @Natural.Natural @Word x `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Natural Int8" $ do + let f = Witch.tryCast @Natural.Natural @Int.Int8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f 128 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Natural Int16" $ do + let f = Witch.tryCast @Natural.Natural @Int.Int16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f 32768 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Natural Int32" $ do + let f = Witch.tryCast @Natural.Natural @Int.Int32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 2147483647 `Hspec.shouldBe` Right 2147483647 + test $ f 2147483648 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Natural Int64" $ do + let f = Witch.tryCast @Natural.Natural @Int.Int64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9223372036854775807 `Hspec.shouldBe` Right 9223372036854775807 + test $ f 9223372036854775808 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Natural Int" $ do + let f = Witch.tryCast @Natural.Natural @Int + test $ f 0 `Hspec.shouldBe` Right 0 + test $ let x = maxBound :: Int in Witch.tryCast @Natural.Natural @Int (fromIntegral x) `Hspec.shouldBe` Right x + test $ let x = fromIntegral (maxBound :: Int) + 1 :: Natural.Natural in Witch.tryCast @Natural.Natural @Int x `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Natural Integer" $ do + let f = Witch.cast @Natural.Natural @Integer + test $ f 0 `Hspec.shouldBe` 0 + test $ f 9223372036854775808 `Hspec.shouldBe` 9223372036854775808 + + Hspec.describe "TryCast Natural Float" $ do + let f = Witch.tryCast @Natural.Natural @Float + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Natural Double" $ do + let f = Witch.tryCast @Natural.Natural @Double + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9007199254740991 `Hspec.shouldBe` Right 9007199254740991 + test $ f 9007199254740992 `Hspec.shouldSatisfy` Either.isLeft + + -- Float + + Hspec.describe "TryCast Float Int8" $ do + let f = Witch.tryCast @Float @Int.Int8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f 128 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-128) `Hspec.shouldBe` Right (-128) + test $ f (-129) `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Float Int16" $ do + let f = Witch.tryCast @Float @Int.Int16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f 32768 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-32768) `Hspec.shouldBe` Right (-32768) + test $ f (-32769) `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Float Int32" $ do + let f = Witch.tryCast @Float @Int.Int32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-16777215) `Hspec.shouldBe` Right (-16777215) + test $ f (-16777216) `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Float Int64" $ do + let f = Witch.tryCast @Float @Int.Int64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-16777215) `Hspec.shouldBe` Right (-16777215) + test $ f (-16777216) `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Float Int" $ do + let f = Witch.tryCast @Float @Int + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-16777215) `Hspec.shouldBe` Right (-16777215) + test $ f (-16777216) `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Float Integer" $ do + let f = Witch.tryCast @Float @Integer + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-16777215) `Hspec.shouldBe` Right (-16777215) + test $ f (-16777216) `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Float Word8" $ do + let f = Witch.tryCast @Float @Word.Word8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 255 `Hspec.shouldBe` Right 255 + test $ f 256 `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Float Word16" $ do + let f = Witch.tryCast @Float @Word.Word16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 65535 `Hspec.shouldBe` Right 65535 + test $ f 65536 `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Float Word32" $ do + let f = Witch.tryCast @Float @Word.Word32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Float Word64" $ do + let f = Witch.tryCast @Float @Word.Word64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Float Word" $ do + let f = Witch.tryCast @Float @Word + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Float Natural" $ do + let f = Witch.tryCast @Float @Natural.Natural + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f 16777216 `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Float Rational" $ do + let f = Witch.tryCast @Float @Rational + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f (-0) `Hspec.shouldBe` Right 0 + test $ f 0.5 `Hspec.shouldBe` Right 0.5 + test $ f (-0.5) `Hspec.shouldBe` Right (-0.5) + test $ f 16777215 `Hspec.shouldBe` Right 16777215 + test $ f (-16777215) `Hspec.shouldBe` Right (-16777215) + test $ f 16777216 `Hspec.shouldBe` Right 16777216 + test $ f (-16777216) `Hspec.shouldBe` Right (-16777216) + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Float Double" $ do + let f = Witch.cast @Float @Double + test $ f 0 `Hspec.shouldBe` 0 + test $ f 0.5 `Hspec.shouldBe` 0.5 + test $ f (-0.5) `Hspec.shouldBe` (-0.5) + test $ f (0 / 0) `Hspec.shouldSatisfy` isNaN + test $ f (1 / 0) `Hspec.shouldBe` (1 / 0) + test $ f (-1 / 0) `Hspec.shouldBe` (-1 / 0) + + -- Double + + Hspec.describe "TryCast Double Int8" $ do + let f = Witch.tryCast @Double @Int.Int8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 127 `Hspec.shouldBe` Right 127 + test $ f 128 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-128) `Hspec.shouldBe` Right (-128) + test $ f (-129) `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Double Int16" $ do + let f = Witch.tryCast @Double @Int.Int16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 32767 `Hspec.shouldBe` Right 32767 + test $ f 32768 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-32768) `Hspec.shouldBe` Right (-32768) + test $ f (-32769) `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Double Int32" $ do + let f = Witch.tryCast @Double @Int.Int32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 2147483647 `Hspec.shouldBe` Right 2147483647 + test $ f 2147483648 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-2147483648) `Hspec.shouldBe` Right (-2147483648) + test $ f (-2147483649) `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Double Int64" $ do + let f = Witch.tryCast @Double @Int.Int64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9007199254740991 `Hspec.shouldBe` Right 9007199254740991 + test $ f 9007199254740992 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-9007199254740991) `Hspec.shouldBe` Right (-9007199254740991) + test $ f (-9007199254740992) `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Double Int" $ do + Monad.when (toInteger (maxBound :: Int) < 9007199254740991) untested + let f = Witch.tryCast @Double @Int + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9007199254740991 `Hspec.shouldBe` Right 9007199254740991 + test $ f 9007199254740992 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-9007199254740991) `Hspec.shouldBe` Right (-9007199254740991) + test $ f (-9007199254740992) `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Double Integer" $ do + let f = Witch.tryCast @Double @Integer + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9007199254740991 `Hspec.shouldBe` Right 9007199254740991 + test $ f 9007199254740992 `Hspec.shouldSatisfy` Either.isLeft + test $ f (-9007199254740991) `Hspec.shouldBe` Right (-9007199254740991) + test $ f (-9007199254740992) `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Double Word8" $ do + let f = Witch.tryCast @Double @Word.Word8 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 255 `Hspec.shouldBe` Right 255 + test $ f 256 `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Double Word16" $ do + let f = Witch.tryCast @Double @Word.Word16 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 65535 `Hspec.shouldBe` Right 65535 + test $ f 65536 `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Double Word32" $ do + let f = Witch.tryCast @Double @Word.Word32 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 4294967295 `Hspec.shouldBe` Right 4294967295 + test $ f 4294967296 `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Double Word64" $ do + let f = Witch.tryCast @Double @Word.Word64 + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9007199254740991 `Hspec.shouldBe` Right 9007199254740991 + test $ f 9007199254740992 `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Double Word" $ do + Monad.when (toInteger (maxBound :: Word) < 9007199254740991) untested + let f = Witch.tryCast @Double @Word + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9007199254740991 `Hspec.shouldBe` Right 9007199254740991 + test $ f 9007199254740992 `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Double Natural" $ do + let f = Witch.tryCast @Double @Natural.Natural + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 9007199254740991 `Hspec.shouldBe` Right 9007199254740991 + test $ f 9007199254740992 `Hspec.shouldSatisfy` Either.isLeft + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "TryCast Double Rational" $ do + let f = Witch.tryCast @Double @Rational + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f (-0) `Hspec.shouldBe` Right 0 + test $ f 0.5 `Hspec.shouldBe` Right 0.5 + test $ f (-0.5) `Hspec.shouldBe` Right (-0.5) + test $ f 9007199254740991 `Hspec.shouldBe` Right 9007199254740991 + test $ f (-9007199254740991) `Hspec.shouldBe` Right (-9007199254740991) + test $ f 9007199254740992 `Hspec.shouldBe` Right 9007199254740992 + test $ f (-9007199254740992) `Hspec.shouldBe` Right (-9007199254740992) + test $ f (0 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (1 / 0) `Hspec.shouldSatisfy` Either.isLeft + test $ f (-1 / 0) `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Double Float" $ do + let f = Witch.cast @Double @Float + test $ f 0 `Hspec.shouldBe` 0 + test $ f 0.5 `Hspec.shouldBe` 0.5 + test $ f (-0.5) `Hspec.shouldBe` (-0.5) + test $ f (0 / 0) `Hspec.shouldSatisfy` isNaN + test $ f (1 / 0) `Hspec.shouldBe` (1 / 0) + test $ f (-1 / 0) `Hspec.shouldBe` (-1 / 0) + + -- Ratio + + Hspec.describe "Cast a (Ratio a)" $ do + test $ Witch.cast @Integer @Rational 0 `Hspec.shouldBe` 0 + let f = Witch.cast @Int @(Ratio.Ratio Int) + test $ f 0 `Hspec.shouldBe` 0 + + Hspec.describe "TryCast (Ratio a) a" $ do + test $ Witch.tryCast @Rational @Integer 0 `Hspec.shouldBe` Right 0 + test $ Witch.tryCast @Rational @Integer 0.5 `Hspec.shouldSatisfy` Either.isLeft + let f = Witch.tryCast @(Ratio.Ratio Int) @Int + test $ f 0 `Hspec.shouldBe` Right 0 + test $ f 0.5 `Hspec.shouldSatisfy` Either.isLeft + + Hspec.describe "Cast Rational Float" $ do + let f = Witch.cast @Rational @Float + test $ f 0 `Hspec.shouldBe` 0 + test $ f 0.5 `Hspec.shouldBe` 0.5 + test $ f (-0.5) `Hspec.shouldBe` (-0.5) + + Hspec.describe "Cast Rational Double" $ do + let f = Witch.cast @Rational @Double + test $ f 0 `Hspec.shouldBe` 0 + test $ f 0.5 `Hspec.shouldBe` 0.5 + test $ f (-0.5) `Hspec.shouldBe` (-0.5) + + -- Fixed + + Hspec.describe "Cast Integer (Fixed a)" $ do + test $ Witch.cast @Integer @Fixed.Uni 1 `Hspec.shouldBe` 1 + let f = Witch.cast @Integer @Fixed.Deci + test $ f 1 `Hspec.shouldBe` 0.1 + + Hspec.describe "Cast (Fixed a) Integer" $ do + test $ Witch.cast @Fixed.Uni @Integer 1 `Hspec.shouldBe` 1 + let f = Witch.cast @Fixed.Deci @Integer + test $ f 1 `Hspec.shouldBe` 10 + + -- Complex + + Hspec.describe "Cast a (Complex a)" $ do + test $ Witch.cast @Double @(Complex.Complex Double) 1 `Hspec.shouldBe` 1 + let f = Witch.cast @Float @(Complex.Complex Float) + test $ f 1 `Hspec.shouldBe` 1 + + Hspec.describe "TryCast (Complex a) a" $ do + test $ Witch.tryCast @(Complex.Complex Double) @Double 1 `Hspec.shouldBe` Right 1 + test $ Witch.tryCast @(Complex.Complex Double) @Double (0 Complex.:+ 1) `Hspec.shouldSatisfy` Either.isLeft + let f = Witch.tryCast @(Complex.Complex Float) @Float + test $ f 1 `Hspec.shouldBe` Right 1 + test $ f (0 Complex.:+ 1) `Hspec.shouldSatisfy` Either.isLeft + + -- NonEmpty + + Hspec.describe "TryCast [a] (NonEmpty a)" $ do + let f = Witch.tryCast @[Int] @(NonEmpty.NonEmpty Int) + test $ f [] `Hspec.shouldSatisfy` Either.isLeft + test $ f [1] `Hspec.shouldBe` Right (1 NonEmpty.:| []) + test $ f [1, 2] `Hspec.shouldBe` Right (1 NonEmpty.:| [2]) + + Hspec.describe "Cast (NonEmpty a) [a]" $ do + let f = Witch.cast @(NonEmpty.NonEmpty Int) @[Int] + test $ f (1 NonEmpty.:| []) `Hspec.shouldBe` [1] + test $ f (1 NonEmpty.:| [2]) `Hspec.shouldBe` [1, 2] + + -- Set + + Hspec.describe "Cast [a] (Set a)" $ do + let f = Witch.cast @[Char] @(Set.Set Char) + test $ f [] `Hspec.shouldBe` Set.fromList [] + test $ f ['a'] `Hspec.shouldBe` Set.fromList ['a'] + test $ f ['a', 'b'] `Hspec.shouldBe` Set.fromList ['a', 'b'] + test $ f ['a', 'a'] `Hspec.shouldBe` Set.fromList ['a'] + + Hspec.describe "Cast (Set a) [a]" $ do + let f = Witch.cast @(Set.Set Char) @[Char] + test $ f (Set.fromList []) `Hspec.shouldBe` [] + test $ f (Set.fromList ['a']) `Hspec.shouldBe` ['a'] + test $ f (Set.fromList ['a', 'b']) `Hspec.shouldBe` ['a', 'b'] + + -- IntSet + + Hspec.describe "Cast [Int] IntSet" $ do + let f = Witch.cast @[Int] @IntSet.IntSet + test $ f [] `Hspec.shouldBe` IntSet.fromList [] + test $ f [1] `Hspec.shouldBe` IntSet.fromList [1] + test $ f [1, 2] `Hspec.shouldBe` IntSet.fromList [1, 2] + + Hspec.describe "Cast IntSet [Int]" $ do + let f = Witch.cast @IntSet.IntSet @[Int] + test $ f (IntSet.fromList []) `Hspec.shouldBe` [] + test $ f (IntSet.fromList [1]) `Hspec.shouldBe` [1] + test $ f (IntSet.fromList [1, 2]) `Hspec.shouldBe` [1, 2] + + -- Map + + Hspec.describe "Cast [(k, v)] (Map k v)" $ do + let f = Witch.cast @[(Char, Int)] @(Map.Map Char Int) + test $ f [] `Hspec.shouldBe` Map.empty + test $ f [('a', 1)] `Hspec.shouldBe` Map.fromList [('a', 1)] + test $ f [('a', 1), ('b', 2)] `Hspec.shouldBe` Map.fromList [('a', 1), ('b', 2)] + test $ f [('a', 1), ('a', 2)] `Hspec.shouldBe` Map.fromList [('a', 2)] + + Hspec.describe "Cast (Map k v) [(k, v)]" $ do + let f = Witch.cast @(Map.Map Char Int) @[(Char, Int)] + test $ f Map.empty `Hspec.shouldBe` [] + test $ f (Map.fromList [('a', 1)]) `Hspec.shouldBe` [('a', 1)] + test $ f (Map.fromList [('a', 1), ('b', 2)]) `Hspec.shouldBe` [('a', 1), ('b', 2)] + + -- IntMap + + Hspec.describe "Cast [(Int, v)] (IntMap v)" $ do + let f = Witch.cast @[(Int, Char)] @(IntMap.IntMap Char) + test $ f [] `Hspec.shouldBe` IntMap.fromList [] + test $ f [(1, 'a')] `Hspec.shouldBe` IntMap.fromList [(1, 'a')] + test $ f [(1, 'a'), (2, 'b')] `Hspec.shouldBe` IntMap.fromList [(1, 'a'), (2, 'b')] + test $ f [(1, 'a'), (1, 'b')] `Hspec.shouldBe` IntMap.fromList [(1, 'b')] + + Hspec.describe "Cast (IntMap v) [(Int, v)]" $ do + let f = Witch.cast @(IntMap.IntMap Char) @[(Int, Char)] + test $ f (IntMap.fromList []) `Hspec.shouldBe` [] + test $ f (IntMap.fromList [(1, 'a')]) `Hspec.shouldBe` [(1, 'a')] + test $ f (IntMap.fromList [(1, 'a'), (2, 'b')]) `Hspec.shouldBe` [(1, 'a'), (2, 'b')] + + -- Seq + + Hspec.describe "Cast [a] (Seq a)" $ do + let f = Witch.cast @[Int] @(Seq.Seq Int) + test $ f [] `Hspec.shouldBe` Seq.fromList [] + test $ f [1] `Hspec.shouldBe` Seq.fromList [1] + test $ f [1, 2] `Hspec.shouldBe` Seq.fromList [1, 2] + + Hspec.describe "Cast (Seq a) [a]" $ do + let f = Witch.cast @(Seq.Seq Int) @[Int] + test $ f (Seq.fromList []) `Hspec.shouldBe` [] + test $ f (Seq.fromList [1]) `Hspec.shouldBe` [1] + test $ f (Seq.fromList [1, 2]) `Hspec.shouldBe` [1, 2] + + -- ByteString + + Hspec.describe "Cast [Word8] ByteString" $ do + let f = Witch.cast @[Word.Word8] @ByteString.ByteString + test $ f [] `Hspec.shouldBe` ByteString.pack [] + test $ f [0x00] `Hspec.shouldBe` ByteString.pack [0x00] + test $ f [0x0f, 0xf0] `Hspec.shouldBe` ByteString.pack [0x0f, 0xf0] + + Hspec.describe "Cast ByteString [Word8]" $ do + let f = Witch.cast @ByteString.ByteString @[Word.Word8] + test $ f (ByteString.pack []) `Hspec.shouldBe` [] + test $ f (ByteString.pack [0x00]) `Hspec.shouldBe` [0x00] + test $ f (ByteString.pack [0x0f, 0xf0]) `Hspec.shouldBe` [0x0f, 0xf0] + + Hspec.describe "Cast ByteString LazyByteString" $ do + let f = Witch.cast @ByteString.ByteString @LazyByteString.ByteString + test $ f (ByteString.pack []) `Hspec.shouldBe` LazyByteString.pack [] + test $ f (ByteString.pack [0x00]) `Hspec.shouldBe` LazyByteString.pack [0x00] + test $ f (ByteString.pack [0x0f, 0xf0]) `Hspec.shouldBe` LazyByteString.pack [0x0f, 0xf0] + + Hspec.describe "Cast ByteString ShortByteString" $ do + let f = Witch.cast @ByteString.ByteString @ShortByteString.ShortByteString + test $ f (ByteString.pack []) `Hspec.shouldBe` ShortByteString.pack [] + test $ f (ByteString.pack [0x00]) `Hspec.shouldBe` ShortByteString.pack [0x00] + test $ f (ByteString.pack [0x0f, 0xf0]) `Hspec.shouldBe` ShortByteString.pack [0x0f, 0xf0] + + Hspec.describe "TryCast ByteString Text" $ do + let f = Witch.tryCast @ByteString.ByteString @Text.Text + test $ f (ByteString.pack []) `Hspec.shouldBe` Right (Text.pack "") + test $ f (ByteString.pack [0x61]) `Hspec.shouldBe` Right (Text.pack "a") + test $ f (ByteString.pack [0xff]) `Hspec.shouldSatisfy` Either.isLeft + + -- LazyByteString + + Hspec.describe "Cast [Word8] LazyByteString" $ do + let f = Witch.cast @[Word.Word8] @LazyByteString.ByteString + test $ f [] `Hspec.shouldBe` LazyByteString.pack [] + test $ f [0x00] `Hspec.shouldBe` LazyByteString.pack [0x00] + test $ f [0x0f, 0xf0] `Hspec.shouldBe` LazyByteString.pack [0x0f, 0xf0] + + Hspec.describe "Cast LazyByteString [Word8]" $ do + let f = Witch.cast @LazyByteString.ByteString @[Word.Word8] + test $ f (LazyByteString.pack []) `Hspec.shouldBe` [] + test $ f (LazyByteString.pack [0x00]) `Hspec.shouldBe` [0x00] + test $ f (LazyByteString.pack [0x0f, 0xf0]) `Hspec.shouldBe` [0x0f, 0xf0] + + Hspec.describe "Cast LazyByteString ByteString" $ do + let f = Witch.cast @LazyByteString.ByteString @ByteString.ByteString + test $ f (LazyByteString.pack []) `Hspec.shouldBe` ByteString.pack [] + test $ f (LazyByteString.pack [0x00]) `Hspec.shouldBe` ByteString.pack [0x00] + test $ f (LazyByteString.pack [0x0f, 0xf0]) `Hspec.shouldBe` ByteString.pack [0x0f, 0xf0] + + Hspec.describe "TryCast LazyByteString LazyText" $ do + let f = Witch.tryCast @LazyByteString.ByteString @LazyText.Text + test $ f (LazyByteString.pack []) `Hspec.shouldBe` Right (LazyText.pack "") + test $ f (LazyByteString.pack [0x61]) `Hspec.shouldBe` Right (LazyText.pack "a") + test $ f (LazyByteString.pack [0xff]) `Hspec.shouldSatisfy` Either.isLeft + + -- ShortByteString + + Hspec.describe "Cast [Word8] ShortByteString" $ do + let f = Witch.cast @[Word.Word8] @ShortByteString.ShortByteString + test $ f [] `Hspec.shouldBe` ShortByteString.pack [] + test $ f [0x00] `Hspec.shouldBe` ShortByteString.pack [0x00] + test $ f [0x0f, 0xf0] `Hspec.shouldBe` ShortByteString.pack [0x0f, 0xf0] + + Hspec.describe "Cast ShortByteString [Word8]" $ do + let f = Witch.cast @ShortByteString.ShortByteString @[Word.Word8] + test $ f (ShortByteString.pack []) `Hspec.shouldBe` [] + test $ f (ShortByteString.pack [0x00]) `Hspec.shouldBe` [0x00] + test $ f (ShortByteString.pack [0x0f, 0xf0]) `Hspec.shouldBe` [0x0f, 0xf0] + + Hspec.describe "Cast ShortByteString ByteString" $ do + let f = Witch.cast @ShortByteString.ShortByteString @ByteString.ByteString + test $ f (ShortByteString.pack []) `Hspec.shouldBe` ByteString.pack [] + test $ f (ShortByteString.pack [0x00]) `Hspec.shouldBe` ByteString.pack [0x00] + test $ f (ShortByteString.pack [0x0f, 0xf0]) `Hspec.shouldBe` ByteString.pack [0x0f, 0xf0] + + -- Text + + Hspec.describe "Cast String Text" $ do + let f = Witch.cast @String @Text.Text + test $ f "" `Hspec.shouldBe` Text.pack "" + test $ f "a" `Hspec.shouldBe` Text.pack "a" + test $ f "ab" `Hspec.shouldBe` Text.pack "ab" + + Hspec.describe "Cast Text String" $ do + let f = Witch.cast @Text.Text @String + test $ f (Text.pack "") `Hspec.shouldBe` "" + test $ f (Text.pack "a") `Hspec.shouldBe` "a" + test $ f (Text.pack "ab") `Hspec.shouldBe` "ab" + + Hspec.describe "Cast Text LazyText" $ do + let f = Witch.cast @Text.Text @LazyText.Text + test $ f (Text.pack "") `Hspec.shouldBe` LazyText.pack "" + test $ f (Text.pack "a") `Hspec.shouldBe` LazyText.pack "a" + test $ f (Text.pack "ab") `Hspec.shouldBe` LazyText.pack "ab" + + Hspec.describe "Cast Text ByteString" $ do + let f = Witch.cast @Text.Text @ByteString.ByteString + test $ f (Text.pack "") `Hspec.shouldBe` ByteString.pack [] + test $ f (Text.pack "a") `Hspec.shouldBe` ByteString.pack [0x61] + + -- LazyText + + Hspec.describe "Cast String LazyText" $ do + let f = Witch.cast @String @LazyText.Text + test $ f "" `Hspec.shouldBe` LazyText.pack "" + test $ f "a" `Hspec.shouldBe` LazyText.pack "a" + test $ f "ab" `Hspec.shouldBe` LazyText.pack "ab" + + Hspec.describe "Cast LazyText String" $ do + let f = Witch.cast @LazyText.Text @String + test $ f (LazyText.pack "") `Hspec.shouldBe` "" + test $ f (LazyText.pack "a") `Hspec.shouldBe` "a" + test $ f (LazyText.pack "ab") `Hspec.shouldBe` "ab" + + Hspec.describe "Cast LazyText Text" $ do + let f = Witch.cast @LazyText.Text @Text.Text + test $ f (LazyText.pack "") `Hspec.shouldBe` Text.pack "" + test $ f (LazyText.pack "a") `Hspec.shouldBe` Text.pack "a" + test $ f (LazyText.pack "ab") `Hspec.shouldBe` Text.pack "ab" + + Hspec.describe "Cast LazyText LazyByteString" $ do + let f = Witch.cast @LazyText.Text @LazyByteString.ByteString + test $ f (LazyText.pack "") `Hspec.shouldBe` LazyByteString.pack [] + test $ f (LazyText.pack "a") `Hspec.shouldBe` LazyByteString.pack [0x61] + +test :: Hspec.Example a => a -> Hspec.SpecWith (Hspec.Arg a) +test = Hspec.it "" + +untested :: Hspec.SpecWith a +untested = Hspec.runIO $ Exception.throwIO Untested + +data Untested + = Untested + deriving (Eq, Show) + +instance Exception.Exception Untested + +newtype Name + = Name String + deriving (Eq, Show) + +instance Witch.Cast Name String + +instance Witch.Cast String Name diff --git a/witch.cabal b/witch.cabal --- a/witch.cabal +++ b/witch.cabal @@ -1,52 +1,77 @@ -cabal-version: >= 1.10 +cabal-version: 2.2 +name: witch +version: 0.1.0.0 +synopsis: Convert values from one type into another. +description: Witch converts values from one type into another. + build-type: Simple category: Data -description: Witch converts values from one type into another. extra-source-files: CHANGELOG.markdown README.markdown license-file: LICENSE.txt license: ISC maintainer: Taylor Fausak -name: witch -synopsis: Convert values from one type into another. -version: 0.0.0.5 source-repository head location: https://github.com/tfausak/witch type: git -library +common basics build-depends: - base >= 4.13.0 && < 4.16 - , bytestring >= 0.10.10 && < 0.11 + , base >= 4.13.0 && < 4.16 + , bytestring >= 0.10.12 && < 0.11 , containers >= 0.6.2 && < 0.7 , text >= 1.2.4 && < 1.3 default-language: Haskell2010 - exposed-modules: Witch ghc-options: -Weverything -Wno-implicit-prelude + -Wno-missing-deriving-strategies + -Wno-missing-export-lists + -Wno-missing-exported-signatures -Wno-redundant-constraints -Wno-safe -Wno-unsafe - hs-source-dirs: src/lib if impl(ghc >= 8.10) ghc-options: -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module +library + import: basics + + build-depends: + , template-haskell >= 2.15.0 && < 2.18 + exposed-modules: + Witch + Witch.Cast + Witch.Identity + Witch.Instances + Witch.Lift + Witch.TryCast + Witch.TryCastException + Witch.Utility + hs-source-dirs: src/lib + + if impl(ghc >= 9.0) + hs-source-dirs: src/ghc-9.0 + else + if impl(ghc >= 8.10) + hs-source-dirs: src/ghc-8.10 + else + hs-source-dirs: src/ghc-8.8 + test-suite test + import: basics + build-depends: - base - , bytestring - , containers - , hspec >= 2.7.6 && < 2.8 - , QuickCheck >= 2.13.2 && < 2.15 - , text + , hspec >= 2.7.9 && < 2.8 , witch - default-language: Haskell2010 - ghc-options: -rtsopts -threaded + ghc-options: + -rtsopts + -threaded + -Wno-all-missed-specialisations hs-source-dirs: src/test main-is: Main.hs type: exitcode-stdio-1.0