diff --git a/Changelog.md b/Changelog.md new file mode 100644 --- /dev/null +++ b/Changelog.md @@ -0,0 +1,11 @@ +# Change log for unwitch project + +## Version 0.1.0 + +Implement some of Double. +Write description + +## Version 0.0.0 + +import [template](https://github.com/jappeace/haskell-template-project). + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2021 Jappie Klooster + +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. diff --git a/Readme.md b/Readme.md new file mode 100644 --- /dev/null +++ b/Readme.md @@ -0,0 +1,99 @@ +[![https://jappieklooster.nl](https://img.shields.io/badge/blog-jappieklooster.nl-lightgrey)](https://jappieklooster.nl/tag/haskell.html) +[![Jappiejappie](https://img.shields.io/badge/twitch.tv-jappiejappie-purple?logo=twitch)](https://www.twitch.tv/jappiejappie) +[![Jappiejappie](https://img.shields.io/badge/discord-jappiejappie-black?logo=discord)](https://discord.gg/Hp4agqy) + +> Three hundred and twenty years have passed since the coven sank in the dark. + +Removes the magic from witch. +This provides safe conversions like witch does. +But it [doesn't](https://jappie.me/death-to-type-classes.html) use [type classes](https://www.haskellforall.com/2012/05/scrap-your-type-classes.html) +or exceptions. +This has a couple of advantages: + +1. No need to use type application for function selection. +2. Functions get names that describe what they do. + This allows ctags to work as well. +3. No trouble with orphans. +4. Custom errors instead of the prelude based ones allow client + code to recover with typesafety even on partial conversions. + +## Usage + +The idea is to select some module *from* which type you want to convert. +So if you have a double you do: + +```haskell +import qualified Unwitch.Convert.Double as Double + +``` +Next you simply use the functions within the module +to convert to something you want, for example: + +```haskell +spec = do + Double.toFloat 5.6 `shouldBe` 5.6 +``` + +Although dubious since float holds less information +then double, +this can never fail in the current implementation. +But there are situation where conversion can fail, +such as when converting to an integer: +```haskell +spec = do + Double.toInteger 5.0 `shouldBe` Right 5 + Double.toInteger 5.6 `shouldBe` Left $ RationalConversion $ DenomNotOne (5 % 6) +``` + +In these situation you'll `Right` for success, or `Left` +for an error. +The library will attempt to give you as much information +as possible, +in this case the denominator wasn't 1 so the rational +conversion failed. + +## Comparison + +### Witch + +Type applications are unnecessary because there is no polymorphism. +Since there are no polymorphic types we don't need to distinct +between conversions that fail and conversions that don't, +This is encoded in types. +Furthermore on failure, if the client can figure out how to go on with a +Rational, they can. +In witch this information gets squashed, we happily provide it. +It's not an exception like witch implied. + + +## Hacking +### Tools +Enter the nix shell. +``` +nix-shell +``` +You can checkout the makefile to see what's available: +``` +cat makefile +``` + +### Running +``` +make run +``` + +### Fast filewatch which runs tests +``` +make ghcid +``` + +## Design decisions + ++ Modules names indicate where you're converting *from*. ++ Errors should be packed with information to allow recovery ++ Only restricted to primitives in base. + The original witch had support for Map, and Text. + I feel this is out of scope. + +https://serokell.io/blog/introduction-to-template-haskell + diff --git a/src/Unwitch.hs b/src/Unwitch.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch.hs @@ -0,0 +1,25 @@ +-- just used to load ghci +module Unwitch () where + +import Unwitch.Errors () +import Unwitch.Constant() +import Unwitch.Convert.ByteString () +import Unwitch.Convert.Double () +import Unwitch.Convert.Float () +import Unwitch.Convert.Int () +import Unwitch.Convert.Int8 () +import Unwitch.Convert.Int16 () +import Unwitch.Convert.Int32 () +import Unwitch.Convert.Int64 () +import Unwitch.Convert.Integer () +import Unwitch.Convert.LazyByteString () +import Unwitch.Convert.LazyText () +import Unwitch.Convert.Natural () +import Unwitch.Convert.Ratio () +import Unwitch.Convert.ShortByteString () +import Unwitch.Convert.Text () +import Unwitch.Convert.Word () +import Unwitch.Convert.Word8 () +import Unwitch.Convert.Word16 () +import Unwitch.Convert.Word32 () +import Unwitch.Convert.Word64 () diff --git a/src/Unwitch/Constant.hs b/src/Unwitch/Constant.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Constant.hs @@ -0,0 +1,15 @@ +module Unwitch.Constant + ( maxIntegralRepDouble + , maxIntegralRepFloat + ) +where + +-- | The maximum integral value that can be unambiguously represented as a +-- 'Double'. Equal to 9,007,199,254,740,991 (2^53 - 1). +maxIntegralRepDouble :: Num a => a +maxIntegralRepDouble = 9007199254740991 + +-- | The maximum integral value that can be unambiguously represented as a +-- 'Float'. Equal to 16,777,215 (2^24 - 1). +maxIntegralRepFloat :: Num a => a +maxIntegralRepFloat = 16777215 diff --git a/src/Unwitch/Convert/ByteString.hs b/src/Unwitch/Convert/ByteString.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/ByteString.hs @@ -0,0 +1,55 @@ +module Unwitch.Convert.ByteString + ( toLazyByteString + , toShortByteString + , toWord8s + , fromWord8s + , toTextLatin1 + , toTextUtf8 + , toTextUtf16LE + , toTextUtf16BE + , toTextUtf32LE + , toTextUtf32BE + ) +where + +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Data.ByteString.Lazy qualified as LBS +import Data.ByteString.Short qualified as SBS +import Data.ByteString.Short (ShortByteString) +import Data.Text (Text) +import Data.Text.Encoding qualified as TE +import Data.Text.Encoding.Error (UnicodeException) +import Data.Word (Word8) +import Unwitch.TryEvaluate (tryEvaluate) + +toLazyByteString :: ByteString -> LBS.ByteString +toLazyByteString = LBS.fromStrict + +toShortByteString :: ByteString -> ShortByteString +toShortByteString = SBS.toShort + +toWord8s :: ByteString -> [Word8] +toWord8s = BS.unpack + +fromWord8s :: [Word8] -> ByteString +fromWord8s = BS.pack + +toTextLatin1 :: ByteString -> Text +toTextLatin1 = TE.decodeLatin1 + +toTextUtf8 :: ByteString -> Either UnicodeException Text +toTextUtf8 = TE.decodeUtf8' + +toTextUtf16LE :: ByteString -> Either UnicodeException Text +toTextUtf16LE = tryEvaluate . TE.decodeUtf16LE + +toTextUtf16BE :: ByteString -> Either UnicodeException Text +toTextUtf16BE = tryEvaluate . TE.decodeUtf16BE + +toTextUtf32LE :: ByteString -> Either UnicodeException Text +toTextUtf32LE = tryEvaluate . TE.decodeUtf32LE + +toTextUtf32BE :: ByteString -> Either UnicodeException Text +toTextUtf32BE = tryEvaluate . TE.decodeUtf32BE + diff --git a/src/Unwitch/Convert/Char.hs b/src/Unwitch/Convert/Char.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Char.hs @@ -0,0 +1,61 @@ +module Unwitch.Convert.Char + ( toInt + , toWord + , fromInt + , fromWord + , fromInt# + , fromWord# + ) +where + +import Data.Char (ord, chr) +import GHC.Exts (Int(..), Word(..), Char(..), chr#, + word2Int#, (>=#), (<=#), leWord#, gtWord#) + +-- | Converts a Char to its Unicode codepoint as Int. Infallible. +toInt :: Char -> Int +toInt = ord + +-- | Converts a Char to its Unicode codepoint as Word. Infallible. +toWord :: Char -> Word +toWord = fromIntegral . ord + +-- | Converts an Int to a Char if it is a valid Unicode codepoint. +-- Valid range: 0..0xD7FF and 0xE000..0x10FFFF (excludes surrogates). +fromInt :: Int -> Maybe Char +fromInt i = if isValidCodepoint (fromIntegral i) + then Just $ chr i + else Nothing + +-- | Unboxed variant of 'fromInt'. Checks valid Unicode codepoint range. +fromInt# :: Int -> (# Char | (# #) #) +fromInt# (I# i#) = case i# >=# 0# of + 1# -> case i# <=# 0xD7FF# of + 1# -> (# C# (chr# i#) | #) + _ -> case i# >=# 0xE000# of + 1# -> case i# <=# 0x10FFFF# of + 1# -> (# C# (chr# i#) | #) + _ -> (# | (# #) #) + _ -> (# | (# #) #) + _ -> (# | (# #) #) + +-- | Converts a Word to a Char if it is a valid Unicode codepoint. +-- Valid range: 0..0xD7FF and 0xE000..0x10FFFF (excludes surrogates). +fromWord :: Word -> Maybe Char +fromWord w = if isValidCodepoint (fromIntegral w) + then Just $ chr (fromIntegral w) + else Nothing + +-- | Unboxed variant of 'fromWord'. Checks valid Unicode codepoint range. +fromWord# :: Word -> (# Char | (# #) #) +fromWord# (W# w#) = case leWord# w# 0xD7FF## of + 1# -> (# C# (chr# (word2Int# w#)) | #) + _ -> case gtWord# w# 0xDFFF## of + 1# -> case leWord# w# 0x10FFFF## of + 1# -> (# C# (chr# (word2Int# w#)) | #) + _ -> (# | (# #) #) + _ -> (# | (# #) #) + +isValidCodepoint :: Integer -> Bool +isValidCodepoint cp = + (cp >= 0 && cp <= 0xD7FF) || (cp >= 0xE000 && cp <= 0x10FFFF) diff --git a/src/Unwitch/Convert/Complex.hs b/src/Unwitch/Convert/Complex.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Complex.hs @@ -0,0 +1,18 @@ +module Unwitch.Convert.Complex + ( fromReal + , toReal + ) +where + +import Data.Complex (Complex((:+)), imagPart, realPart) + +-- | Wraps a real number as a complex number with zero imaginary part. +fromReal :: (Num a) => a -> Complex a +fromReal x = x :+ 0 + +-- | Extracts the real part if the imaginary part is zero. +toReal :: (Eq a, Num a) => Complex a -> Maybe a +toReal c = if imagPart c == 0 + then Just $ realPart c + else Nothing + diff --git a/src/Unwitch/Convert/Double.hs b/src/Unwitch/Convert/Double.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Double.hs @@ -0,0 +1,110 @@ +module Unwitch.Convert.Double + ( toFloat + , toRational + , toInteger + , toInt8 + , toInt16 + , toInt32 + , toInt64 + , toInt + , toWord8 + , toWord16 + , toWord32 + , toWord64 + , toWord + , toNatural + , ViaIntegerErrors(..) + , IntegerErrors(..) + , RationalErrors(..) + ) +where + +import Data.Bifunctor(first) +import Unwitch.Constant +import qualified GHC.Float as F +import Unwitch.Convert.Ratio(unwrapIfDenominatorOne) +import qualified Prelude +import Unwitch.Errors +import Prelude hiding (toRational, toInteger) +import qualified Unwitch.Convert.Integer as Integer +import Data.Word +import Data.Int +import Numeric.Natural (Natural) + +-- loses precision?! +toFloat :: Double -> Float +toFloat = F.double2Float + +data IntegerErrors = IntegerFlow Integer Overflows + | RationalConversion RationalErrors + | DenomNotOne Rational + deriving (Show, Eq) + +data ViaIntegerErrors = MkInteger IntegerErrors + | BitConversionFailed Integer + deriving (Show, Eq) + +toInt8 :: Double -> Either ViaIntegerErrors Int8 +toInt8 = toViaInteger Integer.toInt8 + +toInt16 :: Double -> Either ViaIntegerErrors Int16 +toInt16 = toViaInteger Integer.toInt16 + +toInt32 :: Double -> Either ViaIntegerErrors Int32 +toInt32 = toViaInteger Integer.toInt32 + +toInt64 :: Double -> Either ViaIntegerErrors Int64 +toInt64 = toViaInteger Integer.toInt64 + +toInt :: Double -> Either ViaIntegerErrors Int +toInt = toViaInteger Integer.toInt + +toWord8 :: Double -> Either ViaIntegerErrors Word8 +toWord8 = toViaInteger Integer.toWord8 + +toWord16 :: Double -> Either ViaIntegerErrors Word16 +toWord16 = toViaInteger Integer.toWord16 + +toWord32 :: Double -> Either ViaIntegerErrors Word32 +toWord32 = toViaInteger Integer.toWord32 + +toWord64 :: Double -> Either ViaIntegerErrors Word64 +toWord64 = toViaInteger Integer.toWord64 + +toWord :: Double -> Either ViaIntegerErrors Word +toWord = toViaInteger Integer.toWord + +toNatural :: Double -> Either ViaIntegerErrors Natural +toNatural double = do + integer <- first MkInteger $ toInteger double + case Integer.toNatural integer of + Left err -> Left $ MkInteger $ IntegerFlow integer err + Right n -> Right n + +toViaInteger :: (Integer -> Maybe a) -> Double -> Either ViaIntegerErrors a +toViaInteger fun x = do + integer <- first MkInteger $ toInteger x + maybe (Left $ BitConversionFailed integer) Right $ fun integer + +toInteger :: Double -> Either IntegerErrors Integer +toInteger double = do + rational <- first RationalConversion $ toRational double + integer <- maybe (Left $ DenomNotOne rational) Right $ unwrapIfDenominatorOne rational + if + | integer < -maxIntegralRepDouble -> Left $ IntegerFlow integer Underflow + | integer > maxIntegralRepDouble -> Left $ IntegerFlow integer Overflow + | otherwise -> Right integer + + +data RationalErrors = IsNan + | IsInf Overflows + deriving (Show, Eq) + +toRational :: Double -> Either RationalErrors Rational +toRational double = if + | isNaN double -> Left IsNan + | isInfinite double -> if + | double > 0 -> Left $ IsInf Overflow + | otherwise -> Left $ IsInf Underflow + | True -> Right $ Prelude.toRational double + diff --git a/src/Unwitch/Convert/Fixed.hs b/src/Unwitch/Convert/Fixed.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Fixed.hs @@ -0,0 +1,40 @@ +module Unwitch.Convert.Fixed + ( fromInteger + , toInteger + , toRational + , toFixed + ) +where + +import Data.Fixed (Fixed, HasResolution) +import Data.Ratio (denominator, numerator) +import qualified Prelude +import Prelude hiding (fromInteger, toInteger, toRational) + +-- | Converts an Integer to a Fixed value. Infallible. +fromInteger :: (HasResolution a) => Integer -> Fixed a +fromInteger = Prelude.fromInteger + +-- | Converts a Fixed value to Integer, succeeding only if there is +-- no fractional part (i.e. the value is a whole number). +toInteger :: (HasResolution a) => Fixed a -> Maybe Integer +toInteger fixed = + let r = Prelude.toRational fixed + in if denominator r == 1 + then Just $ numerator r + else Nothing + +-- | Converts a Fixed value to Rational. Infallible, exact. +toRational :: (HasResolution a) => Fixed a -> Rational +toRational = Prelude.toRational + +-- | Converts between Fixed types with potentially different resolutions. +-- Succeeds only if the value can be exactly represented in the target resolution. +toFixed :: (HasResolution a, HasResolution b) => Fixed a -> Maybe (Fixed b) +toFixed source = + let r = Prelude.toRational source + target = Prelude.fromRational r + in if Prelude.toRational target == r + then Just target + else Nothing + diff --git a/src/Unwitch/Convert/Float.hs b/src/Unwitch/Convert/Float.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Float.hs @@ -0,0 +1,113 @@ +module Unwitch.Convert.Float + ( toDouble + , toRational + , toInteger + , toInt8 + , toInt16 + , toInt32 + , toInt64 + , toInt + , toWord8 + , toWord16 + , toWord32 + , toWord64 + , toWord + , toNatural + , ViaIntegerErrors(..) + , IntegerErrors(..) + , RationalErrors(..) + ) +where + +import Data.Bifunctor(first) +import Unwitch.Constant +import qualified GHC.Float as F +import Unwitch.Convert.Ratio(unwrapIfDenominatorOne) +import qualified Prelude +import Unwitch.Errors +import Prelude hiding (toRational, toInteger) +import qualified Unwitch.Convert.Integer as Integer +import Data.Word +import Data.Int +import Numeric.Natural (Natural) + +toDouble :: Float -> Double +toDouble = F.float2Double + +data IntegerErrors = IntegerFlow Integer Overflows + | RationalConversion RationalErrors + | DenomNotOne Rational + deriving (Show, Eq) + +data ViaIntegerErrors = MkInteger IntegerErrors + | BitConversionFailed Integer + deriving (Show, Eq) + +toInt8 :: Float -> Either ViaIntegerErrors Int8 +toInt8 = toViaInteger Integer.toInt8 + + +toInt16 :: Float -> Either ViaIntegerErrors Int16 +toInt16 = toViaInteger Integer.toInt16 + + +toInt32 :: Float -> Either ViaIntegerErrors Int32 +toInt32 = toViaInteger Integer.toInt32 + + +toInt64 :: Float -> Either ViaIntegerErrors Int64 +toInt64 = toViaInteger Integer.toInt64 + + +toInt :: Float -> Either ViaIntegerErrors Int +toInt = toViaInteger Integer.toInt + + +toWord8 :: Float -> Either ViaIntegerErrors Word8 +toWord8 = toViaInteger Integer.toWord8 + + +toWord16 :: Float -> Either ViaIntegerErrors Word16 +toWord16 = toViaInteger Integer.toWord16 + +toWord32 :: Float -> Either ViaIntegerErrors Word32 +toWord32 = toViaInteger Integer.toWord32 + +toWord64 :: Float -> Either ViaIntegerErrors Word64 +toWord64 = toViaInteger Integer.toWord64 + +toWord :: Float -> Either ViaIntegerErrors Word +toWord = toViaInteger Integer.toWord + +toNatural :: Float -> Either ViaIntegerErrors Natural +toNatural float = do + integer <- first MkInteger $ toInteger float + case Integer.toNatural integer of + Left err -> Left $ MkInteger $ IntegerFlow integer err + Right n -> Right n + +toViaInteger :: (Integer -> Maybe a) -> Float -> Either ViaIntegerErrors a +toViaInteger fun x = do + integer <- first MkInteger $ toInteger x + maybe (Left $ BitConversionFailed integer) Right $ fun integer + +toInteger :: Float -> Either IntegerErrors Integer +toInteger float = do + rational <- first RationalConversion $ toRational float + integer <- maybe (Left $ DenomNotOne rational) Right $ unwrapIfDenominatorOne rational + if + | integer < -maxIntegralRepFloat -> Left $ IntegerFlow integer Underflow + | integer > maxIntegralRepFloat -> Left $ IntegerFlow integer Overflow + | otherwise -> Right integer + +data RationalErrors = IsNan + | IsInf Overflows + deriving (Show, Eq) + +toRational :: Float -> Either RationalErrors Rational +toRational float = if + | isNaN float -> Left IsNan + | isInfinite float -> if + | float > 0 -> Left $ IsInf Overflow + | otherwise -> Left $ IsInf Underflow + | True -> Right $ Prelude.toRational float diff --git a/src/Unwitch/Convert/Int.hs b/src/Unwitch/Convert/Int.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Int.hs @@ -0,0 +1,177 @@ +module Unwitch.Convert.Int + ( toInt8 + , toInt8# + , toInt16 + , toInt16# + , toInt32 + , toInt32# + , toInt64 + , toInteger + , toWord8 + , toWord8# + , toWord16 + , toWord16# + , toWord32 + , toWord32# + , toWord64 + , toWord64# + , toWord + , toWord# + , toNatural + , toNatural# + , toFloat + , toFloat# + , toDouble + , toDouble# + ) +where + +import Unwitch.Errors +import Unwitch.Constant +import qualified Data.Bits as Bits +import Data.Word +import Data.Int +import Numeric.Natural (Natural) +import Prelude hiding (toInteger) +import GHC.Exts (Int(..), Word(..), Float(..), Double(..), + intToInt8#, int8ToInt#, intToInt16#, int16ToInt#, + intToInt32#, int32ToInt#, + int2Word#, wordToWord8#, word8ToWord#, + wordToWord16#, word16ToWord#, + wordToWord32#, word32ToWord#, + wordToWord64#, + int2Float#, int2Double#, + (==#), (>=#), (<#), (>#), + word2Int#) +import GHC.Int (Int8(..), Int16(..), Int32(..)) +import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..)) +import GHC.Num.Natural (Natural(NS)) + +toInt8 :: Int -> Maybe Int8 +toInt8 = Bits.toIntegralSized + +toInt16 :: Int -> Maybe Int16 +toInt16 = Bits.toIntegralSized + +toInt32 :: Int -> Maybe Int32 +toInt32 = Bits.toIntegralSized + +toInt64 :: Int -> Int64 +toInt64 = fromIntegral + +toInteger :: Int -> Integer +toInteger = fromIntegral + +toWord8 :: Int -> Maybe Word8 +toWord8 = Bits.toIntegralSized + +toWord16 :: Int -> Maybe Word16 +toWord16 = Bits.toIntegralSized + +toWord32 :: Int -> Maybe Word32 +toWord32 = Bits.toIntegralSized + +toWord64 :: Int -> Maybe Word64 +toWord64 = Bits.toIntegralSized + +toWord :: Int -> Maybe Word +toWord = Bits.toIntegralSized + +toNatural :: Int -> Either Overflows Natural +toNatural x = if + | x < 0 -> Left Underflow + | otherwise -> Right $ fromIntegral x + +toFloat :: Int -> Either Overflows Float +toFloat x = if + | x < -maxIntegralRepFloat -> Left Underflow + | x > maxIntegralRepFloat -> Left Overflow + | otherwise -> Right $ fromIntegral x + +toDouble :: Int -> Either Overflows Double +toDouble x = if + | fromIntegral x < (-maxIntegralRepDouble :: Integer) -> Left Underflow + | fromIntegral x > (maxIntegralRepDouble :: Integer) -> Left Overflow + | otherwise -> Right $ fromIntegral x + +-- | Signed narrowing, roundtrip at Int# +toInt8# :: Int -> (# Int8 | (# #) #) +toInt8# (I# x#) = + let n# = intToInt8# x# + in case int8ToInt# n# ==# x# of + 1# -> (# I8# n# | #) + _ -> (# | (# #) #) + +-- | Signed narrowing, roundtrip at Int# +toInt16# :: Int -> (# Int16 | (# #) #) +toInt16# (I# x#) = + let n# = intToInt16# x# + in case int16ToInt# n# ==# x# of + 1# -> (# I16# n# | #) + _ -> (# | (# #) #) + +-- | Signed narrowing, roundtrip at Int# +toInt32# :: Int -> (# Int32 | (# #) #) +toInt32# (I# x#) = + let n# = intToInt32# x# + in case int32ToInt# n# ==# x# of + 1# -> (# I32# n# | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned narrow, roundtrip via Word# back to Int# +toWord8# :: Int -> (# Word8 | (# #) #) +toWord8# (I# x#) = + let n# = wordToWord8# (int2Word# x#) + in case word2Int# (word8ToWord# n#) ==# x# of + 1# -> (# W8# n# | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned narrow, roundtrip via Word# back to Int# +toWord16# :: Int -> (# Word16 | (# #) #) +toWord16# (I# x#) = + let n# = wordToWord16# (int2Word# x#) + in case word2Int# (word16ToWord# n#) ==# x# of + 1# -> (# W16# n# | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned narrow, roundtrip via Word# back to Int# +toWord32# :: Int -> (# Word32 | (# #) #) +toWord32# (I# x#) = + let n# = wordToWord32# (int2Word# x#) + in case word2Int# (word32ToWord# n#) ==# x# of + 1# -> (# W32# n# | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative +toWord64# :: Int -> (# Word64 | (# #) #) +toWord64# (I# x#) = case x# >=# 0# of + 1# -> (# W64# (wordToWord64# (int2Word# x#)) | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative +toWord# :: Int -> (# Word | (# #) #) +toWord# (I# x#) = case x# >=# 0# of + 1# -> (# W# (int2Word# x#) | #) + _ -> (# | (# #) #) + +-- | Check non-negative, construct NS directly +toNatural# :: Int -> (# Overflows | Natural #) +toNatural# (I# i#) = case i# >=# 0# of + 1# -> (# | NS (int2Word# i#) #) + _ -> (# Underflow | #) + +-- | Bounds-checked float conversion +toFloat# :: Int -> (# Overflows | Float #) +toFloat# (I# i#) = case i# <# -16777215# of + 1# -> (# Underflow | #) + _ -> case i# ># 16777215# of + 1# -> (# Overflow | #) + _ -> (# | F# (int2Float# i#) #) + +-- | Bounds-checked double conversion +toDouble# :: Int -> (# Overflows | Double #) +toDouble# (I# i#) = case i# <# -9007199254740991# of + 1# -> (# Underflow | #) + _ -> case i# ># 9007199254740991# of + 1# -> (# Overflow | #) + _ -> (# | D# (int2Double# i#) #) diff --git a/src/Unwitch/Convert/Int16.hs b/src/Unwitch/Convert/Int16.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Int16.hs @@ -0,0 +1,127 @@ +module Unwitch.Convert.Int16 + ( toInt8 + , toInt32 + , toInt64 + , toInt + , toInteger + , toWord8 + , toWord16 + , toWord32 + , toWord64 + , toWord + , toNatural + , toFloat + , toDouble + , toInt8# + , toWord8# + , toWord16# + , toWord32# + , toWord64# + , toWord# + , toNatural# + ) +where + +import Unwitch.Errors +import qualified Data.Bits as Bits +import Data.Word +import Data.Int +import Numeric.Natural (Natural) +import Prelude hiding (toInteger) +import GHC.Exts (Word(..), int16ToInt#, intToInt8#, int8ToInt#, + int2Word#, word2Int#, + wordToWord8#, word8ToWord#, + wordToWord16#, wordToWord32#, wordToWord64#, + (==#), (>=#)) +import GHC.Int (Int8(..), Int16(..)) +import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..)) +import GHC.Num.Natural (Natural(NS)) + +toInt8 :: Int16 -> Maybe Int8 +toInt8 = Bits.toIntegralSized + +toInt32 :: Int16 -> Int32 +toInt32 = fromIntegral + +toInt64 :: Int16 -> Int64 +toInt64 = fromIntegral + +toInt :: Int16 -> Int +toInt = fromIntegral + +toInteger :: Int16 -> Integer +toInteger = fromIntegral + +toWord8 :: Int16 -> Maybe Word8 +toWord8 = Bits.toIntegralSized + +toWord16 :: Int16 -> Maybe Word16 +toWord16 = Bits.toIntegralSized + +toWord32 :: Int16 -> Maybe Word32 +toWord32 = Bits.toIntegralSized + +toWord64 :: Int16 -> Maybe Word64 +toWord64 = Bits.toIntegralSized + +toWord :: Int16 -> Maybe Word +toWord = Bits.toIntegralSized + +toNatural :: Int16 -> Either Overflows Natural +toNatural x = if + | x < 0 -> Left Underflow + | otherwise -> Right $ fromIntegral x + +toFloat :: Int16 -> Float +toFloat = fromIntegral + +toDouble :: Int16 -> Double +toDouble = fromIntegral + +-- | Signed narrowing, roundtrip at Int# +toInt8# :: Int16 -> (# Int8 | (# #) #) +toInt8# (I16# x16#) = + let i# = int16ToInt# x16# + n# = intToInt8# i# + in case int8ToInt# n# ==# i# of + 1# -> (# I8# n# | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned narrow, roundtrip via Word# back to Int# +toWord8# :: Int16 -> (# Word8 | (# #) #) +toWord8# (I16# x16#) = + let i# = int16ToInt# x16# + n# = wordToWord8# (int2Word# i#) + in case word2Int# (word8ToWord# n#) ==# i# of + 1# -> (# W8# n# | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative +toWord16# :: Int16 -> (# Word16 | (# #) #) +toWord16# (I16# x16#) = case int16ToInt# x16# >=# 0# of + 1# -> (# W16# (wordToWord16# (int2Word# (int16ToInt# x16#))) | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative +toWord32# :: Int16 -> (# Word32 | (# #) #) +toWord32# (I16# x16#) = case int16ToInt# x16# >=# 0# of + 1# -> (# W32# (wordToWord32# (int2Word# (int16ToInt# x16#))) | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative +toWord64# :: Int16 -> (# Word64 | (# #) #) +toWord64# (I16# x16#) = case int16ToInt# x16# >=# 0# of + 1# -> (# W64# (wordToWord64# (int2Word# (int16ToInt# x16#))) | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative +toWord# :: Int16 -> (# Word | (# #) #) +toWord# (I16# x16#) = case int16ToInt# x16# >=# 0# of + 1# -> (# W# (int2Word# (int16ToInt# x16#)) | #) + _ -> (# | (# #) #) + +-- | Check non-negative, construct NS directly +toNatural# :: Int16 -> (# Overflows | Natural #) +toNatural# (I16# x16#) = case int16ToInt# x16# >=# 0# of + 1# -> (# | NS (int2Word# (int16ToInt# x16#)) #) + _ -> (# Underflow | #) diff --git a/src/Unwitch/Convert/Int32.hs b/src/Unwitch/Convert/Int32.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Int32.hs @@ -0,0 +1,164 @@ +module Unwitch.Convert.Int32 + ( toInt8 + , toInt16 + , toInt64 + , toInt + , toInteger + , toWord8 + , toWord16 + , toWord32 + , toWord64 + , toWord + , toNatural + , toFloat + , toDouble + , toInt8# + , toInt16# + , toInt# + , toWord8# + , toWord16# + , toWord32# + , toWord64# + , toWord# + , toNatural# + , toFloat# + ) +where + +import Unwitch.Errors +import Unwitch.Constant +import qualified Data.Bits as Bits +import Data.Word +import Data.Int +import Numeric.Natural (Natural) +import Prelude hiding (toInteger) +import GHC.Exts (Int(..), Word(..), Float(..), + int32ToInt#, intToInt8#, int8ToInt#, + intToInt16#, int16ToInt#, + int2Word#, word2Int#, + wordToWord8#, word8ToWord#, + wordToWord16#, word16ToWord#, + wordToWord32#, wordToWord64#, + int2Float#, + (==#), (>=#), (<#), (>#)) +import GHC.Int (Int8(..), Int16(..), Int32(..)) +import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..)) +import GHC.Num.Natural (Natural(NS)) + +toInt8 :: Int32 -> Maybe Int8 +toInt8 = Bits.toIntegralSized + +toInt16 :: Int32 -> Maybe Int16 +toInt16 = Bits.toIntegralSized + +toInt64 :: Int32 -> Int64 +toInt64 = fromIntegral + +toInt :: Int32 -> Maybe Int +toInt = Bits.toIntegralSized + +toInteger :: Int32 -> Integer +toInteger = fromIntegral + +toWord8 :: Int32 -> Maybe Word8 +toWord8 = Bits.toIntegralSized + +toWord16 :: Int32 -> Maybe Word16 +toWord16 = Bits.toIntegralSized + +toWord32 :: Int32 -> Maybe Word32 +toWord32 = Bits.toIntegralSized + +toWord64 :: Int32 -> Maybe Word64 +toWord64 = Bits.toIntegralSized + +toWord :: Int32 -> Maybe Word +toWord = Bits.toIntegralSized + +toNatural :: Int32 -> Either Overflows Natural +toNatural x = if + | x < 0 -> Left Underflow + | otherwise -> Right $ fromIntegral x + +toFloat :: Int32 -> Either Overflows Float +toFloat x = if + | x < -maxIntegralRepFloat -> Left Underflow + | x > maxIntegralRepFloat -> Left Overflow + | otherwise -> Right $ fromIntegral x + +toDouble :: Int32 -> Double +toDouble = fromIntegral + +-- | Signed narrowing, roundtrip at Int# +toInt8# :: Int32 -> (# Int8 | (# #) #) +toInt8# (I32# x32#) = + let i# = int32ToInt# x32# + n# = intToInt8# i# + in case int8ToInt# n# ==# i# of + 1# -> (# I8# n# | #) + _ -> (# | (# #) #) + +-- | Signed narrowing, roundtrip at Int# +toInt16# :: Int32 -> (# Int16 | (# #) #) +toInt16# (I32# x32#) = + let i# = int32ToInt# x32# + n# = intToInt16# i# + in case int16ToInt# n# ==# i# of + 1# -> (# I16# n# | #) + _ -> (# | (# #) #) + +-- | Int32 always fits in Int (Int is at least 32 bits) +toInt# :: Int32 -> (# Int | (# #) #) +toInt# (I32# x32#) = (# I# (int32ToInt# x32#) | #) + +-- | Signed->unsigned narrow, roundtrip via Word# back to Int# +toWord8# :: Int32 -> (# Word8 | (# #) #) +toWord8# (I32# x32#) = + let i# = int32ToInt# x32# + n# = wordToWord8# (int2Word# i#) + in case word2Int# (word8ToWord# n#) ==# i# of + 1# -> (# W8# n# | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned narrow, roundtrip via Word# back to Int# +toWord16# :: Int32 -> (# Word16 | (# #) #) +toWord16# (I32# x32#) = + let i# = int32ToInt# x32# + n# = wordToWord16# (int2Word# i#) + in case word2Int# (word16ToWord# n#) ==# i# of + 1# -> (# W16# n# | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative +toWord32# :: Int32 -> (# Word32 | (# #) #) +toWord32# (I32# x32#) = case int32ToInt# x32# >=# 0# of + 1# -> (# W32# (wordToWord32# (int2Word# (int32ToInt# x32#))) | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative +toWord64# :: Int32 -> (# Word64 | (# #) #) +toWord64# (I32# x32#) = case int32ToInt# x32# >=# 0# of + 1# -> (# W64# (wordToWord64# (int2Word# (int32ToInt# x32#))) | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative +toWord# :: Int32 -> (# Word | (# #) #) +toWord# (I32# x32#) = case int32ToInt# x32# >=# 0# of + 1# -> (# W# (int2Word# (int32ToInt# x32#)) | #) + _ -> (# | (# #) #) + +-- | Check non-negative, construct NS directly +toNatural# :: Int32 -> (# Overflows | Natural #) +toNatural# (I32# x32#) = case int32ToInt# x32# >=# 0# of + 1# -> (# | NS (int2Word# (int32ToInt# x32#)) #) + _ -> (# Underflow | #) + +-- | Bounds-checked float conversion +toFloat# :: Int32 -> (# Overflows | Float #) +toFloat# (I32# x32#) = + let i# = int32ToInt# x32# + in case i# <# -16777215# of + 1# -> (# Underflow | #) + _ -> case i# ># 16777215# of + 1# -> (# Overflow | #) + _ -> (# | F# (int2Float# i#) #) diff --git a/src/Unwitch/Convert/Int64.hs b/src/Unwitch/Convert/Int64.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Int64.hs @@ -0,0 +1,213 @@ +module Unwitch.Convert.Int64 + ( toInt8 + , toInt16 + , toInt32 + , toInt + , toInteger + , toWord8 + , toWord16 + , toWord32 + , toWord64 + , toWord + , toNatural + , toFloat + , toDouble + , toInt8# + , toInt16# + , toInt32# + , toInt# + , toWord8# + , toWord16# + , toWord32# + , toWord64# + , toWord# + , toNatural# + , toFloat# + , toDouble# + ) +where + +import Unwitch.Errors +import Unwitch.Constant +import qualified Data.Bits as Bits +import Data.Word +import Data.Int +import Numeric.Natural (Natural) +import Prelude hiding (toInteger) +import GHC.Exts (Int(..), Word(..), Float(..), Double(..), + int64ToInt#, intToInt64#, + intToInt8#, int8ToInt#, + intToInt16#, int16ToInt#, + intToInt32#, int32ToInt#, + int2Word#, word2Int#, + wordToWord8#, word8ToWord#, + wordToWord16#, word16ToWord#, + wordToWord32#, word32ToWord#, + wordToWord64#, + int2Float#, int2Double#, + (<#), (>#), + eqInt64#, geInt64#) +import GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..)) +import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..)) +import GHC.Num.Natural (Natural(NS)) + +toInt8 :: Int64 -> Maybe Int8 +toInt8 = Bits.toIntegralSized + +toInt16 :: Int64 -> Maybe Int16 +toInt16 = Bits.toIntegralSized + +toInt32 :: Int64 -> Maybe Int32 +toInt32 = Bits.toIntegralSized + +toInt :: Int64 -> Maybe Int +toInt = Bits.toIntegralSized + +toInteger :: Int64 -> Integer +toInteger = fromIntegral + +toWord8 :: Int64 -> Maybe Word8 +toWord8 = Bits.toIntegralSized + +toWord16 :: Int64 -> Maybe Word16 +toWord16 = Bits.toIntegralSized + +toWord32 :: Int64 -> Maybe Word32 +toWord32 = Bits.toIntegralSized + +toWord64 :: Int64 -> Maybe Word64 +toWord64 = Bits.toIntegralSized + +toWord :: Int64 -> Maybe Word +toWord = Bits.toIntegralSized + +toNatural :: Int64 -> Either Overflows Natural +toNatural x = if + | x < 0 -> Left Underflow + | otherwise -> Right $ fromIntegral x + +toFloat :: Int64 -> Either Overflows Float +toFloat x = if + | x < -maxIntegralRepFloat -> Left Underflow + | x > maxIntegralRepFloat -> Left Overflow + | otherwise -> Right $ fromIntegral x + +toDouble :: Int64 -> Either Overflows Double +toDouble x = if + | x < -maxIntegralRepDouble -> Left Underflow + | x > maxIntegralRepDouble -> Left Overflow + | otherwise -> Right $ fromIntegral x + +-- | Narrow through Int#, compare at Int64# +toInt8# :: Int64 -> (# Int8 | (# #) #) +toInt8# (I64# x64#) = + let i# = int64ToInt# x64# + n# = intToInt8# i# + in case eqInt64# (intToInt64# (int8ToInt# n#)) x64# of + 1# -> (# I8# n# | #) + _ -> (# | (# #) #) + +-- | Signed narrowing via Int64# comparison +toInt16# :: Int64 -> (# Int16 | (# #) #) +toInt16# (I64# x64#) = + let i# = int64ToInt# x64# + n# = intToInt16# i# + in case eqInt64# (intToInt64# (int16ToInt# n#)) x64# of + 1# -> (# I16# n# | #) + _ -> (# | (# #) #) + +-- | Signed narrowing via Int64# comparison +toInt32# :: Int64 -> (# Int32 | (# #) #) +toInt32# (I64# x64#) = + let i# = int64ToInt# x64# + n# = intToInt32# i# + in case eqInt64# (intToInt64# (int32ToInt# n#)) x64# of + 1# -> (# I32# n# | #) + _ -> (# | (# #) #) + +-- | Roundtrip check at Int64# level for platform safety +toInt# :: Int64 -> (# Int | (# #) #) +toInt# (I64# x64#) = + let i# = int64ToInt# x64# + in case eqInt64# (intToInt64# i#) x64# of + 1# -> (# I# i# | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned narrow via Int64# comparison +toWord8# :: Int64 -> (# Word8 | (# #) #) +toWord8# (I64# x64#) = + let i# = int64ToInt# x64# + n# = wordToWord8# (int2Word# i#) + in case eqInt64# (intToInt64# (word2Int# (word8ToWord# n#))) x64# of + 1# -> (# W8# n# | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned narrow via Int64# comparison +toWord16# :: Int64 -> (# Word16 | (# #) #) +toWord16# (I64# x64#) = + let i# = int64ToInt# x64# + n# = wordToWord16# (int2Word# i#) + in case eqInt64# (intToInt64# (word2Int# (word16ToWord# n#))) x64# of + 1# -> (# W16# n# | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned narrow via Int64# comparison +toWord32# :: Int64 -> (# Word32 | (# #) #) +toWord32# (I64# x64#) = + let i# = int64ToInt# x64# + n# = wordToWord32# (int2Word# i#) + in case eqInt64# (intToInt64# (word2Int# (word32ToWord# n#))) x64# of + 1# -> (# W32# n# | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative at Int64# level +toWord64# :: Int64 -> (# Word64 | (# #) #) +toWord64# (I64# x64#) = case geInt64# x64# (intToInt64# 0#) of + 1# -> (# W64# (wordToWord64# (int2Word# (int64ToInt# x64#))) | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative at Int64# then roundtrip +toWord# :: Int64 -> (# Word | (# #) #) +toWord# (I64# x64#) = case geInt64# x64# (intToInt64# 0#) of + 1# -> let i# = int64ToInt# x64# + in case eqInt64# (intToInt64# i#) x64# of + 1# -> (# W# (int2Word# i#) | #) + _ -> (# | (# #) #) + _ -> (# | (# #) #) + +-- | Check non-negative at Int64# level, construct NS +toNatural# :: Int64 -> (# Overflows | Natural #) +toNatural# (I64# x64#) = case geInt64# x64# (intToInt64# 0#) of + 1# -> let i# = int64ToInt# x64# + in case eqInt64# (intToInt64# i#) x64# of + 1# -> (# | NS (int2Word# i#) #) + _ -> (# Overflow | #) + _ -> (# Underflow | #) + +-- | Bounds-checked float conversion via Int# +toFloat# :: Int64 -> (# Overflows | Float #) +toFloat# (I64# x64#) = + let i# = int64ToInt# x64# + in case eqInt64# (intToInt64# i#) x64# of + 1# -> case i# <# -16777215# of + 1# -> (# Underflow | #) + _ -> case i# ># 16777215# of + 1# -> (# Overflow | #) + _ -> (# | F# (int2Float# i#) #) + _ -> case geInt64# x64# (intToInt64# 0#) of + 1# -> (# Overflow | #) + _ -> (# Underflow | #) + +-- | Bounds-checked double conversion via Int# +toDouble# :: Int64 -> (# Overflows | Double #) +toDouble# (I64# x64#) = + let i# = int64ToInt# x64# + in case eqInt64# (intToInt64# i#) x64# of + 1# -> case i# <# -9007199254740991# of + 1# -> (# Underflow | #) + _ -> case i# ># 9007199254740991# of + 1# -> (# Overflow | #) + _ -> (# | D# (int2Double# i#) #) + _ -> case geInt64# x64# (intToInt64# 0#) of + 1# -> (# Overflow | #) + _ -> (# Underflow | #) diff --git a/src/Unwitch/Convert/Int8.hs b/src/Unwitch/Convert/Int8.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Int8.hs @@ -0,0 +1,112 @@ +module Unwitch.Convert.Int8 + ( toInt16 + , toInt32 + , toInt64 + , toInt + , toInteger + , toWord8 + , toWord16 + , toWord32 + , toWord64 + , toWord + , toNatural + , toFloat + , toDouble + , toWord8# + , toWord16# + , toWord32# + , toWord64# + , toWord# + , toNatural# + ) +where + +import Unwitch.Errors +import qualified Data.Bits as Bits +import Data.Word +import Data.Int +import Numeric.Natural (Natural) +import Prelude hiding (toInteger) +import GHC.Exts (Word(..), int8ToInt#, int2Word#, + wordToWord8#, wordToWord16#, wordToWord32#, + wordToWord64#, (>=#)) +import GHC.Int (Int8(..)) +import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..)) +import GHC.Num.Natural (Natural(NS)) + +toInt16 :: Int8 -> Int16 +toInt16 = fromIntegral + +toInt32 :: Int8 -> Int32 +toInt32 = fromIntegral + +toInt64 :: Int8 -> Int64 +toInt64 = fromIntegral + +toInt :: Int8 -> Int +toInt = fromIntegral + +toInteger :: Int8 -> Integer +toInteger = fromIntegral + +toWord8 :: Int8 -> Maybe Word8 +toWord8 = Bits.toIntegralSized + +toWord16 :: Int8 -> Maybe Word16 +toWord16 = Bits.toIntegralSized + +toWord32 :: Int8 -> Maybe Word32 +toWord32 = Bits.toIntegralSized + +toWord64 :: Int8 -> Maybe Word64 +toWord64 = Bits.toIntegralSized + +toWord :: Int8 -> Maybe Word +toWord = Bits.toIntegralSized + +toNatural :: Int8 -> Either Overflows Natural +toNatural x = if + | x < 0 -> Left Underflow + | otherwise -> Right $ fromIntegral x + +toFloat :: Int8 -> Float +toFloat = fromIntegral + +toDouble :: Int8 -> Double +toDouble = fromIntegral + +-- | Signed->unsigned, check non-negative +toWord8# :: Int8 -> (# Word8 | (# #) #) +toWord8# (I8# x8#) = case int8ToInt# x8# >=# 0# of + 1# -> (# W8# (wordToWord8# (int2Word# (int8ToInt# x8#))) | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative +toWord16# :: Int8 -> (# Word16 | (# #) #) +toWord16# (I8# x8#) = case int8ToInt# x8# >=# 0# of + 1# -> (# W16# (wordToWord16# (int2Word# (int8ToInt# x8#))) | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative +toWord32# :: Int8 -> (# Word32 | (# #) #) +toWord32# (I8# x8#) = case int8ToInt# x8# >=# 0# of + 1# -> (# W32# (wordToWord32# (int2Word# (int8ToInt# x8#))) | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative +toWord64# :: Int8 -> (# Word64 | (# #) #) +toWord64# (I8# x8#) = case int8ToInt# x8# >=# 0# of + 1# -> (# W64# (wordToWord64# (int2Word# (int8ToInt# x8#))) | #) + _ -> (# | (# #) #) + +-- | Signed->unsigned, check non-negative +toWord# :: Int8 -> (# Word | (# #) #) +toWord# (I8# x8#) = case int8ToInt# x8# >=# 0# of + 1# -> (# W# (int2Word# (int8ToInt# x8#)) | #) + _ -> (# | (# #) #) + +-- | Check non-negative, construct NS directly +toNatural# :: Int8 -> (# Overflows | Natural #) +toNatural# (I8# x8#) = case int8ToInt# x8# >=# 0# of + 1# -> (# | NS (int2Word# (int8ToInt# x8#)) #) + _ -> (# Underflow | #) diff --git a/src/Unwitch/Convert/Integer.hs b/src/Unwitch/Convert/Integer.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Integer.hs @@ -0,0 +1,238 @@ +module Unwitch.Convert.Integer + ( toDouble + , toDouble# + , toFloat + , toFloat# + , toNatural + , toNatural# + , toInt8 + , toInt8# + , toInt16 + , toInt16# + , toInt32 + , toInt32# + , toInt64 + , toInt64# + , toInt + , toInt# + , toWord8 + , toWord8# + , toWord16 + , toWord16# + , toWord32 + , toWord32# + , toWord64 + , toWord64# + , toWord + , toWord# + ) +where + +import Unwitch.Errors +import Unwitch.Constant +import qualified Data.Bits as Bits +import Data.Word +import Data.Int +import Numeric.Natural (Natural) +import GHC.Exts (Int(..), Word(..), Float(..), Double(..), + intToInt8#, int8ToInt#, + intToInt16#, int16ToInt#, + intToInt32#, int32ToInt#, + intToInt64#, + int2Word#, word2Int#, + wordToWord8#, word8ToWord#, + wordToWord16#, word16ToWord#, + wordToWord32#, word32ToWord#, + wordToWord64#, + int2Float#, int2Double#, + (==#), (>=#), (<#), (>#)) +import GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..)) +import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..)) +import GHC.Num.Integer (Integer(..), integerToWord#, + integerFromWord#, integerEq#) +import GHC.Num.Natural (Natural(NS, NB)) + + +toDouble :: Integer -> Either Overflows Double +toDouble integer = if + | integer < -maxIntegralRepDouble -> Left Underflow + | integer > maxIntegralRepDouble -> Left Overflow + | otherwise -> Right $ Prelude.fromIntegral integer + +toFloat :: Integer -> Either Overflows Float +toFloat integer = if + | integer < -maxIntegralRepFloat -> Left Underflow + | integer > maxIntegralRepFloat -> Left Overflow + | otherwise -> Right $ Prelude.fromIntegral integer + +toNatural :: Integer -> Either Overflows Natural +toNatural integer = if + | integer < 0 -> Left Underflow + | otherwise -> Right $ Prelude.fromIntegral integer + +toInt8 :: Integer -> Maybe Int8 +toInt8 = Bits.toIntegralSized + +toInt16 :: Integer -> Maybe Int16 +toInt16 = Bits.toIntegralSized + +toInt32 :: Integer -> Maybe Int32 +toInt32 = Bits.toIntegralSized + +toInt64 :: Integer -> Maybe Int64 +toInt64 = Bits.toIntegralSized + +toInt :: Integer -> Maybe Int +toInt = Bits.toIntegralSized + +toWord8 :: Integer -> Maybe Word8 +toWord8 = Bits.toIntegralSized + +toWord16 :: Integer -> Maybe Word16 +toWord16 = Bits.toIntegralSized + +toWord32 :: Integer -> Maybe Word32 +toWord32 = Bits.toIntegralSized + +toWord64 :: Integer -> Maybe Word64 +toWord64 = Bits.toIntegralSized + +toWord :: Integer -> Maybe Word +toWord = Bits.toIntegralSized + +-- | Bounds-checked double conversion via IS/IP/IN +toDouble# :: Integer -> (# Overflows | Double #) +toDouble# x = case x of + IS i# -> case i# <# -9007199254740991# of + 1# -> (# Underflow | #) + _ -> case i# ># 9007199254740991# of + 1# -> (# Overflow | #) + _ -> (# | D# (int2Double# i#) #) + IP _ -> (# Overflow | #) + IN _ -> (# Underflow | #) + +-- | Bounds-checked float conversion via IS/IP/IN +toFloat# :: Integer -> (# Overflows | Float #) +toFloat# x = case x of + IS i# -> case i# <# -16777215# of + 1# -> (# Underflow | #) + _ -> case i# ># 16777215# of + 1# -> (# Overflow | #) + _ -> (# | F# (int2Float# i#) #) + IP _ -> (# Overflow | #) + IN _ -> (# Underflow | #) + +-- | Integer->Natural via IS/IP/IN +toNatural# :: Integer -> (# Overflows | Natural #) +toNatural# x = case x of + IS i# -> case i# >=# 0# of + 1# -> (# | NS (int2Word# i#) #) + _ -> (# Underflow | #) + IP ba# -> (# | NB ba# #) + IN _ -> (# Underflow | #) + +-- | Integer->Int8 via IS/IP/IN, narrow and roundtrip at Int# +toInt8# :: Integer -> (# Int8 | (# #) #) +toInt8# x = case x of + IS i# -> + let n# = intToInt8# i# + in case int8ToInt# n# ==# i# of + 1# -> (# I8# n# | #) + _ -> (# | (# #) #) + IP _ -> (# | (# #) #) + IN _ -> (# | (# #) #) + +-- | Integer->Int16 via IS/IP/IN +toInt16# :: Integer -> (# Int16 | (# #) #) +toInt16# x = case x of + IS i# -> + let n# = intToInt16# i# + in case int16ToInt# n# ==# i# of + 1# -> (# I16# n# | #) + _ -> (# | (# #) #) + IP _ -> (# | (# #) #) + IN _ -> (# | (# #) #) + +-- | Integer->Int32 via IS/IP/IN +toInt32# :: Integer -> (# Int32 | (# #) #) +toInt32# x = case x of + IS i# -> + let n# = intToInt32# i# + in case int32ToInt# n# ==# i# of + 1# -> (# I32# n# | #) + _ -> (# | (# #) #) + IP _ -> (# | (# #) #) + IN _ -> (# | (# #) #) + +-- | Integer->Int64 via IS/IP/IN +toInt64# :: Integer -> (# Int64 | (# #) #) +toInt64# x = case x of + IS i# -> (# I64# (intToInt64# i#) | #) + IP _ -> (# | (# #) #) + IN _ -> (# | (# #) #) + +-- | Integer->Int via IS/IP/IN +toInt# :: Integer -> (# Int | (# #) #) +toInt# x = case x of + IS i# -> (# I# i# | #) + IP _ -> (# | (# #) #) + IN _ -> (# | (# #) #) + +-- | Integer->Word8, IS case uses signed->unsigned narrow +toWord8# :: Integer -> (# Word8 | (# #) #) +toWord8# x = case x of + IS i# -> + let n# = wordToWord8# (int2Word# i#) + in case word2Int# (word8ToWord# n#) ==# i# of + 1# -> (# W8# n# | #) + _ -> (# | (# #) #) + IP _ -> (# | (# #) #) + IN _ -> (# | (# #) #) + +-- | Integer->Word16 +toWord16# :: Integer -> (# Word16 | (# #) #) +toWord16# x = case x of + IS i# -> + let n# = wordToWord16# (int2Word# i#) + in case word2Int# (word16ToWord# n#) ==# i# of + 1# -> (# W16# n# | #) + _ -> (# | (# #) #) + IP _ -> (# | (# #) #) + IN _ -> (# | (# #) #) + +-- | Integer->Word32 +toWord32# :: Integer -> (# Word32 | (# #) #) +toWord32# x = case x of + IS i# -> + let n# = wordToWord32# (int2Word# i#) + in case word2Int# (word32ToWord# n#) ==# i# of + 1# -> (# W32# n# | #) + _ -> (# | (# #) #) + IP _ -> (# | (# #) #) + IN _ -> (# | (# #) #) + +-- | Integer->Word64: IS checks non-negative; IP uses integerToWord# roundtrip +toWord64# :: Integer -> (# Word64 | (# #) #) +toWord64# x = case x of + IS i# -> case i# >=# 0# of + 1# -> (# W64# (wordToWord64# (int2Word# i#)) | #) + _ -> (# | (# #) #) + IP _ -> + let w# = integerToWord# x + in case integerEq# (integerFromWord# w#) x of + 1# -> (# W64# (wordToWord64# w#) | #) + _ -> (# | (# #) #) + IN _ -> (# | (# #) #) + +-- | Integer->Word: IS checks non-negative; IP uses integerToWord# roundtrip +toWord# :: Integer -> (# Word | (# #) #) +toWord# x = case x of + IS i# -> case i# >=# 0# of + 1# -> (# W# (int2Word# i#) | #) + _ -> (# | (# #) #) + IP _ -> + let w# = integerToWord# x + in case integerEq# (integerFromWord# w#) x of + 1# -> (# W# w# | #) + _ -> (# | (# #) #) + IN _ -> (# | (# #) #) diff --git a/src/Unwitch/Convert/LazyByteString.hs b/src/Unwitch/Convert/LazyByteString.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/LazyByteString.hs @@ -0,0 +1,48 @@ +module Unwitch.Convert.LazyByteString + ( toByteString + , toWord8s + , fromWord8s + , toLazyTextLatin1 + , toLazyTextUtf8 + , toLazyTextUtf16LE + , toLazyTextUtf16BE + , toLazyTextUtf32LE + , toLazyTextUtf32BE + ) +where + +import Data.ByteString (ByteString) +import Data.ByteString.Lazy qualified as LBS +import Data.Text.Lazy qualified as LT +import Data.Text.Lazy.Encoding qualified as LTE +import Data.Text.Encoding.Error (UnicodeException) +import Data.Word (Word8) +import Unwitch.TryEvaluate (tryEvaluate) + +toByteString :: LBS.ByteString -> ByteString +toByteString = LBS.toStrict + +toWord8s :: LBS.ByteString -> [Word8] +toWord8s = LBS.unpack + +fromWord8s :: [Word8] -> LBS.ByteString +fromWord8s = LBS.pack + +toLazyTextLatin1 :: LBS.ByteString -> LT.Text +toLazyTextLatin1 = LTE.decodeLatin1 + +toLazyTextUtf8 :: LBS.ByteString -> Either UnicodeException LT.Text +toLazyTextUtf8 = LTE.decodeUtf8' + +toLazyTextUtf16LE :: LBS.ByteString -> Either UnicodeException LT.Text +toLazyTextUtf16LE = tryEvaluate . LTE.decodeUtf16LE + +toLazyTextUtf16BE :: LBS.ByteString -> Either UnicodeException LT.Text +toLazyTextUtf16BE = tryEvaluate . LTE.decodeUtf16BE + +toLazyTextUtf32LE :: LBS.ByteString -> Either UnicodeException LT.Text +toLazyTextUtf32LE = tryEvaluate . LTE.decodeUtf32LE + +toLazyTextUtf32BE :: LBS.ByteString -> Either UnicodeException LT.Text +toLazyTextUtf32BE = tryEvaluate . LTE.decodeUtf32BE + diff --git a/src/Unwitch/Convert/LazyText.hs b/src/Unwitch/Convert/LazyText.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/LazyText.hs @@ -0,0 +1,50 @@ +module Unwitch.Convert.LazyText + ( toText + , toString + , fromString + , toLazyByteStringUtf8 + , toLazyByteStringUtf16LE + , toLazyByteStringUtf16BE + , toLazyByteStringUtf32LE + , toLazyByteStringUtf32BE + , toLazyByteStringLatin1 + ) +where + +import Data.ByteString.Lazy qualified as LBS +import Data.ByteString.Lazy.Char8 qualified as LBSC8 +import Data.Text (Text) +import Data.Text.Lazy qualified as LT +import Data.Text.Lazy.Encoding qualified as LTE + +toText :: LT.Text -> Text +toText = LT.toStrict + +toString :: LT.Text -> String +toString = LT.unpack + +fromString :: String -> LT.Text +fromString = LT.pack + +toLazyByteStringUtf8 :: LT.Text -> LBS.ByteString +toLazyByteStringUtf8 = LTE.encodeUtf8 + +toLazyByteStringUtf16LE :: LT.Text -> LBS.ByteString +toLazyByteStringUtf16LE = LTE.encodeUtf16LE + +toLazyByteStringUtf16BE :: LT.Text -> LBS.ByteString +toLazyByteStringUtf16BE = LTE.encodeUtf16BE + +toLazyByteStringUtf32LE :: LT.Text -> LBS.ByteString +toLazyByteStringUtf32LE = LTE.encodeUtf32LE + +toLazyByteStringUtf32BE :: LT.Text -> LBS.ByteString +toLazyByteStringUtf32BE = LTE.encodeUtf32BE + +toLazyByteStringLatin1 :: LT.Text -> Maybe LBS.ByteString +toLazyByteStringLatin1 t = if LT.all isLatin1 t + then Just $ LBSC8.pack (LT.unpack t) + else Nothing + +isLatin1 :: Char -> Bool +isLatin1 c = c <= '\xFF' diff --git a/src/Unwitch/Convert/Natural.hs b/src/Unwitch/Convert/Natural.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Natural.hs @@ -0,0 +1,196 @@ +module Unwitch.Convert.Natural + ( toWord8 + , toWord16 + , toWord32 + , toWord64 + , toWord + , toInt8 + , toInt16 + , toInt32 + , toInt64 + , toInt + , toInteger + , toFloat + , toDouble + , toWord8# + , toWord16# + , toWord32# + , toWord64# + , toWord# + , toInt8# + , toInt16# + , toInt32# + , toInt64# + , toInt# + , toFloat# + , toDouble# + ) +where + +import Unwitch.Errors +import Unwitch.Constant +import qualified Data.Bits as Bits +import Data.Word +import Data.Int +import Numeric.Natural (Natural) +import Prelude hiding (toInteger) +import GHC.Exts (Int(..), Word(..), Float(..), Double(..), + word2Int#, + wordToWord8#, word8ToWord#, + wordToWord16#, word16ToWord#, + wordToWord32#, word32ToWord#, + wordToWord64#, + intToInt8#, + intToInt16#, + intToInt32#, + intToInt64#, + int2Float#, int2Double#, + eqWord#, leWord#, (>=#)) +import GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..)) +import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..)) +import GHC.Num.Natural (naturalToWordMaybe#) + +toWord8 :: Natural -> Maybe Word8 +toWord8 = Bits.toIntegralSized + +toWord16 :: Natural -> Maybe Word16 +toWord16 = Bits.toIntegralSized + +toWord32 :: Natural -> Maybe Word32 +toWord32 = Bits.toIntegralSized + +toWord64 :: Natural -> Maybe Word64 +toWord64 = Bits.toIntegralSized + +toWord :: Natural -> Maybe Word +toWord = Bits.toIntegralSized + +toInt8 :: Natural -> Maybe Int8 +toInt8 = Bits.toIntegralSized + +toInt16 :: Natural -> Maybe Int16 +toInt16 = Bits.toIntegralSized + +toInt32 :: Natural -> Maybe Int32 +toInt32 = Bits.toIntegralSized + +toInt64 :: Natural -> Maybe Int64 +toInt64 = Bits.toIntegralSized + +toInt :: Natural -> Maybe Int +toInt = Bits.toIntegralSized + +toInteger :: Natural -> Integer +toInteger = fromIntegral + +toFloat :: Natural -> Either Overflows Float +toFloat x = if + | x > maxIntegralRepFloat -> Left Overflow + | otherwise -> Right $ fromIntegral x + +toDouble :: Natural -> Either Overflows Double +toDouble x = if + | x > maxIntegralRepDouble -> Left Overflow + | otherwise -> Right $ fromIntegral x + +-- | Via naturalToWordMaybe#, then narrow and roundtrip at Word# +toWord8# :: Natural -> (# Word8 | (# #) #) +toWord8# nat = case naturalToWordMaybe# nat of + (# (# #) | #) -> (# | (# #) #) + (# | w# #) -> + let n# = wordToWord8# w# + in case word8ToWord# n# `eqWord#` w# of + 1# -> (# W8# n# | #) + _ -> (# | (# #) #) + +-- | Via naturalToWordMaybe#, then narrow +toWord16# :: Natural -> (# Word16 | (# #) #) +toWord16# nat = case naturalToWordMaybe# nat of + (# (# #) | #) -> (# | (# #) #) + (# | w# #) -> + let n# = wordToWord16# w# + in case word16ToWord# n# `eqWord#` w# of + 1# -> (# W16# n# | #) + _ -> (# | (# #) #) + +-- | Via naturalToWordMaybe#, then narrow +toWord32# :: Natural -> (# Word32 | (# #) #) +toWord32# nat = case naturalToWordMaybe# nat of + (# (# #) | #) -> (# | (# #) #) + (# | w# #) -> + let n# = wordToWord32# w# + in case word32ToWord# n# `eqWord#` w# of + 1# -> (# W32# n# | #) + _ -> (# | (# #) #) + +-- | Via naturalToWordMaybe#, then widen to Word64 +toWord64# :: Natural -> (# Word64 | (# #) #) +toWord64# nat = case naturalToWordMaybe# nat of + (# (# #) | #) -> (# | (# #) #) + (# | w# #) -> (# W64# (wordToWord64# w#) | #) + +-- | Via naturalToWordMaybe# +toWord# :: Natural -> (# Word | (# #) #) +toWord# nat = case naturalToWordMaybe# nat of + (# (# #) | #) -> (# | (# #) #) + (# | w# #) -> (# W# w# | #) + +-- | Via naturalToWordMaybe#, check upper bound for Int8 +toInt8# :: Natural -> (# Int8 | (# #) #) +toInt8# nat = case naturalToWordMaybe# nat of + (# (# #) | #) -> (# | (# #) #) + (# | w# #) -> case leWord# w# 127## of + 1# -> (# I8# (intToInt8# (word2Int# w#)) | #) + _ -> (# | (# #) #) + +-- | Via naturalToWordMaybe#, check upper bound for Int16 +toInt16# :: Natural -> (# Int16 | (# #) #) +toInt16# nat = case naturalToWordMaybe# nat of + (# (# #) | #) -> (# | (# #) #) + (# | w# #) -> case leWord# w# 32767## of + 1# -> (# I16# (intToInt16# (word2Int# w#)) | #) + _ -> (# | (# #) #) + +-- | Via naturalToWordMaybe#, check upper bound for Int32 +toInt32# :: Natural -> (# Int32 | (# #) #) +toInt32# nat = case naturalToWordMaybe# nat of + (# (# #) | #) -> (# | (# #) #) + (# | w# #) -> case leWord# w# 2147483647## of + 1# -> (# I32# (intToInt32# (word2Int# w#)) | #) + _ -> (# | (# #) #) + +-- | Via naturalToWordMaybe#, check fits in non-negative Int64 +toInt64# :: Natural -> (# Int64 | (# #) #) +toInt64# nat = case naturalToWordMaybe# nat of + (# (# #) | #) -> (# | (# #) #) + (# | w# #) -> + let i# = word2Int# w# + in case i# >=# 0# of + 1# -> (# I64# (intToInt64# i#) | #) + _ -> (# | (# #) #) + +-- | Via naturalToWordMaybe#, check fits in non-negative Int +toInt# :: Natural -> (# Int | (# #) #) +toInt# nat = case naturalToWordMaybe# nat of + (# (# #) | #) -> (# | (# #) #) + (# | w# #) -> + let i# = word2Int# w# + in case i# >=# 0# of + 1# -> (# I# i# | #) + _ -> (# | (# #) #) + +-- | Via naturalToWordMaybe#, bounds-checked float +toFloat# :: Natural -> (# Overflows | Float #) +toFloat# nat = case naturalToWordMaybe# nat of + (# (# #) | #) -> (# Overflow | #) + (# | w# #) -> case leWord# w# 16777215## of + 1# -> (# | F# (int2Float# (word2Int# w#)) #) + _ -> (# Overflow | #) + +-- | Via naturalToWordMaybe#, bounds-checked double +toDouble# :: Natural -> (# Overflows | Double #) +toDouble# nat = case naturalToWordMaybe# nat of + (# (# #) | #) -> (# Overflow | #) + (# | w# #) -> case leWord# w# 9007199254740991## of + 1# -> (# | D# (int2Double# (word2Int# w#)) #) + _ -> (# Overflow | #) diff --git a/src/Unwitch/Convert/Ratio.hs b/src/Unwitch/Convert/Ratio.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Ratio.hs @@ -0,0 +1,30 @@ +module Unwitch.Convert.Ratio + ( unwrapIfDenominatorOne + , fromIntegralToRatio + , toFloat + , toDouble + ) +where + +import Data.Ratio(Ratio, (%)) +import qualified Data.Ratio as Ratio + +-- | Converts if denominator == 1 +unwrapIfDenominatorOne :: (Eq a, Num a) => Ratio a -> Maybe a +unwrapIfDenominatorOne s = if Ratio.denominator s == 1 then + Just $ Ratio.numerator s + else Nothing + +-- | Wraps an integral value as a Ratio with denominator 1. +fromIntegralToRatio :: (Integral a) => a -> Ratio a +fromIntegralToRatio x = x % 1 + +-- | Converts a Rational to Float. This is lossy for rationals +-- that cannot be exactly represented as Float. +toFloat :: Rational -> Float +toFloat = fromRational + +-- | Converts a Rational to Double. This is lossy for rationals +-- that cannot be exactly represented as Double. +toDouble :: Rational -> Double +toDouble = fromRational diff --git a/src/Unwitch/Convert/ShortByteString.hs b/src/Unwitch/Convert/ShortByteString.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/ShortByteString.hs @@ -0,0 +1,20 @@ +module Unwitch.Convert.ShortByteString + ( toByteString + , toWord8s + , fromWord8s + ) +where + +import Data.ByteString (ByteString) +import Data.ByteString.Short (ShortByteString) +import Data.ByteString.Short qualified as SBS +import Data.Word (Word8) + +toByteString :: ShortByteString -> ByteString +toByteString = SBS.fromShort + +toWord8s :: ShortByteString -> [Word8] +toWord8s = SBS.unpack + +fromWord8s :: [Word8] -> ShortByteString +fromWord8s = SBS.pack diff --git a/src/Unwitch/Convert/Text.hs b/src/Unwitch/Convert/Text.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Text.hs @@ -0,0 +1,52 @@ +module Unwitch.Convert.Text + ( toLazyText + , toString + , fromString + , toByteStringUtf8 + , toByteStringUtf16LE + , toByteStringUtf16BE + , toByteStringUtf32LE + , toByteStringUtf32BE + , toByteStringLatin1 + ) +where + +import Data.ByteString (ByteString) +import Data.ByteString.Char8 qualified as BSC8 +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Encoding qualified as TE +import Data.Text.Lazy qualified as LT + +toLazyText :: Text -> LT.Text +toLazyText = LT.fromStrict + +toString :: Text -> String +toString = T.unpack + +fromString :: String -> Text +fromString = T.pack + +toByteStringUtf8 :: Text -> ByteString +toByteStringUtf8 = TE.encodeUtf8 + +toByteStringUtf16LE :: Text -> ByteString +toByteStringUtf16LE = TE.encodeUtf16LE + +toByteStringUtf16BE :: Text -> ByteString +toByteStringUtf16BE = TE.encodeUtf16BE + +toByteStringUtf32LE :: Text -> ByteString +toByteStringUtf32LE = TE.encodeUtf32LE + +toByteStringUtf32BE :: Text -> ByteString +toByteStringUtf32BE = TE.encodeUtf32BE + +toByteStringLatin1 :: Text -> Maybe ByteString +toByteStringLatin1 t = if T.all isLatin1 t + then Just $ BSC8.pack (T.unpack t) + else Nothing + +isLatin1 :: Char -> Bool +isLatin1 c = c <= '\xFF' + diff --git a/src/Unwitch/Convert/Word.hs b/src/Unwitch/Convert/Word.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Word.hs @@ -0,0 +1,158 @@ +module Unwitch.Convert.Word + ( toWord8 + , toWord16 + , toWord32 + , toWord64 + , toNatural + , toInt8 + , toInt16 + , toInt32 + , toInt64 + , toInt + , toInteger + , toFloat + , toDouble + , toWord8# + , toWord16# + , toWord32# + , toInt8# + , toInt16# + , toInt32# + , toInt64# + , toInt# + , toFloat# + , toDouble# + ) +where + +import Unwitch.Errors +import Unwitch.Constant +import qualified Data.Bits as Bits +import Data.Word +import Data.Int +import Numeric.Natural (Natural) +import Prelude hiding (toInteger) +import GHC.Exts (Int(..), Word(..), Float(..), Double(..), + wordToWord8#, word8ToWord#, + wordToWord16#, word16ToWord#, + wordToWord32#, word32ToWord#, + word2Int#, + intToInt8#, intToInt16#, intToInt32#, + intToInt64#, + int2Float#, int2Double#, + eqWord#, leWord#, (>=#)) +import GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..)) +import GHC.Word (Word8(..), Word16(..), Word32(..)) + +toWord8 :: Word -> Maybe Word8 +toWord8 = Bits.toIntegralSized + +toWord16 :: Word -> Maybe Word16 +toWord16 = Bits.toIntegralSized + +toWord32 :: Word -> Maybe Word32 +toWord32 = Bits.toIntegralSized + +toWord64 :: Word -> Word64 +toWord64 = fromIntegral + +toNatural :: Word -> Natural +toNatural = fromIntegral + +toInt8 :: Word -> Maybe Int8 +toInt8 = Bits.toIntegralSized + +toInt16 :: Word -> Maybe Int16 +toInt16 = Bits.toIntegralSized + +toInt32 :: Word -> Maybe Int32 +toInt32 = Bits.toIntegralSized + +toInt64 :: Word -> Maybe Int64 +toInt64 = Bits.toIntegralSized + +toInt :: Word -> Maybe Int +toInt = Bits.toIntegralSized + +toInteger :: Word -> Integer +toInteger = fromIntegral + +toFloat :: Word -> Either Overflows Float +toFloat x = if + | x > maxIntegralRepFloat -> Left Overflow + | otherwise -> Right $ fromIntegral x + +toDouble :: Word -> Either Overflows Double +toDouble x = if + | fromIntegral x > (maxIntegralRepDouble :: Integer) -> Left Overflow + | otherwise -> Right $ fromIntegral x + +-- | Unsigned narrowing, roundtrip at Word# +toWord8# :: Word -> (# Word8 | (# #) #) +toWord8# (W# w#) = + let n# = wordToWord8# w# + in case word8ToWord# n# `eqWord#` w# of + 1# -> (# W8# n# | #) + _ -> (# | (# #) #) + +-- | Unsigned narrowing, roundtrip at Word# +toWord16# :: Word -> (# Word16 | (# #) #) +toWord16# (W# w#) = + let n# = wordToWord16# w# + in case word16ToWord# n# `eqWord#` w# of + 1# -> (# W16# n# | #) + _ -> (# | (# #) #) + +-- | Unsigned narrowing, roundtrip at Word# +toWord32# :: Word -> (# Word32 | (# #) #) +toWord32# (W# w#) = + let n# = wordToWord32# w# + in case word32ToWord# n# `eqWord#` w# of + 1# -> (# W32# n# | #) + _ -> (# | (# #) #) + +-- | Check upper bound for signed target +toInt8# :: Word -> (# Int8 | (# #) #) +toInt8# (W# w#) = case leWord# w# 127## of + 1# -> (# I8# (intToInt8# (word2Int# w#)) | #) + _ -> (# | (# #) #) + +-- | Check upper bound for signed target +toInt16# :: Word -> (# Int16 | (# #) #) +toInt16# (W# w#) = case leWord# w# 32767## of + 1# -> (# I16# (intToInt16# (word2Int# w#)) | #) + _ -> (# | (# #) #) + +-- | Check upper bound for signed target +toInt32# :: Word -> (# Int32 | (# #) #) +toInt32# (W# w#) = case leWord# w# 2147483647## of + 1# -> (# I32# (intToInt32# (word2Int# w#)) | #) + _ -> (# | (# #) #) + +-- | Check high bit not set for Int64 +toInt64# :: Word -> (# Int64 | (# #) #) +toInt64# (W# w#) = + let i# = word2Int# w# + in case i# >=# 0# of + 1# -> (# I64# (intToInt64# i#) | #) + _ -> (# | (# #) #) + +-- | Check high bit not set for Int +toInt# :: Word -> (# Int | (# #) #) +toInt# (W# w#) = + let i# = word2Int# w# + in case i# >=# 0# of + 1# -> (# I# i# | #) + _ -> (# | (# #) #) + +-- | Bounds-checked float conversion +toFloat# :: Word -> (# Overflows | Float #) +toFloat# (W# w#) = case leWord# w# 16777215## of + 1# -> (# | F# (int2Float# (word2Int# w#)) #) + _ -> (# Overflow | #) + +-- | Bounds-checked double conversion +toDouble# :: Word -> (# Overflows | Double #) +toDouble# (W# w#) = case leWord# w# 9007199254740991## of + 1# -> (# | D# (int2Double# (word2Int# w#)) #) + _ -> (# Overflow | #) diff --git a/src/Unwitch/Convert/Word16.hs b/src/Unwitch/Convert/Word16.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Word16.hs @@ -0,0 +1,98 @@ +module Unwitch.Convert.Word16 + ( toWord8 + , toWord32 + , toWord64 + , toWord + , toNatural + , toInt8 + , toInt16 + , toInt32 + , toInt64 + , toInt + , toInteger + , toFloat + , toDouble + , toWord8# + , toInt8# + , toInt16# + ) +where + +import qualified Data.Bits as Bits +import Data.Word +import Data.Int +import Numeric.Natural (Natural) +import Prelude hiding (toInteger) +import GHC.Exts (word16ToWord#, word2Int#, + wordToWord8#, word8ToWord#, + intToInt8#, int8ToInt#, + intToInt16#, int16ToInt#, + eqWord#, (==#)) +import GHC.Int (Int8(..), Int16(..)) +import GHC.Word (Word8(..), Word16(..)) + +toWord8 :: Word16 -> Maybe Word8 +toWord8 = Bits.toIntegralSized + +toWord32 :: Word16 -> Word32 +toWord32 = fromIntegral + +toWord64 :: Word16 -> Word64 +toWord64 = fromIntegral + +toWord :: Word16 -> Word +toWord = fromIntegral + +toNatural :: Word16 -> Natural +toNatural = fromIntegral + +toInt8 :: Word16 -> Maybe Int8 +toInt8 = Bits.toIntegralSized + +toInt16 :: Word16 -> Maybe Int16 +toInt16 = Bits.toIntegralSized + +toInt32 :: Word16 -> Int32 +toInt32 = fromIntegral + +toInt64 :: Word16 -> Int64 +toInt64 = fromIntegral + +toInt :: Word16 -> Int +toInt = fromIntegral + +toInteger :: Word16 -> Integer +toInteger = fromIntegral + +toFloat :: Word16 -> Float +toFloat = fromIntegral + +toDouble :: Word16 -> Double +toDouble = fromIntegral + +-- | Unsigned narrowing, roundtrip at Word# +toWord8# :: Word16 -> (# Word8 | (# #) #) +toWord8# (W16# w16#) = + let w# = word16ToWord# w16# + n# = wordToWord8# w# + in case word8ToWord# n# `eqWord#` w# of + 1# -> (# W8# n# | #) + _ -> (# | (# #) #) + +-- | Unsigned->signed, source fits in Int#, roundtrip at Int# +toInt8# :: Word16 -> (# Int8 | (# #) #) +toInt8# (W16# w16#) = + let i# = word2Int# (word16ToWord# w16#) + n# = intToInt8# i# + in case int8ToInt# n# ==# i# of + 1# -> (# I8# n# | #) + _ -> (# | (# #) #) + +-- | Unsigned->signed, source fits in Int#, roundtrip at Int# +toInt16# :: Word16 -> (# Int16 | (# #) #) +toInt16# (W16# w16#) = + let i# = word2Int# (word16ToWord# w16#) + n# = intToInt16# i# + in case int16ToInt# n# ==# i# of + 1# -> (# I16# n# | #) + _ -> (# | (# #) #) diff --git a/src/Unwitch/Convert/Word32.hs b/src/Unwitch/Convert/Word32.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Word32.hs @@ -0,0 +1,147 @@ +module Unwitch.Convert.Word32 + ( toWord8 + , toWord16 + , toWord64 + , toWord + , toNatural + , toInt8 + , toInt16 + , toInt32 + , toInt64 + , toInt + , toInteger + , toFloat + , toDouble + , toWord8# + , toWord16# + , toWord# + , toInt8# + , toInt16# + , toInt32# + , toInt# + , toFloat# + ) +where + +import Unwitch.Errors +import Unwitch.Constant +import qualified Data.Bits as Bits +import Data.Word +import Data.Int +import Numeric.Natural (Natural) +import Prelude hiding (toInteger) +import GHC.Exts (Int(..), Word(..), Float(..), + word32ToWord#, word2Int#, + wordToWord8#, word8ToWord#, + wordToWord16#, word16ToWord#, + intToInt8#, int8ToInt#, + intToInt16#, int16ToInt#, + intToInt32#, int32ToInt#, + int2Float#, + eqWord#, leWord#, (==#), (>=#)) +import GHC.Int (Int8(..), Int16(..), Int32(..)) +import GHC.Word (Word8(..), Word16(..), Word32(..)) + +toWord8 :: Word32 -> Maybe Word8 +toWord8 = Bits.toIntegralSized + +toWord16 :: Word32 -> Maybe Word16 +toWord16 = Bits.toIntegralSized + +toWord64 :: Word32 -> Word64 +toWord64 = fromIntegral + +toWord :: Word32 -> Maybe Word +toWord = Bits.toIntegralSized + +toNatural :: Word32 -> Natural +toNatural = fromIntegral + +toInt8 :: Word32 -> Maybe Int8 +toInt8 = Bits.toIntegralSized + +toInt16 :: Word32 -> Maybe Int16 +toInt16 = Bits.toIntegralSized + +toInt32 :: Word32 -> Maybe Int32 +toInt32 = Bits.toIntegralSized + +toInt64 :: Word32 -> Int64 +toInt64 = fromIntegral + +toInt :: Word32 -> Maybe Int +toInt = Bits.toIntegralSized + +toInteger :: Word32 -> Integer +toInteger = fromIntegral + +toFloat :: Word32 -> Either Overflows Float +toFloat x = if + | x > maxIntegralRepFloat -> Left Overflow + | otherwise -> Right $ fromIntegral x + +toDouble :: Word32 -> Double +toDouble = fromIntegral + +-- | Unsigned narrowing, roundtrip at Word# +toWord8# :: Word32 -> (# Word8 | (# #) #) +toWord8# (W32# w32#) = + let w# = word32ToWord# w32# + n# = wordToWord8# w# + in case word8ToWord# n# `eqWord#` w# of + 1# -> (# W8# n# | #) + _ -> (# | (# #) #) + +-- | Unsigned narrowing, roundtrip at Word# +toWord16# :: Word32 -> (# Word16 | (# #) #) +toWord16# (W32# w32#) = + let w# = word32ToWord# w32# + n# = wordToWord16# w# + in case word16ToWord# n# `eqWord#` w# of + 1# -> (# W16# n# | #) + _ -> (# | (# #) #) + +-- | Word32 always fits in Word (Word is at least 32 bits) +toWord# :: Word32 -> (# Word | (# #) #) +toWord# (W32# w32#) = (# W# (word32ToWord# w32#) | #) + +-- | Unsigned->signed, source fits in Int#, roundtrip at Int# +toInt8# :: Word32 -> (# Int8 | (# #) #) +toInt8# (W32# w32#) = + let i# = word2Int# (word32ToWord# w32#) + n# = intToInt8# i# + in case int8ToInt# n# ==# i# of + 1# -> (# I8# n# | #) + _ -> (# | (# #) #) + +-- | Unsigned->signed, source fits in Int#, roundtrip at Int# +toInt16# :: Word32 -> (# Int16 | (# #) #) +toInt16# (W32# w32#) = + let i# = word2Int# (word32ToWord# w32#) + n# = intToInt16# i# + in case int16ToInt# n# ==# i# of + 1# -> (# I16# n# | #) + _ -> (# | (# #) #) + +-- | Unsigned->signed, roundtrip at Int# +toInt32# :: Word32 -> (# Int32 | (# #) #) +toInt32# (W32# w32#) = + let i# = word2Int# (word32ToWord# w32#) + n# = intToInt32# i# + in case int32ToInt# n# ==# i# of + 1# -> (# I32# n# | #) + _ -> (# | (# #) #) + +-- | Word32 fits in non-negative Int on all platforms, check via sign bit +toInt# :: Word32 -> (# Int | (# #) #) +toInt# (W32# w32#) = + let i# = word2Int# (word32ToWord# w32#) + in case i# >=# 0# of + 1# -> (# I# i# | #) + _ -> (# | (# #) #) + +-- | Bounds-checked float conversion +toFloat# :: Word32 -> (# Overflows | Float #) +toFloat# (W32# w32#) = case leWord# (word32ToWord# w32#) 16777215## of + 1# -> (# | F# (int2Float# (word2Int# (word32ToWord# w32#))) #) + _ -> (# Overflow | #) diff --git a/src/Unwitch/Convert/Word64.hs b/src/Unwitch/Convert/Word64.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Word64.hs @@ -0,0 +1,178 @@ +module Unwitch.Convert.Word64 + ( toWord8 + , toWord16 + , toWord32 + , toWord + , toNatural + , toInt8 + , toInt16 + , toInt32 + , toInt64 + , toInt + , toInteger + , toFloat + , toDouble + , toWord8# + , toWord16# + , toWord32# + , toWord# + , toInt8# + , toInt16# + , toInt32# + , toInt64# + , toInt# + , toFloat# + , toDouble# + ) +where + +import Unwitch.Errors +import Unwitch.Constant +import qualified Data.Bits as Bits +import Data.Word +import Data.Int +import Numeric.Natural (Natural) +import Prelude hiding (toInteger) +import GHC.Exts (Int(..), Word(..), Float(..), Double(..), + word64ToWord#, wordToWord64#, + word2Int#, + wordToWord8#, word8ToWord#, + wordToWord16#, word16ToWord#, + wordToWord32#, word32ToWord#, + intToInt8#, intToInt16#, intToInt32#, + intToInt64#, + int2Float#, int2Double#, + eqWord64#, leWord64#, + (>=#)) +import GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..)) +import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..)) + +toWord8 :: Word64 -> Maybe Word8 +toWord8 = Bits.toIntegralSized + +toWord16 :: Word64 -> Maybe Word16 +toWord16 = Bits.toIntegralSized + +toWord32 :: Word64 -> Maybe Word32 +toWord32 = Bits.toIntegralSized + +toWord :: Word64 -> Maybe Word +toWord = Bits.toIntegralSized + +toNatural :: Word64 -> Natural +toNatural = fromIntegral + +toInt8 :: Word64 -> Maybe Int8 +toInt8 = Bits.toIntegralSized + +toInt16 :: Word64 -> Maybe Int16 +toInt16 = Bits.toIntegralSized + +toInt32 :: Word64 -> Maybe Int32 +toInt32 = Bits.toIntegralSized + +toInt64 :: Word64 -> Maybe Int64 +toInt64 = Bits.toIntegralSized + +toInt :: Word64 -> Maybe Int +toInt = Bits.toIntegralSized + +toInteger :: Word64 -> Integer +toInteger = fromIntegral + +toFloat :: Word64 -> Either Overflows Float +toFloat x = if + | x > maxIntegralRepFloat -> Left Overflow + | otherwise -> Right $ fromIntegral x + +toDouble :: Word64 -> Either Overflows Double +toDouble x = if + | x > maxIntegralRepDouble -> Left Overflow + | otherwise -> Right $ fromIntegral x + +-- | Unsigned narrowing via Word64# comparison +toWord8# :: Word64 -> (# Word8 | (# #) #) +toWord8# (W64# w64#) = + let w# = word64ToWord# w64# + n# = wordToWord8# w# + in case eqWord64# (wordToWord64# (word8ToWord# n#)) w64# of + 1# -> (# W8# n# | #) + _ -> (# | (# #) #) + +-- | Unsigned narrowing via Word64# comparison +toWord16# :: Word64 -> (# Word16 | (# #) #) +toWord16# (W64# w64#) = + let w# = word64ToWord# w64# + n# = wordToWord16# w# + in case eqWord64# (wordToWord64# (word16ToWord# n#)) w64# of + 1# -> (# W16# n# | #) + _ -> (# | (# #) #) + +-- | Unsigned narrowing via Word64# comparison +toWord32# :: Word64 -> (# Word32 | (# #) #) +toWord32# (W64# w64#) = + let w# = word64ToWord# w64# + n# = wordToWord32# w# + in case eqWord64# (wordToWord64# (word32ToWord# n#)) w64# of + 1# -> (# W32# n# | #) + _ -> (# | (# #) #) + +-- | Roundtrip check at Word64# level +toWord# :: Word64 -> (# Word | (# #) #) +toWord# (W64# w64#) = + let w# = word64ToWord# w64# + in case eqWord64# (wordToWord64# w#) w64# of + 1# -> (# W# w# | #) + _ -> (# | (# #) #) + +-- | Check upper bound at Word64# level +toInt8# :: Word64 -> (# Int8 | (# #) #) +toInt8# (W64# w64#) = case leWord64# w64# (wordToWord64# 127##) of + 1# -> (# I8# (intToInt8# (word2Int# (word64ToWord# w64#))) | #) + _ -> (# | (# #) #) + +-- | Check upper bound for Int16 +toInt16# :: Word64 -> (# Int16 | (# #) #) +toInt16# (W64# w64#) = case leWord64# w64# (wordToWord64# 32767##) of + 1# -> (# I16# (intToInt16# (word2Int# (word64ToWord# w64#))) | #) + _ -> (# | (# #) #) + +-- | Check upper bound for Int32 +toInt32# :: Word64 -> (# Int32 | (# #) #) +toInt32# (W64# w64#) = case leWord64# w64# (wordToWord64# 2147483647##) of + 1# -> (# I32# (intToInt32# (word2Int# (word64ToWord# w64#))) | #) + _ -> (# | (# #) #) + +-- | Check high bit not set for Int64 +toInt64# :: Word64 -> (# Int64 | (# #) #) +toInt64# (W64# w64#) = + let w# = word64ToWord# w64# + i# = word2Int# w# + in case i# >=# 0# of + 1# -> case eqWord64# (wordToWord64# w#) w64# of + 1# -> (# I64# (intToInt64# i#) | #) + _ -> (# | (# #) #) + _ -> (# | (# #) #) + +-- | Check fits in non-negative Int range +toInt# :: Word64 -> (# Int | (# #) #) +toInt# (W64# w64#) = + let w# = word64ToWord# w64# + i# = word2Int# w# + in case i# >=# 0# of + 1# -> case eqWord64# (wordToWord64# w#) w64# of + 1# -> (# I# i# | #) + _ -> (# | (# #) #) + _ -> (# | (# #) #) + +-- | Bounds-checked float conversion at Word64# level +toFloat# :: Word64 -> (# Overflows | Float #) +toFloat# (W64# w64#) = case leWord64# w64# (wordToWord64# 16777215##) of + 1# -> (# | F# (int2Float# (word2Int# (word64ToWord# w64#))) #) + _ -> (# Overflow | #) + +-- | Bounds-checked double conversion at Word64# level +toDouble# :: Word64 -> (# Overflows | Double #) +toDouble# (W64# w64#) = case leWord64# w64# (wordToWord64# 9007199254740991##) of + 1# -> (# | D# (int2Double# (word2Int# (word64ToWord# w64#))) #) + _ -> (# Overflow | #) diff --git a/src/Unwitch/Convert/Word8.hs b/src/Unwitch/Convert/Word8.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Convert/Word8.hs @@ -0,0 +1,75 @@ +module Unwitch.Convert.Word8 + ( toWord16 + , toWord32 + , toWord64 + , toWord + , toNatural + , toInt8 + , toInt16 + , toInt32 + , toInt64 + , toInt + , toInteger + , toFloat + , toDouble + , toInt8# + ) +where + +import qualified Data.Bits as Bits +import Data.Word +import Data.Int +import Numeric.Natural (Natural) +import Prelude hiding (toInteger) +import GHC.Exts (word8ToWord#, word2Int#, intToInt8#, int8ToInt#, + (==#)) +import GHC.Int (Int8(..)) +import GHC.Word (Word8(..)) + +toWord16 :: Word8 -> Word16 +toWord16 = fromIntegral + +toWord32 :: Word8 -> Word32 +toWord32 = fromIntegral + +toWord64 :: Word8 -> Word64 +toWord64 = fromIntegral + +toWord :: Word8 -> Word +toWord = fromIntegral + +toNatural :: Word8 -> Natural +toNatural = fromIntegral + +toInt8 :: Word8 -> Maybe Int8 +toInt8 = Bits.toIntegralSized + +toInt16 :: Word8 -> Int16 +toInt16 = fromIntegral + +toInt32 :: Word8 -> Int32 +toInt32 = fromIntegral + +toInt64 :: Word8 -> Int64 +toInt64 = fromIntegral + +toInt :: Word8 -> Int +toInt = fromIntegral + +toInteger :: Word8 -> Integer +toInteger = fromIntegral + +toFloat :: Word8 -> Float +toFloat = fromIntegral + +toDouble :: Word8 -> Double +toDouble = fromIntegral + +-- | Unsigned->signed, source fits in Int#, roundtrip at Int# +toInt8# :: Word8 -> (# Int8 | (# #) #) +toInt8# (W8# w8#) = + let i# = word2Int# (word8ToWord# w8#) + n# = intToInt8# i# + in case int8ToInt# n# ==# i# of + 1# -> (# I8# n# | #) + _ -> (# | (# #) #) diff --git a/src/Unwitch/Errors.hs b/src/Unwitch/Errors.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/Errors.hs @@ -0,0 +1,8 @@ +module Unwitch.Errors + ( Overflows(..) + ) +where + +data Overflows = Overflow + | Underflow + deriving (Show, Eq) diff --git a/src/Unwitch/TryEvaluate.hs b/src/Unwitch/TryEvaluate.hs new file mode 100644 --- /dev/null +++ b/src/Unwitch/TryEvaluate.hs @@ -0,0 +1,11 @@ +module Unwitch.TryEvaluate + ( tryEvaluate + ) +where + +import Control.Exception (Exception, evaluate, try) +import System.IO.Unsafe (unsafePerformIO) + +tryEvaluate :: Exception e => a -> Either e a +tryEvaluate = unsafePerformIO . try . evaluate +{-# NOINLINE tryEvaluate #-} diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,36 @@ +module Main where + +import Test.Hspec +import qualified Test.Convert.Int8Spec +import qualified Test.Convert.Int16Spec +import qualified Test.Convert.Int32Spec +import qualified Test.Convert.Int64Spec +import qualified Test.Convert.IntSpec +import qualified Test.Convert.Word8Spec +import qualified Test.Convert.Word16Spec +import qualified Test.Convert.Word32Spec +import qualified Test.Convert.Word64Spec +import qualified Test.Convert.WordSpec +import qualified Test.Convert.NaturalSpec +import qualified Test.Convert.IntegerSpec +import qualified Test.Convert.FloatSpec +import qualified Test.Convert.DoubleSpec +import qualified Test.Convert.PropertySpec + +main :: IO () +main = hspec $ do + Test.Convert.Int8Spec.spec + Test.Convert.Int16Spec.spec + Test.Convert.Int32Spec.spec + Test.Convert.Int64Spec.spec + Test.Convert.IntSpec.spec + Test.Convert.Word8Spec.spec + Test.Convert.Word16Spec.spec + Test.Convert.Word32Spec.spec + Test.Convert.Word64Spec.spec + Test.Convert.WordSpec.spec + Test.Convert.NaturalSpec.spec + Test.Convert.IntegerSpec.spec + Test.Convert.FloatSpec.spec + Test.Convert.DoubleSpec.spec + Test.Convert.PropertySpec.spec diff --git a/test/Test/Convert/ByteStringSpec.hs b/test/Test/Convert/ByteStringSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/ByteStringSpec.hs @@ -0,0 +1,72 @@ +module Test.Convert.ByteStringSpec (spec) where + +import Test.Hspec +import Data.ByteString qualified as BS +import Data.Word (Word8) +import qualified Unwitch.Convert.ByteString as ByteString +import qualified Unwitch.Convert.LazyByteString as LazyByteString +import qualified Unwitch.Convert.ShortByteString as ShortByteString + +spec :: Spec +spec = describe "Unwitch.Convert.ByteString" $ do + + describe "toLazyByteString / toByteString round-trip" $ + it "round-trips" $ + let bs = BS.pack [104, 101, 108, 108, 111] + in LazyByteString.toByteString (ByteString.toLazyByteString bs) `shouldBe` bs + + describe "toShortByteString round-trip" $ + it "round-trips with ShortByteString.toByteString" $ + let bs = BS.pack [1, 2, 3] + in ShortByteString.toByteString (ByteString.toShortByteString bs) `shouldBe` bs + + describe "toWord8s / fromWord8s" $ do + it "round-trips" $ + let ws = [72, 105] :: [Word8] + in ByteString.toWord8s (ByteString.fromWord8s ws) `shouldBe` ws + it "empty list" $ + ByteString.toWord8s (ByteString.fromWord8s []) `shouldBe` ([] :: [Word8]) + + describe "toTextLatin1" $ + it "decodes latin1 bytes" $ + let bs = BS.pack [0xE9, 0xE8] -- e-acute, e-grave + in ByteString.toTextLatin1 bs `shouldBe` "\x00E9\x00E8" + + describe "toTextUtf8" $ do + it "decodes valid UTF-8" $ + ByteString.toTextUtf8 "hello" `shouldBe` Right "hello" + it "fails on invalid UTF-8" $ + let bs = BS.pack [0xFF, 0xFE] + in case ByteString.toTextUtf8 bs of + Left _ -> pure () + Right _ -> expectationFailure "expected Left" + + describe "toTextUtf16LE" $ do + it "decodes valid UTF-16LE" $ + let bs = BS.pack [0x41, 0x00] -- 'A' in UTF-16LE + in ByteString.toTextUtf16LE bs `shouldBe` Right "A" + it "fails on truncated input" $ + let bs = BS.pack [0x41] -- odd byte count + in case ByteString.toTextUtf16LE bs of + Left _ -> pure () + Right _ -> expectationFailure "expected Left" + + describe "toTextUtf16BE" $ + it "decodes valid UTF-16BE" $ + let bs = BS.pack [0x00, 0x42] -- 'B' in UTF-16BE + in ByteString.toTextUtf16BE bs `shouldBe` Right "B" + + describe "toTextUtf32LE" $ + it "decodes valid UTF-32LE" $ + let bs = BS.pack [0x43, 0x00, 0x00, 0x00] -- 'C' in UTF-32LE + in ByteString.toTextUtf32LE bs `shouldBe` Right "C" + + describe "toTextUtf32BE" $ do + it "decodes valid UTF-32BE" $ + let bs = BS.pack [0x00, 0x00, 0x00, 0x44] -- 'D' in UTF-32BE + in ByteString.toTextUtf32BE bs `shouldBe` Right "D" + it "fails on invalid input" $ + let bs = BS.pack [0x01] -- not 4-byte aligned + in case ByteString.toTextUtf32BE bs of + Left _ -> pure () + Right _ -> expectationFailure "expected Left" diff --git a/test/Test/Convert/CharSpec.hs b/test/Test/Convert/CharSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/CharSpec.hs @@ -0,0 +1,41 @@ +module Test.Convert.CharSpec (spec) where + +import Test.Hspec +import qualified Unwitch.Convert.Char as Char + +spec :: Spec +spec = describe "Unwitch.Convert.Char" $ do + + describe "toInt" $ do + it "converts 'A' to 65" $ + Char.toInt 'A' `shouldBe` 65 + it "converts '0' to 48" $ + Char.toInt '0' `shouldBe` 48 + + describe "toWord" $ do + it "converts 'A' to 65" $ + Char.toWord 'A' `shouldBe` (65 :: Word) + it "converts null to 0" $ + Char.toWord '\0' `shouldBe` (0 :: Word) + + describe "fromInt" $ do + it "succeeds for valid codepoint" $ + Char.fromInt 65 `shouldBe` Just 'A' + it "fails for negative" $ + Char.fromInt (-1) `shouldBe` Nothing + it "fails for value > 0x10FFFF" $ + Char.fromInt 0x110000 `shouldBe` Nothing + it "fails for surrogate" $ + Char.fromInt 0xD800 `shouldBe` Nothing + + describe "fromWord" $ do + it "succeeds for valid codepoint" $ + Char.fromWord 65 `shouldBe` Just 'A' + it "fails for value > 0x10FFFF" $ + Char.fromWord 0x110000 `shouldBe` Nothing + it "fails for surrogate" $ + Char.fromWord 0xD800 `shouldBe` Nothing + + describe "round-trip" $ + it "fromInt . toInt == Just" $ + Char.fromInt (Char.toInt 'Z') `shouldBe` Just 'Z' diff --git a/test/Test/Convert/ComplexSpec.hs b/test/Test/Convert/ComplexSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/ComplexSpec.hs @@ -0,0 +1,24 @@ +module Test.Convert.ComplexSpec (spec) where + +import Test.Hspec +import Data.Complex (Complex((:+))) +import qualified Unwitch.Convert.Complex as Complex + +spec :: Spec +spec = describe "Unwitch.Convert.Complex" $ do + + describe "fromReal" $ do + it "wraps with zero imaginary part" $ + Complex.fromReal (3.0 :: Double) `shouldBe` (3.0 :+ 0.0) + it "wraps zero" $ + Complex.fromReal (0 :: Int) `shouldBe` (0 :+ 0) + + describe "toReal" $ do + it "succeeds when imaginary is 0" $ + Complex.toReal (5.0 :+ 0.0 :: Complex Double) `shouldBe` Just 5.0 + it "fails when imaginary is nonzero" $ + Complex.toReal (5.0 :+ 1.0 :: Complex Double) `shouldBe` Nothing + + describe "round-trip" $ + it "toReal . fromReal == Just" $ + Complex.toReal (Complex.fromReal (42.0 :: Double)) `shouldBe` Just 42.0 diff --git a/test/Test/Convert/DoubleSpec.hs b/test/Test/Convert/DoubleSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/DoubleSpec.hs @@ -0,0 +1,87 @@ +module Test.Convert.DoubleSpec (spec) where + +import Test.Hspec +import Data.Int +import Data.Word +import Numeric.Natural (Natural) +import Unwitch.Errors +import qualified Unwitch.Convert.Double as Double + +spec :: Spec +spec = describe "Unwitch.Convert.Double" $ do + + describe "toFloat" $ + it "converts 0" $ + Double.toFloat 0.0 `shouldBe` 0.0 + + describe "toRational" $ do + it "converts finite value" $ + Double.toRational 1.5 `shouldBe` Right (3 / 2) + it "rejects NaN" $ + Double.toRational (0 / 0 :: Double) `shouldSatisfy` isLeft + it "rejects positive Infinity" $ + Double.toRational (1 / 0 :: Double) `shouldBe` Left (Double.IsInf Overflow) + it "rejects negative Infinity" $ + Double.toRational ((-1) / 0 :: Double) `shouldBe` Left (Double.IsInf Underflow) + + describe "toInteger" $ do + it "converts whole number" $ + Double.toInteger 42.0 `shouldBe` Right 42 + it "rejects fractional" $ + Double.toInteger 1.5 `shouldSatisfy` isLeft + + describe "toInt8" $ do + it "converts in-range" $ + Double.toInt8 42.0 `shouldBe` Right (42 :: Int8) + it "rejects out-of-range" $ + Double.toInt8 200.0 `shouldSatisfy` isLeft + + describe "toInt16" $ + it "converts in-range" $ + Double.toInt16 1000.0 `shouldBe` Right (1000 :: Int16) + + describe "toInt32" $ + it "converts in-range" $ + Double.toInt32 100000.0 `shouldBe` Right (100000 :: Int32) + + describe "toInt64" $ + it "converts in-range" $ + Double.toInt64 100000.0 `shouldBe` Right (100000 :: Int64) + + describe "toInt" $ + it "converts in-range" $ + Double.toInt 42.0 `shouldBe` Right (42 :: Int) + + describe "toWord8" $ do + it "converts in-range" $ + Double.toWord8 200.0 `shouldBe` Right (200 :: Word8) + it "rejects negative" $ + Double.toWord8 (-1.0) `shouldSatisfy` isLeft + + describe "toWord16" $ + it "converts in-range" $ + Double.toWord16 1000.0 `shouldBe` Right (1000 :: Word16) + + describe "toWord32" $ + it "converts in-range" $ + Double.toWord32 100000.0 `shouldBe` Right (100000 :: Word32) + + describe "toWord64" $ + it "converts in-range" $ + Double.toWord64 100000.0 `shouldBe` Right (100000 :: Word64) + + describe "toWord" $ + it "converts in-range" $ + Double.toWord 42.0 `shouldBe` Right (42 :: Word) + + describe "toNatural" $ do + it "converts positive whole number" $ + Double.toNatural 42.0 `shouldBe` Right (42 :: Natural) + it "rejects negative" $ + Double.toNatural (-1.0) `shouldSatisfy` isLeft + it "rejects fractional" $ + Double.toNatural 1.5 `shouldSatisfy` isLeft + +isLeft :: Either a b -> Bool +isLeft (Left _) = True +isLeft (Right _) = False diff --git a/test/Test/Convert/FixedSpec.hs b/test/Test/Convert/FixedSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/FixedSpec.hs @@ -0,0 +1,38 @@ +module Test.Convert.FixedSpec (spec) where + +import Test.Hspec +import Data.Fixed (Fixed, E2, E6) +import Data.Ratio (numerator) +import qualified Unwitch.Convert.Fixed as Fixed + +spec :: Spec +spec = describe "Unwitch.Convert.Fixed" $ do + + describe "fromInteger" $ do + it "converts integer to Fixed E2" $ + Fixed.fromInteger 42 `shouldBe` (42.0 :: Fixed E2) + it "converts zero" $ + Fixed.fromInteger 0 `shouldBe` (0.0 :: Fixed E2) + + describe "toInteger" $ do + it "succeeds for whole Fixed values" $ + Fixed.toInteger (42.0 :: Fixed E2) `shouldBe` Just 42 + it "fails for fractional Fixed values" $ + Fixed.toInteger (1.50 :: Fixed E2) `shouldBe` Nothing + + describe "toRational" $ do + it "converts Fixed to exact Rational" $ + Fixed.toRational (1.50 :: Fixed E2) `shouldBe` (3 / 2) + it "round-trips whole values through toInteger" $ + let f = 10.0 :: Fixed E2 + in Fixed.toInteger f `shouldBe` Just (numerator (Fixed.toRational f)) + + describe "toFixed" $ do + it "succeeds for compatible resolutions" $ + Fixed.toFixed (1.50 :: Fixed E2) `shouldBe` Just (1.500000 :: Fixed E6) + it "fails for incompatible resolutions" $ + -- 0.01 as E2 is representable, but converting to E6 should also work + -- However 1/3 cannot be represented in either, so let's test a value + -- that exists in E6 but not in E2: + -- 1.123 in E6 -> 1.12 in E2 loses precision + Fixed.toFixed (1.123000 :: Fixed E6) `shouldBe` (Nothing :: Maybe (Fixed E2)) diff --git a/test/Test/Convert/FloatSpec.hs b/test/Test/Convert/FloatSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/FloatSpec.hs @@ -0,0 +1,91 @@ +module Test.Convert.FloatSpec (spec) where + +import Test.Hspec +import Data.Int +import Data.Word +import Numeric.Natural (Natural) +import Unwitch.Errors +import qualified Unwitch.Convert.Float as Float + +spec :: Spec +spec = describe "Unwitch.Convert.Float" $ do + + describe "toDouble (infallible)" $ do + it "converts 0" $ + Float.toDouble 0.0 `shouldBe` 0.0 + it "converts 1.5" $ + Float.toDouble 1.5 `shouldBe` 1.5 + + describe "toRational" $ do + it "converts finite value" $ + Float.toRational 1.5 `shouldBe` Right (3 / 2) + it "rejects NaN" $ + Float.toRational (0 / 0 :: Float) `shouldSatisfy` isLeft + it "rejects positive Infinity" $ + Float.toRational (1 / 0 :: Float) `shouldBe` Left (Float.IsInf Overflow) + it "rejects negative Infinity" $ + Float.toRational ((-1) / 0 :: Float) `shouldBe` Left (Float.IsInf Underflow) + + describe "toInteger" $ do + it "converts whole number" $ + Float.toInteger 42.0 `shouldBe` Right 42 + it "rejects fractional" $ + Float.toInteger 1.5 `shouldSatisfy` isLeft + it "rejects NaN" $ + Float.toInteger (0 / 0 :: Float) `shouldSatisfy` isLeft + + describe "toInt8" $ do + it "converts in-range" $ + Float.toInt8 42.0 `shouldBe` Right (42 :: Int8) + it "rejects out-of-range" $ + Float.toInt8 200.0 `shouldSatisfy` isLeft + it "rejects fractional" $ + Float.toInt8 1.5 `shouldSatisfy` isLeft + + describe "toInt16" $ + it "converts in-range" $ + Float.toInt16 1000.0 `shouldBe` Right (1000 :: Int16) + + describe "toInt32" $ + it "converts in-range" $ + Float.toInt32 100000.0 `shouldBe` Right (100000 :: Int32) + + describe "toInt64" $ + it "converts in-range" $ + Float.toInt64 100000.0 `shouldBe` Right (100000 :: Int64) + + describe "toInt" $ + it "converts in-range" $ + Float.toInt 42.0 `shouldBe` Right (42 :: Int) + + describe "toWord8" $ do + it "converts in-range" $ + Float.toWord8 200.0 `shouldBe` Right (200 :: Word8) + it "rejects negative" $ + Float.toWord8 (-1.0) `shouldSatisfy` isLeft + + describe "toWord16" $ + it "converts in-range" $ + Float.toWord16 1000.0 `shouldBe` Right (1000 :: Word16) + + describe "toWord32" $ + it "converts in-range" $ + Float.toWord32 100000.0 `shouldBe` Right (100000 :: Word32) + + describe "toWord64" $ + it "converts in-range" $ + Float.toWord64 100000.0 `shouldBe` Right (100000 :: Word64) + + describe "toWord" $ + it "converts in-range" $ + Float.toWord 42.0 `shouldBe` Right (42 :: Word) + + describe "toNatural" $ do + it "converts positive whole number" $ + Float.toNatural 42.0 `shouldBe` Right (42 :: Natural) + it "rejects negative" $ + Float.toNatural (-1.0) `shouldSatisfy` isLeft + +isLeft :: Either a b -> Bool +isLeft (Left _) = True +isLeft (Right _) = False diff --git a/test/Test/Convert/Int16Spec.hs b/test/Test/Convert/Int16Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/Int16Spec.hs @@ -0,0 +1,39 @@ +module Test.Convert.Int16Spec (spec) where + +import Test.Hspec +import Data.Int +import Data.Word +import qualified Unwitch.Convert.Int16 as Int16 + +-- Property tests cover: toInt8 narrowing, toInt32/64 round-trips, +-- toWord16 (same-width), toNatural iff negative, toFloat/toDouble. +-- Kept: toInt (no property), cross-width signed-to-unsigned. + +spec :: Spec +spec = describe "Unwitch.Convert.Int16" $ do + + describe "toInt (infallible)" $ + it "widens maxBound" $ + Int16.toInt maxBound `shouldBe` 32767 + + describe "toWord8 (fallible)" $ do + it "rejects negative" $ + Int16.toWord8 (-1 :: Int16) `shouldBe` Nothing + it "rejects too large" $ + Int16.toWord8 (256 :: Int16) `shouldBe` Nothing + it "converts in range" $ + Int16.toWord8 (255 :: Int16) `shouldBe` Just (255 :: Word8) + + describe "toWord32 (fallible)" $ do + it "rejects negative" $ + Int16.toWord32 (-1 :: Int16) `shouldBe` Nothing + it "converts maxBound" $ + Int16.toWord32 (32767 :: Int16) `shouldBe` Just (32767 :: Word32) + + describe "toWord64 (fallible)" $ + it "rejects negative" $ + Int16.toWord64 (-1 :: Int16) `shouldBe` Nothing + + describe "toWord (fallible)" $ + it "rejects negative" $ + Int16.toWord (-1 :: Int16) `shouldBe` Nothing diff --git a/test/Test/Convert/Int32Spec.hs b/test/Test/Convert/Int32Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/Int32Spec.hs @@ -0,0 +1,43 @@ +module Test.Convert.Int32Spec (spec) where + +import Test.Hspec +import Data.Int +import Data.Word +import qualified Unwitch.Convert.Int32 as Int32 + +-- Property tests cover: toInt16 narrowing, toInt64 round-trip, +-- toWord32 (same-width), toNatural iff negative, +-- toFloat range check, toDouble preserve value. +-- Kept: toInt8 (no property), toInt (no property), +-- cross-width signed-to-unsigned. + +spec :: Spec +spec = describe "Unwitch.Convert.Int32" $ do + + describe "toInt8 (fallible)" $ do + it "narrows in-range" $ + Int32.toInt8 (100 :: Int32) `shouldBe` Just (100 :: Int8) + it "rejects out-of-range" $ + Int32.toInt8 (200 :: Int32) `shouldBe` Nothing + + describe "toInt (fallible via toIntegralSized)" $ + it "converts 0" $ + Int32.toInt 0 `shouldBe` Just 0 + + describe "toWord8 (fallible)" $ do + it "rejects negative" $ + Int32.toWord8 (-1 :: Int32) `shouldBe` Nothing + it "converts in-range" $ + Int32.toWord8 (255 :: Int32) `shouldBe` Just (255 :: Word8) + + describe "toWord16 (fallible)" $ + it "rejects too large" $ + Int32.toWord16 (70000 :: Int32) `shouldBe` Nothing + + describe "toWord64 (fallible)" $ + it "rejects negative" $ + Int32.toWord64 (-1 :: Int32) `shouldBe` Nothing + + describe "toWord (fallible)" $ + it "rejects negative" $ + Int32.toWord (-1 :: Int32) `shouldBe` Nothing diff --git a/test/Test/Convert/Int64Spec.hs b/test/Test/Convert/Int64Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/Int64Spec.hs @@ -0,0 +1,44 @@ +module Test.Convert.Int64Spec (spec) where + +import Test.Hspec +import Data.Int +import qualified Unwitch.Convert.Int64 as Int64 + +-- Property tests cover: toInt32 narrowing, toInteger widening, +-- toWord64 (same-width), toNatural iff negative, +-- toFloat range check, toDouble range check. +-- Kept: toInt8/toInt16 (no property), toInt (no property), +-- cross-width signed-to-unsigned. + +spec :: Spec +spec = describe "Unwitch.Convert.Int64" $ do + + describe "toInt8 (fallible)" $ do + it "narrows in-range" $ + Int64.toInt8 (42 :: Int64) `shouldBe` Just (42 :: Int8) + it "rejects out-of-range" $ + Int64.toInt8 (200 :: Int64) `shouldBe` Nothing + + describe "toInt16 (fallible)" $ + it "rejects out-of-range" $ + Int64.toInt16 (40000 :: Int64) `shouldBe` Nothing + + describe "toInt (fallible)" $ + it "converts 0" $ + Int64.toInt 0 `shouldBe` Just 0 + + describe "toWord8 (fallible)" $ + it "rejects negative" $ + Int64.toWord8 (-1 :: Int64) `shouldBe` Nothing + + describe "toWord16 (fallible)" $ + it "rejects negative" $ + Int64.toWord16 (-1 :: Int64) `shouldBe` Nothing + + describe "toWord32 (fallible)" $ + it "rejects negative" $ + Int64.toWord32 (-1 :: Int64) `shouldBe` Nothing + + describe "toWord (fallible)" $ + it "rejects negative" $ + Int64.toWord (-1 :: Int64) `shouldBe` Nothing diff --git a/test/Test/Convert/Int8Spec.hs b/test/Test/Convert/Int8Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/Int8Spec.hs @@ -0,0 +1,38 @@ +module Test.Convert.Int8Spec (spec) where + +import Test.Hspec +import Data.Int +import Data.Word +import qualified Unwitch.Convert.Int8 as Int8 + +-- Only cross-width signed-to-unsigned conversions that no property test covers. +-- All other Int8 conversions are fully covered by PropertySpec: +-- round-trips, toNatural iff negative, toFloat/toDouble preserve value, +-- path independence, signed-to-unsigned (same-width Int8->Word8). + +spec :: Spec +spec = describe "Unwitch.Convert.Int8" $ do + + describe "toWord16 (fallible)" $ do + it "rejects negative values" $ + Int8.toWord16 (-1 :: Int8) `shouldBe` Nothing + it "converts maxBound" $ + Int8.toWord16 (127 :: Int8) `shouldBe` Just (127 :: Word16) + + describe "toWord32 (fallible)" $ do + it "rejects negative values" $ + Int8.toWord32 (-1 :: Int8) `shouldBe` Nothing + it "converts maxBound" $ + Int8.toWord32 (127 :: Int8) `shouldBe` Just (127 :: Word32) + + describe "toWord64 (fallible)" $ do + it "rejects negative values" $ + Int8.toWord64 (-1 :: Int8) `shouldBe` Nothing + it "converts maxBound" $ + Int8.toWord64 (127 :: Int8) `shouldBe` Just (127 :: Word64) + + describe "toWord (fallible)" $ do + it "rejects negative values" $ + Int8.toWord (-1 :: Int8) `shouldBe` Nothing + it "converts maxBound" $ + Int8.toWord (127 :: Int8) `shouldBe` Just (127 :: Word) diff --git a/test/Test/Convert/IntSpec.hs b/test/Test/Convert/IntSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/IntSpec.hs @@ -0,0 +1,73 @@ +module Test.Convert.IntSpec (spec) where + +import Test.Hspec +import Data.Int +import Numeric.Natural (Natural) +import Unwitch.Errors +import qualified Unwitch.Convert.Int as Int + +-- Property tests only cover Int.toNatural (iff negative). +-- All other Int conversions have no property coverage. + +spec :: Spec +spec = describe "Unwitch.Convert.Int" $ do + + describe "toInt8 (fallible)" $ do + it "narrows in-range" $ + Int.toInt8 (42 :: Int) `shouldBe` Just (42 :: Int8) + it "rejects out-of-range" $ + Int.toInt8 (200 :: Int) `shouldBe` Nothing + + describe "toInt16 (fallible)" $ + it "rejects out-of-range" $ + Int.toInt16 (40000 :: Int) `shouldBe` Nothing + + describe "toInt32 (fallible)" $ + it "converts in-range" $ + Int.toInt32 (1000 :: Int) `shouldBe` Just (1000 :: Int32) + + describe "toInt64 (infallible)" $ + it "widens maxBound" $ + Int.toInt64 maxBound `shouldBe` fromIntegral (maxBound :: Int) + + describe "toInteger (infallible)" $ + it "converts maxBound" $ + Int.toInteger maxBound `shouldBe` fromIntegral (maxBound :: Int) + + describe "toWord8 (fallible)" $ + it "rejects negative" $ + Int.toWord8 (-1 :: Int) `shouldBe` Nothing + + describe "toWord16 (fallible)" $ + it "rejects negative" $ + Int.toWord16 (-1 :: Int) `shouldBe` Nothing + + describe "toWord32 (fallible)" $ + it "rejects negative" $ + Int.toWord32 (-1 :: Int) `shouldBe` Nothing + + describe "toWord64 (fallible)" $ + it "rejects negative" $ + Int.toWord64 (-1 :: Int) `shouldBe` Nothing + + describe "toWord (fallible)" $ do + it "rejects negative" $ + Int.toWord (-1 :: Int) `shouldBe` Nothing + it "converts 0" $ + Int.toWord 0 `shouldBe` Just (0 :: Word) + + describe "toNatural" $ do + it "rejects negative with Underflow" $ + Int.toNatural (-1 :: Int) `shouldBe` Left Underflow + it "converts 0" $ + Int.toNatural 0 `shouldBe` Right (0 :: Natural) + + describe "toFloat (range-checked)" $ do + it "converts at boundary" $ + Int.toFloat (16777215 :: Int) `shouldBe` Right 16777215.0 + it "rejects above boundary" $ + Int.toFloat (16777216 :: Int) `shouldBe` Left Overflow + + describe "toDouble (range-checked)" $ + it "converts 0" $ + Int.toDouble 0 `shouldBe` Right (0.0 :: Double) diff --git a/test/Test/Convert/IntegerSpec.hs b/test/Test/Convert/IntegerSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/IntegerSpec.hs @@ -0,0 +1,46 @@ +module Test.Convert.IntegerSpec (spec) where + +import Test.Hspec +import Data.Int +import Data.Word +import qualified Unwitch.Convert.Integer as Integer + +-- Property tests cover: toDouble/toFloat/toNatural range checks, +-- toInt8/toWord8 narrowing (success implies fromIntegral). +-- Kept: toInt16, toInt32, toInt64, toInt, toWord16, toWord32, +-- toWord64, toWord (no direct property coverage). + +spec :: Spec +spec = describe "Unwitch.Convert.Integer" $ do + + describe "toInt16 (fallible)" $ + it "rejects too large" $ + Integer.toInt16 32768 `shouldBe` Nothing + + describe "toInt32 (fallible)" $ + it "rejects too large" $ + Integer.toInt32 2147483648 `shouldBe` Nothing + + describe "toInt64 (fallible)" $ + it "converts in-range" $ + Integer.toInt64 42 `shouldBe` Just (42 :: Int64) + + describe "toInt (fallible)" $ + it "converts 0" $ + Integer.toInt 0 `shouldBe` Just (0 :: Int) + + describe "toWord16 (fallible)" $ + it "rejects too large" $ + Integer.toWord16 65536 `shouldBe` Nothing + + describe "toWord32 (fallible)" $ + it "rejects too large" $ + Integer.toWord32 4294967296 `shouldBe` Nothing + + describe "toWord64 (fallible)" $ + it "converts in-range" $ + Integer.toWord64 42 `shouldBe` Just (42 :: Word64) + + describe "toWord (fallible)" $ + it "converts 0" $ + Integer.toWord 0 `shouldBe` Just (0 :: Word) diff --git a/test/Test/Convert/LazyByteStringSpec.hs b/test/Test/Convert/LazyByteStringSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/LazyByteStringSpec.hs @@ -0,0 +1,56 @@ +module Test.Convert.LazyByteStringSpec (spec) where + +import Test.Hspec +import Data.ByteString.Lazy qualified as LBS +import Data.Word (Word8) +import qualified Unwitch.Convert.LazyByteString as LazyByteString +import qualified Unwitch.Convert.ByteString as ByteString + +spec :: Spec +spec = describe "Unwitch.Convert.LazyByteString" $ do + + describe "toByteString / toLazyByteString round-trip" $ + it "round-trips" $ + let lbs = LBS.pack [10, 20, 30] + in ByteString.toLazyByteString (LazyByteString.toByteString lbs) `shouldBe` lbs + + describe "toWord8s / fromWord8s" $ do + it "round-trips" $ + let ws = [1, 2, 3, 4] :: [Word8] + in LazyByteString.toWord8s (LazyByteString.fromWord8s ws) `shouldBe` ws + it "empty list" $ + LazyByteString.toWord8s (LazyByteString.fromWord8s []) `shouldBe` ([] :: [Word8]) + + describe "toLazyTextLatin1" $ + it "decodes latin1 bytes" $ + let lbs = LBS.pack [0xFC] -- u-umlaut + in LazyByteString.toLazyTextLatin1 lbs `shouldBe` "\x00FC" + + describe "toLazyTextUtf8" $ do + it "decodes valid UTF-8" $ + LazyByteString.toLazyTextUtf8 "hello" `shouldBe` Right "hello" + it "fails on invalid UTF-8" $ + let lbs = LBS.pack [0xFF, 0xFE] + in case LazyByteString.toLazyTextUtf8 lbs of + Left _ -> pure () + Right _ -> expectationFailure "expected Left" + + describe "toLazyTextUtf16LE" $ + it "decodes valid UTF-16LE" $ + let lbs = LBS.pack [0x41, 0x00] + in LazyByteString.toLazyTextUtf16LE lbs `shouldBe` Right "A" + + describe "toLazyTextUtf16BE" $ + it "decodes valid UTF-16BE" $ + let lbs = LBS.pack [0x00, 0x42] + in LazyByteString.toLazyTextUtf16BE lbs `shouldBe` Right "B" + + describe "toLazyTextUtf32LE" $ + it "decodes valid UTF-32LE" $ + let lbs = LBS.pack [0x43, 0x00, 0x00, 0x00] + in LazyByteString.toLazyTextUtf32LE lbs `shouldBe` Right "C" + + describe "toLazyTextUtf32BE" $ + it "decodes valid UTF-32BE" $ + let lbs = LBS.pack [0x00, 0x00, 0x00, 0x44] + in LazyByteString.toLazyTextUtf32BE lbs `shouldBe` Right "D" diff --git a/test/Test/Convert/LazyTextSpec.hs b/test/Test/Convert/LazyTextSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/LazyTextSpec.hs @@ -0,0 +1,60 @@ +module Test.Convert.LazyTextSpec (spec) where + +import Test.Hspec +import Data.Text.Lazy qualified as LT +import qualified Unwitch.Convert.LazyText as LazyText +import qualified Unwitch.Convert.Text as Text +import qualified Unwitch.Convert.LazyByteString as LazyByteString + +spec :: Spec +spec = describe "Unwitch.Convert.LazyText" $ do + + describe "toText / toLazyText round-trip" $ + it "round-trips" $ + let lt = LT.pack "hello world" + in Text.toLazyText (LazyText.toText lt) `shouldBe` lt + + describe "toString / fromString" $ do + it "round-trips" $ + let s = "test string" + in LazyText.toString (LazyText.fromString s) `shouldBe` s + it "handles unicode" $ + let s = "\x00E9\x00FC\x00F1" + in LazyText.toString (LazyText.fromString s) `shouldBe` s + + describe "toLazyByteStringUtf8" $ do + it "encodes ASCII" $ + LazyText.toLazyByteStringUtf8 "hello" `shouldBe` "hello" + it "round-trips with LazyByteString.toLazyTextUtf8" $ + let lt = LT.pack "caf\x00E9" + in LazyByteString.toLazyTextUtf8 (LazyText.toLazyByteStringUtf8 lt) `shouldBe` Right lt + + describe "toLazyByteStringUtf16LE" $ + it "produces valid output" $ + let lt = LT.pack "A" + in LazyByteString.toLazyTextUtf16LE (LazyText.toLazyByteStringUtf16LE lt) `shouldBe` Right lt + + describe "toLazyByteStringUtf16BE" $ + it "produces valid output" $ + let lt = LT.pack "B" + in LazyByteString.toLazyTextUtf16BE (LazyText.toLazyByteStringUtf16BE lt) `shouldBe` Right lt + + describe "toLazyByteStringUtf32LE" $ + it "produces valid output" $ + let lt = LT.pack "C" + in LazyByteString.toLazyTextUtf32LE (LazyText.toLazyByteStringUtf32LE lt) `shouldBe` Right lt + + describe "toLazyByteStringUtf32BE" $ + it "produces valid output" $ + let lt = LT.pack "D" + in LazyByteString.toLazyTextUtf32BE (LazyText.toLazyByteStringUtf32BE lt) `shouldBe` Right lt + + describe "toLazyByteStringLatin1" $ do + it "succeeds for Latin1 range chars" $ + let lt = LT.pack "\x00E9\x00FC" + in case LazyText.toLazyByteStringLatin1 lt of + Just lbs -> LazyByteString.toLazyTextLatin1 lbs `shouldBe` lt + Nothing -> expectationFailure "expected Just" + it "fails for chars above 0xFF" $ + let lt = LT.pack "\x0100" + in LazyText.toLazyByteStringLatin1 lt `shouldBe` Nothing diff --git a/test/Test/Convert/NaturalSpec.hs b/test/Test/Convert/NaturalSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/NaturalSpec.hs @@ -0,0 +1,69 @@ +module Test.Convert.NaturalSpec (spec) where + +import Test.Hspec +import Data.Int +import Data.Word +import Numeric.Natural (Natural) +import Unwitch.Errors +import qualified Unwitch.Convert.Natural as Natural + +spec :: Spec +spec = describe "Unwitch.Convert.Natural" $ do + + describe "toWord8 (fallible)" $ do + it "rejects too large" $ + Natural.toWord8 (256 :: Natural) `shouldBe` Nothing + it "converts in-range" $ + Natural.toWord8 (255 :: Natural) `shouldBe` Just (255 :: Word8) + + describe "toWord16 (fallible)" $ + it "rejects too large" $ + Natural.toWord16 (65536 :: Natural) `shouldBe` Nothing + + describe "toWord32 (fallible)" $ + it "rejects too large" $ + Natural.toWord32 (4294967296 :: Natural) `shouldBe` Nothing + + describe "toWord64 (fallible)" $ + it "rejects too large" $ + Natural.toWord64 (18446744073709551616 :: Natural) `shouldBe` Nothing + + describe "toWord (fallible)" $ + it "converts 0" $ + Natural.toWord 0 `shouldBe` Just (0 :: Word) + + describe "toInt8 (fallible)" $ + it "rejects too large" $ + Natural.toInt8 (128 :: Natural) `shouldBe` Nothing + + describe "toInt16 (fallible)" $ + it "rejects too large" $ + Natural.toInt16 (32768 :: Natural) `shouldBe` Nothing + + describe "toInt32 (fallible)" $ + it "rejects too large" $ + Natural.toInt32 (2147483648 :: Natural) `shouldBe` Nothing + + describe "toInt64 (fallible)" $ + it "converts in-range" $ + Natural.toInt64 (100 :: Natural) `shouldBe` Just (100 :: Int64) + + describe "toInt (fallible)" $ + it "converts 0" $ + Natural.toInt 0 `shouldBe` Just (0 :: Int) + + describe "toInteger (infallible)" $ + it "converts large value" $ + Natural.toInteger (999999999999 :: Natural) `shouldBe` 999999999999 + + describe "toFloat (range-checked)" $ do + it "converts in-range" $ + Natural.toFloat (16777215 :: Natural) `shouldBe` Right 16777215.0 + it "rejects too large" $ + Natural.toFloat (16777216 :: Natural) `shouldBe` Left Overflow + + describe "toDouble (range-checked)" $ do + it "converts in-range" $ + Natural.toDouble (9007199254740991 :: Natural) `shouldBe` Right 9007199254740991.0 + it "rejects too large" $ + Natural.toDouble (9007199254740992 :: Natural) `shouldBe` Left Overflow diff --git a/test/Test/Convert/PropertySpec.hs b/test/Test/Convert/PropertySpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/PropertySpec.hs @@ -0,0 +1,495 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Test.Convert.PropertySpec (spec) where + +import Test.Hspec +import Test.Hspec.QuickCheck (prop) +import Data.Int +import Data.Word +import qualified Unwitch.Convert.Int8 as Int8 +import qualified Unwitch.Convert.Int16 as Int16 +import qualified Unwitch.Convert.Int32 as Int32 +import qualified Unwitch.Convert.Int64 as Int64 +import qualified Unwitch.Convert.Int as Int +import qualified Unwitch.Convert.Word8 as Word8 +import qualified Unwitch.Convert.Word16 as Word16 +import qualified Unwitch.Convert.Word32 as Word32 +import qualified Unwitch.Convert.Word64 as Word64 +import qualified Unwitch.Convert.Natural as Natural +import qualified Unwitch.Convert.Integer as Integer +import qualified Unwitch.Convert.Word as Word +import qualified Unwitch.Convert.Char as Char +import qualified Unwitch.Convert.Float as Float +import qualified Unwitch.Convert.Double as Double +import Numeric.Natural (Natural) + +spec :: Spec +spec = describe "Property tests" $ do + + describe "Round-trip: widen then narrow recovers original" $ do + prop "Int8 -> Int16 -> Int8" $ \(x :: Int8) -> + Int16.toInt8 (Int8.toInt16 x) `shouldBe` Just x + + prop "Int8 -> Int32 -> Int8" $ \(x :: Int8) -> + Int32.toInt8 (Int8.toInt32 x) `shouldBe` Just x + + prop "Int8 -> Int64 -> Int8" $ \(x :: Int8) -> + Int64.toInt8 (Int8.toInt64 x) `shouldBe` Just x + + prop "Int8 -> Integer -> Int8" $ \(x :: Int8) -> + Integer.toInt8 (Int8.toInteger x) `shouldBe` Just x + + prop "Int16 -> Int32 -> Int16" $ \(x :: Int16) -> + Int32.toInt16 (Int16.toInt32 x) `shouldBe` Just x + + prop "Int16 -> Int64 -> Int16" $ \(x :: Int16) -> + Int64.toInt16 (Int16.toInt64 x) `shouldBe` Just x + + prop "Int32 -> Int64 -> Int32" $ \(x :: Int32) -> + Int64.toInt32 (Int32.toInt64 x) `shouldBe` Just x + + prop "Word8 -> Word16 -> Word8" $ \(x :: Word8) -> + Word16.toWord8 (Word8.toWord16 x) `shouldBe` Just x + + prop "Word8 -> Word32 -> Word8" $ \(x :: Word8) -> + Word32.toWord8 (Word8.toWord32 x) `shouldBe` Just x + + prop "Word8 -> Word64 -> Word8" $ \(x :: Word8) -> + Word64.toWord8 (Word8.toWord64 x) `shouldBe` Just x + + prop "Word16 -> Word32 -> Word16" $ \(x :: Word16) -> + Word32.toWord16 (Word16.toWord32 x) `shouldBe` Just x + + prop "Word16 -> Word64 -> Word16" $ \(x :: Word16) -> + Word64.toWord16 (Word16.toWord64 x) `shouldBe` Just x + + prop "Word32 -> Word64 -> Word32" $ \(x :: Word32) -> + Word64.toWord32 (Word32.toWord64 x) `shouldBe` Just x + + prop "Word8 -> Int16 -> Word8" $ \(x :: Word8) -> + Int16.toWord8 (Word8.toInt16 x) `shouldBe` Just x + + prop "Word8 -> Int32 -> Word8" $ \(x :: Word8) -> + Int32.toWord8 (Word8.toInt32 x) `shouldBe` Just x + + -- Int via Int + prop "Int8 -> Int -> Int8" $ \(x :: Int8) -> + Int.toInt8 (Int8.toInt x) `shouldBe` Just x + + prop "Int16 -> Int -> Int16" $ \(x :: Int16) -> + Int.toInt16 (Int16.toInt x) `shouldBe` Just x + + -- Int via Integer + prop "Int16 -> Integer -> Int16" $ \(x :: Int16) -> + Integer.toInt16 (Int16.toInteger x) `shouldBe` Just x + + prop "Int32 -> Integer -> Int32" $ \(x :: Int32) -> + Integer.toInt32 (Int32.toInteger x) `shouldBe` Just x + + prop "Int64 -> Integer -> Int64" $ \(x :: Int64) -> + Integer.toInt64 (Int64.toInteger x) `shouldBe` Just x + + prop "Int -> Int64 -> Int" $ \(x :: Int) -> + Int64.toInt (Int.toInt64 x) `shouldBe` Just x + + prop "Int -> Integer -> Int" $ \(x :: Int) -> + Integer.toInt (Int.toInteger x) `shouldBe` Just x + + -- Word via Word + prop "Word8 -> Word -> Word8" $ \(x :: Word8) -> + Word.toWord8 (Word8.toWord x) `shouldBe` Just x + + prop "Word16 -> Word -> Word16" $ \(x :: Word16) -> + Word.toWord16 (Word16.toWord x) `shouldBe` Just x + + -- Word via Natural + prop "Word8 -> Natural -> Word8" $ \(x :: Word8) -> + Natural.toWord8 (Word8.toNatural x) `shouldBe` Just x + + prop "Word16 -> Natural -> Word16" $ \(x :: Word16) -> + Natural.toWord16 (Word16.toNatural x) `shouldBe` Just x + + prop "Word32 -> Natural -> Word32" $ \(x :: Word32) -> + Natural.toWord32 (Word32.toNatural x) `shouldBe` Just x + + prop "Word64 -> Natural -> Word64" $ \(x :: Word64) -> + Natural.toWord64 (Word64.toNatural x) `shouldBe` Just x + + prop "Word -> Natural -> Word" $ \(x :: Word) -> + Natural.toWord (Word.toNatural x) `shouldBe` Just x + + -- Word via Integer + prop "Word64 -> Integer -> Word64" $ \(x :: Word64) -> + Integer.toWord64 (Word64.toInteger x) `shouldBe` Just x + + prop "Word -> Word64 -> Word" $ \(x :: Word) -> + Word64.toWord (Word.toWord64 x) `shouldBe` Just x + + prop "Word -> Integer -> Word" $ \(x :: Word) -> + Integer.toWord (Word.toInteger x) `shouldBe` Just x + + -- Cross-sign: Word via signed + prop "Word8 -> Int64 -> Word8" $ \(x :: Word8) -> + Int64.toWord8 (Word8.toInt64 x) `shouldBe` Just x + + prop "Word8 -> Int -> Word8" $ \(x :: Word8) -> + Int.toWord8 (Word8.toInt x) `shouldBe` Just x + + prop "Word8 -> Integer -> Word8" $ \(x :: Word8) -> + Integer.toWord8 (Word8.toInteger x) `shouldBe` Just x + + prop "Word16 -> Int32 -> Word16" $ \(x :: Word16) -> + Int32.toWord16 (Word16.toInt32 x) `shouldBe` Just x + + prop "Word16 -> Int64 -> Word16" $ \(x :: Word16) -> + Int64.toWord16 (Word16.toInt64 x) `shouldBe` Just x + + prop "Word16 -> Int -> Word16" $ \(x :: Word16) -> + Int.toWord16 (Word16.toInt x) `shouldBe` Just x + + prop "Word16 -> Integer -> Word16" $ \(x :: Word16) -> + Integer.toWord16 (Word16.toInteger x) `shouldBe` Just x + + prop "Word32 -> Int64 -> Word32" $ \(x :: Word32) -> + Int64.toWord32 (Word32.toInt64 x) `shouldBe` Just x + + prop "Word32 -> Integer -> Word32" $ \(x :: Word32) -> + Integer.toWord32 (Word32.toInteger x) `shouldBe` Just x + + -- Natural via Integer (Either pattern, generated via Word64) + prop "Natural -> Integer -> Natural" $ \(w :: Word64) -> + let x = fromIntegral w :: Natural + in Integer.toNatural (Natural.toInteger x) `shouldBe` Right x + + -- Char + prop "Char -> Int -> Char" $ \(x :: Char) -> + Char.fromInt (Char.toInt x) `shouldBe` Just x + + prop "Char -> Word -> Char" $ \(x :: Char) -> + Char.fromWord (Char.toWord x) `shouldBe` Just x + + -- Via Float (Either ViaIntegerErrors pattern) + prop "Int8 -> Float -> Int8" $ \(x :: Int8) -> + Float.toInt8 (Int8.toFloat x) `shouldBe` Right x + + prop "Int16 -> Float -> Int16" $ \(x :: Int16) -> + Float.toInt16 (Int16.toFloat x) `shouldBe` Right x + + prop "Word8 -> Float -> Word8" $ \(x :: Word8) -> + Float.toWord8 (Word8.toFloat x) `shouldBe` Right x + + prop "Word16 -> Float -> Word16" $ \(x :: Word16) -> + Float.toWord16 (Word16.toFloat x) `shouldBe` Right x + + -- Via Double (Either ViaIntegerErrors pattern) + prop "Int8 -> Double -> Int8" $ \(x :: Int8) -> + Double.toInt8 (Int8.toDouble x) `shouldBe` Right x + + prop "Int16 -> Double -> Int16" $ \(x :: Int16) -> + Double.toInt16 (Int16.toDouble x) `shouldBe` Right x + + prop "Int32 -> Double -> Int32" $ \(x :: Int32) -> + Double.toInt32 (Int32.toDouble x) `shouldBe` Right x + + prop "Word8 -> Double -> Word8" $ \(x :: Word8) -> + Double.toWord8 (Word8.toDouble x) `shouldBe` Right x + + prop "Word16 -> Double -> Word16" $ \(x :: Word16) -> + Double.toWord16 (Word16.toDouble x) `shouldBe` Right x + + prop "Word32 -> Double -> Word32" $ \(x :: Word32) -> + Double.toWord32 (Word32.toDouble x) `shouldBe` Right x + + describe "Fallible narrowing success agrees with fromIntegral" $ do + prop "Int16 -> Int8: success implies fromIntegral match" $ \(x :: Int16) -> + case Int16.toInt8 x of + Just y -> fromIntegral y `shouldBe` x + Nothing -> pure () + + prop "Int32 -> Int16: success implies fromIntegral match" $ \(x :: Int32) -> + case Int32.toInt16 x of + Just y -> fromIntegral y `shouldBe` x + Nothing -> pure () + + prop "Int64 -> Int32: success implies fromIntegral match" $ \(x :: Int64) -> + case Int64.toInt32 x of + Just y -> fromIntegral y `shouldBe` x + Nothing -> pure () + + prop "Word16 -> Word8: success implies fromIntegral match" $ \(x :: Word16) -> + case Word16.toWord8 x of + Just y -> fromIntegral y `shouldBe` x + Nothing -> pure () + + prop "Word32 -> Word16: success implies fromIntegral match" $ \(x :: Word32) -> + case Word32.toWord16 x of + Just y -> fromIntegral y `shouldBe` x + Nothing -> pure () + + prop "Word64 -> Word32: success implies fromIntegral match" $ \(x :: Word64) -> + case Word64.toWord32 x of + Just y -> fromIntegral y `shouldBe` x + Nothing -> pure () + + prop "Integer -> Int8: success implies fromIntegral match" $ \(x :: Integer) -> + case Integer.toInt8 x of + Just y -> fromIntegral y `shouldBe` x + Nothing -> pure () + + prop "Integer -> Word8: success implies fromIntegral match" $ \(x :: Integer) -> + case Integer.toWord8 x of + Just y -> fromIntegral y `shouldBe` x + Nothing -> pure () + + prop "Int32 -> Int8: success implies fromIntegral match" $ \(x :: Int32) -> + case Int32.toInt8 x of + Just y -> fromIntegral y `shouldBe` x + Nothing -> pure () + + prop "Int64 -> Int16: success implies fromIntegral match" $ \(x :: Int64) -> + case Int64.toInt16 x of + Just y -> fromIntegral y `shouldBe` x + Nothing -> pure () + + prop "Int64 -> Int8: success implies fromIntegral match" $ \(x :: Int64) -> + case Int64.toInt8 x of + Just y -> fromIntegral y `shouldBe` x + Nothing -> pure () + + prop "Word32 -> Word8: success implies fromIntegral match" $ \(x :: Word32) -> + case Word32.toWord8 x of + Just y -> fromIntegral y `shouldBe` x + Nothing -> pure () + + prop "Word64 -> Word16: success implies fromIntegral match" $ \(x :: Word64) -> + case Word64.toWord16 x of + Just y -> fromIntegral y `shouldBe` x + Nothing -> pure () + + prop "Word64 -> Word8: success implies fromIntegral match" $ \(x :: Word64) -> + case Word64.toWord8 x of + Just y -> fromIntegral y `shouldBe` x + Nothing -> pure () + + describe "toNatural rejects iff negative" $ do + prop "Int8 -> Natural: Left iff x < 0" $ \(x :: Int8) -> + isLeft (Int8.toNatural x) `shouldBe` (x < 0) + + prop "Int16 -> Natural: Left iff x < 0" $ \(x :: Int16) -> + isLeft (Int16.toNatural x) `shouldBe` (x < 0) + + prop "Int32 -> Natural: Left iff x < 0" $ \(x :: Int32) -> + isLeft (Int32.toNatural x) `shouldBe` (x < 0) + + prop "Int64 -> Natural: Left iff x < 0" $ \(x :: Int64) -> + isLeft (Int64.toNatural x) `shouldBe` (x < 0) + + prop "Int -> Natural: Left iff x < 0" $ \(x :: Int) -> + isLeft (Int.toNatural x) `shouldBe` (x < 0) + + prop "Integer -> Natural: Left iff x < 0" $ \(x :: Integer) -> + isLeft (Integer.toNatural x) `shouldBe` (x < 0) + + describe "toNatural success preserves value" $ do + prop "Int64 -> Natural -> Integer round-trips via Integer" $ \(x :: Int64) -> + case Int64.toNatural x of + Right n -> Natural.toInteger n `shouldBe` fromIntegral x + Left _ -> pure () + + prop "Word64 -> Natural -> Integer preserves value" $ \(x :: Word64) -> + Natural.toInteger (Word64.toNatural x) `shouldBe` fromIntegral x + + describe "Float range check is exact at boundary" $ do + prop "Int32 -> Float: succeeds iff abs value <= maxRepFloat" $ \(x :: Int32) -> + let xi = fromIntegral x :: Integer + in isRight (Int32.toFloat x) `shouldBe` + (xi >= -maxRepFloat && xi <= maxRepFloat) + + prop "Word32 -> Float: succeeds iff value <= maxRepFloat" $ \(x :: Word32) -> + isRight (Word32.toFloat x) `shouldBe` + (fromIntegral x <= (maxRepFloat :: Integer)) + + prop "Int64 -> Float: succeeds iff abs value <= maxRepFloat" $ \(x :: Int64) -> + let xi = fromIntegral x :: Integer + in isRight (Int64.toFloat x) `shouldBe` + (xi >= -maxRepFloat && xi <= maxRepFloat) + + prop "Word64 -> Float: succeeds iff value <= maxRepFloat" $ \(x :: Word64) -> + isRight (Word64.toFloat x) `shouldBe` + (fromIntegral x <= (maxRepFloat :: Integer)) + + prop "Integer -> Float: succeeds iff abs value <= maxRepFloat" $ \(x :: Integer) -> + isRight (Integer.toFloat x) `shouldBe` + (x >= -maxRepFloat && x <= maxRepFloat) + + describe "Double range check is exact at boundary" $ do + prop "Int64 -> Double: succeeds iff abs value <= maxRepDouble" $ \(x :: Int64) -> + let xi = fromIntegral x :: Integer + in isRight (Int64.toDouble x) `shouldBe` + (xi >= -maxRepDouble && xi <= maxRepDouble) + + prop "Word64 -> Double: succeeds iff value <= maxRepDouble" $ \(x :: Word64) -> + isRight (Word64.toDouble x) `shouldBe` + (fromIntegral x <= (maxRepDouble :: Integer)) + + prop "Integer -> Double: succeeds iff abs value <= maxRepDouble" $ \(x :: Integer) -> + isRight (Integer.toDouble x) `shouldBe` + (x >= -maxRepDouble && x <= maxRepDouble) + + describe "Path independence: different widening paths agree" $ do + prop "Int8: toInt32 == toInt16 >> Int16.toInt32" $ \(x :: Int8) -> + Int8.toInt32 x `shouldBe` Int16.toInt32 (Int8.toInt16 x) + + prop "Int8: toInt64 == toInt32 >> Int32.toInt64" $ \(x :: Int8) -> + Int8.toInt64 x `shouldBe` Int32.toInt64 (Int8.toInt32 x) + + prop "Int8: toInteger == toInt64 >> Int64.toInteger" $ \(x :: Int8) -> + Int8.toInteger x `shouldBe` Int64.toInteger (Int8.toInt64 x) + + prop "Word8: toWord32 == toWord16 >> Word16.toWord32" $ \(x :: Word8) -> + Word8.toWord32 x `shouldBe` Word16.toWord32 (Word8.toWord16 x) + + prop "Word8: toWord64 == toWord32 >> Word32.toWord64" $ \(x :: Word8) -> + Word8.toWord64 x `shouldBe` Word32.toWord64 (Word8.toWord32 x) + + prop "Word8: toInteger == toWord64 >> Word64.toInteger" $ \(x :: Word8) -> + Word8.toInteger x `shouldBe` Word64.toInteger (Word8.toWord64 x) + + describe "Infallible conversions preserve numeric value (via Integer)" $ do + prop "Int8.toFloat preserves value" $ \(x :: Int8) -> + Int8.toFloat x `shouldBe` fromIntegral x + + prop "Int8.toDouble preserves value" $ \(x :: Int8) -> + Int8.toDouble x `shouldBe` fromIntegral x + + prop "Int16.toFloat preserves value" $ \(x :: Int16) -> + Int16.toFloat x `shouldBe` fromIntegral x + + prop "Int16.toDouble preserves value" $ \(x :: Int16) -> + Int16.toDouble x `shouldBe` fromIntegral x + + prop "Word8.toFloat preserves value" $ \(x :: Word8) -> + Word8.toFloat x `shouldBe` fromIntegral x + + prop "Word8.toDouble preserves value" $ \(x :: Word8) -> + Word8.toDouble x `shouldBe` fromIntegral x + + prop "Word16.toFloat preserves value" $ \(x :: Word16) -> + Word16.toFloat x `shouldBe` fromIntegral x + + prop "Word16.toDouble preserves value" $ \(x :: Word16) -> + Word16.toDouble x `shouldBe` fromIntegral x + + prop "Int32.toDouble preserves value" $ \(x :: Int32) -> + Int32.toDouble x `shouldBe` fromIntegral x + + prop "Word32.toDouble preserves value" $ \(x :: Word32) -> + Word32.toDouble x `shouldBe` fromIntegral x + + describe "Signed-to-unsigned: Nothing iff negative or too large" $ do + prop "Int8 -> Word8: Nothing iff x < 0" $ \(x :: Int8) -> + (Int8.toWord8 x == Nothing) `shouldBe` (x < 0) + + prop "Int16 -> Word16: Nothing iff x < 0" $ \(x :: Int16) -> + (Int16.toWord16 x == Nothing) `shouldBe` (x < 0) + + prop "Int32 -> Word32: Nothing iff x < 0" $ \(x :: Int32) -> + (Int32.toWord32 x == Nothing) `shouldBe` (x < 0) + + prop "Int64 -> Word64: Nothing iff x < 0" $ \(x :: Int64) -> + (Int64.toWord64 x == Nothing) `shouldBe` (x < 0) + + describe "Cross-sign narrowing: exact failure condition" $ do + prop "Int16 -> Word8: Nothing iff x < 0 || x > 255" $ \(x :: Int16) -> + (Int16.toWord8 x == Nothing) `shouldBe` (x < 0 || x > 255) + + prop "Int32 -> Word16: Nothing iff x < 0 || x > 65535" $ \(x :: Int32) -> + (Int32.toWord16 x == Nothing) `shouldBe` (x < 0 || x > 65535) + + prop "Int64 -> Word32: Nothing iff x < 0 || x > 4294967295" $ \(x :: Int64) -> + (Int64.toWord32 x == Nothing) `shouldBe` (x < 0 || x > 4294967295) + + prop "Word16 -> Int8: Nothing iff x > 127" $ \(x :: Word16) -> + (Word16.toInt8 x == Nothing) `shouldBe` (x > 127) + + prop "Word32 -> Int16: Nothing iff x > 32767" $ \(x :: Word32) -> + (Word32.toInt16 x == Nothing) `shouldBe` (x > 32767) + + prop "Word64 -> Int32: Nothing iff x > 2147483647" $ \(x :: Word64) -> + (Word64.toInt32 x == Nothing) `shouldBe` (x > 2147483647) + + describe "Float/Double to integer: exact success condition" $ do + prop "Float -> Integer: succeeds iff finite and whole" $ \(x :: Float) -> + isRight (Float.toInteger x) `shouldBe` isWholeFloat x + + prop "Float -> Int8: succeeds iff finite, whole, in [-128,127]" $ \(x :: Float) -> + let i = truncate x :: Integer + in isRight (Float.toInt8 x) `shouldBe` + (isWholeFloat x && i >= -128 && i <= 127) + + prop "Float -> Word8: succeeds iff finite, whole, in [0,255]" $ \(x :: Float) -> + let i = truncate x :: Integer + in isRight (Float.toWord8 x) `shouldBe` + (isWholeFloat x && i >= 0 && i <= 255) + + prop "Double -> Integer: succeeds iff finite and whole" $ \(x :: Double) -> + isRight (Double.toInteger x) `shouldBe` isWholeDouble x + + prop "Double -> Int8: succeeds iff finite, whole, in [-128,127]" $ \(x :: Double) -> + let i = truncate x :: Integer + in isRight (Double.toInt8 x) `shouldBe` + (isWholeDouble x && i >= -128 && i <= 127) + + prop "Double -> Word8: succeeds iff finite, whole, in [0,255]" $ \(x :: Double) -> + let i = truncate x :: Integer + in isRight (Double.toWord8 x) `shouldBe` + (isWholeDouble x && i >= 0 && i <= 255) + + describe "Integer to Float/Double round-trip via toInteger" $ do + prop "Int32 -> Float -> Integer: success round-trips" $ \(x :: Int32) -> + case Int32.toFloat x of + Right y -> Float.toInteger y `shouldBe` Right (fromIntegral x) + Left _ -> pure () + + prop "Int64 -> Double -> Integer: success round-trips" $ \(x :: Int64) -> + case Int64.toDouble x of + Right y -> Double.toInteger y `shouldBe` Right (fromIntegral x) + Left _ -> pure () + + prop "Word32 -> Float -> Integer: success round-trips" $ \(x :: Word32) -> + case Word32.toFloat x of + Right y -> Float.toInteger y `shouldBe` Right (fromIntegral x) + Left _ -> pure () + + prop "Word64 -> Double -> Integer: success round-trips" $ \(x :: Word64) -> + case Word64.toDouble x of + Right y -> Double.toInteger y `shouldBe` Right (fromIntegral x) + Left _ -> pure () + + describe "Float to Double round-trip" $ do + prop "Float -> Double -> Float preserves value" $ \(x :: Float) -> + let y = Double.toFloat (Float.toDouble x) + in if isNaN x + then y `shouldSatisfy` isNaN + else y `shouldBe` x + +maxRepFloat :: Num a => a +maxRepFloat = 16777215 + +maxRepDouble :: Num a => a +maxRepDouble = 9007199254740991 + +isLeft :: Either a b -> Bool +isLeft (Left _) = True +isLeft (Right _) = False + +isRight :: Either a b -> Bool +isRight (Right _) = True +isRight (Left _) = False + +isWholeFloat :: Float -> Bool +isWholeFloat x = not (isNaN x) && not (isInfinite x) + && x == fromIntegral (truncate x :: Integer) + +isWholeDouble :: Double -> Bool +isWholeDouble x = not (isNaN x) && not (isInfinite x) + && x == fromIntegral (truncate x :: Integer) diff --git a/test/Test/Convert/RatioSpec.hs b/test/Test/Convert/RatioSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/RatioSpec.hs @@ -0,0 +1,35 @@ +module Test.Convert.RatioSpec (spec) where + +import Test.Hspec +import Data.Ratio ((%)) +import qualified Unwitch.Convert.Ratio as Ratio + +spec :: Spec +spec = describe "Unwitch.Convert.Ratio" $ do + + describe "fromIntegralToRatio" $ do + it "wraps integer as ratio with denominator 1" $ + Ratio.fromIntegralToRatio (5 :: Integer) `shouldBe` (5 % 1) + it "wraps zero" $ + Ratio.fromIntegralToRatio (0 :: Integer) `shouldBe` (0 % 1) + it "wraps negative" $ + Ratio.fromIntegralToRatio ((-3) :: Integer) `shouldBe` ((-3) % 1) + + describe "unwrapIfDenominatorOne" $ do + it "round-trips with fromIntegralToRatio" $ + Ratio.unwrapIfDenominatorOne (Ratio.fromIntegralToRatio (7 :: Integer)) + `shouldBe` Just 7 + it "rejects non-unit denominator" $ + Ratio.unwrapIfDenominatorOne (3 % 2 :: Rational) `shouldBe` Nothing + + describe "toFloat" $ do + it "converts simple rational" $ + Ratio.toFloat (3 % 2) `shouldBe` (1.5 :: Float) + it "converts integer rational" $ + Ratio.toFloat (4 % 1) `shouldBe` (4.0 :: Float) + + describe "toDouble" $ do + it "converts simple rational" $ + Ratio.toDouble (3 % 2) `shouldBe` (1.5 :: Double) + it "converts integer rational" $ + Ratio.toDouble (4 % 1) `shouldBe` (4.0 :: Double) diff --git a/test/Test/Convert/ShortByteStringSpec.hs b/test/Test/Convert/ShortByteStringSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/ShortByteStringSpec.hs @@ -0,0 +1,22 @@ +module Test.Convert.ShortByteStringSpec (spec) where + +import Test.Hspec +import Data.ByteString.Short qualified as SBS +import Data.Word (Word8) +import qualified Unwitch.Convert.ShortByteString as ShortByteString +import qualified Unwitch.Convert.ByteString as ByteString + +spec :: Spec +spec = describe "Unwitch.Convert.ShortByteString" $ do + + describe "toByteString round-trip" $ + it "round-trips with ByteString.toShortByteString" $ + let sbs = SBS.pack [5, 10, 15] + in ByteString.toShortByteString (ShortByteString.toByteString sbs) `shouldBe` sbs + + describe "toWord8s / fromWord8s" $ do + it "round-trips" $ + let ws = [100, 200, 255] :: [Word8] + in ShortByteString.toWord8s (ShortByteString.fromWord8s ws) `shouldBe` ws + it "empty list" $ + ShortByteString.toWord8s (ShortByteString.fromWord8s []) `shouldBe` ([] :: [Word8]) diff --git a/test/Test/Convert/TextSpec.hs b/test/Test/Convert/TextSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/TextSpec.hs @@ -0,0 +1,68 @@ +module Test.Convert.TextSpec (spec) where + +import Test.Hspec +import Data.Text qualified as T +import qualified Unwitch.Convert.Text as Text +import qualified Unwitch.Convert.LazyText as LazyText +import qualified Unwitch.Convert.ByteString as ByteString + +spec :: Spec +spec = describe "Unwitch.Convert.Text" $ do + + describe "toLazyText / toText round-trip" $ + it "round-trips" $ + let t = T.pack "hello world" + in LazyText.toText (Text.toLazyText t) `shouldBe` t + + describe "toString / fromString" $ do + it "round-trips" $ + let s = "test string" + in Text.toString (Text.fromString s) `shouldBe` s + it "handles unicode" $ + let s = "\x00E9\x00FC\x00F1" + in Text.toString (Text.fromString s) `shouldBe` s + + describe "toByteStringUtf8" $ do + it "encodes ASCII" $ + Text.toByteStringUtf8 "hello" `shouldBe` "hello" + it "round-trips with ByteString.toTextUtf8" $ + let t = T.pack "caf\x00E9" + in ByteString.toTextUtf8 (Text.toByteStringUtf8 t) `shouldBe` Right t + + describe "toByteStringUtf16LE" $ + it "produces valid UTF-16LE output" $ + let t = T.pack "A" + bs = Text.toByteStringUtf16LE t + in ByteString.toTextUtf16LE bs `shouldBe` Right t + + describe "toByteStringUtf16BE" $ + it "produces valid UTF-16BE output" $ + let t = T.pack "B" + bs = Text.toByteStringUtf16BE t + in ByteString.toTextUtf16BE bs `shouldBe` Right t + + describe "toByteStringUtf32LE" $ + it "produces valid UTF-32LE output" $ + let t = T.pack "C" + bs = Text.toByteStringUtf32LE t + in ByteString.toTextUtf32LE bs `shouldBe` Right t + + describe "toByteStringUtf32BE" $ + it "produces valid UTF-32BE output" $ + let t = T.pack "D" + bs = Text.toByteStringUtf32BE t + in ByteString.toTextUtf32BE bs `shouldBe` Right t + + describe "toByteStringLatin1" $ do + it "succeeds for ASCII text" $ + Text.toByteStringLatin1 "hello" `shouldSatisfy` \case + Just _ -> True + Nothing -> False + it "succeeds for Latin1 range chars" $ + let t = T.pack "\x00E9\x00FC" + in case Text.toByteStringLatin1 t of + Just bs -> ByteString.toTextLatin1 bs `shouldBe` t + Nothing -> expectationFailure "expected Just" + it "fails for chars above 0xFF" $ + let t = T.pack "\x0100" -- Latin Extended-A + in Text.toByteStringLatin1 t `shouldBe` Nothing diff --git a/test/Test/Convert/UnboxedSpec.hs b/test/Test/Convert/UnboxedSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/UnboxedSpec.hs @@ -0,0 +1,154 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Test.Convert.UnboxedSpec + ( spec + ) +where + +import Test.Hspec +import Test.Hspec.QuickCheck (prop) + +import qualified Unwitch.Convert.Integer as Integer +import qualified Unwitch.Convert.Int as Int +import qualified Unwitch.Convert.Int8 as Int8 +import qualified Unwitch.Convert.Int16 as Int16 +import qualified Unwitch.Convert.Int32 as Int32 +import qualified Unwitch.Convert.Int64 as Int64 +import qualified Unwitch.Convert.Word as Word +import qualified Unwitch.Convert.Word8 as Word8 +import qualified Unwitch.Convert.Word16 as Word16 +import qualified Unwitch.Convert.Word32 as Word32 +import qualified Unwitch.Convert.Word64 as Word64 +import qualified Unwitch.Convert.Natural as Natural +import qualified Unwitch.Convert.Char as Char +import Data.Int +import Data.Word +import Numeric.Natural (Natural) + +spec :: Spec +spec = describe "Unboxed sum variants" $ do + + describe "Integer" $ do + prop "toInt8# agrees with toInt8" $ \(x :: Integer) -> + case Integer.toInt8# x of + (# y | #) -> Integer.toInt8 x `shouldBe` Just y + (# | (# #) #) -> Integer.toInt8 x `shouldBe` Nothing + + prop "toDouble# agrees with toDouble" $ \(x :: Integer) -> + case Integer.toDouble# x of + (# e | #) -> Integer.toDouble x `shouldBe` Left e + (# | y #) -> Integer.toDouble x `shouldBe` Right y + + describe "Int" $ do + prop "toInt8# agrees with toInt8" $ \(x :: Int) -> + case Int.toInt8# x of + (# y | #) -> Int.toInt8 x `shouldBe` Just y + (# | (# #) #) -> Int.toInt8 x `shouldBe` Nothing + + prop "toNatural# agrees with toNatural" $ \(x :: Int) -> + case Int.toNatural# x of + (# e | #) -> Int.toNatural x `shouldBe` Left e + (# | y #) -> Int.toNatural x `shouldBe` Right y + + describe "Int8" $ do + prop "toWord8# agrees with toWord8" $ \(x :: Int8) -> + case Int8.toWord8# x of + (# y | #) -> Int8.toWord8 x `shouldBe` Just y + (# | (# #) #) -> Int8.toWord8 x `shouldBe` Nothing + + prop "toNatural# agrees with toNatural" $ \(x :: Int8) -> + case Int8.toNatural# x of + (# e | #) -> Int8.toNatural x `shouldBe` Left e + (# | y #) -> Int8.toNatural x `shouldBe` Right y + + describe "Int16" $ do + prop "toInt8# agrees with toInt8" $ \(x :: Int16) -> + case Int16.toInt8# x of + (# y | #) -> Int16.toInt8 x `shouldBe` Just y + (# | (# #) #) -> Int16.toInt8 x `shouldBe` Nothing + + describe "Int32" $ do + prop "toInt8# agrees with toInt8" $ \(x :: Int32) -> + case Int32.toInt8# x of + (# y | #) -> Int32.toInt8 x `shouldBe` Just y + (# | (# #) #) -> Int32.toInt8 x `shouldBe` Nothing + + prop "toFloat# agrees with toFloat" $ \(x :: Int32) -> + case Int32.toFloat# x of + (# e | #) -> Int32.toFloat x `shouldBe` Left e + (# | y #) -> Int32.toFloat x `shouldBe` Right y + + describe "Int64" $ do + prop "toInt8# agrees with toInt8" $ \(x :: Int64) -> + case Int64.toInt8# x of + (# y | #) -> Int64.toInt8 x `shouldBe` Just y + (# | (# #) #) -> Int64.toInt8 x `shouldBe` Nothing + + prop "toDouble# agrees with toDouble" $ \(x :: Int64) -> + case Int64.toDouble# x of + (# e | #) -> Int64.toDouble x `shouldBe` Left e + (# | y #) -> Int64.toDouble x `shouldBe` Right y + + describe "Word" $ do + prop "toWord8# agrees with toWord8" $ \(x :: Word) -> + case Word.toWord8# x of + (# y | #) -> Word.toWord8 x `shouldBe` Just y + (# | (# #) #) -> Word.toWord8 x `shouldBe` Nothing + + prop "toFloat# agrees with toFloat" $ \(x :: Word) -> + case Word.toFloat# x of + (# e | #) -> Word.toFloat x `shouldBe` Left e + (# | y #) -> Word.toFloat x `shouldBe` Right y + + describe "Word8" $ do + prop "toInt8# agrees with toInt8" $ \(x :: Word8) -> + case Word8.toInt8# x of + (# y | #) -> Word8.toInt8 x `shouldBe` Just y + (# | (# #) #) -> Word8.toInt8 x `shouldBe` Nothing + + describe "Word16" $ do + prop "toWord8# agrees with toWord8" $ \(x :: Word16) -> + case Word16.toWord8# x of + (# y | #) -> Word16.toWord8 x `shouldBe` Just y + (# | (# #) #) -> Word16.toWord8 x `shouldBe` Nothing + + describe "Word32" $ do + prop "toWord8# agrees with toWord8" $ \(x :: Word32) -> + case Word32.toWord8# x of + (# y | #) -> Word32.toWord8 x `shouldBe` Just y + (# | (# #) #) -> Word32.toWord8 x `shouldBe` Nothing + + prop "toFloat# agrees with toFloat" $ \(x :: Word32) -> + case Word32.toFloat# x of + (# e | #) -> Word32.toFloat x `shouldBe` Left e + (# | y #) -> Word32.toFloat x `shouldBe` Right y + + describe "Word64" $ do + prop "toWord8# agrees with toWord8" $ \(x :: Word64) -> + case Word64.toWord8# x of + (# y | #) -> Word64.toWord8 x `shouldBe` Just y + (# | (# #) #) -> Word64.toWord8 x `shouldBe` Nothing + + prop "toFloat# agrees with toFloat" $ \(x :: Word64) -> + case Word64.toFloat# x of + (# e | #) -> Word64.toFloat x `shouldBe` Left e + (# | y #) -> Word64.toFloat x `shouldBe` Right y + + describe "Natural" $ do + prop "toWord8# agrees with toWord8" $ \(w :: Word) -> + let x = fromIntegral w :: Natural + in case Natural.toWord8# x of + (# y | #) -> Natural.toWord8 x `shouldBe` Just y + (# | (# #) #) -> Natural.toWord8 x `shouldBe` Nothing + + prop "toFloat# agrees with toFloat" $ \(w :: Word) -> + let x = fromIntegral w :: Natural + in case Natural.toFloat# x of + (# e | #) -> Natural.toFloat x `shouldBe` Left e + (# | y #) -> Natural.toFloat x `shouldBe` Right y + + describe "Char" $ do + prop "fromInt# agrees with fromInt" $ \(x :: Int) -> + case Char.fromInt# x of + (# y | #) -> Char.fromInt x `shouldBe` Just y + (# | (# #) #) -> Char.fromInt x `shouldBe` Nothing + diff --git a/test/Test/Convert/Word16Spec.hs b/test/Test/Convert/Word16Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/Word16Spec.hs @@ -0,0 +1,49 @@ +module Test.Convert.Word16Spec (spec) where + +import Test.Hspec +import Data.Int +import Data.Word +import Numeric.Natural (Natural) +import qualified Unwitch.Convert.Word16 as Word16 + +-- Property tests cover: Word16->Word32/64 round-trips, +-- Word16->Word8 narrowing, toFloat/toDouble preserve value. +-- Kept: toWord, toNatural, toInt8, toInt16, toInt32, toInt64, toInt, +-- toInteger (all have no direct property coverage). + +spec :: Spec +spec = describe "Unwitch.Convert.Word16" $ do + + describe "toWord (infallible)" $ + it "widens maxBound" $ + Word16.toWord maxBound `shouldBe` 65535 + + describe "toNatural (infallible)" $ + it "converts maxBound" $ + Word16.toNatural maxBound `shouldBe` (65535 :: Natural) + + describe "toInt8 (fallible)" $ + it "rejects too large" $ + Word16.toInt8 (128 :: Word16) `shouldBe` Nothing + + describe "toInt16 (fallible)" $ do + it "rejects too large" $ + Word16.toInt16 (32768 :: Word16) `shouldBe` Nothing + it "converts in-range" $ + Word16.toInt16 (32767 :: Word16) `shouldBe` Just (32767 :: Int16) + + describe "toInt32 (infallible)" $ + it "widens maxBound" $ + Word16.toInt32 maxBound `shouldBe` 65535 + + describe "toInt64 (infallible)" $ + it "widens maxBound" $ + Word16.toInt64 maxBound `shouldBe` 65535 + + describe "toInt (infallible)" $ + it "widens maxBound" $ + Word16.toInt maxBound `shouldBe` 65535 + + describe "toInteger (infallible)" $ + it "widens maxBound" $ + Word16.toInteger maxBound `shouldBe` 65535 diff --git a/test/Test/Convert/Word32Spec.hs b/test/Test/Convert/Word32Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/Word32Spec.hs @@ -0,0 +1,54 @@ +module Test.Convert.Word32Spec (spec) where + +import Test.Hspec +import Data.Int +import Data.Word +import Numeric.Natural (Natural) +import qualified Unwitch.Convert.Word32 as Word32 + +-- Property tests cover: Word32->Word64 round-trip, +-- Word32->Word16 narrowing, toFloat range check, +-- toDouble preserve value. +-- Kept: toWord8 (no property), toWord, toNatural, toInt8, toInt16, +-- toInt32, toInt64, toInt, toInteger. + +spec :: Spec +spec = describe "Unwitch.Convert.Word32" $ do + + describe "toWord8 (fallible)" $ + it "rejects too large" $ + Word32.toWord8 (256 :: Word32) `shouldBe` Nothing + + describe "toWord (fallible)" $ + it "converts 0" $ + Word32.toWord 0 `shouldBe` Just (0 :: Word) + + describe "toNatural (infallible)" $ + it "converts maxBound" $ + Word32.toNatural maxBound `shouldBe` (4294967295 :: Natural) + + describe "toInt8 (fallible)" $ + it "rejects too large" $ + Word32.toInt8 (200 :: Word32) `shouldBe` Nothing + + describe "toInt16 (fallible)" $ + it "rejects too large" $ + Word32.toInt16 (40000 :: Word32) `shouldBe` Nothing + + describe "toInt32 (fallible)" $ do + it "rejects too large" $ + Word32.toInt32 (2147483648 :: Word32) `shouldBe` Nothing + it "converts at boundary" $ + Word32.toInt32 (2147483647 :: Word32) `shouldBe` Just (2147483647 :: Int32) + + describe "toInt64 (infallible)" $ + it "widens maxBound" $ + Word32.toInt64 maxBound `shouldBe` 4294967295 + + describe "toInt (fallible)" $ + it "converts 0" $ + Word32.toInt 0 `shouldBe` Just (0 :: Int) + + describe "toInteger (infallible)" $ + it "converts maxBound" $ + Word32.toInteger maxBound `shouldBe` 4294967295 diff --git a/test/Test/Convert/Word64Spec.hs b/test/Test/Convert/Word64Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/Word64Spec.hs @@ -0,0 +1,53 @@ +module Test.Convert.Word64Spec (spec) where + +import Test.Hspec +import Data.Int +import Data.Word +import qualified Unwitch.Convert.Word64 as Word64 + +-- Property tests cover: Word64->Word32 narrowing, +-- Word64->Natural->Integer round-trip, +-- toFloat range check, toDouble range check. +-- Kept: toWord8, toWord16, toWord, toInt8, toInt16, toInt32, +-- toInt64, toInt, toInteger (all have no direct property coverage). + +spec :: Spec +spec = describe "Unwitch.Convert.Word64" $ do + + describe "toWord8 (fallible)" $ + it "rejects too large" $ + Word64.toWord8 (256 :: Word64) `shouldBe` Nothing + + describe "toWord16 (fallible)" $ + it "rejects too large" $ + Word64.toWord16 (65536 :: Word64) `shouldBe` Nothing + + describe "toWord (fallible)" $ + it "converts 0" $ + Word64.toWord 0 `shouldBe` Just (0 :: Word) + + describe "toInt8 (fallible)" $ + it "rejects too large" $ + Word64.toInt8 (200 :: Word64) `shouldBe` Nothing + + describe "toInt16 (fallible)" $ + it "rejects too large" $ + Word64.toInt16 (40000 :: Word64) `shouldBe` Nothing + + describe "toInt32 (fallible)" $ + it "rejects too large" $ + Word64.toInt32 (3000000000 :: Word64) `shouldBe` Nothing + + describe "toInt64 (fallible)" $ do + it "rejects too large" $ + Word64.toInt64 (maxBound :: Word64) `shouldBe` Nothing + it "converts at boundary" $ + Word64.toInt64 (9223372036854775807 :: Word64) `shouldBe` Just (9223372036854775807 :: Int64) + + describe "toInt (fallible)" $ + it "converts 0" $ + Word64.toInt 0 `shouldBe` Just (0 :: Int) + + describe "toInteger (infallible)" $ + it "converts maxBound" $ + Word64.toInteger maxBound `shouldBe` 18446744073709551615 diff --git a/test/Test/Convert/Word8Spec.hs b/test/Test/Convert/Word8Spec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/Word8Spec.hs @@ -0,0 +1,38 @@ +module Test.Convert.Word8Spec (spec) where + +import Test.Hspec +import Data.Int +import Data.Word +import Numeric.Natural (Natural) +import qualified Unwitch.Convert.Word8 as Word8 + +-- Property tests cover: Word8->Word16/32/64 round-trips, +-- Word8->Int16/32 round-trips, Word8->Integer path independence, +-- toFloat/toDouble preserve value. +-- Kept: toWord (no property), toNatural (no property), +-- toInt8 (no property), toInt64 (no property), toInt (no property). + +spec :: Spec +spec = describe "Unwitch.Convert.Word8" $ do + + describe "toWord (infallible)" $ + it "widens maxBound" $ + Word8.toWord maxBound `shouldBe` 255 + + describe "toNatural (infallible)" $ + it "converts maxBound" $ + Word8.toNatural maxBound `shouldBe` (255 :: Natural) + + describe "toInt8 (fallible)" $ do + it "rejects too large" $ + Word8.toInt8 (128 :: Word8) `shouldBe` Nothing + it "converts in-range" $ + Word8.toInt8 (127 :: Word8) `shouldBe` Just (127 :: Int8) + + describe "toInt64 (infallible)" $ + it "widens maxBound" $ + Word8.toInt64 maxBound `shouldBe` 255 + + describe "toInt (infallible)" $ + it "widens maxBound" $ + Word8.toInt maxBound `shouldBe` 255 diff --git a/test/Test/Convert/WordSpec.hs b/test/Test/Convert/WordSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Convert/WordSpec.hs @@ -0,0 +1,66 @@ +module Test.Convert.WordSpec (spec) where + +import Test.Hspec +import Data.Int +import Data.Word +import Unwitch.Errors +import qualified Unwitch.Convert.Word as Word + +spec :: Spec +spec = describe "Unwitch.Convert.Word" $ do + + describe "toWord8 (fallible)" $ + it "rejects too large" $ + Word.toWord8 (256 :: Word) `shouldBe` Nothing + + describe "toWord16 (fallible)" $ + it "rejects too large" $ + Word.toWord16 (65536 :: Word) `shouldBe` Nothing + + describe "toWord32 (fallible)" $ + it "converts in-range" $ + Word.toWord32 (100 :: Word) `shouldBe` Just (100 :: Word32) + + describe "toWord64 (infallible)" $ + it "widens maxBound" $ + Word.toWord64 maxBound `shouldBe` fromIntegral (maxBound :: Word) + + describe "toNatural (infallible)" $ + it "converts maxBound" $ + Word.toNatural maxBound `shouldBe` fromIntegral (maxBound :: Word) + + describe "toInt8 (fallible)" $ + it "rejects too large" $ + Word.toInt8 (200 :: Word) `shouldBe` Nothing + + describe "toInt16 (fallible)" $ + it "rejects too large" $ + Word.toInt16 (40000 :: Word) `shouldBe` Nothing + + describe "toInt32 (fallible)" $ + it "rejects too large" $ + Word.toInt32 (3000000000 :: Word) `shouldBe` Nothing + + describe "toInt64 (fallible)" $ + it "converts in-range" $ + Word.toInt64 (100 :: Word) `shouldBe` Just (100 :: Int64) + + describe "toInt (fallible)" $ do + it "rejects maxBound" $ + Word.toInt (maxBound :: Word) `shouldBe` Nothing + it "converts 0" $ + Word.toInt 0 `shouldBe` Just (0 :: Int) + + describe "toInteger (infallible)" $ + it "converts maxBound" $ + Word.toInteger maxBound `shouldBe` fromIntegral (maxBound :: Word) + + describe "toFloat (range-checked)" $ do + it "converts in-range" $ + Word.toFloat (16777215 :: Word) `shouldBe` Right 16777215.0 + it "rejects too large" $ + Word.toFloat (16777216 :: Word) `shouldBe` Left Overflow + + describe "toDouble (range-checked)" $ + it "converts 0" $ + Word.toDouble 0 `shouldBe` Right (0.0 :: Double) diff --git a/unwitch.cabal b/unwitch.cabal new file mode 100644 --- /dev/null +++ b/unwitch.cabal @@ -0,0 +1,151 @@ +cabal-version: 3.0 + +name: unwitch +version: 1.0.0 +homepage: https://github.com/jappeace/haskell-unwitch-project#readme +synopsis: converts between primitives +description: + Removes the magic from witch. + This provides safe conversions like witch does. + But it [doesn't](https://jappie.me/death-to-type-classes.html) use [type classes](https://www.haskellforall.com/2012/05/scrap-your-type-classes.html) + or exceptions. + This has a couple of advantages: + + 1. No need to use type application for function selection. + 2. Functions get names that describe what they do. + This allows ctags to work as well. + 3. No trouble with orphans. + 4. Custom errors instead of the prelude based ones allow client + code to recover with typesafety even on partial conversions. +bug-reports: https://github.com/jappeace/haskell-unwitch-project/issues +author: Jappie Klooster +maintainer: jappieklooster@hotmail.com +copyright: 2020 Jappie Klooster +license: MIT +category: Data +license-file: LICENSE +build-type: Simple +extra-source-files: + Readme.md + LICENSE +extra-doc-files: + Changelog.md + +source-repository head + type: git + location: https://github.com/jappeace/haskell-unwitch-project + +common common-options + default-extensions: + EmptyCase + FlexibleContexts + FlexibleInstances + InstanceSigs + MultiParamTypeClasses + LambdaCase + MultiWayIf + NamedFieldPuns + TupleSections + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveLift + DeriveTraversable + DerivingStrategies + GeneralizedNewtypeDeriving + StandaloneDeriving + OverloadedStrings + TypeApplications + NumericUnderscores + ImportQualifiedPost + UnboxedSums + UnboxedTuples + MagicHash + + ghc-options: + -Wall -Wincomplete-uni-patterns + -Wincomplete-record-updates -Widentities -Wredundant-constraints + -Wcpp-undef -fwarn-tabs -Wpartial-fields + -fdefer-diagnostics -Wunused-packages + -fenable-th-splice-warnings + -fno-omit-yields + + build-depends: + base >=4.18.0.0 && <4.23, + ghc-bignum < 2, + bytestring >= 0.10 && < 0.13, + text >= 1.2 && < 2.2 + + default-language: Haskell2010 + +library + import: common-options + exposed-modules: + Unwitch.Convert.ByteString + Unwitch.Convert.Char + Unwitch.Convert.Complex + Unwitch.Convert.Double + Unwitch.Convert.Fixed + Unwitch.Convert.Float + Unwitch.Convert.Int + Unwitch.Convert.Int8 + Unwitch.Convert.Int16 + Unwitch.Convert.Int32 + Unwitch.Convert.Int64 + Unwitch.Convert.Integer + Unwitch.Convert.LazyByteString + Unwitch.Convert.LazyText + Unwitch.Convert.Natural + Unwitch.Convert.Ratio + Unwitch.Convert.ShortByteString + Unwitch.Convert.Text + Unwitch.Convert.Word + Unwitch.Convert.Word8 + Unwitch.Convert.Word16 + Unwitch.Convert.Word32 + Unwitch.Convert.Word64 + Unwitch.Errors + other-modules: + Unwitch + Unwitch.Constant + Unwitch.TryEvaluate + hs-source-dirs: + src + +test-suite unit + import: common-options + type: exitcode-stdio-1.0 + main-is: Spec.hs + ghc-options: -threaded -rtsopts "-with-rtsopts=-N" -Wno-unused-packages + other-modules: + Test.Convert.ByteStringSpec + Test.Convert.Int8Spec + Test.Convert.Int16Spec + Test.Convert.Int32Spec + Test.Convert.Int64Spec + Test.Convert.IntSpec + Test.Convert.LazyByteStringSpec + Test.Convert.LazyTextSpec + Test.Convert.Word8Spec + Test.Convert.Word16Spec + Test.Convert.Word32Spec + Test.Convert.Word64Spec + Test.Convert.WordSpec + Test.Convert.NaturalSpec + Test.Convert.IntegerSpec + Test.Convert.FloatSpec + Test.Convert.DoubleSpec + Test.Convert.PropertySpec + Test.Convert.RatioSpec + Test.Convert.FixedSpec + Test.Convert.ComplexSpec + Test.Convert.CharSpec + Test.Convert.ShortByteStringSpec + Test.Convert.TextSpec + Test.Convert.UnboxedSpec + hs-source-dirs: + test + build-depends: + hspec, + hspec-core, + unwitch