witch-1.2.1.1/0000755000000000000000000000000007346545000011161 5ustar0000000000000000witch-1.2.1.1/CHANGELOG.md0000644000000000000000000000025107346545000012770 0ustar0000000000000000# Change log Witch follows the [Package Versioning Policy](https://pvp.haskell.org). You can find release notes [on GitHub](https://github.com/tfausak/witch/releases). witch-1.2.1.1/LICENSE.txt0000644000000000000000000000205607346545000013007 0ustar0000000000000000MIT License Copyright (c) 2023 Taylor Fausak Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. witch-1.2.1.1/README.md0000644000000000000000000000056607346545000012447 0ustar0000000000000000# Witch [![CI](https://github.com/tfausak/witch/actions/workflows/ci.yml/badge.svg)](https://github.com/tfausak/witch/actions/workflows/ci.yml) [![Hackage](https://badgen.net/hackage/v/witch)](https://hackage.haskell.org/package/witch) :mage_woman: Convert values from one type into another. See the documentation on Hackage: . witch-1.2.1.1/source/library/0000755000000000000000000000000007346545000014125 5ustar0000000000000000witch-1.2.1.1/source/library/Witch.hs0000644000000000000000000003061107346545000015540 0ustar0000000000000000-- | 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: -- -- >>> import Witch -- -- In typical usage, the functions that you will use most often are -- 'Witch.Utility.into' for conversions that always succeed and -- 'Witch.Utility.tryInto' for conversions that sometimes fail. -- -- Please consider reading the blog post that announces this library: -- module Witch ( -- * Type classes -- ** From Witch.From.From (from), Witch.Utility.into, -- ** TryFrom Witch.TryFrom.TryFrom (tryFrom), Witch.Utility.tryInto, -- * Data types Witch.TryFromException.TryFromException (..), -- ** Encodings Witch.Encoding.ISO_8859_1, Witch.Encoding.UTF_8, Witch.Encoding.UTF_16LE, Witch.Encoding.UTF_16BE, Witch.Encoding.UTF_32LE, Witch.Encoding.UTF_32BE, -- * Utilities Witch.Utility.via, Witch.Utility.tryVia, Witch.Utility.maybeTryFrom, Witch.Utility.eitherTryFrom, -- ** Unsafe -- | These functions should only be used in two circumstances: When you know -- a conversion is safe even though you can't prove it to the compiler, and -- when you're alright with your program crashing if the conversion fails. -- In all other cases you should prefer the normal conversion functions like -- 'Witch.TryFrom.tryFrom'. And if you're converting a literal value, -- consider using the Template Haskell conversion functions like -- 'Witch.Lift.liftedFrom'. Witch.Utility.unsafeFrom, Witch.Utility.unsafeInto, -- ** Template Haskell -- | This library uses /typed/ Template Haskell, which may be a little -- different than what you're used to. Normally Template Haskell uses the -- @$(...)@ syntax for splicing in things to run at compile time. The typed -- variant uses the @$$(...)@ syntax for splices, doubling up on the dollar -- signs. Other than that, using typed Template Haskell should be pretty -- much the same as using regular Template Haskell. Witch.Lift.liftedFrom, Witch.Lift.liftedInto, -- * Notes -- ** 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. -- -- This library tries to address that problem by providing a common -- interface for converting between types. The 'Witch.From.From' type class -- is for conversions that cannot fail, and the 'Witch.TryFrom.TryFrom' 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. -- ** Type applications -- | Although you can use this library without the [@TypeApplications@](https://downloads.haskell.org/ghc/9.6.1/docs/users_guide/exts/type_applications.html) -- language extension, the extension is strongly recommended. Since most -- functions provided by this library are polymorphic in at least one type -- variable, it's easy to use them in a situation that would be ambiguous. -- Normally you could resolve the ambiguity with an explicit type signature, -- but type applications are much more ergonomic. For example: -- -- > -- Avoid this: -- > f . (from :: Int8 -> Int16) . g -- > -- > -- Prefer this: -- > f . from @Int8 @Int16 . g -- -- Most functions in this library have two versions with their type -- variables in opposite orders. That's because usually one side of the -- conversion or the other already has its type inferred by context. In -- those situations it makes sense to only provide one type argument. -- -- > -- Avoid this: (assuming f :: Int16 -> ...) -- > f $ from @Int8 @Int16 0 -- > -- > -- Prefer this: -- > f $ from @Int8 0 -- -- > -- Avoid this: (assuming x :: Int8) -- > g $ from @Int8 @Int16 x -- > -- > -- Prefer this: -- > g $ into @Int16 x -- ** 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. -- ** Instances -- | When should you add a 'Witch.From.From' (or 'Witch.TryFrom.TryFrom') -- 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 -- 'Witch.From.From' instance for them. -- -- - Conversions should be lossless. If you have @From a b@ then no two @a@ -- values should be converted to the same @b@ value. -- -- - Some conversions necessarily lose information, like converting from -- a list into a set. -- -- - If you have both @From a b@ and @From b a@, then -- @from \@b \@a . from \@a \@b@ should be the same as 'id'. In other -- words, @a@ and @b@ are isomorphic. -- -- - This often true, but not always. For example, converting a list -- into a set will remove duplicates. And then converting back into a -- list will put the elements in ascending order. -- -- - If you have both @From a b@ and @From b c@, then you could also have -- @From a c@ and it should be the same as @from \@b \@c . from \@a \@b@. -- In other words, @From@ is transitive. -- -- - This is not always true. For example an @Int8@ may be represented -- as a number in JSON, whereas an @Int64@ might be represented as a -- string. That means @into \@JSON (into \@Int64 int8)@ would not be -- the same as @into \@JSON int8@. -- -- - You should not have both a @From@ instance and a @TryFrom@ instance for -- the same pair of types. -- -- - If you have a @From@ or @TryFrom@ instance for a pair of types, then -- you should probably have a @From@ or @TryFrom@ instance for the same -- pair of types but in the opposite direction. In other words if you have -- @From a b@ then you should have @From b a@ or @TryFrom b a@. -- -- In general if @s@ /is/ a @t@, then you should add a 'Witch.From.From' -- instance for it. But if @s@ merely /can be/ a @t@, then you could add a -- 'Witch.TryFrom.TryFrom' 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. -- ** Laws -- | As the previous section notes, there aren't any cut and dried laws for -- the @From@ and @TryFrom@ type classes. However it can be useful to -- consider the following equations for guiding instances: -- -- > -- same strictness -- > seq (from @a @b x) y = seq x y -- > seq (tryFrom @a @b x) y = seq x y -- -- > -- round trip -- > from @b @a (from @a @b x) = x -- -- > -- transitive -- > from @b @c (from @a @b x) = from @a @c x -- > tryFrom @b @a (from @a @b x) = Right x -- > if isRight (tryFrom @a @b x) then -- > fmap (from @b @a) (tryFrom @a @b x) = Right x -- > if isRight (tryFrom @a @b x) then do -- > fmap (tryFrom @b @a) (tryFrom @a @b x) = Right (Right x) -- ** Integral types -- | There are a lot of types that represent various different ranges of -- integers, and Witch may not provide the instances you want. In particular -- it does not provide a total way to convert from an @Int32@ into an @Int@. -- Why is that? -- -- The Haskell Language Report only demands that @Int@s have at least 30 -- bits of precision. That means a reasonable Haskell implementation could -- have an @Int@ type that's smaller than the @Int32@ type. -- -- However in practice everyone uses the same Haskell implementation: GHC. -- And with GHC the @Int@ type always has 32 bits of precision, even on -- 32-bit architectures. So for almost everybody, it's probably safe to use -- @unsafeFrom \@Int32 \@Int@. Similarly most software these days runs on -- machines with 64-bit architectures. That means it's also probably safe -- for you to use @unsafeFrom \@Int64 \@Int@. -- -- All of the above also applies for @Word@, @Word32@, and @Word64@. -- ** Downsides -- | As the author of this library, I obviously think that everyone should -- use it because it's the greatest thing since sliced bread. But nothing is -- perfect, so what are some downsides to this library? -- -- - More specific type classes are often better. For example, @IsString s@ -- is more useful that @From String s@. The former says that the type @s@ -- is the same as a string literal, but the latter just says you can -- produce a value of type @s@ when given a string. -- -- - The @From@ type class works great for specific pairs of types, but can -- get confusing when it's polymorphic. For example if you have some -- function with a @From s t@ constraint, that doesn't really tell you -- anything about what it's doing. ) where import qualified Witch.Encoding import qualified Witch.From import Witch.Instances () import qualified Witch.Lift import qualified Witch.TryFrom import qualified Witch.TryFromException import qualified Witch.Utility witch-1.2.1.1/source/library/Witch/0000755000000000000000000000000007346545000015203 5ustar0000000000000000witch-1.2.1.1/source/library/Witch/Encoding.hs0000644000000000000000000000115107346545000017263 0ustar0000000000000000{-# LANGUAGE DataKinds #-} module Witch.Encoding where import qualified Data.Tagged as Tagged -- | type ISO_8859_1 = Tagged.Tagged "ISO-8859-1" -- | type UTF_8 = Tagged.Tagged "UTF-8" -- | type UTF_16LE = Tagged.Tagged "UTF-16LE" -- | type UTF_16BE = Tagged.Tagged "UTF-16BE" -- | type UTF_32LE = Tagged.Tagged "UTF-32LE" -- | type UTF_32BE = Tagged.Tagged "UTF-32BE" witch-1.2.1.1/source/library/Witch/From.hs0000644000000000000000000000256107346545000016446 0ustar0000000000000000{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} module Witch.From 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 @'From' source target@ means that -- you can convert from a value of type @source@ into a value of type -- @target@. -- -- This type class is for conversions that always succeed. If your conversion -- sometimes fails, consider implementing @TryFrom@ instead. class From source target where -- | This method implements the conversion of a value between types. At call -- sites you may prefer to use @into@ instead. -- -- > -- Avoid this: -- > from (x :: s) -- > -- > -- Prefer this (using [@TypeApplications@](https://downloads.haskell.org/ghc/9.6.1/docs/users_guide/exts/type_applications.html) language extension): -- > from @s x -- -- 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 From Name String -- >>> instance From String Name from :: source -> target default from :: (Coerce.Coercible source target) => source -> target from = Coerce.coerce witch-1.2.1.1/source/library/Witch/Instances.hs0000644000000000000000000015004607346545000017474 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} module Witch.Instances where import qualified Control.Exception as Exception import qualified Control.Monad as Monad import qualified Data.Bits as Bits import qualified Data.ByteString as ByteString import qualified Data.ByteString.Char8 as Char8 import qualified Data.ByteString.Lazy as LazyByteString import qualified Data.ByteString.Lazy.Char8 as LazyChar8 import qualified Data.ByteString.Short as ShortByteString import qualified Data.Char as Char 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 as List 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.Tagged as Tagged import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Text.Encoding.Error as Text import qualified Data.Text.Lazy as LazyText import qualified Data.Text.Lazy.Encoding as LazyText import qualified Data.Time as Time import qualified Data.Time.Clock.POSIX as Time import qualified Data.Time.Clock.System as Time import qualified Data.Time.Clock.TAI as Time import qualified Data.Word as Word import qualified GHC.Float as Float import qualified Numeric import qualified Numeric.Natural as Natural import qualified System.IO.Unsafe as Unsafe import qualified Witch.Encoding as Encoding import qualified Witch.From as From import qualified Witch.TryFrom as TryFrom import qualified Witch.TryFromException as TryFromException import qualified Witch.Utility as Utility -- | Uses 'id'. instance From.From a a where from = id -- Int8 -- | Uses 'fromIntegral'. instance From.From Int.Int8 Int.Int16 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Int.Int8 Int.Int32 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Int.Int8 Int.Int64 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Int.Int8 Int where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Int.Int8 Integer where from = fromIntegral -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int8 Word.Word8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int8 Word.Word16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int8 Word.Word32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int8 Word.Word64 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int8 Word where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral' when the input is not negative. instance TryFrom.TryFrom Int.Int8 Natural.Natural where tryFrom = Utility.eitherTryFrom fromNonNegativeIntegral -- | Uses 'fromIntegral'. instance From.From Int.Int8 Float where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Int.Int8 Double where from = fromIntegral -- Int16 -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int16 Int.Int8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Int.Int16 Int.Int32 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Int.Int16 Int.Int64 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Int.Int16 Int where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Int.Int16 Integer where from = fromIntegral -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int16 Word.Word8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int16 Word.Word16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int16 Word.Word32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int16 Word.Word64 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int16 Word where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral' when the input is not negative. instance TryFrom.TryFrom Int.Int16 Natural.Natural where tryFrom = Utility.eitherTryFrom fromNonNegativeIntegral -- | Uses 'fromIntegral'. instance From.From Int.Int16 Float where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Int.Int16 Double where from = fromIntegral -- Int32 -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int32 Int.Int8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int32 Int.Int16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Int.Int32 Int.Int64 where from = fromIntegral -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int32 Int where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Int.Int32 Integer where from = fromIntegral -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int32 Word.Word8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int32 Word.Word16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int32 Word.Word32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int32 Word.Word64 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int32 Word where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral' when the input is not negative. instance TryFrom.TryFrom Int.Int32 Natural.Natural where tryFrom = Utility.eitherTryFrom fromNonNegativeIntegral -- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215 -- inclusive. instance TryFrom.TryFrom Int.Int32 Float where tryFrom = Utility.eitherTryFrom $ \s -> if s < -maxFloat then Left Exception.Underflow else if s > maxFloat then Left Exception.Overflow else Right $ fromIntegral s -- | Uses 'fromIntegral'. instance From.From Int.Int32 Double where from = fromIntegral -- Int64 -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int64 Int.Int8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int64 Int.Int16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int64 Int.Int32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int64 Int where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Int.Int64 Integer where from = fromIntegral -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int64 Word.Word8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int64 Word.Word16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int64 Word.Word32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int64 Word.Word64 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int.Int64 Word where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral' when the input is not negative. instance TryFrom.TryFrom Int.Int64 Natural.Natural where -- This should use @eitherTryFrom fromNonNegativeIntegral@, but that causes -- a bug in GHC 9.0.1. -- https://mail.haskell.org/pipermail/haskell-cafe/2021-March/133540.html tryFrom = Utility.eitherTryFrom $ \s -> TryFrom.tryFrom (From.from s :: Integer) -- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215 -- inclusive. instance TryFrom.TryFrom Int.Int64 Float where tryFrom = Utility.eitherTryFrom $ \s -> if s < -maxFloat then Left Exception.Underflow else if s > maxFloat then Left Exception.Overflow else Right $ fromIntegral s -- | Uses 'fromIntegral' when the input is between -9,007,199,254,740,991 and -- 9,007,199,254,740,991 inclusive. instance TryFrom.TryFrom Int.Int64 Double where tryFrom = Utility.eitherTryFrom $ \s -> if s < -maxDouble then Left Exception.Underflow else if s > maxDouble then Left Exception.Overflow else Right $ fromIntegral s -- Int -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int Int.Int8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int Int.Int16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int Int.Int32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Int Int.Int64 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Int Integer where from = fromIntegral -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int Word.Word8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int Word.Word16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int Word.Word32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int Word.Word64 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Int Word where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral' when the input is not negative. instance TryFrom.TryFrom Int Natural.Natural where tryFrom = Utility.eitherTryFrom fromNonNegativeIntegral -- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215 -- inclusive. instance TryFrom.TryFrom Int Float where tryFrom = Utility.eitherTryFrom $ \s -> if s < -maxFloat then Left Exception.Underflow else if s > maxFloat then Left Exception.Overflow else Right $ fromIntegral s -- | Uses 'fromIntegral' when the input is between -9,007,199,254,740,991 and -- 9,007,199,254,740,991 inclusive. instance TryFrom.TryFrom Int Double where tryFrom = Utility.eitherTryFrom $ \s -> if toInteger (maxBound :: Int) <= maxDouble then Right $ fromIntegral s else if s < -maxDouble then Left Exception.Underflow else if s > maxDouble then Left Exception.Overflow else Right $ fromIntegral s -- Integer -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Integer Int.Int8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Integer Int.Int16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Integer Int.Int32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Integer Int.Int64 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Integer Int where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Integer Word.Word8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Integer Word.Word16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Integer Word.Word32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Integer Word.Word64 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Integer Word where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromInteger' when the input is not negative. instance TryFrom.TryFrom Integer Natural.Natural where -- This should use @eitherTryFrom 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 tryFrom = Utility.eitherTryFrom $ \s -> if s < 0 then Left Exception.Underflow else Right $ fromInteger s -- | Uses 'fromIntegral' when the input is between -16,777,215 and 16,777,215 -- inclusive. instance TryFrom.TryFrom Integer Float where tryFrom = Utility.eitherTryFrom $ \s -> if s < -maxFloat then Left Exception.Underflow else if s > maxFloat then Left Exception.Overflow else Right $ fromIntegral s -- | Uses 'fromIntegral' when the input is between -9,007,199,254,740,991 and -- 9,007,199,254,740,991 inclusive. instance TryFrom.TryFrom Integer Double where tryFrom = Utility.eitherTryFrom $ \s -> if s < -maxDouble then Left Exception.Underflow else if s > maxDouble then Left Exception.Overflow else Right $ fromIntegral s -- Word8 -- | Uses 'fromIntegral'. instance From.From Word.Word8 Word.Word16 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word8 Word.Word32 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word8 Word.Word64 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word8 Word where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word8 Natural.Natural where from = fromIntegral -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word8 Int.Int8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Word.Word8 Int.Int16 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word8 Int.Int32 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word8 Int.Int64 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word8 Int where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word8 Integer where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word8 Float where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word8 Double where from = fromIntegral -- Word16 -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word16 Word.Word8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Word.Word16 Word.Word32 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word16 Word.Word64 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word16 Word where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word16 Natural.Natural where from = fromIntegral -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word16 Int.Int8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word16 Int.Int16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Word.Word16 Int.Int32 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word16 Int.Int64 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word16 Int where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word16 Integer where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word16 Float where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word.Word16 Double where from = fromIntegral -- Word32 -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word32 Word.Word8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word32 Word.Word16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Word.Word32 Word.Word64 where from = fromIntegral -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word32 Word where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Word.Word32 Natural.Natural where from = fromIntegral -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word32 Int.Int8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word32 Int.Int16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word32 Int.Int32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Word.Word32 Int.Int64 where from = fromIntegral -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word32 Int where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Word.Word32 Integer where from = fromIntegral -- | Uses 'fromIntegral' when the input is less than or equal to 16,777,215. instance TryFrom.TryFrom Word.Word32 Float where tryFrom = Utility.eitherTryFrom $ \s -> if s <= maxFloat then Right $ fromIntegral s else Left Exception.Overflow -- | Uses 'fromIntegral'. instance From.From Word.Word32 Double where from = fromIntegral -- Word64 -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word64 Word.Word8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word64 Word.Word16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word64 Word.Word32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word64 Word where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Word.Word64 Natural.Natural where -- This should use @fromIntegral@, but that causes a bug in GHC 9.0.1. -- https://mail.haskell.org/pipermail/haskell-cafe/2021-March/133540.html from s = Utility.unsafeFrom (From.from s :: Integer) -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word64 Int.Int8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word64 Int.Int16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word64 Int.Int32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word64 Int.Int64 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word.Word64 Int where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Word.Word64 Integer where from = fromIntegral -- | Uses 'fromIntegral' when the input is less than or equal to 16,777,215. instance TryFrom.TryFrom Word.Word64 Float where tryFrom = Utility.eitherTryFrom $ \s -> if s <= maxFloat then Right $ fromIntegral s else Left Exception.Overflow -- | Uses 'fromIntegral' when the input is less than or equal to -- 9,007,199,254,740,991. instance TryFrom.TryFrom Word.Word64 Double where tryFrom = Utility.eitherTryFrom $ \s -> if s <= maxDouble then Right $ fromIntegral s else Left Exception.Overflow -- Word -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word Word.Word8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word Word.Word16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word Word.Word32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Word Word.Word64 where from = fromIntegral -- | Uses 'fromIntegral'. instance From.From Word Natural.Natural where from = fromIntegral -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word Int.Int8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word Int.Int16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word Int.Int32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word Int.Int64 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Word Int where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Word Integer where from = fromIntegral -- | Uses 'fromIntegral' when the input is less than or equal to 16,777,215. instance TryFrom.TryFrom Word Float where tryFrom = Utility.eitherTryFrom $ \s -> if s <= maxFloat then Right $ fromIntegral s else Left Exception.Overflow -- | Uses 'fromIntegral' when the input is less than or equal to -- 9,007,199,254,740,991. instance TryFrom.TryFrom Word Double where tryFrom = Utility.eitherTryFrom $ \s -> if (toInteger (maxBound :: Word) <= maxDouble) || (s <= maxDouble) then Right $ fromIntegral s else Left Exception.Overflow -- Natural -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Natural.Natural Word.Word8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Natural.Natural Word.Word16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Natural.Natural Word.Word32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Natural.Natural Word.Word64 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Natural.Natural Word where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Natural.Natural Int.Int8 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Natural.Natural Int.Int16 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Natural.Natural Int.Int32 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Natural.Natural Int.Int64 where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'Bits.toIntegralSized'. instance TryFrom.TryFrom Natural.Natural Int where tryFrom = Utility.maybeTryFrom Bits.toIntegralSized -- | Uses 'fromIntegral'. instance From.From Natural.Natural Integer where from = fromIntegral -- | Uses 'fromIntegral' when the input is less than or equal to 16,777,215. instance TryFrom.TryFrom Natural.Natural Float where tryFrom = Utility.eitherTryFrom $ \s -> if s <= maxFloat then Right $ fromIntegral s else Left Exception.Overflow -- | Uses 'fromIntegral' when the input is less than or equal to -- 9,007,199,254,740,991. instance TryFrom.TryFrom Natural.Natural Double where tryFrom = Utility.eitherTryFrom $ \s -> if s <= maxDouble then Right $ fromIntegral s else Left Exception.Overflow -- Float -- | Converts via 'Integer'. instance TryFrom.TryFrom Float Int.Int8 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Float Int.Int16 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Float Int.Int32 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Float Int.Int64 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Float Int where tryFrom = Utility.tryVia @Integer -- | Converts via 'Rational' when the input is between -16,777,215 and -- 16,777,215 inclusive. instance TryFrom.TryFrom Float Integer where tryFrom = Utility.eitherTryFrom $ \s -> case Utility.tryVia @Rational s of Left e -> Left $ Exception.toException e Right t | t < -maxFloat -> Left $ Exception.toException Exception.Underflow | t > maxFloat -> Left $ Exception.toException Exception.Overflow | otherwise -> Right t -- | Converts via 'Integer'. instance TryFrom.TryFrom Float Word.Word8 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Float Word.Word16 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Float Word.Word32 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Float Word.Word64 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Float Word where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Float Natural.Natural where tryFrom = Utility.tryVia @Integer -- | Uses 'Numeric.floatToDigits' when the input is not NaN or infinity. instance TryFrom.TryFrom Float Rational where tryFrom = Utility.eitherTryFrom realFloatToRational -- | Uses 'Float.float2Double'. instance From.From Float Double where from = Float.float2Double -- Double -- | Converts via 'Integer'. instance TryFrom.TryFrom Double Int.Int8 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Double Int.Int16 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Double Int.Int32 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Double Int.Int64 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Double Int where tryFrom = 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 TryFrom.TryFrom Double Integer where tryFrom = Utility.eitherTryFrom $ \s -> case Utility.tryVia @Rational s of Left e -> Left $ Exception.toException e Right t | t < -maxDouble -> Left $ Exception.toException Exception.Underflow | t > maxDouble -> Left $ Exception.toException Exception.Overflow | otherwise -> Right t -- | Converts via 'Integer'. instance TryFrom.TryFrom Double Word.Word8 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Double Word.Word16 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Double Word.Word32 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Double Word.Word64 where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Double Word where tryFrom = Utility.tryVia @Integer -- | Converts via 'Integer'. instance TryFrom.TryFrom Double Natural.Natural where tryFrom = Utility.tryVia @Integer -- | Uses 'Numeric.floatToDigits' when the input is not NaN or infinity. instance TryFrom.TryFrom Double Rational where tryFrom = Utility.eitherTryFrom realFloatToRational -- | Uses 'Float.double2Float'. This necessarily loses some precision. instance From.From Double Float where from = Float.double2Float -- Ratio -- | Uses '(Ratio.%)' with a denominator of 1. instance (Integral a) => From.From a (Ratio.Ratio a) where from = (Ratio.% 1) -- | Uses 'Ratio.numerator' when the denominator is 1. instance (Eq a, Num a) => TryFrom.TryFrom (Ratio.Ratio a) a where tryFrom = Utility.eitherTryFrom $ \s -> if Ratio.denominator s == 1 then Right $ Ratio.numerator s else Left Exception.LossOfPrecision -- | Uses 'fromRational'. This necessarily loses some precision. instance From.From Rational Float where from = fromRational -- | Uses 'fromRational'. This necessarily loses some precision. instance From.From Rational Double where from = fromRational -- | Uses `fromRational` as long as there isn't a loss of precision. instance (Fixed.HasResolution a) => TryFrom.TryFrom Rational (Fixed.Fixed a) where tryFrom = Utility.eitherTryFrom $ \s -> let t :: Fixed.Fixed a t = fromRational s in if toRational t == s then Right t else Left Exception.LossOfPrecision -- Fixed -- | Uses 'Fixed.MkFixed'. This means @from \@Integer \@Centi 2@ is @0.02@ -- rather than @2.00@. instance From.From Integer (Fixed.Fixed a) where from = Fixed.MkFixed -- | Uses 'Fixed.MkFixed'. This means @from \@Centi \@Integer 3.00@ is @300@ -- rather than @3@. instance From.From (Fixed.Fixed a) Integer where from (Fixed.MkFixed t) = t -- | Uses 'toRational'. instance (Fixed.HasResolution a) => From.From (Fixed.Fixed a) Rational where from = toRational -- Complex -- | Uses '(Complex.:+)' with an imaginary part of 0. instance (Num a) => From.From a (Complex.Complex a) where from = (Complex.:+ 0) -- | Uses 'Complex.realPart' when the imaginary part is 0. instance (Eq a, Num a) => TryFrom.TryFrom (Complex.Complex a) a where tryFrom = Utility.eitherTryFrom $ \s -> if Complex.imagPart s == 0 then Right $ Complex.realPart s else Left Exception.LossOfPrecision -- NonEmpty -- | Uses 'NonEmpty.nonEmpty'. instance TryFrom.TryFrom [a] (NonEmpty.NonEmpty a) where tryFrom = Utility.maybeTryFrom NonEmpty.nonEmpty -- | Uses 'NonEmpty.toList'. instance From.From (NonEmpty.NonEmpty a) [a] where from = NonEmpty.toList -- Set -- | Uses 'Set.fromList'. instance (Ord a) => From.From [a] (Set.Set a) where from = Set.fromList -- | Uses 'Set.toAscList'. instance From.From (Set.Set a) [a] where from = Set.toAscList -- IntSet -- | Uses 'IntSet.fromList'. instance From.From [Int] IntSet.IntSet where from = IntSet.fromList -- | Uses 'IntSet.toAscList'. instance From.From IntSet.IntSet [Int] where from = IntSet.toAscList -- Map -- | Uses 'Map.fromList'. If there are duplicate keys, later values will -- overwrite earlier ones. instance (Ord k) => From.From [(k, v)] (Map.Map k v) where from = Map.fromList -- | Uses 'Map.toAscList'. instance From.From (Map.Map k v) [(k, v)] where from = Map.toAscList -- IntMap -- | Uses 'IntMap.fromList'. If there are duplicate keys, later values will -- overwrite earlier ones. instance From.From [(Int, v)] (IntMap.IntMap v) where from = IntMap.fromList -- | Uses 'IntMap.toAscList'. instance From.From (IntMap.IntMap v) [(Int, v)] where from = IntMap.toAscList -- Seq -- | Uses 'Seq.fromList'. instance From.From [a] (Seq.Seq a) where from = Seq.fromList -- | Uses 'Foldable.toList'. instance From.From (Seq.Seq a) [a] where from = Foldable.toList -- ByteString -- | Uses 'ByteString.pack'. instance From.From [Word.Word8] ByteString.ByteString where from = ByteString.pack -- | Uses 'ByteString.unpack'. instance From.From ByteString.ByteString [Word.Word8] where from = ByteString.unpack -- | Uses 'LazyByteString.fromStrict'. instance From.From ByteString.ByteString LazyByteString.ByteString where from = LazyByteString.fromStrict -- | Uses 'ShortByteString.toShort'. instance From.From ByteString.ByteString ShortByteString.ShortByteString where from = ShortByteString.toShort -- LazyByteString -- | Uses 'LazyByteString.pack'. instance From.From [Word.Word8] LazyByteString.ByteString where from = LazyByteString.pack -- | Uses 'LazyByteString.unpack'. instance From.From LazyByteString.ByteString [Word.Word8] where from = LazyByteString.unpack -- | Uses 'LazyByteString.toStrict'. instance From.From LazyByteString.ByteString ByteString.ByteString where from = LazyByteString.toStrict -- ShortByteString -- | Uses 'ShortByteString.pack'. instance From.From [Word.Word8] ShortByteString.ShortByteString where from = ShortByteString.pack -- | Uses 'ShortByteString.unpack'. instance From.From ShortByteString.ShortByteString [Word.Word8] where from = ShortByteString.unpack -- | Uses 'ShortByteString.fromShort'. instance From.From ShortByteString.ShortByteString ByteString.ByteString where from = ShortByteString.fromShort -- Text -- | Uses 'LazyText.fromStrict'. instance From.From Text.Text LazyText.Text where from = LazyText.fromStrict -- LazyText -- | Uses 'LazyText.toStrict'. instance From.From LazyText.Text Text.Text where from = LazyText.toStrict -- String -- | Uses 'Text.pack'. Some 'Char' values cannot be represented in 'Text.Text' -- and will be replaced with @'\\xFFFD'@. instance From.From String Text.Text where from = Text.pack -- | Uses 'Text.unpack'. instance From.From Text.Text String where from = Text.unpack -- | Uses 'LazyText.pack'. Some 'Char' values cannot be represented in -- 'LazyText.Text' and will be replaced with @'\\xFFFD'@. instance From.From String LazyText.Text where from = LazyText.pack -- | Uses 'LazyText.unpack'. instance From.From LazyText.Text String where from = LazyText.unpack -- TryFromException -- | Uses @coerce@. instance From.From (TryFromException.TryFromException source oldTarget) (TryFromException.TryFromException source newTarget) -- Day -- | Uses 'Time.ModifiedJulianDay'. instance From.From Integer Time.Day where from = Time.ModifiedJulianDay -- | Uses 'Time.toModifiedJulianDay'. instance From.From Time.Day Integer where from = Time.toModifiedJulianDay -- DayOfWeek -- | Uses 'Time.dayOfWeek'. instance From.From Time.Day Time.DayOfWeek where from = Time.dayOfWeek -- UniversalTime -- | Uses 'Time.ModJulianDate'. instance From.From Rational Time.UniversalTime where from = Time.ModJulianDate -- | Uses 'Time.getModJulianDate'. instance From.From Time.UniversalTime Rational where from = Time.getModJulianDate -- DiffTime -- | Uses 'realToFrac'. instance From.From Fixed.Pico Time.DiffTime where from = realToFrac -- | Uses 'realToFrac'. instance From.From Time.DiffTime Fixed.Pico where from = realToFrac -- NominalDiffTime -- | Uses 'Time.secondsToNominalDiffTime'. instance From.From Fixed.Pico Time.NominalDiffTime where from = Time.secondsToNominalDiffTime -- | Uses 'Time.nominalDiffTimeToSeconds'. instance From.From Time.NominalDiffTime Fixed.Pico where from = Time.nominalDiffTimeToSeconds -- POSIXTime -- | Uses 'Time.systemToPOSIXTime'. instance From.From Time.SystemTime Time.POSIXTime where from = Time.systemToPOSIXTime -- | Uses 'Time.utcTimeToPOSIXSeconds'. instance From.From Time.UTCTime Time.POSIXTime where from = Time.utcTimeToPOSIXSeconds -- | Uses 'Time.posixSecondsToUTCTime'. instance From.From Time.POSIXTime Time.UTCTime where from = Time.posixSecondsToUTCTime -- SystemTime -- | Uses 'Time.utcToSystemTime'. instance From.From Time.UTCTime Time.SystemTime where from = Time.utcToSystemTime -- | Uses 'Time.systemToTAITime'. instance From.From Time.SystemTime Time.AbsoluteTime where from = Time.systemToTAITime -- | Uses 'Time.systemToUTCTime'. instance From.From Time.SystemTime Time.UTCTime where from = Time.systemToUTCTime -- TimeOfDay -- | Uses 'Time.timeToTimeOfDay'. instance From.From Time.DiffTime Time.TimeOfDay where from = Time.timeToTimeOfDay -- | Uses 'Time.dayFractionToTimeOfDay'. instance From.From Rational Time.TimeOfDay where from = Time.dayFractionToTimeOfDay -- | Uses 'Time.timeOfDayToTime'. instance From.From Time.TimeOfDay Time.DiffTime where from = Time.timeOfDayToTime -- | Uses 'Time.timeOfDayToDayFraction'. instance From.From Time.TimeOfDay Rational where from = Time.timeOfDayToDayFraction -- CalendarDiffTime -- | Uses 'Time.calendarTimeDays'. instance From.From Time.CalendarDiffDays Time.CalendarDiffTime where from = Time.calendarTimeDays -- | Uses 'Time.calendarTimeTime'. instance From.From Time.NominalDiffTime Time.CalendarDiffTime where from = Time.calendarTimeTime -- ZonedTime -- | Uses 'Time.zonedTimeToUTC'. instance From.From Time.ZonedTime Time.UTCTime where from = Time.zonedTimeToUTC -- Tagged -- | Uses @coerce@. Essentially the same as 'Tagged.Tagged'. instance From.From a (Tagged.Tagged t a) -- | Uses @coerce@. Essentially the same as 'Tagged.unTagged'. instance From.From (Tagged.Tagged t a) a -- | Uses @coerce@. Essentially the same as 'Tagged.retag'. instance From.From (Tagged.Tagged t a) (Tagged.Tagged u a) -- ISO-8859-1 -- | Uses 'Text.decodeLatin1'. instance From.From (Encoding.ISO_8859_1 ByteString.ByteString) Text.Text where from = Text.decodeLatin1 . From.from -- | Converts via 'Text.Text'. instance From.From (Encoding.ISO_8859_1 ByteString.ByteString) LazyText.Text where from = Utility.via @Text.Text -- | Converts via 'Text.Text'. instance From.From (Encoding.ISO_8859_1 ByteString.ByteString) String where from = Utility.via @Text.Text -- | Uses 'LazyText.decodeLatin1'. instance From.From (Encoding.ISO_8859_1 LazyByteString.ByteString) LazyText.Text where from = LazyText.decodeLatin1 . From.from -- | Converts via 'LazyText.Text'. instance From.From (Encoding.ISO_8859_1 LazyByteString.ByteString) Text.Text where from = Utility.via @LazyText.Text -- | Converts via 'LazyText.Text'. instance From.From (Encoding.ISO_8859_1 LazyByteString.ByteString) String where from = Utility.via @LazyText.Text -- | Converts via 'String'. instance TryFrom.TryFrom Text.Text (Encoding.ISO_8859_1 ByteString.ByteString) where tryFrom = Utility.eitherTryFrom $ TryFrom.tryFrom . Utility.into @String -- | Converts via 'String'. instance TryFrom.TryFrom Text.Text (Encoding.ISO_8859_1 LazyByteString.ByteString) where tryFrom = Utility.eitherTryFrom $ TryFrom.tryFrom . Utility.into @String -- | Converts via 'String'. instance TryFrom.TryFrom LazyText.Text (Encoding.ISO_8859_1 LazyByteString.ByteString) where tryFrom = Utility.eitherTryFrom $ TryFrom.tryFrom . Utility.into @String -- | Converts via 'String'. instance TryFrom.TryFrom LazyText.Text (Encoding.ISO_8859_1 ByteString.ByteString) where tryFrom = Utility.eitherTryFrom $ TryFrom.tryFrom . Utility.into @String -- | Uses 'Char8.pack' when each character 'Char.isLatin1'. instance TryFrom.TryFrom String (Encoding.ISO_8859_1 ByteString.ByteString) where tryFrom = Utility.maybeTryFrom $ \string -> do Monad.guard $ all Char.isLatin1 string pure . From.from $ Char8.pack string -- | Uses 'LazyChar8.pack' when each character 'Char.isLatin1'. instance TryFrom.TryFrom String (Encoding.ISO_8859_1 LazyByteString.ByteString) where tryFrom = Utility.maybeTryFrom $ \string -> do Monad.guard $ all Char.isLatin1 string pure . From.from $ LazyChar8.pack string -- UTF-8 -- | Uses 'Text.decodeUtf8''. instance TryFrom.TryFrom (Encoding.UTF_8 ByteString.ByteString) Text.Text where tryFrom = Utility.eitherTryFrom $ Text.decodeUtf8' . From.from -- | Converts via 'Text.Text'. instance TryFrom.TryFrom (Encoding.UTF_8 ByteString.ByteString) LazyText.Text where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @LazyText.Text) . Utility.tryInto @Text.Text -- | Converts via 'Text.Text'. instance TryFrom.TryFrom (Encoding.UTF_8 ByteString.ByteString) String where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @String) . Utility.tryInto @Text.Text -- | Uses 'LazyText.decodeUtf8''. instance TryFrom.TryFrom (Encoding.UTF_8 LazyByteString.ByteString) LazyText.Text where tryFrom = Utility.eitherTryFrom $ LazyText.decodeUtf8' . From.from -- | Converts via 'LazyText.Text'. instance TryFrom.TryFrom (Encoding.UTF_8 LazyByteString.ByteString) Text.Text where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @Text.Text) . Utility.tryInto @LazyText.Text -- | Converts via 'LazyText.Text'. instance TryFrom.TryFrom (Encoding.UTF_8 LazyByteString.ByteString) String where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @String) . Utility.tryInto @LazyText.Text -- | Uses 'Text.encodeUtf8'. instance From.From Text.Text (Encoding.UTF_8 ByteString.ByteString) where from = From.from . Text.encodeUtf8 -- | Converts via 'ByteString.ByteString'. instance From.From Text.Text (Encoding.UTF_8 LazyByteString.ByteString) where from = fmap From.from . Utility.into @(Encoding.UTF_8 ByteString.ByteString) -- | Uses 'LazyText.encodeUtf8'. instance From.From LazyText.Text (Encoding.UTF_8 LazyByteString.ByteString) where from = From.from . LazyText.encodeUtf8 -- | Converts via 'LazyByteString.ByteString'. instance From.From LazyText.Text (Encoding.UTF_8 ByteString.ByteString) where from = fmap From.from . Utility.into @(Encoding.UTF_8 LazyByteString.ByteString) -- | Converts via 'Text.Text'. instance From.From String (Encoding.UTF_8 ByteString.ByteString) where from = Utility.via @Text.Text -- | Converts via 'LazyText.Text'. instance From.From String (Encoding.UTF_8 LazyByteString.ByteString) where from = Utility.via @LazyText.Text -- UTF-16LE -- | Uses 'Text.decodeUtf16LE'. instance TryFrom.TryFrom (Encoding.UTF_16LE ByteString.ByteString) Text.Text where tryFrom = Utility.eitherTryFrom $ tryEvaluate @Text.UnicodeException . Text.decodeUtf16LE . From.from -- | Converts via 'Text.Text'. instance TryFrom.TryFrom (Encoding.UTF_16LE ByteString.ByteString) LazyText.Text where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @LazyText.Text) . Utility.tryInto @Text.Text -- | Converts via 'Text.Text'. instance TryFrom.TryFrom (Encoding.UTF_16LE ByteString.ByteString) String where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @String) . Utility.tryInto @Text.Text -- | Uses 'LazyText.decodeUtf16LE'. instance TryFrom.TryFrom (Encoding.UTF_16LE LazyByteString.ByteString) LazyText.Text where tryFrom = Utility.eitherTryFrom $ tryEvaluate @Text.UnicodeException . LazyText.decodeUtf16LE . From.from -- | Converts via 'LazyText.Text'. instance TryFrom.TryFrom (Encoding.UTF_16LE LazyByteString.ByteString) Text.Text where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @Text.Text) . Utility.tryInto @LazyText.Text -- | Converts via 'LazyText.Text'. instance TryFrom.TryFrom (Encoding.UTF_16LE LazyByteString.ByteString) String where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @String) . Utility.tryInto @LazyText.Text -- | Uses 'Text.encodeUtf16LE'. instance From.From Text.Text (Encoding.UTF_16LE ByteString.ByteString) where from = From.from . Text.encodeUtf16LE -- | Converts via 'ByteString.ByteString'. instance From.From Text.Text (Encoding.UTF_16LE LazyByteString.ByteString) where from = fmap From.from . Utility.into @(Encoding.UTF_16LE ByteString.ByteString) -- | Uses 'LazyText.encodeUtf16LE'. instance From.From LazyText.Text (Encoding.UTF_16LE LazyByteString.ByteString) where from = From.from . LazyText.encodeUtf16LE -- | Converts via 'LazyByteString.ByteString'. instance From.From LazyText.Text (Encoding.UTF_16LE ByteString.ByteString) where from = fmap From.from . Utility.into @(Encoding.UTF_16LE LazyByteString.ByteString) -- | Converts via 'Text.Text'. instance From.From String (Encoding.UTF_16LE ByteString.ByteString) where from = Utility.via @Text.Text -- | Converts via 'LazyText.Text'. instance From.From String (Encoding.UTF_16LE LazyByteString.ByteString) where from = Utility.via @LazyText.Text -- UTF-16BE -- | Uses 'Text.decodeUtf16BE'. instance TryFrom.TryFrom (Encoding.UTF_16BE ByteString.ByteString) Text.Text where tryFrom = Utility.eitherTryFrom $ tryEvaluate @Text.UnicodeException . Text.decodeUtf16BE . From.from -- | Converts via 'Text.Text'. instance TryFrom.TryFrom (Encoding.UTF_16BE ByteString.ByteString) LazyText.Text where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @LazyText.Text) . Utility.tryInto @Text.Text -- | Converts via 'Text.Text'. instance TryFrom.TryFrom (Encoding.UTF_16BE ByteString.ByteString) String where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @String) . Utility.tryInto @Text.Text -- | Uses 'LazyText.decodeUtf16BE'. instance TryFrom.TryFrom (Encoding.UTF_16BE LazyByteString.ByteString) LazyText.Text where tryFrom = Utility.eitherTryFrom $ tryEvaluate @Text.UnicodeException . LazyText.decodeUtf16BE . From.from -- | Converts via 'LazyText.Text'. instance TryFrom.TryFrom (Encoding.UTF_16BE LazyByteString.ByteString) Text.Text where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @Text.Text) . Utility.tryInto @LazyText.Text -- | Converts via 'LazyText.Text'. instance TryFrom.TryFrom (Encoding.UTF_16BE LazyByteString.ByteString) String where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @String) . Utility.tryInto @LazyText.Text -- | Uses 'Text.encodeUtf16BE'. instance From.From Text.Text (Encoding.UTF_16BE ByteString.ByteString) where from = From.from . Text.encodeUtf16BE -- | Converts via 'ByteString.ByteString'. instance From.From Text.Text (Encoding.UTF_16BE LazyByteString.ByteString) where from = fmap From.from . Utility.into @(Encoding.UTF_16BE ByteString.ByteString) -- | Uses 'LazyText.encodeUtf16BE'. instance From.From LazyText.Text (Encoding.UTF_16BE LazyByteString.ByteString) where from = From.from . LazyText.encodeUtf16BE -- | Converts via 'LazyByteString.ByteString'. instance From.From LazyText.Text (Encoding.UTF_16BE ByteString.ByteString) where from = fmap From.from . Utility.into @(Encoding.UTF_16BE LazyByteString.ByteString) -- | Converts via 'Text.Text'. instance From.From String (Encoding.UTF_16BE ByteString.ByteString) where from = Utility.via @Text.Text -- | Converts via 'LazyText.Text'. instance From.From String (Encoding.UTF_16BE LazyByteString.ByteString) where from = Utility.via @LazyText.Text -- UTF-32LE -- | Uses 'Text.decodeUtf32LE'. instance TryFrom.TryFrom (Encoding.UTF_32LE ByteString.ByteString) Text.Text where tryFrom = Utility.eitherTryFrom $ tryEvaluate @Text.UnicodeException . Text.decodeUtf32LE . From.from -- | Converts via 'Text.Text'. instance TryFrom.TryFrom (Encoding.UTF_32LE ByteString.ByteString) LazyText.Text where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @LazyText.Text) . Utility.tryInto @Text.Text -- | Converts via 'Text.Text'. instance TryFrom.TryFrom (Encoding.UTF_32LE ByteString.ByteString) String where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @String) . Utility.tryInto @Text.Text -- | Uses 'LazyText.decodeUtf32LE'. instance TryFrom.TryFrom (Encoding.UTF_32LE LazyByteString.ByteString) LazyText.Text where tryFrom = Utility.eitherTryFrom $ tryEvaluate @Text.UnicodeException . LazyText.decodeUtf32LE . From.from -- | Converts via 'LazyText.Text'. instance TryFrom.TryFrom (Encoding.UTF_32LE LazyByteString.ByteString) Text.Text where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @Text.Text) . Utility.tryInto @LazyText.Text -- | Converts via 'LazyText.Text'. instance TryFrom.TryFrom (Encoding.UTF_32LE LazyByteString.ByteString) String where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @String) . Utility.tryInto @LazyText.Text -- | Uses 'Text.encodeUtf32LE'. instance From.From Text.Text (Encoding.UTF_32LE ByteString.ByteString) where from = From.from . Text.encodeUtf32LE -- | Converts via 'ByteString.ByteString'. instance From.From Text.Text (Encoding.UTF_32LE LazyByteString.ByteString) where from = fmap From.from . Utility.into @(Encoding.UTF_32LE ByteString.ByteString) -- | Uses 'LazyText.encodeUtf32LE'. instance From.From LazyText.Text (Encoding.UTF_32LE LazyByteString.ByteString) where from = From.from . LazyText.encodeUtf32LE -- | Converts via 'LazyByteString.ByteString'. instance From.From LazyText.Text (Encoding.UTF_32LE ByteString.ByteString) where from = fmap From.from . Utility.into @(Encoding.UTF_32LE LazyByteString.ByteString) -- | Converts via 'Text.Text'. instance From.From String (Encoding.UTF_32LE ByteString.ByteString) where from = Utility.via @Text.Text -- | Converts via 'LazyText.Text'. instance From.From String (Encoding.UTF_32LE LazyByteString.ByteString) where from = Utility.via @LazyText.Text -- UTF-32BE -- | Uses 'Text.decodeUtf32BE'. instance TryFrom.TryFrom (Encoding.UTF_32BE ByteString.ByteString) Text.Text where tryFrom = Utility.eitherTryFrom $ tryEvaluate @Text.UnicodeException . Text.decodeUtf32BE . From.from -- | Converts via 'Text.Text'. instance TryFrom.TryFrom (Encoding.UTF_32BE ByteString.ByteString) LazyText.Text where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @LazyText.Text) . Utility.tryInto @Text.Text -- | Converts via 'Text.Text'. instance TryFrom.TryFrom (Encoding.UTF_32BE ByteString.ByteString) String where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @String) . Utility.tryInto @Text.Text -- | Uses 'LazyText.decodeUtf32BE'. instance TryFrom.TryFrom (Encoding.UTF_32BE LazyByteString.ByteString) LazyText.Text where tryFrom = Utility.eitherTryFrom $ tryEvaluate @Text.UnicodeException . LazyText.decodeUtf32BE . From.from -- | Converts via 'LazyText.Text'. instance TryFrom.TryFrom (Encoding.UTF_32BE LazyByteString.ByteString) Text.Text where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @Text.Text) . Utility.tryInto @LazyText.Text -- | Converts via 'LazyText.Text'. instance TryFrom.TryFrom (Encoding.UTF_32BE LazyByteString.ByteString) String where tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @String) . Utility.tryInto @LazyText.Text -- | Uses 'Text.encodeUtf32BE'. instance From.From Text.Text (Encoding.UTF_32BE ByteString.ByteString) where from = From.from . Text.encodeUtf32BE -- | Converts via 'ByteString.ByteString'. instance From.From Text.Text (Encoding.UTF_32BE LazyByteString.ByteString) where from = fmap From.from . Utility.into @(Encoding.UTF_32BE ByteString.ByteString) -- | Uses 'LazyText.encodeUtf32BE'. instance From.From LazyText.Text (Encoding.UTF_32BE LazyByteString.ByteString) where from = From.from . LazyText.encodeUtf32BE -- | Converts via 'LazyByteString.ByteString'. instance From.From LazyText.Text (Encoding.UTF_32BE ByteString.ByteString) where from = fmap From.from . Utility.into @(Encoding.UTF_32BE LazyByteString.ByteString) -- | Converts via 'Text.Text'. instance From.From String (Encoding.UTF_32BE ByteString.ByteString) where from = Utility.via @Text.Text -- | Converts via 'LazyText.Text'. instance From.From String (Encoding.UTF_32BE LazyByteString.ByteString) where from = Utility.via @LazyText.Text -- realFloatToRational :: (RealFloat s) => s -> Either Exception.ArithException Rational realFloatToRational s | isNaN s = Left Exception.LossOfPrecision | isInfinite s = if s > 0 then Left Exception.Overflow else Left Exception.Underflow | otherwise = Right $ overPositive (uncurry makeRational . uncurry fromDigits . Numeric.floatToDigits 10) s overPositive :: (Eq a, Num a, Num b) => (a -> b) -> a -> b overPositive f x = if signum x == -1 then -(f (-x)) else f x fromDigits :: [Int] -> Int -> (Integer, Integer) fromDigits ds e = List.foldl' (\(a, n) d -> (a * 10 + toInteger d, n - 1)) (0, toInteger e) ds makeRational :: Integer -> Integer -> Rational makeRational d e = toRational d * 10 ^^ e fromNonNegativeIntegral :: (Integral s, Num t) => s -> Either Exception.ArithException t fromNonNegativeIntegral x = if x < 0 then Left Exception.Underflow else Right $ fromIntegral x -- | 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 tryEvaluate :: (Exception.Exception e) => a -> Either e a tryEvaluate = Unsafe.unsafePerformIO . Exception.try . Exception.evaluate witch-1.2.1.1/source/library/Witch/Lift.hs0000644000000000000000000000226007346545000016435 0ustar0000000000000000{-# LANGUAGE ExplicitForAll #-} module Witch.Lift where import qualified Data.Typeable as Typeable import qualified Language.Haskell.TH.Syntax as TH import qualified Witch.TryFrom as TryFrom import qualified Witch.Utility as Utility -- | This is like 'Utility.unsafeFrom' except that it works at compile time -- rather than runtime. -- -- > -- Avoid this: -- > unsafeFrom @s "some literal" -- > -- > -- Prefer this: -- > $$(liftedFrom @s "some literal") liftedFrom :: forall source target m. ( TryFrom.TryFrom source target, TH.Lift target, Show source, Typeable.Typeable source, Typeable.Typeable target, TH.Quote m ) => source -> TH.Code m target liftedFrom = TH.liftTyped . Utility.unsafeFrom -- | This is like 'Utility.unsafeInto' except that it works at compile time -- rather than runtime. -- -- > -- Avoid this: -- > unsafeInto @t "some literal" -- > -- > -- Prefer this: -- > $$(liftedInto @t "some literal") liftedInto :: forall target source m. ( TryFrom.TryFrom source target, TH.Lift target, Show source, Typeable.Typeable source, Typeable.Typeable target, TH.Quote m ) => source -> TH.Code m target liftedInto = liftedFrom witch-1.2.1.1/source/library/Witch/TryFrom.hs0000644000000000000000000000175207346545000017146 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} module Witch.TryFrom where import qualified Witch.TryFromException as TryFromException -- | This type class is for converting values from some @source@ type into -- some other @target@ type. The constraint @'TryFrom' 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 sometimes fail. If your -- conversion always succeeds, consider implementing @From@ instead. class TryFrom source target where -- | This method implements the conversion of a value between types. At call -- sites you may want to use @tryInto@ instead. -- -- > -- Avoid this: -- > tryFrom (x :: s) -- > -- > -- Prefer this: -- > tryFrom @s -- -- Consider using @maybeTryFrom@ or @eitherTryFrom@ to implement this -- method. tryFrom :: source -> Either (TryFromException.TryFromException source target) target witch-1.2.1.1/source/library/Witch/TryFromException.hs0000644000000000000000000000240107346545000021015 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module Witch.TryFromException 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 @TryFrom@ conversion fails. It has the -- original @source@ value that caused the failure and it knows the @target@ -- type it was trying to convert into. It also has an optional -- 'Exception.SomeException' for communicating what went wrong while -- converting. data TryFromException source target = TryFromException source (Maybe Exception.SomeException) instance ( Show source, Typeable.Typeable source, Typeable.Typeable target ) => Show (TryFromException source target) where showsPrec d (TryFromException x e) = showParen (d > 10) $ showString "TryFromException @" . showsPrec 11 (Typeable.typeRep (Proxy.Proxy :: Proxy.Proxy source)) . showString " @" . showsPrec 11 (Typeable.typeRep (Proxy.Proxy :: Proxy.Proxy target)) . showChar ' ' . showsPrec 11 x . showChar ' ' . showsPrec 11 e instance ( Show source, Typeable.Typeable source, Typeable.Typeable target ) => Exception.Exception (TryFromException source target) witch-1.2.1.1/source/library/Witch/Utility.hs0000644000000000000000000001331407346545000017204 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Witch.Utility where import qualified Control.Exception as Exception import qualified Data.Coerce as Coerce import qualified Data.Typeable as Typeable import qualified GHC.Stack as Stack import qualified Witch.From as From import qualified Witch.TryFrom as TryFrom import qualified Witch.TryFromException as TryFromException -- | This is the same as 'id'. 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 source. source -> source as = id -- | This is the same as 'From.from' except that the type variables are in the -- opposite order. -- -- > -- Avoid this: -- > from x :: t -- > -- > -- Prefer this: -- > into @t x into :: forall target source. (From.From source target) => source -> target into = From.from -- | 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 . into @t -- > -- > -- Prefer this: -- > over @t f over :: forall target source. (From.From source target, From.From target source) => (target -> target) -> source -> source over f = From.from . f . From.from -- | 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 'From.From' 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 through source target. (From.From source through, From.From through target) => source -> target via = From.from . (\x -> x :: through) . From.from -- | This is the same as 'TryFrom.tryFrom' except that the type variables are -- in the opposite order. -- -- > -- Avoid this: -- > tryFrom x :: Either (TryFromException s t) t -- > -- > -- Prefer this: -- > tryInto @t x tryInto :: forall target source. (TryFrom.TryFrom source target) => source -> Either (TryFromException.TryFromException source target) target tryInto = TryFrom.tryFrom -- | This is similar to 'via' except that it works with 'TryFrom.TryFrom' -- instances instead. This function is especially convenient because juggling -- the types in the 'TryFromException.TryFromException' can be tedious. -- -- > -- Avoid this: -- > case tryInto @u x of -- > Left (TryFromException _ e) -> Left $ TryFromException x e -- > Right y -> case tryFrom @u y of -- > Left (TryFromException _ e) -> Left $ TryFromException x e -- > Right z -> Right z -- > -- > -- Prefer this: -- > tryVia @u tryVia :: forall through source target. (TryFrom.TryFrom source through, TryFrom.TryFrom through target) => source -> Either (TryFromException.TryFromException source target) target tryVia s = case TryFrom.tryFrom s of Left e -> Left $ withTarget e Right u -> case TryFrom.tryFrom (u :: through) of Left e -> Left $ withSource s e Right t -> Right t -- | This function can be used to implement 'TryFrom.tryFrom' with a function -- that returns 'Maybe'. For example: -- -- > -- Avoid this: -- > tryFrom s = case f s of -- > Nothing -> Left $ TryFromException s Nothing -- > Just t -> Right t -- > -- > -- Prefer this: -- > tryFrom = maybeTryFrom f maybeTryFrom :: (source -> Maybe target) -> source -> Either (TryFromException.TryFromException source target) target maybeTryFrom f s = case f s of Nothing -> Left $ TryFromException.TryFromException s Nothing Just t -> Right t -- | This function can be used to implement 'TryFrom.tryFrom' with a function -- that returns 'Either'. For example: -- -- > -- Avoid this: -- > tryFrom s = case f s of -- > Left e -> Left . TryFromException s . Just $ toException e -- > Right t -> Right t -- > -- > -- Prefer this: -- > tryFrom = eitherTryFrom f eitherTryFrom :: (Exception.Exception exception) => (source -> Either exception target) -> source -> Either (TryFromException.TryFromException source target) target eitherTryFrom f s = case f s of Left e -> Left . TryFromException.TryFromException s . Just $ Exception.toException e Right t -> Right t -- | This function is like 'TryFrom.tryFrom' except that it will throw an -- impure exception if the conversion fails. -- -- > -- Avoid this: -- > either throw id . tryFrom @s -- > -- > -- Prefer this: -- > unsafeFrom @s unsafeFrom :: forall source target. ( Stack.HasCallStack, TryFrom.TryFrom source target, Show source, Typeable.Typeable source, Typeable.Typeable target ) => source -> target unsafeFrom = either Exception.throw id . TryFrom.tryFrom -- | This function is like 'tryInto' except that it will throw an impure -- exception if the conversion fails. -- -- > -- Avoid this: -- > either throw id . tryInto @t -- > -- > -- Prefer this: -- > unsafeInto @t unsafeInto :: forall target source. ( Stack.HasCallStack, TryFrom.TryFrom source target, Show source, Typeable.Typeable source, Typeable.Typeable target ) => source -> target unsafeInto = unsafeFrom withSource :: newSource -> TryFromException.TryFromException oldSource target -> TryFromException.TryFromException newSource target withSource x (TryFromException.TryFromException _ e) = TryFromException.TryFromException x e withTarget :: forall newTarget source oldTarget. TryFromException.TryFromException source oldTarget -> TryFromException.TryFromException source newTarget withTarget = Coerce.coerce witch-1.2.1.1/source/test-suite/0000755000000000000000000000000007346545000014567 5ustar0000000000000000witch-1.2.1.1/source/test-suite/Main.hs0000644000000000000000000026777107346545000016033 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NegativeLiterals #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-error=overflowed-literals #-} import qualified Control.Exception as Exception import qualified Control.Monad.Trans.Writer as Writer 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.Tagged as Tagged import qualified Data.Text as Text import qualified Data.Text.Lazy as LazyText import qualified Data.Time as Time import qualified Data.Time.Clock.POSIX as Time import qualified Data.Time.Clock.System as Time import qualified Data.Time.Clock.TAI as Time import qualified Data.Word as Word import qualified GHC.Stack as Stack import qualified Numeric.Natural as Natural import qualified Test.HUnit as HUnit import qualified Witch import qualified Witch.Encoding as Encoding import qualified Witch.Utility as Utility main :: IO () main = HUnit.runTestTTAndExit $ specToTest spec spec :: Spec spec = describe "Witch" $ do describe "From" $ do describe "from" $ do it "works" $ do Witch.from @Int.Int8 @Int.Int16 1 `shouldBe` 1 describe "TryFrom" $ do describe "tryFrom" $ do let f = hush . Witch.tryFrom @Int.Int16 @Int.Int8 it "works" $ do f 1 `shouldBe` Just 1 f 128 `shouldBe` Nothing describe "Utility" $ do describe "as" $ do it "works" $ do Utility.as @Int.Int8 1 `shouldBe` 1 describe "into" $ do it "works" $ do Witch.into @Int.Int16 @Int.Int8 1 `shouldBe` 1 describe "over" $ do it "works" $ do Utility.over @Int.Int8 (+ 1) (Age 1) `shouldBe` Age 2 describe "via" $ do it "works" $ do Witch.via @Int.Int16 @Int.Int8 @Int.Int32 1 `shouldBe` 1 describe "tryInto" $ do let f = hush . Witch.tryInto @Int.Int8 @Int.Int16 it "works" $ do f 1 `shouldBe` Just 1 f 128 `shouldBe` Nothing describe "tryVia" $ do let f = hush . Witch.tryVia @Int.Int16 @Int.Int32 @Int.Int8 it "works" $ do f 1 `shouldBe` Just 1 f 128 `shouldBe` Nothing f 32768 `shouldBe` Nothing describe "unsafeFrom" $ do let f = Witch.unsafeFrom @Int.Int16 @Int.Int8 it "works" $ do f 1 `shouldBe` 1 Exception.evaluate (f 128) `shouldThrow` anyTryFromException @Int.Int16 @Int.Int8 describe "unsafeInto" $ do let f = Witch.unsafeInto @Int.Int8 @Int.Int16 it "works" $ do f 1 `shouldBe` 1 Exception.evaluate (f 128) `shouldThrow` anyTryFromException @Int.Int16 @Int.Int8 describe "Lift" $ do describe "liftedFrom" $ do it "works" $ do $$(Witch.liftedFrom @Int.Int16 @Int.Int8 1) `shouldBe` 1 describe "liftedInto" $ do it "works" $ do $$(Witch.liftedInto @Int.Int8 @Int.Int16 1) `shouldBe` 1 describe "TryFromException" $ do describe "show" $ do it "works" $ do show (Witch.TryFromException @Int @Int 0 Nothing) `shouldBe` "TryFromException @Int @Int 0 Nothing" show ( Witch.TryFromException @(Seq.Seq Int) @(Seq.Seq Int) (Seq.fromList []) (Just (Exception.toException Exception.Overflow)) ) `shouldBe` "TryFromException @(Seq Int) @(Seq Int) (fromList []) (Just arithmetic overflow)" describe "Instances" $ do describe "From a a" $ do it "works" $ do Witch.from @Int @Int 0 `shouldBe` 0 describe "From Int8 Int16" $ do let f = Witch.from @Int.Int8 @Int.Int16 it "works" $ do f 0 `shouldBe` 0 f 127 `shouldBe` 127 f -128 `shouldBe` -128 describe "From Int8 Int32" $ do let f = Witch.from @Int.Int8 @Int.Int32 it "works" $ do f 0 `shouldBe` 0 f 127 `shouldBe` 127 f -128 `shouldBe` -128 describe "From Int8 Int64" $ do let f = Witch.from @Int.Int8 @Int.Int64 it "works" $ do f 0 `shouldBe` 0 f 127 `shouldBe` 127 f -128 `shouldBe` -128 describe "From Int8 Int" $ do let f = Witch.from @Int.Int8 @Int it "works" $ do f 0 `shouldBe` 0 f 127 `shouldBe` 127 f -128 `shouldBe` -128 describe "From Int8 Integer" $ do let f = Witch.from @Int.Int8 @Integer it "works" $ do f 0 `shouldBe` 0 f 127 `shouldBe` 127 f -128 `shouldBe` -128 describe "TryFrom Int8 Word8" $ do let f = hush . Witch.tryFrom @Int.Int8 @Word.Word8 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f -1 `shouldBe` Nothing describe "TryFrom Int8 Word16" $ do let f = hush . Witch.tryFrom @Int.Int8 @Word.Word16 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f -1 `shouldBe` Nothing describe "TryFrom Int8 Word32" $ do let f = hush . Witch.tryFrom @Int.Int8 @Word.Word32 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f -1 `shouldBe` Nothing describe "TryFrom Int8 Word64" $ do let f = hush . Witch.tryFrom @Int.Int8 @Word.Word64 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f -1 `shouldBe` Nothing describe "TryFrom Int8 Word" $ do let f = hush . Witch.tryFrom @Int.Int8 @Word it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f -1 `shouldBe` Nothing describe "TryFrom Int8 Natural" $ do let f = hush . Witch.tryFrom @Int.Int8 @Natural.Natural it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f -1 `shouldBe` Nothing describe "From Int8 Float" $ do let f = Witch.from @Int.Int8 @Float it "works" $ do f 0 `shouldBe` 0 f 127 `shouldBe` 127 f -128 `shouldBe` -128 describe "From Int8 Double" $ do let f = Witch.from @Int.Int8 @Double it "works" $ do f 0 `shouldBe` 0 f 127 `shouldBe` 127 f -128 `shouldBe` -128 describe "TryFrom Int16 Int8" $ do let f = hush . Witch.tryFrom @Int.Int16 @Int.Int8 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f 128 `shouldBe` Nothing f -128 `shouldBe` Just -128 f -129 `shouldBe` Nothing describe "From Int16 Int32" $ do let f = Witch.from @Int.Int16 @Int.Int32 it "works" $ do f 0 `shouldBe` 0 f 32767 `shouldBe` 32767 f -32768 `shouldBe` -32768 describe "From Int16 Int64" $ do let f = Witch.from @Int.Int16 @Int.Int64 it "works" $ do f 0 `shouldBe` 0 f 32767 `shouldBe` 32767 f -32768 `shouldBe` -32768 describe "From Int16 Int" $ do let f = Witch.from @Int.Int16 @Int it "works" $ do f 0 `shouldBe` 0 f 32767 `shouldBe` 32767 f -32768 `shouldBe` -32768 describe "From Int16 Integer" $ do let f = Witch.from @Int.Int16 @Integer it "works" $ do f 0 `shouldBe` 0 f 32767 `shouldBe` 32767 f -32768 `shouldBe` -32768 describe "TryFrom Int16 Word8" $ do let f = hush . Witch.tryFrom @Int.Int16 @Word.Word8 it "works" $ do f 0 `shouldBe` Just 0 f 255 `shouldBe` Just 255 f 256 `shouldBe` Nothing f -1 `shouldBe` Nothing describe "TryFrom Int16 Word16" $ do let f = hush . Witch.tryFrom @Int.Int16 @Word.Word16 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f -1 `shouldBe` Nothing describe "TryFrom Int16 Word32" $ do let f = hush . Witch.tryFrom @Int.Int16 @Word.Word32 it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f -1 `shouldBe` Nothing describe "TryFrom Int16 Word64" $ do let f = hush . Witch.tryFrom @Int.Int16 @Word.Word64 it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f -1 `shouldBe` Nothing describe "TryFrom Int16 Word" $ do let f = hush . Witch.tryFrom @Int.Int16 @Word it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f -1 `shouldBe` Nothing describe "TryFrom Int16 Natural" $ do let f = hush . Witch.tryFrom @Int.Int16 @Natural.Natural it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f -1 `shouldBe` Nothing describe "From Int16 Float" $ do let f = Witch.from @Int.Int16 @Float it "works" $ do f 0 `shouldBe` 0 f 32767 `shouldBe` 32767 f -32768 `shouldBe` -32768 describe "From Int16 Double" $ do let f = Witch.from @Int.Int16 @Double it "works" $ do f 0 `shouldBe` 0 f 32767 `shouldBe` 32767 f -32768 `shouldBe` -32768 describe "TryFrom Int32 Int8" $ do let f = hush . Witch.tryFrom @Int.Int32 @Int.Int8 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f 128 `shouldBe` Nothing f -128 `shouldBe` Just -128 f -129 `shouldBe` Nothing describe "TryFrom Int32 Int16" $ do let f = hush . Witch.tryFrom @Int.Int32 @Int.Int16 it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f 32768 `shouldBe` Nothing f -32768 `shouldBe` Just -32768 f -32769 `shouldBe` Nothing describe "From Int32 Int64" $ do let f = Witch.from @Int.Int32 @Int.Int64 it "works" $ do f 0 `shouldBe` 0 f 2147483647 `shouldBe` 2147483647 f -2147483648 `shouldBe` -2147483648 describe "TryFrom Int32 Int" $ do let f = hush . Witch.tryFrom @Int.Int32 @Int it "works" $ do f 0 `shouldBe` Just 0 f 2147483647 `shouldBe` Just 2147483647 f -2147483648 `shouldBe` Just -2147483648 describe "From Int32 Integer" $ do let f = Witch.from @Int.Int32 @Integer it "works" $ do f 0 `shouldBe` 0 f 2147483647 `shouldBe` 2147483647 f -2147483648 `shouldBe` -2147483648 describe "TryFrom Int32 Word8" $ do let f = hush . Witch.tryFrom @Int.Int32 @Word.Word8 it "works" $ do f 0 `shouldBe` Just 0 f 255 `shouldBe` Just 255 f 256 `shouldBe` Nothing f -1 `shouldBe` Nothing describe "TryFrom Int32 Word16" $ do let f = hush . Witch.tryFrom @Int.Int32 @Word.Word16 it "works" $ do f 0 `shouldBe` Just 0 f 65535 `shouldBe` Just 65535 f 65536 `shouldBe` Nothing f -1 `shouldBe` Nothing describe "TryFrom Int32 Word32" $ do let f = hush . Witch.tryFrom @Int.Int32 @Word.Word32 it "works" $ do f 0 `shouldBe` Just 0 f 2147483647 `shouldBe` Just 2147483647 f -1 `shouldBe` Nothing describe "TryFrom Int32 Word64" $ do let f = hush . Witch.tryFrom @Int.Int32 @Word.Word64 it "works" $ do f 0 `shouldBe` Just 0 f 2147483647 `shouldBe` Just 2147483647 f -1 `shouldBe` Nothing describe "TryFrom Int32 Word" $ do let f = hush . Witch.tryFrom @Int.Int32 @Word it "works" $ do f 0 `shouldBe` Just 0 f 2147483647 `shouldBe` Just 2147483647 f -1 `shouldBe` Nothing describe "TryFrom Int32 Natural" $ do let f = hush . Witch.tryFrom @Int.Int32 @Natural.Natural it "works" $ do f 0 `shouldBe` Just 0 f 2147483647 `shouldBe` Just 2147483647 f -1 `shouldBe` Nothing describe "TryFrom Int32 Float" $ do let f = hush . Witch.tryFrom @Int.Int32 @Float it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing f -16777215 `shouldBe` Just -16777215 f -16777216 `shouldBe` Nothing describe "From Int32 Double" $ do let f = Witch.from @Int.Int32 @Double it "works" $ do f 0 `shouldBe` 0 f 2147483647 `shouldBe` 2147483647 f -2147483648 `shouldBe` -2147483648 describe "TryFrom Int64 Int8" $ do let f = hush . Witch.tryFrom @Int.Int64 @Int.Int8 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f 128 `shouldBe` Nothing f -128 `shouldBe` Just -128 f -129 `shouldBe` Nothing describe "TryFrom Int64 Int16" $ do let f = hush . Witch.tryFrom @Int.Int64 @Int.Int16 it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f 32768 `shouldBe` Nothing f -32768 `shouldBe` Just -32768 f -32769 `shouldBe` Nothing describe "TryFrom Int64 Int32" $ do let f = hush . Witch.tryFrom @Int.Int64 @Int.Int32 it "works" $ do f 0 `shouldBe` Just 0 f 2147483647 `shouldBe` Just 2147483647 f 2147483648 `shouldBe` Nothing f -2147483648 `shouldBe` Just -2147483648 f -2147483649 `shouldBe` Nothing describe "TryFrom Int64 Int" $ do let f = hush . Witch.tryFrom @Int.Int64 @Int hi = maxBound :: Int lo = minBound :: Int it "works" $ do f 0 `shouldBe` Just 0 if toInteger hi >= 9223372036854775807 then f 9223372036854775807 `shouldBe` Just 9223372036854775807 else f (fromIntegral hi) `shouldBe` Just hi if toInteger lo <= -9223372036854775808 then f -9223372036854775808 `shouldBe` Just -9223372036854775808 else f (fromIntegral lo) `shouldBe` Just lo describe "From Int64 Integer" $ do let f = Witch.from @Int.Int64 @Integer it "works" $ do f 0 `shouldBe` 0 f 9223372036854775807 `shouldBe` 9223372036854775807 f -9223372036854775808 `shouldBe` -9223372036854775808 describe "TryFrom Int64 Word8" $ do let f = hush . Witch.tryFrom @Int.Int64 @Word.Word8 it "works" $ do f 0 `shouldBe` Just 0 f 255 `shouldBe` Just 255 f 256 `shouldBe` Nothing f -1 `shouldBe` Nothing describe "TryFrom Int64 Word16" $ do let f = hush . Witch.tryFrom @Int.Int64 @Word.Word16 it "works" $ do f 0 `shouldBe` Just 0 f 65535 `shouldBe` Just 65535 f 65536 `shouldBe` Nothing f -1 `shouldBe` Nothing describe "TryFrom Int64 Word32" $ do let f = hush . Witch.tryFrom @Int.Int64 @Word.Word32 it "works" $ do f 0 `shouldBe` Just 0 f 2147483647 `shouldBe` Just 2147483647 f -1 `shouldBe` Nothing describe "TryFrom Int64 Word64" $ do let f = hush . Witch.tryFrom @Int.Int64 @Word.Word64 it "works" $ do f 0 `shouldBe` Just 0 f 9223372036854775807 `shouldBe` Just 9223372036854775807 f -1 `shouldBe` Nothing describe "TryFrom Int64 Word" $ do let f = hush . Witch.tryFrom @Int.Int64 @Word hi = maxBound :: Word it "works" $ do f 0 `shouldBe` Just 0 if toInteger hi >= 9223372036854775807 then f 9223372036854775807 `shouldBe` Just 9223372036854775807 else f (fromIntegral hi) `shouldBe` Just hi f -1 `shouldBe` Nothing describe "TryFrom Int64 Natural" $ do let f = hush . Witch.tryFrom @Int.Int64 @Natural.Natural it "works" $ do f 0 `shouldBe` Just 0 f 9223372036854775807 `shouldBe` Just 9223372036854775807 f -1 `shouldBe` Nothing describe "TryFrom Int64 Float" $ do let f = hush . Witch.tryFrom @Int.Int64 @Float it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing f -16777215 `shouldBe` Just -16777215 f -16777216 `shouldBe` Nothing describe "TryFrom Int64 Double" $ do let f = hush . Witch.tryFrom @Int.Int64 @Double it "works" $ do f 0 `shouldBe` Just 0 f 9007199254740991 `shouldBe` Just 9007199254740991 f 9007199254740992 `shouldBe` Nothing f -9007199254740991 `shouldBe` Just -9007199254740991 f -9007199254740992 `shouldBe` Nothing describe "TryFrom Int Int8" $ do let f = hush . Witch.tryFrom @Int @Int.Int8 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f 128 `shouldBe` Nothing f -128 `shouldBe` Just -128 f -129 `shouldBe` Nothing describe "TryFrom Int Int16" $ do let f = hush . Witch.tryFrom @Int @Int.Int16 it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f 32768 `shouldBe` Nothing f -32768 `shouldBe` Just -32768 f -32769 `shouldBe` Nothing describe "TryFrom Int Int32" $ do let f = hush . Witch.tryFrom @Int @Int.Int32 hi = maxBound :: Int lo = minBound :: Int it "works" $ do f 0 `shouldBe` Just 0 f 2147483647 `shouldBe` Just 2147483647 if toInteger hi >= 2147483648 then f 2147483648 `shouldBe` Nothing else f hi `shouldBe` Just (fromIntegral hi) f -2147483648 `shouldBe` Just -2147483648 if toInteger lo <= -2147483649 then f -2147483649 `shouldBe` Nothing else f lo `shouldBe` Just (fromIntegral lo) describe "From Int Int64" $ do let f = Witch.from @Int @Int.Int64 it "works" $ do f 0 `shouldBe` 0 f maxBound `shouldBe` fromIntegral (maxBound :: Int) f minBound `shouldBe` fromIntegral (minBound :: Int) describe "From Int Integer" $ do let f = Witch.from @Int @Integer it "works" $ do f 0 `shouldBe` 0 f maxBound `shouldBe` fromIntegral (maxBound :: Int) f minBound `shouldBe` fromIntegral (minBound :: Int) describe "TryFrom Int Word8" $ do let f = hush . Witch.tryFrom @Int @Word.Word8 it "works" $ do f 0 `shouldBe` Just 0 f 255 `shouldBe` Just 255 f 256 `shouldBe` Nothing f -1 `shouldBe` Nothing describe "TryFrom Int Word16" $ do let f = hush . Witch.tryFrom @Int @Word.Word16 it "works" $ do f 0 `shouldBe` Just 0 f 65535 `shouldBe` Just 65535 f 65536 `shouldBe` Nothing f -1 `shouldBe` Nothing describe "TryFrom Int Word32" $ do let f = hush . Witch.tryFrom @Int @Word.Word32 hi = maxBound :: Int it "works" $ do f 0 `shouldBe` Just 0 if toInteger hi >= 4294967295 then f 4294967295 `shouldBe` Just 4294967295 else f hi `shouldBe` Just (fromIntegral hi) if toInteger hi >= 4294967296 then f 4294967296 `shouldBe` Nothing else f hi `shouldBe` Just (fromIntegral hi) f -1 `shouldBe` Nothing describe "TryFrom Int Word64" $ do let f = hush . Witch.tryFrom @Int @Word.Word64 it "works" $ do f 0 `shouldBe` Just 0 f maxBound `shouldBe` Just (fromIntegral (maxBound :: Int)) f -1 `shouldBe` Nothing describe "TryFrom Int Word" $ do let f = hush . Witch.tryFrom @Int @Word it "works" $ do f 0 `shouldBe` Just 0 f maxBound `shouldBe` Just (fromIntegral (maxBound :: Int)) f -1 `shouldBe` Nothing describe "TryFrom Int Natural" $ do let f = hush . Witch.tryFrom @Int @Natural.Natural it "works" $ do f 0 `shouldBe` Just 0 f maxBound `shouldBe` Just (fromIntegral (maxBound :: Int)) f -1 `shouldBe` Nothing describe "TryFrom Int Float" $ do let f = hush . Witch.tryFrom @Int @Float it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing f -16777215 `shouldBe` Just -16777215 f -16777216 `shouldBe` Nothing describe "TryFrom Int Double" $ do let f = hush . Witch.tryFrom @Int @Double hi = maxBound :: Int lo = minBound :: Int it "works" $ do f 0 `shouldBe` Just 0 if toInteger hi >= 9007199254740991 then f 9007199254740991 `shouldBe` Just 9007199254740991 else f hi `shouldBe` Just (fromIntegral hi) if toInteger hi >= 9007199254740992 then f 9007199254740992 `shouldBe` Nothing else f hi `shouldBe` Just (fromIntegral hi) if toInteger lo <= -9007199254740991 then f -9007199254740991 `shouldBe` Just -9007199254740991 else f lo `shouldBe` Just (fromIntegral lo) if toInteger lo <= -9007199254740992 then f -9007199254740992 `shouldBe` Nothing else f lo `shouldBe` Just (fromIntegral lo) describe "TryFrom Integer Int8" $ do let f = hush . Witch.tryFrom @Integer @Int.Int8 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f 128 `shouldBe` Nothing f -128 `shouldBe` Just -128 f -129 `shouldBe` Nothing describe "TryFrom Integer Int16" $ do let f = hush . Witch.tryFrom @Integer @Int.Int16 it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f 32768 `shouldBe` Nothing f -32768 `shouldBe` Just -32768 f -32769 `shouldBe` Nothing describe "TryFrom Integer Int32" $ do let f = hush . Witch.tryFrom @Integer @Int.Int32 it "works" $ do f 0 `shouldBe` Just 0 f 2147483647 `shouldBe` Just 2147483647 f 2147483648 `shouldBe` Nothing f -2147483648 `shouldBe` Just -2147483648 f -2147483649 `shouldBe` Nothing describe "TryFrom Integer Int64" $ do let f = hush . Witch.tryFrom @Integer @Int.Int64 it "works" $ do f 0 `shouldBe` Just 0 f 9223372036854775807 `shouldBe` Just 9223372036854775807 f 9223372036854775808 `shouldBe` Nothing f -9223372036854775808 `shouldBe` Just -9223372036854775808 f -9223372036854775809 `shouldBe` Nothing describe "TryFrom Integer Int" $ do let f = hush . Witch.tryFrom @Integer @Int hi = maxBound :: Int lo = minBound :: Int it "works" $ do f 0 `shouldBe` Just 0 f (fromIntegral hi) `shouldBe` Just hi f (toInteger hi + 1) `shouldBe` Nothing f (fromIntegral lo) `shouldBe` Just lo f (toInteger lo - 1) `shouldBe` Nothing describe "TryFrom Integer Word8" $ do let f = hush . Witch.tryFrom @Integer @Word.Word8 it "works" $ do f 0 `shouldBe` Just 0 f 255 `shouldBe` Just 255 f 256 `shouldBe` Nothing f -1 `shouldBe` Nothing describe "TryFrom Integer Word16" $ do let f = hush . Witch.tryFrom @Integer @Word.Word16 it "works" $ do f 0 `shouldBe` Just 0 f 65535 `shouldBe` Just 65535 f 65536 `shouldBe` Nothing f -1 `shouldBe` Nothing describe "TryFrom Integer Word32" $ do let f = hush . Witch.tryFrom @Integer @Word.Word32 it "works" $ do f 0 `shouldBe` Just 0 f 4294967295 `shouldBe` Just 4294967295 f 4294967296 `shouldBe` Nothing f -1 `shouldBe` Nothing describe "TryFrom Integer Word64" $ do let f = hush . Witch.tryFrom @Integer @Word.Word64 it "works" $ do f 0 `shouldBe` Just 0 f 18446744073709551615 `shouldBe` Just 18446744073709551615 f 18446744073709551616 `shouldBe` Nothing f -1 `shouldBe` Nothing describe "TryFrom Integer Word" $ do let f = hush . Witch.tryFrom @Integer @Word hi = maxBound :: Word it "works" $ do f 0 `shouldBe` Just 0 f (fromIntegral hi) `shouldBe` Just hi f (toInteger hi + 1) `shouldBe` Nothing f -1 `shouldBe` Nothing describe "TryFrom Integer Natural" $ do let f = hush . Witch.tryFrom @Integer @Natural.Natural it "works" $ do f 0 `shouldBe` Just 0 f 18446744073709551616 `shouldBe` Just 18446744073709551616 f -1 `shouldBe` Nothing describe "TryFrom Integer Float" $ do let f = hush . Witch.tryFrom @Integer @Float it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing f -16777215 `shouldBe` Just -16777215 f -16777216 `shouldBe` Nothing describe "TryFrom Integer Double" $ do let f = hush . Witch.tryFrom @Integer @Double it "works" $ do f 0 `shouldBe` Just 0 f 9007199254740991 `shouldBe` Just 9007199254740991 f 9007199254740992 `shouldBe` Nothing f -9007199254740991 `shouldBe` Just -9007199254740991 f -9007199254740992 `shouldBe` Nothing describe "From Word8 Word16" $ do let f = Witch.from @Word.Word8 @Word.Word16 it "works" $ do f 0 `shouldBe` 0 f 255 `shouldBe` 255 describe "From Word8 Word32" $ do let f = Witch.from @Word.Word8 @Word.Word32 it "works" $ do f 0 `shouldBe` 0 f 255 `shouldBe` 255 describe "From Word8 Word64" $ do let f = Witch.from @Word.Word8 @Word.Word64 it "works" $ do f 0 `shouldBe` 0 f 255 `shouldBe` 255 describe "From Word8 Word" $ do let f = Witch.from @Word.Word8 @Word it "works" $ do f 0 `shouldBe` 0 f 255 `shouldBe` 255 describe "From Word8 Natural" $ do let f = Witch.from @Word.Word8 @Natural.Natural it "works" $ do f 0 `shouldBe` 0 f 255 `shouldBe` 255 describe "TryFrom Word8 Int8" $ do let f = hush . Witch.tryFrom @Word.Word8 @Int.Int8 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f 128 `shouldBe` Nothing describe "From Word8 Int16" $ do let f = Witch.from @Word.Word8 @Int.Int16 it "works" $ do f 0 `shouldBe` 0 f 255 `shouldBe` 255 describe "From Word8 Int32" $ do let f = Witch.from @Word.Word8 @Int.Int32 it "works" $ do f 0 `shouldBe` 0 f 255 `shouldBe` 255 describe "From Word8 Int64" $ do let f = Witch.from @Word.Word8 @Int.Int64 it "works" $ do f 0 `shouldBe` 0 f 255 `shouldBe` 255 describe "From Word8 Int" $ do let f = Witch.from @Word.Word8 @Int it "works" $ do f 0 `shouldBe` 0 f 255 `shouldBe` 255 describe "From Word8 Integer" $ do let f = Witch.from @Word.Word8 @Integer it "works" $ do f 0 `shouldBe` 0 f 255 `shouldBe` 255 describe "From Word8 Float" $ do let f = Witch.from @Word.Word8 @Float it "works" $ do f 0 `shouldBe` 0 f 255 `shouldBe` 255 describe "From Word8 Double" $ do let f = Witch.from @Word.Word8 @Double it "works" $ do f 0 `shouldBe` 0 f 255 `shouldBe` 255 describe "TryFrom Word16 Word8" $ do let f = hush . Witch.tryFrom @Word.Word16 @Word.Word8 it "works" $ do f 0 `shouldBe` Just 0 f 255 `shouldBe` Just 255 f 256 `shouldBe` Nothing describe "From Word16 Word32" $ do let f = Witch.from @Word.Word16 @Word.Word32 it "works" $ do f 0 `shouldBe` 0 f 65535 `shouldBe` 65535 describe "From Word16 Word64" $ do let f = Witch.from @Word.Word16 @Word.Word64 it "works" $ do f 0 `shouldBe` 0 f 65535 `shouldBe` 65535 describe "From Word16 Word" $ do let f = Witch.from @Word.Word16 @Word it "works" $ do f 0 `shouldBe` 0 f 65535 `shouldBe` 65535 describe "From Word16 Natural" $ do let f = Witch.from @Word.Word16 @Natural.Natural it "works" $ do f 0 `shouldBe` 0 f 65535 `shouldBe` 65535 describe "TryFrom Word16 Int8" $ do let f = hush . Witch.tryFrom @Word.Word16 @Int.Int8 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f 128 `shouldBe` Nothing describe "TryFrom Word16 Int16" $ do let f = hush . Witch.tryFrom @Word.Word16 @Int.Int16 it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f 32768 `shouldBe` Nothing describe "From Word16 Int32" $ do let f = Witch.from @Word.Word16 @Int.Int32 it "works" $ do f 0 `shouldBe` 0 f 65535 `shouldBe` 65535 describe "From Word16 Int64" $ do let f = Witch.from @Word.Word16 @Int.Int64 it "works" $ do f 0 `shouldBe` 0 f 65535 `shouldBe` 65535 describe "From Word16 Int" $ do let f = Witch.from @Word.Word16 @Int it "works" $ do f 0 `shouldBe` 0 f 65535 `shouldBe` 65535 describe "From Word16 Integer" $ do let f = Witch.from @Word.Word16 @Integer it "works" $ do f 0 `shouldBe` 0 f 65535 `shouldBe` 65535 describe "From Word16 Float" $ do let f = Witch.from @Word.Word16 @Float it "works" $ do f 0 `shouldBe` 0 f 65535 `shouldBe` 65535 describe "From Word16 Double" $ do let f = Witch.from @Word.Word16 @Double it "works" $ do f 0 `shouldBe` 0 f 65535 `shouldBe` 65535 describe "TryFrom Word32 Word8" $ do let f = hush . Witch.tryFrom @Word.Word32 @Word.Word8 it "works" $ do f 0 `shouldBe` Just 0 f 255 `shouldBe` Just 255 f 256 `shouldBe` Nothing describe "TryFrom Word32 Word16" $ do let f = hush . Witch.tryFrom @Word.Word32 @Word.Word16 it "works" $ do f 0 `shouldBe` Just 0 f 65535 `shouldBe` Just 65535 f 65536 `shouldBe` Nothing describe "From Word32 Word64" $ do let f = Witch.from @Word.Word32 @Word.Word64 it "works" $ do f 0 `shouldBe` 0 f 4294967295 `shouldBe` 4294967295 describe "TryFrom Word32 Word" $ do let f = hush . Witch.tryFrom @Word.Word32 @Word it "works" $ do f 0 `shouldBe` Just 0 f 4294967295 `shouldBe` Just 4294967295 describe "From Word32 Natural" $ do let f = Witch.from @Word.Word32 @Natural.Natural it "works" $ do f 0 `shouldBe` 0 f 4294967295 `shouldBe` 4294967295 describe "TryFrom Word32 Int8" $ do let f = hush . Witch.tryFrom @Word.Word32 @Int.Int8 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f 128 `shouldBe` Nothing describe "TryFrom Word32 Int16" $ do let f = hush . Witch.tryFrom @Word.Word32 @Int.Int16 it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f 32768 `shouldBe` Nothing describe "TryFrom Word32 Int32" $ do let f = hush . Witch.tryFrom @Word.Word32 @Int.Int32 it "works" $ do f 0 `shouldBe` Just 0 f 2147483647 `shouldBe` Just 2147483647 f 2147483648 `shouldBe` Nothing describe "From Word32 Int64" $ do let f = Witch.from @Word.Word32 @Int.Int64 it "works" $ do f 0 `shouldBe` 0 f 4294967295 `shouldBe` 4294967295 describe "TryFrom Word32 Int" $ do let f = hush . Witch.tryFrom @Word.Word32 @Int hi = maxBound :: Int it "works" $ do f 0 `shouldBe` Just 0 if toInteger hi >= 4294967295 then f 4294967295 `shouldBe` Just 4294967295 else f (fromIntegral hi) `shouldBe` Just hi describe "From Word32 Integer" $ do let f = Witch.from @Word.Word32 @Integer it "works" $ do f 0 `shouldBe` 0 f 4294967295 `shouldBe` 4294967295 describe "TryFrom Word32 Float" $ do let f = hush . Witch.tryFrom @Word.Word32 @Float it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing describe "From Word32 Double" $ do let f = Witch.from @Word.Word32 @Double it "works" $ do f 0 `shouldBe` 0 f 4294967295 `shouldBe` 4294967295 describe "TryFrom Word64 Word8" $ do let f = hush . Witch.tryFrom @Word.Word64 @Word.Word8 it "works" $ do f 0 `shouldBe` Just 0 f 255 `shouldBe` Just 255 f 256 `shouldBe` Nothing describe "TryFrom Word64 Word16" $ do let f = hush . Witch.tryFrom @Word.Word64 @Word.Word16 it "works" $ do f 0 `shouldBe` Just 0 f 65535 `shouldBe` Just 65535 f 65536 `shouldBe` Nothing describe "TryFrom Word64 Word32" $ do let f = hush . Witch.tryFrom @Word.Word64 @Word.Word32 it "works" $ do f 0 `shouldBe` Just 0 f 4294967295 `shouldBe` Just 4294967295 f 4294967296 `shouldBe` Nothing describe "TryFrom Word64 Word" $ do let f = hush . Witch.tryFrom @Word.Word64 @Word hi = maxBound :: Word it "works" $ do f 0 `shouldBe` Just 0 if toInteger hi >= 18446744073709551615 then f 18446744073709551615 `shouldBe` Just 18446744073709551615 else f (fromIntegral hi) `shouldBe` Just hi describe "From Word64 Natural" $ do let f = Witch.from @Word.Word64 @Natural.Natural it "works" $ do f 0 `shouldBe` 0 f 18446744073709551615 `shouldBe` 18446744073709551615 describe "TryFrom Word64 Int8" $ do let f = hush . Witch.tryFrom @Word.Word64 @Int.Int8 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f 128 `shouldBe` Nothing describe "TryFrom Word64 Int16" $ do let f = hush . Witch.tryFrom @Word.Word64 @Int.Int16 it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f 32768 `shouldBe` Nothing describe "TryFrom Word64 Int32" $ do let f = hush . Witch.tryFrom @Word.Word64 @Int.Int32 it "works" $ do f 0 `shouldBe` Just 0 f 2147483647 `shouldBe` Just 2147483647 f 2147483648 `shouldBe` Nothing describe "TryFrom Word64 Int64" $ do let f = hush . Witch.tryFrom @Word.Word64 @Int.Int64 it "works" $ do f 0 `shouldBe` Just 0 f 9223372036854775807 `shouldBe` Just 9223372036854775807 f 9223372036854775808 `shouldBe` Nothing describe "TryFrom Word64 Int" $ do let f = hush . Witch.tryFrom @Word.Word64 @Int hi = maxBound :: Int it "works" $ do f 0 `shouldBe` Just 0 f (fromIntegral hi) `shouldBe` Just hi f (fromIntegral hi + 1) `shouldBe` Nothing describe "From Word64 Integer" $ do let f = Witch.from @Word.Word64 @Integer it "works" $ do f 0 `shouldBe` 0 f 18446744073709551615 `shouldBe` 18446744073709551615 describe "TryFrom Word64 Float" $ do let f = hush . Witch.tryFrom @Word.Word64 @Float it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing describe "TryFrom Word64 Double" $ do let f = hush . Witch.tryFrom @Word.Word64 @Double it "works" $ do f 0 `shouldBe` Just 0 f 9007199254740991 `shouldBe` Just 9007199254740991 f 9007199254740992 `shouldBe` Nothing describe "TryFrom Word Word8" $ do let f = hush . Witch.tryFrom @Word @Word.Word8 it "works" $ do f 0 `shouldBe` Just 0 f 255 `shouldBe` Just 255 f 256 `shouldBe` Nothing describe "TryFrom Word Word16" $ do let f = hush . Witch.tryFrom @Word @Word.Word16 it "works" $ do f 0 `shouldBe` Just 0 f 65535 `shouldBe` Just 65535 f 65536 `shouldBe` Nothing describe "TryFrom Word Word32" $ do let f = hush . Witch.tryFrom @Word @Word.Word32 hi = maxBound :: Word it "works" $ do f 0 `shouldBe` Just 0 f 4294967295 `shouldBe` Just 4294967295 if toInteger hi >= 4294967296 then f 4294967296 `shouldBe` Nothing else f hi `shouldBe` Just (fromIntegral hi) describe "From Word Word64" $ do let f = Witch.from @Word @Word.Word64 it "works" $ do f 0 `shouldBe` 0 f maxBound `shouldBe` fromIntegral (maxBound :: Word) describe "From Word Natural" $ do let f = Witch.from @Word @Natural.Natural it "works" $ do f 0 `shouldBe` 0 f maxBound `shouldBe` fromIntegral (maxBound :: Word) describe "TryFrom Word Int8" $ do let f = hush . Witch.tryFrom @Word @Int.Int8 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f 128 `shouldBe` Nothing describe "TryFrom Word Int16" $ do let f = hush . Witch.tryFrom @Word @Int.Int16 it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f 32768 `shouldBe` Nothing describe "TryFrom Word Int32" $ do let f = hush . Witch.tryFrom @Word @Int.Int32 it "works" $ do f 0 `shouldBe` Just 0 f 2147483647 `shouldBe` Just 2147483647 f 2147483648 `shouldBe` Nothing describe "TryFrom Word Int64" $ do let f = hush . Witch.tryFrom @Word @Int.Int64 hi = maxBound :: Word it "works" $ do f 0 `shouldBe` Just 0 if toInteger hi >= 9223372036854775807 then f 9223372036854775807 `shouldBe` Just 9223372036854775807 else f hi `shouldBe` Just (fromIntegral hi) if toInteger hi >= 9223372036854775808 then f 9223372036854775808 `shouldBe` Nothing else f hi `shouldBe` Just (fromIntegral hi) describe "TryFrom Word Int" $ do let f = hush . Witch.tryFrom @Word @Int hi = maxBound :: Int it "works" $ do f 0 `shouldBe` Just 0 f (fromIntegral hi) `shouldBe` Just hi f (fromIntegral hi + 1) `shouldBe` Nothing describe "From Word Integer" $ do let f = Witch.from @Word @Integer hi = maxBound :: Word it "works" $ do f 0 `shouldBe` 0 f hi `shouldBe` fromIntegral hi describe "TryFrom Word Float" $ do let f = hush . Witch.tryFrom @Word @Float it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing describe "TryFrom Word Double" $ do let f = hush . Witch.tryFrom @Word @Double hi = maxBound :: Word it "works" $ do f 0 `shouldBe` Just 0 if toInteger hi >= 9007199254740991 then f 9007199254740991 `shouldBe` Just 9007199254740991 else f hi `shouldBe` Just (fromIntegral hi) if toInteger hi >= 9007199254740992 then f 9007199254740992 `shouldBe` Nothing else f hi `shouldBe` Just (fromIntegral hi) describe "TryFrom Natural Word8" $ do let f = hush . Witch.tryFrom @Natural.Natural @Word.Word8 it "works" $ do f 0 `shouldBe` Just 0 f 255 `shouldBe` Just 255 f 256 `shouldBe` Nothing describe "TryFrom Natural Word16" $ do let f = hush . Witch.tryFrom @Natural.Natural @Word.Word16 it "works" $ do f 0 `shouldBe` Just 0 f 65535 `shouldBe` Just 65535 f 65536 `shouldBe` Nothing describe "TryFrom Natural Word32" $ do let f = hush . Witch.tryFrom @Natural.Natural @Word.Word32 it "works" $ do f 0 `shouldBe` Just 0 f 4294967295 `shouldBe` Just 4294967295 f 4294967296 `shouldBe` Nothing describe "TryFrom Natural Word64" $ do let f = hush . Witch.tryFrom @Natural.Natural @Word.Word64 it "works" $ do f 0 `shouldBe` Just 0 f 18446744073709551615 `shouldBe` Just 18446744073709551615 f 18446744073709551616 `shouldBe` Nothing describe "TryFrom Natural Word" $ do let f = hush . Witch.tryFrom @Natural.Natural @Word hi = maxBound :: Word it "works" $ do f 0 `shouldBe` Just 0 f (fromIntegral hi) `shouldBe` Just hi f (fromIntegral hi + 1) `shouldBe` Nothing describe "TryFrom Natural Int8" $ do let f = hush . Witch.tryFrom @Natural.Natural @Int.Int8 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f 128 `shouldBe` Nothing describe "TryFrom Natural Int16" $ do let f = hush . Witch.tryFrom @Natural.Natural @Int.Int16 it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f 32768 `shouldBe` Nothing describe "TryFrom Natural Int32" $ do let f = hush . Witch.tryFrom @Natural.Natural @Int.Int32 it "works" $ do f 0 `shouldBe` Just 0 f 2147483647 `shouldBe` Just 2147483647 f 2147483648 `shouldBe` Nothing describe "TryFrom Natural Int64" $ do let f = hush . Witch.tryFrom @Natural.Natural @Int.Int64 it "works" $ do f 0 `shouldBe` Just 0 f 9223372036854775807 `shouldBe` Just 9223372036854775807 f 9223372036854775808 `shouldBe` Nothing describe "TryFrom Natural Int" $ do let f = hush . Witch.tryFrom @Natural.Natural @Int hi = maxBound :: Int it "works" $ do f 0 `shouldBe` Just 0 f (fromIntegral hi) `shouldBe` Just hi f (fromIntegral hi + 1) `shouldBe` Nothing describe "From Natural Integer" $ do let f = Witch.from @Natural.Natural @Integer it "works" $ do f 0 `shouldBe` 0 f 9223372036854775808 `shouldBe` 9223372036854775808 describe "TryFrom Natural Float" $ do let f = hush . Witch.tryFrom @Natural.Natural @Float it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing describe "TryFrom Natural Double" $ do let f = hush . Witch.tryFrom @Natural.Natural @Double it "works" $ do f 0 `shouldBe` Just 0 f 9007199254740991 `shouldBe` Just 9007199254740991 f 9007199254740992 `shouldBe` Nothing describe "TryFrom Float Int8" $ do let f = hush . Witch.tryFrom @Float @Int.Int8 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f 128 `shouldBe` Nothing f -128 `shouldBe` Just -128 f -129 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Float Int16" $ do let f = hush . Witch.tryFrom @Float @Int.Int16 it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f 32768 `shouldBe` Nothing f -32768 `shouldBe` Just -32768 f -32769 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Float Int32" $ do let f = hush . Witch.tryFrom @Float @Int.Int32 it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing f -16777215 `shouldBe` Just -16777215 f -16777216 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Float Int64" $ do let f = hush . Witch.tryFrom @Float @Int.Int64 it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing f -16777215 `shouldBe` Just -16777215 f -16777216 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Float Int" $ do let f = hush . Witch.tryFrom @Float @Int it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing f -16777215 `shouldBe` Just -16777215 f -16777216 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Float Integer" $ do let f = hush . Witch.tryFrom @Float @Integer it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing f -16777215 `shouldBe` Just -16777215 f -16777216 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Float Word8" $ do let f = hush . Witch.tryFrom @Float @Word.Word8 it "works" $ do f 0 `shouldBe` Just 0 f 255 `shouldBe` Just 255 f 256 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Float Word16" $ do let f = hush . Witch.tryFrom @Float @Word.Word16 it "works" $ do f 0 `shouldBe` Just 0 f 65535 `shouldBe` Just 65535 f 65536 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Float Word32" $ do let f = hush . Witch.tryFrom @Float @Word.Word32 it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Float Word64" $ do let f = hush . Witch.tryFrom @Float @Word.Word64 it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Float Word" $ do let f = hush . Witch.tryFrom @Float @Word it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Float Natural" $ do let f = hush . Witch.tryFrom @Float @Natural.Natural it "works" $ do f 0 `shouldBe` Just 0 f 16777215 `shouldBe` Just 16777215 f 16777216 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Float Rational" $ do let f = hush . Witch.tryFrom @Float @Rational it "works" $ do f 0 `shouldBe` Just 0 f -0 `shouldBe` Just 0 f 0.5 `shouldBe` Just 0.5 f (-0.5) `shouldBe` Just (-0.5) f 16777215 `shouldBe` Just 16777215 f -16777215 `shouldBe` Just -16777215 f 16777216 `shouldBe` Just 16777216 f -16777216 `shouldBe` Just -16777216 f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing f 0.1 `shouldBe` Just 0.1 f (-0.1) `shouldBe` Just (-0.1) describe "From Float Double" $ do let f = Witch.from @Float @Double it "works" $ do f 0 `shouldBe` 0 f 0.5 `shouldBe` 0.5 f (-0.5) `shouldBe` (-0.5) f (0 / 0) `shouldSatisfy` isNaN f (1 / 0) `shouldBe` (1 / 0) f (-1 / 0) `shouldBe` (-1 / 0) describe "TryFrom Double Int8" $ do let f = hush . Witch.tryFrom @Double @Int.Int8 it "works" $ do f 0 `shouldBe` Just 0 f 127 `shouldBe` Just 127 f 128 `shouldBe` Nothing f -128 `shouldBe` Just -128 f -129 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Double Int16" $ do let f = hush . Witch.tryFrom @Double @Int.Int16 it "works" $ do f 0 `shouldBe` Just 0 f 32767 `shouldBe` Just 32767 f 32768 `shouldBe` Nothing f -32768 `shouldBe` Just -32768 f -32769 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Double Int32" $ do let f = hush . Witch.tryFrom @Double @Int.Int32 it "works" $ do f 0 `shouldBe` Just 0 f 2147483647 `shouldBe` Just 2147483647 f 2147483648 `shouldBe` Nothing f -2147483648 `shouldBe` Just -2147483648 f -2147483649 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Double Int64" $ do let f = hush . Witch.tryFrom @Double @Int.Int64 it "works" $ do f 0 `shouldBe` Just 0 f 9007199254740991 `shouldBe` Just 9007199254740991 f 9007199254740992 `shouldBe` Nothing f -9007199254740991 `shouldBe` Just -9007199254740991 f -9007199254740992 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Double Int" $ do let f = hush . Witch.tryFrom @Double @Int hi = maxBound :: Int lo = minBound :: Int it "works" $ do f 0 `shouldBe` Just 0 if toInteger hi >= 9007199254740991 then f 9007199254740991 `shouldBe` Just 9007199254740991 else f (fromIntegral hi) `shouldBe` Just hi f 9007199254740992 `shouldBe` Nothing if toInteger lo <= -9007199254740991 then f -9007199254740991 `shouldBe` Just -9007199254740991 else f (fromIntegral lo) `shouldBe` Just lo f -9007199254740992 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Double Integer" $ do let f = hush . Witch.tryFrom @Double @Integer it "works" $ do f 0 `shouldBe` Just 0 f 9007199254740991 `shouldBe` Just 9007199254740991 f 9007199254740992 `shouldBe` Nothing f -9007199254740991 `shouldBe` Just -9007199254740991 f -9007199254740992 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Double Word8" $ do let f = hush . Witch.tryFrom @Double @Word.Word8 it "works" $ do f 0 `shouldBe` Just 0 f 255 `shouldBe` Just 255 f 256 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Double Word16" $ do let f = hush . Witch.tryFrom @Double @Word.Word16 it "works" $ do f 0 `shouldBe` Just 0 f 65535 `shouldBe` Just 65535 f 65536 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Double Word32" $ do let f = hush . Witch.tryFrom @Double @Word.Word32 it "works" $ do f 0 `shouldBe` Just 0 f 4294967295 `shouldBe` Just 4294967295 f 4294967296 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Double Word64" $ do let f = hush . Witch.tryFrom @Double @Word.Word64 it "works" $ do f 0 `shouldBe` Just 0 f 9007199254740991 `shouldBe` Just 9007199254740991 f 9007199254740992 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Double Word" $ do let f = hush . Witch.tryFrom @Double @Word hi = maxBound :: Word it "works" $ do f 0 `shouldBe` Just 0 if toInteger hi >= 9007199254740991 then f 9007199254740991 `shouldBe` Just 9007199254740991 else f (fromIntegral hi) `shouldBe` Just hi f 9007199254740992 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Double Natural" $ do let f = hush . Witch.tryFrom @Double @Natural.Natural it "works" $ do f 0 `shouldBe` Just 0 f 9007199254740991 `shouldBe` Just 9007199254740991 f 9007199254740992 `shouldBe` Nothing f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing describe "TryFrom Double Rational" $ do let f = hush . Witch.tryFrom @Double @Rational it "works" $ do f 0 `shouldBe` Just 0 f -0 `shouldBe` Just 0 f 0.5 `shouldBe` Just 0.5 f (-0.5) `shouldBe` Just (-0.5) f 9007199254740991 `shouldBe` Just 9007199254740991 f -9007199254740991 `shouldBe` Just -9007199254740991 f 9007199254740992 `shouldBe` Just 9007199254740992 f -9007199254740992 `shouldBe` Just -9007199254740992 f (0 / 0) `shouldBe` Nothing f (1 / 0) `shouldBe` Nothing f (-1 / 0) `shouldBe` Nothing f 0.1 `shouldBe` Just 0.1 f (-0.1) `shouldBe` Just (-0.1) describe "From Double Float" $ do let f = Witch.from @Double @Float it "works" $ do f 0 `shouldBe` 0 f 0.5 `shouldBe` 0.5 f (-0.5) `shouldBe` (-0.5) f (0 / 0) `shouldSatisfy` isNaN f (1 / 0) `shouldBe` (1 / 0) f (-1 / 0) `shouldBe` (-1 / 0) describe "From a (Ratio a)" $ do let f = Witch.from @Int @(Ratio.Ratio Int) it "works" $ do f 0 `shouldBe` 0 f 1 `shouldBe` 1 describe "TryFrom (Ratio a) a" $ do let f = hush . Witch.tryFrom @(Ratio.Ratio Int) @Int it "works" $ do f 0 `shouldBe` Just 0 f 0.5 `shouldBe` Nothing f 1 `shouldBe` Just 1 describe "From Rational Float" $ do let f = Witch.from @Rational @Float it "works" $ do f 0 `shouldBe` 0 f 0.5 `shouldBe` 0.5 f (-0.5) `shouldBe` (-0.5) f 0.1 `shouldBe` 0.1 f (-0.1) `shouldBe` (-0.1) describe "From Rational Double" $ do let f = Witch.from @Rational @Double it "works" $ do f 0 `shouldBe` 0 f 0.5 `shouldBe` 0.5 f (-0.5) `shouldBe` (-0.5) f 0.1 `shouldBe` 0.1 f (-0.1) `shouldBe` (-0.1) describe "TryFrom Rational (Fixed a)" $ do let f = hush . Witch.tryFrom @Rational @Fixed.Deci it "works" $ do f 0.1 `shouldBe` Just 0.1 f 1.2 `shouldBe` Just 1.2 f 12.3 `shouldBe` Just 12.3 f 0.12 `shouldBe` Nothing describe "From Integer (Fixed a)" $ do let f = Witch.from @Integer @Fixed.Deci it "works" $ do f 1 `shouldBe` 0.1 f 10 `shouldBe` 1 f 120 `shouldBe` 12 describe "From (Fixed a) Integer" $ do let f = Witch.from @Fixed.Deci @Integer it "works" $ do f 0.1 `shouldBe` 1 f 1 `shouldBe` 10 f 12 `shouldBe` 120 describe "From (Fixed a) Rational" $ do let f = Witch.from @Fixed.Deci @Rational it "works" $ do f 0.1 `shouldBe` 0.1 f 1 `shouldBe` 1 f 12 `shouldBe` 12 describe "From a (Complex a)" $ do let f = Witch.from @Float @(Complex.Complex Float) it "works" $ do f 0 `shouldBe` 0 f 1 `shouldBe` 1 describe "TryFrom (Complex a) a" $ do let f = hush . Witch.tryFrom @(Complex.Complex Float) @Float it "works" $ do f 0 `shouldBe` Just 0 f 1 `shouldBe` Just 1 f (0 Complex.:+ 1) `shouldBe` Nothing describe "TryFrom [a] (NonEmpty a)" $ do let f = hush . Witch.tryFrom @[Int] @(NonEmpty.NonEmpty Int) it "works" $ do f [] `shouldBe` Nothing f [1] `shouldBe` Just (1 NonEmpty.:| []) f [1, 2] `shouldBe` Just (1 NonEmpty.:| [2]) describe "From (NonEmpty a) [a]" $ do let f = Witch.from @(NonEmpty.NonEmpty Int) @[Int] it "works" $ do f (1 NonEmpty.:| []) `shouldBe` [1] f (1 NonEmpty.:| [2]) `shouldBe` [1, 2] describe "From [a] (Set a)" $ do let f = Witch.from @[Char] @(Set.Set Char) it "works" $ do f [] `shouldBe` Set.fromList [] f ['a'] `shouldBe` Set.fromList ['a'] f ['a', 'b'] `shouldBe` Set.fromList ['a', 'b'] f ['a', 'a'] `shouldBe` Set.fromList ['a'] describe "From (Set a) [a]" $ do let f = Witch.from @(Set.Set Char) @[Char] it "works" $ do f (Set.fromList []) `shouldBe` [] f (Set.fromList ['a']) `shouldBe` ['a'] f (Set.fromList ['a', 'b']) `shouldBe` ['a', 'b'] describe "From [Int] IntSet" $ do let f = Witch.from @[Int] @IntSet.IntSet it "works" $ do f [] `shouldBe` IntSet.fromList [] f [1] `shouldBe` IntSet.fromList [1] f [1, 2] `shouldBe` IntSet.fromList [1, 2] describe "From IntSet [Int]" $ do let f = Witch.from @IntSet.IntSet @[Int] it "works" $ do f (IntSet.fromList []) `shouldBe` [] f (IntSet.fromList [1]) `shouldBe` [1] f (IntSet.fromList [1, 2]) `shouldBe` [1, 2] describe "From [(k, v)] (Map k v)" $ do let f = Witch.from @[(Char, Int)] @(Map.Map Char Int) it "works" $ do f [] `shouldBe` Map.empty f [('a', 1)] `shouldBe` Map.fromList [('a', 1)] f [('a', 1), ('b', 2)] `shouldBe` Map.fromList [('a', 1), ('b', 2)] f [('a', 1), ('a', 2)] `shouldBe` Map.fromList [('a', 2)] describe "From (Map k v) [(k, v)]" $ do let f = Witch.from @(Map.Map Char Int) @[(Char, Int)] it "works" $ do f Map.empty `shouldBe` [] f (Map.fromList [('a', 1)]) `shouldBe` [('a', 1)] f (Map.fromList [('a', 1), ('b', 2)]) `shouldBe` [('a', 1), ('b', 2)] describe "From [(Int, v)] (IntMap v)" $ do let f = Witch.from @[(Int, Char)] @(IntMap.IntMap Char) it "works" $ do f [] `shouldBe` IntMap.fromList [] f [(1, 'a')] `shouldBe` IntMap.fromList [(1, 'a')] f [(1, 'a'), (2, 'b')] `shouldBe` IntMap.fromList [(1, 'a'), (2, 'b')] f [(1, 'a'), (1, 'b')] `shouldBe` IntMap.fromList [(1, 'b')] describe "From (IntMap v) [(Int, v)]" $ do let f = Witch.from @(IntMap.IntMap Char) @[(Int, Char)] it "works" $ do f (IntMap.fromList []) `shouldBe` [] f (IntMap.fromList [(1, 'a')]) `shouldBe` [(1, 'a')] f (IntMap.fromList [(1, 'a'), (2, 'b')]) `shouldBe` [(1, 'a'), (2, 'b')] describe "From [a] (Seq a)" $ do let f = Witch.from @[Int] @(Seq.Seq Int) it "works" $ do f [] `shouldBe` Seq.fromList [] f [1] `shouldBe` Seq.fromList [1] f [1, 2] `shouldBe` Seq.fromList [1, 2] describe "From (Seq a) [a]" $ do let f = Witch.from @(Seq.Seq Int) @[Int] it "works" $ do f (Seq.fromList []) `shouldBe` [] f (Seq.fromList [1]) `shouldBe` [1] f (Seq.fromList [1, 2]) `shouldBe` [1, 2] describe "From [Word8] ByteString" $ do let f = Witch.from @[Word.Word8] @ByteString.ByteString it "works" $ do f [] `shouldBe` ByteString.pack [] f [0x00] `shouldBe` ByteString.pack [0x00] f [0x0f, 0xf0] `shouldBe` ByteString.pack [0x0f, 0xf0] describe "From ByteString [Word8]" $ do let f = Witch.from @ByteString.ByteString @[Word.Word8] it "works" $ do f (ByteString.pack []) `shouldBe` [] f (ByteString.pack [0x00]) `shouldBe` [0x00] f (ByteString.pack [0x0f, 0xf0]) `shouldBe` [0x0f, 0xf0] describe "From ByteString LazyByteString" $ do let f = Witch.from @ByteString.ByteString @LazyByteString.ByteString it "works" $ do f (ByteString.pack []) `shouldBe` LazyByteString.pack [] f (ByteString.pack [0x00]) `shouldBe` LazyByteString.pack [0x00] f (ByteString.pack [0x0f, 0xf0]) `shouldBe` LazyByteString.pack [0x0f, 0xf0] describe "From ByteString ShortByteString" $ do let f = Witch.from @ByteString.ByteString @ShortByteString.ShortByteString it "works" $ do f (ByteString.pack []) `shouldBe` ShortByteString.pack [] f (ByteString.pack [0x00]) `shouldBe` ShortByteString.pack [0x00] f (ByteString.pack [0x0f, 0xf0]) `shouldBe` ShortByteString.pack [0x0f, 0xf0] describe "From [Word8] LazyByteString" $ do let f = Witch.from @[Word.Word8] @LazyByteString.ByteString it "works" $ do f [] `shouldBe` LazyByteString.pack [] f [0x00] `shouldBe` LazyByteString.pack [0x00] f [0x0f, 0xf0] `shouldBe` LazyByteString.pack [0x0f, 0xf0] describe "From LazyByteString [Word8]" $ do let f = Witch.from @LazyByteString.ByteString @[Word.Word8] it "works" $ do f (LazyByteString.pack []) `shouldBe` [] f (LazyByteString.pack [0x00]) `shouldBe` [0x00] f (LazyByteString.pack [0x0f, 0xf0]) `shouldBe` [0x0f, 0xf0] describe "From LazyByteString ByteString" $ do let f = Witch.from @LazyByteString.ByteString @ByteString.ByteString it "works" $ do f (LazyByteString.pack []) `shouldBe` ByteString.pack [] f (LazyByteString.pack [0x00]) `shouldBe` ByteString.pack [0x00] f (LazyByteString.pack [0x0f, 0xf0]) `shouldBe` ByteString.pack [0x0f, 0xf0] describe "From [Word8] ShortByteString" $ do let f = Witch.from @[Word.Word8] @ShortByteString.ShortByteString it "works" $ do f [] `shouldBe` ShortByteString.pack [] f [0x00] `shouldBe` ShortByteString.pack [0x00] f [0x0f, 0xf0] `shouldBe` ShortByteString.pack [0x0f, 0xf0] describe "From ShortByteString [Word8]" $ do let f = Witch.from @ShortByteString.ShortByteString @[Word.Word8] it "works" $ do f (ShortByteString.pack []) `shouldBe` [] f (ShortByteString.pack [0x00]) `shouldBe` [0x00] f (ShortByteString.pack [0x0f, 0xf0]) `shouldBe` [0x0f, 0xf0] describe "From ShortByteString ByteString" $ do let f = Witch.from @ShortByteString.ShortByteString @ByteString.ByteString it "works" $ do f (ShortByteString.pack []) `shouldBe` ByteString.pack [] f (ShortByteString.pack [0x00]) `shouldBe` ByteString.pack [0x00] f (ShortByteString.pack [0x0f, 0xf0]) `shouldBe` ByteString.pack [0x0f, 0xf0] describe "From Text LazyText" $ do let f = Witch.from @Text.Text @LazyText.Text it "works" $ do f (Text.pack "") `shouldBe` LazyText.pack "" f (Text.pack "a") `shouldBe` LazyText.pack "a" f (Text.pack "ab") `shouldBe` LazyText.pack "ab" describe "From LazyText Text" $ do let f = Witch.from @LazyText.Text @Text.Text it "works" $ do f (LazyText.pack "") `shouldBe` Text.pack "" f (LazyText.pack "a") `shouldBe` Text.pack "a" f (LazyText.pack "ab") `shouldBe` Text.pack "ab" describe "From String Text" $ do let f = Witch.from @String @Text.Text it "works" $ do f "" `shouldBe` Text.pack "" f "a" `shouldBe` Text.pack "a" f "ab" `shouldBe` Text.pack "ab" describe "From Text String" $ do let f = Witch.from @Text.Text @String it "works" $ do f (Text.pack "") `shouldBe` "" f (Text.pack "a") `shouldBe` "a" f (Text.pack "ab") `shouldBe` "ab" describe "From String LazyText" $ do let f = Witch.from @String @LazyText.Text it "works" $ do f "" `shouldBe` LazyText.pack "" f "a" `shouldBe` LazyText.pack "a" f "ab" `shouldBe` LazyText.pack "ab" describe "From LazyText String" $ do let f = Witch.from @LazyText.Text @String it "works" $ do f (LazyText.pack "") `shouldBe` "" f (LazyText.pack "a") `shouldBe` "a" f (LazyText.pack "ab") `shouldBe` "ab" describe "From Integer Day" $ do let f = Witch.from @Integer @Time.Day it "works" $ do f 0 `shouldBe` Time.ModifiedJulianDay 0 describe "From Day Integer" $ do let f = Witch.from @Time.Day @Integer it "works" $ do f (Time.ModifiedJulianDay 0) `shouldBe` 0 describe "From Day DayOfWeek" $ do let f = Witch.from @Time.Day @Time.DayOfWeek it "works" $ do f (Time.ModifiedJulianDay 0) `shouldBe` Time.Wednesday describe "From Rational UniversalTime" $ do let f = Witch.from @Rational @Time.UniversalTime it "works" $ do f 0 `shouldBe` Time.ModJulianDate 0 describe "From UniversalTime Rational" $ do let f = Witch.from @Time.UniversalTime @Rational it "works" $ do f (Time.ModJulianDate 0) `shouldBe` 0 describe "From Pico DiffTime" $ do let f = Witch.from @Fixed.Pico @Time.DiffTime it "works" $ do f 0 `shouldBe` 0 describe "From DiffTime Pico" $ do let f = Witch.from @Time.DiffTime @Fixed.Pico it "works" $ do f 0 `shouldBe` 0 describe "From Pico NominalDiffTime" $ do let f = Witch.from @Fixed.Pico @Time.NominalDiffTime it "works" $ do f 0 `shouldBe` 0 describe "From NominalDiffTime Pico" $ do let f = Witch.from @Time.NominalDiffTime @Fixed.Pico it "works" $ do f 0 `shouldBe` 0 describe "From SystemTime POSIXTime" $ do let f = Witch.from @Time.SystemTime @Time.POSIXTime it "works" $ do f (Time.MkSystemTime 0 0) `shouldBe` 0 describe "From UTCTime POSIXTime" $ do let f = Witch.from @Time.UTCTime @Time.POSIXTime it "works" $ do f unixEpoch `shouldBe` 0 describe "From POSIXTime UTCTime" $ do let f = Witch.from @Time.POSIXTime @Time.UTCTime it "works" $ do f 0 `shouldBe` unixEpoch describe "From UTCTime SystemTime" $ do let f = Witch.from @Time.UTCTime @Time.SystemTime it "works" $ do f unixEpoch `shouldBe` Time.MkSystemTime 0 0 describe "From SystemTime AbsoluteTime" $ do let f = Witch.from @Time.SystemTime @Time.AbsoluteTime it "works" $ do f (Time.MkSystemTime -3506716800 0) `shouldBe` Time.taiEpoch describe "From SystemTime UTCTime" $ do let f = Witch.from @Time.SystemTime @Time.UTCTime it "works" $ do f (Time.MkSystemTime 0 0) `shouldBe` unixEpoch describe "From DiffTime TimeOfDay" $ do let f = Witch.from @Time.DiffTime @Time.TimeOfDay it "works" $ do f 0 `shouldBe` Time.TimeOfDay 0 0 0 describe "From Rational TimeOfDay" $ do let f = Witch.from @Rational @Time.TimeOfDay it "works" $ do f 0 `shouldBe` Time.TimeOfDay 0 0 0 describe "From TimeOfDay DiffTime" $ do let f = Witch.from @Time.TimeOfDay @Time.DiffTime it "works" $ do f (Time.TimeOfDay 0 0 0) `shouldBe` 0 describe "From TimeOfDay Rational" $ do let f = Witch.from @Time.TimeOfDay @Rational it "works" $ do f (Time.TimeOfDay 0 0 0) `shouldBe` 0 describe "From CalendarDiffDays CalendarDiffTime" $ do let f = Witch.from @Time.CalendarDiffDays @Time.CalendarDiffTime it "works" $ do f (Time.CalendarDiffDays 0 0) `shouldBe` Time.CalendarDiffTime 0 0 describe "From NominalDiffTime CalendarDiffTime" $ do let f = Witch.from @Time.NominalDiffTime @Time.CalendarDiffTime it "works" $ do f 0 `shouldBe` Time.CalendarDiffTime 0 0 describe "From ZonedTime UTCTime" $ do let f = Witch.from @Time.ZonedTime @Time.UTCTime it "works" $ do f (Time.ZonedTime (Time.LocalTime (Time.ModifiedJulianDay 0) (Time.TimeOfDay 0 0 0)) Time.utc) `shouldBe` Time.UTCTime (Time.ModifiedJulianDay 0) 0 describe "From a (Tagged t a)" $ do let f = Witch.from @Bool @(Tagged.Tagged () Bool) it "works" $ do f False `shouldBe` Tagged.Tagged False describe "From (Tagged t a) a" $ do let f = Witch.from @(Tagged.Tagged () Bool) @Bool it "works" $ do f (Tagged.Tagged False) `shouldBe` False describe "From (Tagged t a) (Tagged u a)" $ do let f = Witch.from @(Tagged.Tagged "old" Bool) @(Tagged.Tagged "new" Bool) it "works" $ do f (Tagged.Tagged False) `shouldBe` Tagged.Tagged False describe "From (ISO_8859_1 ByteString) Text" $ do let f = Witch.from @(Encoding.ISO_8859_1 ByteString.ByteString) @Text.Text it "works" $ do f (Tagged.Tagged (ByteString.pack [0x61])) `shouldBe` Text.pack "a" describe "From (ISO_8859_1 ByteString) LazyText" $ do let f = Witch.from @(Encoding.ISO_8859_1 ByteString.ByteString) @LazyText.Text it "works" $ do f (Tagged.Tagged (ByteString.pack [0x61])) `shouldBe` LazyText.pack "a" describe "From (ISO_8859_1 ByteString) String" $ do let f = Witch.from @(Encoding.ISO_8859_1 ByteString.ByteString) @String it "works" $ do f (Tagged.Tagged (ByteString.pack [0x61])) `shouldBe` "a" describe "From (ISO_8859_1 LazyByteString) LazyText" $ do let f = Witch.from @(Encoding.ISO_8859_1 LazyByteString.ByteString) @LazyText.Text it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x61])) `shouldBe` LazyText.pack "a" describe "From (ISO_8859_1 LazyByteString) Text" $ do let f = Witch.from @(Encoding.ISO_8859_1 LazyByteString.ByteString) @Text.Text it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x61])) `shouldBe` Text.pack "a" describe "From (ISO_8859_1 LazyByteString) String" $ do let f = Witch.from @(Encoding.ISO_8859_1 LazyByteString.ByteString) @String it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x61])) `shouldBe` "a" describe "TryFrom Text (ISO_8859_1 ByteString)" $ do let f = hush . Witch.tryFrom @Text.Text @(Encoding.ISO_8859_1 ByteString.ByteString) it "works" $ do f (Text.pack "a") `shouldBe` Just (Tagged.Tagged $ ByteString.pack [0x61]) f (Text.pack "\x100") `shouldBe` Nothing describe "TryFrom Text (ISO_8859_1 LazyByteString)" $ do let f = hush . Witch.tryFrom @Text.Text @(Encoding.ISO_8859_1 LazyByteString.ByteString) it "works" $ do f (Text.pack "a") `shouldBe` Just (Tagged.Tagged $ LazyByteString.pack [0x61]) f (Text.pack "\x100") `shouldBe` Nothing describe "TryFrom LazyText (ISO_8859_1 LazyByteString)" $ do let f = hush . Witch.tryFrom @LazyText.Text @(Encoding.ISO_8859_1 LazyByteString.ByteString) it "works" $ do f (LazyText.pack "a") `shouldBe` Just (Tagged.Tagged $ LazyByteString.pack [0x61]) f (LazyText.pack "\x100") `shouldBe` Nothing describe "TryFrom LazyText (ISO_8859_1 ByteString)" $ do let f = hush . Witch.tryFrom @LazyText.Text @(Encoding.ISO_8859_1 ByteString.ByteString) it "works" $ do f (LazyText.pack "a") `shouldBe` Just (Tagged.Tagged $ ByteString.pack [0x61]) f (LazyText.pack "\x100") `shouldBe` Nothing describe "TryFrom String (ISO_8859_1 ByteString)" $ do let f = hush . Witch.tryFrom @String @(Encoding.ISO_8859_1 ByteString.ByteString) it "works" $ do f "a" `shouldBe` Just (Tagged.Tagged $ ByteString.pack [0x61]) f "\x100" `shouldBe` Nothing describe "TryFrom String (ISO_8859_1 LazyByteString)" $ do let f = hush . Witch.tryFrom @String @(Encoding.ISO_8859_1 LazyByteString.ByteString) it "works" $ do f "a" `shouldBe` Just (Tagged.Tagged $ LazyByteString.pack [0x61]) f "\x100" `shouldBe` Nothing describe "TryFrom (UTF_8 ByteString) Text" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_8 ByteString.ByteString) @Text.Text it "works" $ do f (Tagged.Tagged (ByteString.pack [])) `shouldBe` Just (Text.pack "") f (Tagged.Tagged (ByteString.pack [0x61])) `shouldBe` Just (Text.pack "a") f (Tagged.Tagged (ByteString.pack [0xff])) `shouldBe` Nothing f (Tagged.Tagged (ByteString.pack [0x24])) `shouldBe` Just (Text.pack "\x24") f (Tagged.Tagged (ByteString.pack [0xc2, 0xa3])) `shouldBe` Just (Text.pack "\xa3") f (Tagged.Tagged (ByteString.pack [0xe2, 0x82, 0xac])) `shouldBe` Just (Text.pack "\x20ac") f (Tagged.Tagged (ByteString.pack [0xf0, 0x90, 0x8d, 0x88])) `shouldBe` Just (Text.pack "\x10348") describe "TryFrom (UTF_8 ByteString) LazyText" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_8 ByteString.ByteString) @LazyText.Text it "works" $ do f (Tagged.Tagged (ByteString.pack [])) `shouldBe` Just (LazyText.pack "") f (Tagged.Tagged (ByteString.pack [0x61])) `shouldBe` Just (LazyText.pack "a") f (Tagged.Tagged (ByteString.pack [0xff])) `shouldBe` Nothing describe "TryFrom (UTF_8 ByteString) String" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_8 ByteString.ByteString) @String it "works" $ do f (Tagged.Tagged (ByteString.pack [])) `shouldBe` Just "" f (Tagged.Tagged (ByteString.pack [0x61])) `shouldBe` Just "a" f (Tagged.Tagged (ByteString.pack [0xff])) `shouldBe` Nothing describe "TryFrom (UTF_8 LazyByteString) LazyText" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_8 LazyByteString.ByteString) @LazyText.Text it "works" $ do f (Tagged.Tagged (LazyByteString.pack [])) `shouldBe` Just (LazyText.pack "") f (Tagged.Tagged (LazyByteString.pack [0x61])) `shouldBe` Just (LazyText.pack "a") f (Tagged.Tagged (LazyByteString.pack [0xff])) `shouldBe` Nothing describe "TryFrom (UTF_8 LazyByteString) Text" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_8 LazyByteString.ByteString) @Text.Text it "works" $ do f (Tagged.Tagged (LazyByteString.pack [])) `shouldBe` Just (Text.pack "") f (Tagged.Tagged (LazyByteString.pack [0x61])) `shouldBe` Just (Text.pack "a") f (Tagged.Tagged (LazyByteString.pack [0xff])) `shouldBe` Nothing describe "TryFrom (UTF_8 LazyByteString) String" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_8 LazyByteString.ByteString) @String it "works" $ do f (Tagged.Tagged (LazyByteString.pack [])) `shouldBe` Just "" f (Tagged.Tagged (LazyByteString.pack [0x61])) `shouldBe` Just "a" f (Tagged.Tagged (LazyByteString.pack [0xff])) `shouldBe` Nothing describe "From Text (UTF_8 ByteString)" $ do let f = Witch.from @Text.Text @(Encoding.UTF_8 ByteString.ByteString) it "works" $ do f (Text.pack "") `shouldBe` Tagged.Tagged (ByteString.pack []) f (Text.pack "a") `shouldBe` Tagged.Tagged (ByteString.pack [0x61]) f (Text.pack "\x24") `shouldBe` Tagged.Tagged (ByteString.pack [0x24]) f (Text.pack "\xa3") `shouldBe` Tagged.Tagged (ByteString.pack [0xc2, 0xa3]) f (Text.pack "\x20ac") `shouldBe` Tagged.Tagged (ByteString.pack [0xe2, 0x82, 0xac]) f (Text.pack "\x10348") `shouldBe` Tagged.Tagged (ByteString.pack [0xf0, 0x90, 0x8d, 0x88]) describe "From Text (UTF_8 LazyByteString)" $ do let f = Witch.from @Text.Text @(Encoding.UTF_8 LazyByteString.ByteString) it "works" $ do f (Text.pack "") `shouldBe` Tagged.Tagged (LazyByteString.pack []) f (Text.pack "a") `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61]) describe "From LazyText (UTF_8 LazyByteString)" $ do let f = Witch.from @LazyText.Text @(Encoding.UTF_8 LazyByteString.ByteString) it "works" $ do f (LazyText.pack "") `shouldBe` Tagged.Tagged (LazyByteString.pack []) f (LazyText.pack "a") `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61]) describe "From LazyText (UTF_8 ByteString)" $ do let f = Witch.from @LazyText.Text @(Encoding.UTF_8 ByteString.ByteString) it "works" $ do f (LazyText.pack "") `shouldBe` Tagged.Tagged (ByteString.pack []) f (LazyText.pack "a") `shouldBe` Tagged.Tagged (ByteString.pack [0x61]) describe "From String (UTF_8 ByteString)" $ do let f = Witch.from @String @(Encoding.UTF_8 ByteString.ByteString) it "works" $ do f "" `shouldBe` Tagged.Tagged (ByteString.pack []) f "a" `shouldBe` Tagged.Tagged (ByteString.pack [0x61]) describe "From String (UTF_8 LazyByteString)" $ do let f = Witch.from @String @(Encoding.UTF_8 LazyByteString.ByteString) it "works" $ do f "" `shouldBe` Tagged.Tagged (LazyByteString.pack []) f "a" `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61]) describe "TryFrom (UTF_16LE ByteString) Text" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_16LE ByteString.ByteString) @Text.Text it "works" $ do f (Tagged.Tagged (ByteString.pack [])) `shouldBe` Just (Text.pack "") f (Tagged.Tagged (ByteString.pack [0x24, 0x00])) `shouldBe` Just (Text.pack "\x24") f (Tagged.Tagged (ByteString.pack [0xa3, 0x00])) `shouldBe` Just (Text.pack "\xa3") f (Tagged.Tagged (ByteString.pack [0xac, 0x20])) `shouldBe` Just (Text.pack "\x20ac") f (Tagged.Tagged (ByteString.pack [0x00, 0xd8, 0x48, 0xdf])) `shouldBe` Just (Text.pack "\x10348") f (Tagged.Tagged (ByteString.pack [0x00])) `shouldBe` Nothing describe "TryFrom (UTF_16LE ByteString) LazyText" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_16LE ByteString.ByteString) @LazyText.Text it "works" $ do f (Tagged.Tagged (ByteString.pack [0x61, 0x00])) `shouldBe` Just (LazyText.pack "a") describe "TryFrom (UTF_16LE ByteString) String" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_16LE ByteString.ByteString) @String it "works" $ do f (Tagged.Tagged (ByteString.pack [0x61, 0x00])) `shouldBe` Just "a" describe "TryFrom (UTF_16LE LazyByteString) LazyText" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_16LE LazyByteString.ByteString) @LazyText.Text it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x61, 0x00])) `shouldBe` Just (LazyText.pack "a") describe "TryFrom (UTF_16LE LazyByteString) Text" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_16LE LazyByteString.ByteString) @Text.Text it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x61, 0x00])) `shouldBe` Just (Text.pack "a") describe "TryFrom (UTF_16LE LazyByteString) String" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_16LE LazyByteString.ByteString) @String it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x61, 0x00])) `shouldBe` Just "a" describe "From Text (UTF_16LE ByteString)" $ do let f = Witch.from @Text.Text @(Encoding.UTF_16LE ByteString.ByteString) it "works" $ do f (Text.pack "") `shouldBe` Tagged.Tagged (ByteString.pack []) f (Text.pack "\x24") `shouldBe` Tagged.Tagged (ByteString.pack [0x24, 0x00]) f (Text.pack "\xa3") `shouldBe` Tagged.Tagged (ByteString.pack [0xa3, 0x00]) f (Text.pack "\x20ac") `shouldBe` Tagged.Tagged (ByteString.pack [0xac, 0x20]) f (Text.pack "\x10348") `shouldBe` Tagged.Tagged (ByteString.pack [0x00, 0xd8, 0x48, 0xdf]) describe "From Text (UTF_16LE LazyByteString)" $ do let f = Witch.from @Text.Text @(Encoding.UTF_16LE LazyByteString.ByteString) it "works" $ do f (Text.pack "a") `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61, 0x00]) describe "From LazyText (UTF_16LE LazyByteString)" $ do let f = Witch.from @LazyText.Text @(Encoding.UTF_16LE LazyByteString.ByteString) it "works" $ do f (LazyText.pack "a") `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61, 0x00]) describe "From LazyText (UTF_16LE ByteString)" $ do let f = Witch.from @LazyText.Text @(Encoding.UTF_16LE ByteString.ByteString) it "works" $ do f (LazyText.pack "a") `shouldBe` Tagged.Tagged (ByteString.pack [0x61, 0x00]) describe "From String (UTF_16LE ByteString)" $ do let f = Witch.from @String @(Encoding.UTF_16LE ByteString.ByteString) it "works" $ do f "a" `shouldBe` Tagged.Tagged (ByteString.pack [0x61, 0x00]) describe "From String (UTF_16LE LazyByteString)" $ do let f = Witch.from @String @(Encoding.UTF_16LE LazyByteString.ByteString) it "works" $ do f "a" `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61, 0x00]) describe "TryFrom (UTF_16BE ByteString) Text" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_16BE ByteString.ByteString) @Text.Text it "works" $ do f (Tagged.Tagged (ByteString.pack [])) `shouldBe` Just (Text.pack "") f (Tagged.Tagged (ByteString.pack [0x00, 0x24])) `shouldBe` Just (Text.pack "\x24") f (Tagged.Tagged (ByteString.pack [0x00, 0xa3])) `shouldBe` Just (Text.pack "\xa3") f (Tagged.Tagged (ByteString.pack [0x20, 0xac])) `shouldBe` Just (Text.pack "\x20ac") f (Tagged.Tagged (ByteString.pack [0xd8, 0x00, 0xdf, 0x48])) `shouldBe` Just (Text.pack "\x10348") f (Tagged.Tagged (ByteString.pack [0x00])) `shouldBe` Nothing describe "TryFrom (UTF_16BE ByteString) LazyText" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_16BE ByteString.ByteString) @LazyText.Text it "works" $ do f (Tagged.Tagged (ByteString.pack [0x00, 0x61])) `shouldBe` Just (LazyText.pack "a") describe "TryFrom (UTF_16BE ByteString) String" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_16BE ByteString.ByteString) @String it "works" $ do f (Tagged.Tagged (ByteString.pack [0x00, 0x61])) `shouldBe` Just "a" describe "TryFrom (UTF_16BE LazyByteString) LazyText" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_16BE LazyByteString.ByteString) @LazyText.Text it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x00, 0x61])) `shouldBe` Just (LazyText.pack "a") describe "TryFrom (UTF_16BE LazyByteString) Text" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_16BE LazyByteString.ByteString) @Text.Text it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x00, 0x61])) `shouldBe` Just (Text.pack "a") describe "TryFrom (UTF_16BE LazyByteString) String" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_16BE LazyByteString.ByteString) @String it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x00, 0x61])) `shouldBe` Just "a" describe "From Text (UTF_16BE ByteString)" $ do let f = Witch.from @Text.Text @(Encoding.UTF_16BE ByteString.ByteString) it "works" $ do f (Text.pack "") `shouldBe` Tagged.Tagged (ByteString.pack []) f (Text.pack "\x24") `shouldBe` Tagged.Tagged (ByteString.pack [0x00, 0x24]) f (Text.pack "\xa3") `shouldBe` Tagged.Tagged (ByteString.pack [0x00, 0xa3]) f (Text.pack "\x20ac") `shouldBe` Tagged.Tagged (ByteString.pack [0x20, 0xac]) f (Text.pack "\x10348") `shouldBe` Tagged.Tagged (ByteString.pack [0xd8, 0x00, 0xdf, 0x48]) describe "From Text (UTF_16BE LazyByteString)" $ do let f = Witch.from @Text.Text @(Encoding.UTF_16BE LazyByteString.ByteString) it "works" $ do f (Text.pack "a") `shouldBe` Tagged.Tagged (LazyByteString.pack [0x00, 0x61]) describe "From LazyText (UTF_16BE LazyByteString)" $ do let f = Witch.from @LazyText.Text @(Encoding.UTF_16BE LazyByteString.ByteString) it "works" $ do f (LazyText.pack "a") `shouldBe` Tagged.Tagged (LazyByteString.pack [0x00, 0x61]) describe "From LazyText (UTF_16BE ByteString)" $ do let f = Witch.from @LazyText.Text @(Encoding.UTF_16BE ByteString.ByteString) it "works" $ do f (LazyText.pack "a") `shouldBe` Tagged.Tagged (ByteString.pack [0x00, 0x61]) describe "From String (UTF_16BE ByteString)" $ do let f = Witch.from @String @(Encoding.UTF_16BE ByteString.ByteString) it "works" $ do f "a" `shouldBe` Tagged.Tagged (ByteString.pack [0x00, 0x61]) describe "From String (UTF_16BE LazyByteString)" $ do let f = Witch.from @String @(Encoding.UTF_16BE LazyByteString.ByteString) it "works" $ do f "a" `shouldBe` Tagged.Tagged (LazyByteString.pack [0x00, 0x61]) describe "TryFrom (UTF_32LE ByteString) Text" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_32LE ByteString.ByteString) @Text.Text it "works" $ do f (Tagged.Tagged (ByteString.pack [])) `shouldBe` Just (Text.pack "") f (Tagged.Tagged (ByteString.pack [0x24, 0x00, 0x00, 0x00])) `shouldBe` Just (Text.pack "\x24") f (Tagged.Tagged (ByteString.pack [0xa3, 0x00, 0x00, 0x00])) `shouldBe` Just (Text.pack "\xa3") f (Tagged.Tagged (ByteString.pack [0xac, 0x20, 0x00, 0x00])) `shouldBe` Just (Text.pack "\x20ac") f (Tagged.Tagged (ByteString.pack [0x48, 0x03, 0x01, 0x00])) `shouldBe` Just (Text.pack "\x10348") f (Tagged.Tagged (ByteString.pack [0x00])) `shouldBe` Nothing describe "TryFrom (UTF_32LE ByteString) LazyText" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_32LE ByteString.ByteString) @LazyText.Text it "works" $ do f (Tagged.Tagged (ByteString.pack [0x61, 0x00, 0x00, 0x00])) `shouldBe` Just (LazyText.pack "a") describe "TryFrom (UTF_32LE ByteString) String" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_32LE ByteString.ByteString) @String it "works" $ do f (Tagged.Tagged (ByteString.pack [0x61, 0x00, 0x00, 0x00])) `shouldBe` Just "a" describe "TryFrom (UTF_32LE LazyByteString) LazyText" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_32LE LazyByteString.ByteString) @LazyText.Text it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x61, 0x00, 0x00, 0x00])) `shouldBe` Just (LazyText.pack "a") describe "TryFrom (UTF_32LE LazyByteString) Text" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_32LE LazyByteString.ByteString) @Text.Text it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x61, 0x00, 0x00, 0x00])) `shouldBe` Just (Text.pack "a") describe "TryFrom (UTF_32LE LazyByteString) String" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_32LE LazyByteString.ByteString) @String it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x61, 0x00, 0x00, 0x00])) `shouldBe` Just "a" describe "From Text (UTF_32LE ByteString)" $ do let f = Witch.from @Text.Text @(Encoding.UTF_32LE ByteString.ByteString) it "works" $ do f (Text.pack "") `shouldBe` Tagged.Tagged (ByteString.pack []) f (Text.pack "\x24") `shouldBe` Tagged.Tagged (ByteString.pack [0x24, 0x00, 0x00, 0x00]) f (Text.pack "\xa3") `shouldBe` Tagged.Tagged (ByteString.pack [0xa3, 0x00, 0x00, 0x00]) f (Text.pack "\x20ac") `shouldBe` Tagged.Tagged (ByteString.pack [0xac, 0x20, 0x00, 0x00]) f (Text.pack "\x10348") `shouldBe` Tagged.Tagged (ByteString.pack [0x48, 0x03, 0x01, 0x00]) describe "From Text (UTF_32LE LazyByteString)" $ do let f = Witch.from @Text.Text @(Encoding.UTF_32LE LazyByteString.ByteString) it "works" $ do f (Text.pack "a") `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61, 0x00, 0x00, 0x00]) describe "From LazyText (UTF_32LE LazyByteString)" $ do let f = Witch.from @LazyText.Text @(Encoding.UTF_32LE LazyByteString.ByteString) it "works" $ do f (LazyText.pack "a") `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61, 0x00, 0x00, 0x00]) describe "From LazyText (UTF_32LE ByteString)" $ do let f = Witch.from @LazyText.Text @(Encoding.UTF_32LE ByteString.ByteString) it "works" $ do f (LazyText.pack "a") `shouldBe` Tagged.Tagged (ByteString.pack [0x61, 0x00, 0x00, 0x00]) describe "From String (UTF_32LE ByteString)" $ do let f = Witch.from @String @(Encoding.UTF_32LE ByteString.ByteString) it "works" $ do f "a" `shouldBe` Tagged.Tagged (ByteString.pack [0x61, 0x00, 0x00, 0x00]) describe "From String (UTF_32LE LazyByteString)" $ do let f = Witch.from @String @(Encoding.UTF_32LE LazyByteString.ByteString) it "works" $ do f "a" `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61, 0x00, 0x00, 0x00]) describe "TryFrom (UTF_32BE ByteString) Text" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_32BE ByteString.ByteString) @Text.Text it "works" $ do f (Tagged.Tagged (ByteString.pack [])) `shouldBe` Just (Text.pack "") f (Tagged.Tagged (ByteString.pack [0x00, 0x00, 0x00, 0x24])) `shouldBe` Just (Text.pack "\x24") f (Tagged.Tagged (ByteString.pack [0x00, 0x00, 0x00, 0xa3])) `shouldBe` Just (Text.pack "\xa3") f (Tagged.Tagged (ByteString.pack [0x00, 0x00, 0x20, 0xac])) `shouldBe` Just (Text.pack "\x20ac") f (Tagged.Tagged (ByteString.pack [0x00, 0x01, 0x03, 0x48])) `shouldBe` Just (Text.pack "\x10348") f (Tagged.Tagged (ByteString.pack [0x00])) `shouldBe` Nothing describe "TryFrom (UTF_32BE ByteString) LazyText" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_32BE ByteString.ByteString) @LazyText.Text it "works" $ do f (Tagged.Tagged (ByteString.pack [0x00, 0x00, 0x00, 0x61])) `shouldBe` Just (LazyText.pack "a") describe "TryFrom (UTF_32BE ByteString) String" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_32BE ByteString.ByteString) @String it "works" $ do f (Tagged.Tagged (ByteString.pack [0x00, 0x00, 0x00, 0x61])) `shouldBe` Just "a" describe "TryFrom (UTF_32BE LazyByteString) LazyText" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_32BE LazyByteString.ByteString) @LazyText.Text it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x00, 0x00, 0x00, 0x61])) `shouldBe` Just (LazyText.pack "a") describe "TryFrom (UTF_32BE LazyByteString) Text" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_32BE LazyByteString.ByteString) @Text.Text it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x00, 0x00, 0x00, 0x61])) `shouldBe` Just (Text.pack "a") describe "TryFrom (UTF_32BE LazyByteString) String" $ do let f = hush . Witch.tryFrom @(Encoding.UTF_32BE LazyByteString.ByteString) @String it "works" $ do f (Tagged.Tagged (LazyByteString.pack [0x00, 0x00, 0x00, 0x61])) `shouldBe` Just "a" describe "From Text (UTF_32BE ByteString)" $ do let f = Witch.from @Text.Text @(Encoding.UTF_32BE ByteString.ByteString) it "works" $ do f (Text.pack "") `shouldBe` Tagged.Tagged (ByteString.pack []) f (Text.pack "\x24") `shouldBe` Tagged.Tagged (ByteString.pack [0x00, 0x00, 0x00, 0x24]) f (Text.pack "\xa3") `shouldBe` Tagged.Tagged (ByteString.pack [0x00, 0x00, 0x00, 0xa3]) f (Text.pack "\x20ac") `shouldBe` Tagged.Tagged (ByteString.pack [0x00, 0x00, 0x20, 0xac]) f (Text.pack "\x10348") `shouldBe` Tagged.Tagged (ByteString.pack [0x00, 0x01, 0x03, 0x48]) describe "From Text (UTF_32BE LazyByteString)" $ do let f = Witch.from @Text.Text @(Encoding.UTF_32BE LazyByteString.ByteString) it "works" $ do f (Text.pack "a") `shouldBe` Tagged.Tagged (LazyByteString.pack [0x00, 0x00, 0x00, 0x61]) describe "From LazyText (UTF_32BE LazyByteString)" $ do let f = Witch.from @LazyText.Text @(Encoding.UTF_32BE LazyByteString.ByteString) it "works" $ do f (LazyText.pack "a") `shouldBe` Tagged.Tagged (LazyByteString.pack [0x00, 0x00, 0x00, 0x61]) describe "From LazyText (UTF_32BE ByteString)" $ do let f = Witch.from @LazyText.Text @(Encoding.UTF_32BE ByteString.ByteString) it "works" $ do f (LazyText.pack "a") `shouldBe` Tagged.Tagged (ByteString.pack [0x00, 0x00, 0x00, 0x61]) describe "From String (UTF_32BE ByteString)" $ do let f = Witch.from @String @(Encoding.UTF_32BE ByteString.ByteString) it "works" $ do f "a" `shouldBe` Tagged.Tagged (ByteString.pack [0x00, 0x00, 0x00, 0x61]) describe "From String (UTF_32BE LazyByteString)" $ do let f = Witch.from @String @(Encoding.UTF_32BE LazyByteString.ByteString) it "works" $ do f "a" `shouldBe` Tagged.Tagged (LazyByteString.pack [0x00, 0x00, 0x00, 0x61]) newtype Age = Age Int.Int8 deriving (Eq, Show) instance Witch.From Age Int.Int8 instance Witch.From Int.Int8 Age type Selector e = e -> Bool type Spec = Writer.Writer (Seq.Seq HUnit.Test) () anyTryFromException :: Selector (Witch.TryFromException s t) anyTryFromException = const True describe :: (Stack.HasCallStack) => String -> Spec -> Spec describe label = testToSpec . HUnit.TestLabel label . specToTest hush :: Either x a -> Maybe a hush = either (const Nothing) Just it :: (Stack.HasCallStack) => String -> HUnit.Assertion -> Spec it label = testToSpec . HUnit.TestLabel label . HUnit.TestCase shouldBe :: (Stack.HasCallStack, Eq a, Show a) => a -> a -> HUnit.Assertion shouldBe = (HUnit.@?=) shouldSatisfy :: (Stack.HasCallStack, Show a) => a -> (a -> Bool) -> HUnit.Assertion shouldSatisfy value predicate = HUnit.assertBool ("predicate failed on: " <> show value) $ predicate value shouldThrow :: (Stack.HasCallStack, Exception.Exception e) => IO a -> Selector e -> HUnit.Assertion shouldThrow action predicate = do result <- Exception.try action case result of Right _ -> HUnit.assertFailure "did not get expected exception" Left exception -> HUnit.assertBool ("predicate failed on expected exception: " <> show exception) $ predicate exception specToTest :: (Stack.HasCallStack) => Spec -> HUnit.Test specToTest = HUnit.TestList . Foldable.toList . Writer.execWriter testToSpec :: (Stack.HasCallStack) => HUnit.Test -> Spec testToSpec = Writer.tell . Seq.singleton unixEpoch :: Time.UTCTime unixEpoch = Time.UTCTime (Time.fromGregorian 1970 1 1) 0 witch-1.2.1.1/witch.cabal0000644000000000000000000000354307346545000013270 0ustar0000000000000000cabal-version: 2.2 name: witch version: 1.2.1.1 synopsis: Convert values from one type into another. description: Witch converts values from one type into another. build-type: Simple category: Data extra-doc-files: CHANGELOG.md README.md license-file: LICENSE.txt license: MIT maintainer: Taylor Fausak source-repository head location: https://github.com/tfausak/witch type: git flag pedantic default: False manual: True common library build-depends: base ^>=4.18.0.0 || ^>=4.19.0.0 || ^>=4.20.0.0 build-depends: bytestring ^>=0.11.4.0 || ^>=0.12.0.2, containers ^>=0.6.7 || ^>=0.7, tagged ^>=0.8.8, text ^>=2.0.2 || ^>=2.1, time ^>=1.12.2 || ^>=1.14, default-language: Haskell2010 ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-deriving-strategies -Wno-missing-export-lists -Wno-missing-exported-signatures -Wno-missing-kind-signatures -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-redundant-constraints -Wno-safe -Wno-unsafe if flag(pedantic) ghc-options: -Werror if impl(ghc >= 9.8) ghc-options: -Wno-missing-role-annotations common executable import: library build-depends: witch ghc-options: -rtsopts -threaded library import: library build-depends: template-haskell ^>=2.20.0.0 || ^>=2.21.0.0 || ^>=2.22.0.0 -- cabal-gild: discover source/library exposed-modules: Witch Witch.Encoding Witch.From Witch.Instances Witch.Lift Witch.TryFrom Witch.TryFromException Witch.Utility hs-source-dirs: source/library test-suite witch-test-suite import: executable build-depends: HUnit ^>=1.6.2.0, transformers ^>=0.6.1.0, hs-source-dirs: source/test-suite main-is: Main.hs type: exitcode-stdio-1.0