diff --git a/src/Data/Validity.hs b/src/Data/Validity.hs --- a/src/Data/Validity.hs +++ b/src/Data/Validity.hs @@ -99,7 +99,7 @@ import Data.Char (ord) import Data.Int (Int64) import GHC.Int (Int8(..), Int16(..), Int32(..)) -import GHC.Exts (isTrue#, (<#), (>=#)) +import GHC.Exts (Char(..), ord#, isTrue#, (<=#), (>=#), (<#), (>=#)) #if MIN_VERSION_base(4,8,0) import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..)) #else @@ -402,7 +402,10 @@ -- | Trivially valid instance Validity Char where - validate = trivialValidation + validate (C# c#) = mconcat + [ declare "The contained value is positive" $ isTrue# (ord# c# >=# 0#) + , declare "The contained value is smaller than 0x10FFFF = 1114111" $ isTrue# (ord# c# <=# 1114111#) + ] validateCharNotUtf16SurrogateCodePoint :: Char -> Validation validateCharNotUtf16SurrogateCodePoint c = @@ -420,7 +423,7 @@ validate (I8# i#) = mconcat [ declare "The contained integer is smaller than 2^7 = 128" $ isTrue# (i# <# 128#) - , declare "The contained integer is greater than or equal to -128" $ isTrue# (i# >=# -128#) + , declare "The contained integer is greater than or equal to -2^7 = -128" $ isTrue# (i# >=# -128#) ] -- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. @@ -428,7 +431,7 @@ validate (I16# i#) = mconcat [ declare "The contained integer is smaller than 2^15 = 32768" $ isTrue# (i# <# 32768#) - , declare "The contained integer is greater than or equal to -32768" $ isTrue# (i# >=# -32768#) + , declare "The contained integer is greater than or equal to -2^15 = -32768" $ isTrue# (i# >=# -32768#) ] -- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. @@ -436,7 +439,7 @@ validate (I32# i#) = mconcat [ declare "The contained integer is smaller than 2^31 = 2147483648" $ isTrue# (i# <# 2147483648#) - , declare "The contained integer is greater than or equal to -2147483648" $ isTrue# (i# >=# -2147483648#) + , declare "The contained integer is greater than or equal to -2^31 = -2147483648" $ isTrue# (i# >=# -2147483648#) ] -- | Trivially valid diff --git a/test/Data/ValiditySpec.hs b/test/Data/ValiditySpec.hs --- a/test/Data/ValiditySpec.hs +++ b/test/Data/ValiditySpec.hs @@ -13,6 +13,7 @@ -- #endif import Data.Maybe import Data.Validity +import GHC.Exts (Char (..), chr#) import GHC.Generics (Generic) import GHC.Int (Int16 (..), Int32 (..), Int8 (..)) import GHC.Real (Ratio (..), infinity, notANumber) @@ -53,29 +54,50 @@ spec = do describe "Small numbers" $ do describe "Validity Int8" $ do + it "Says that minBound is valid" $ isValid (minBound :: Int8) `shouldBe` True + it "Says that maxBound is valid" $ isValid (maxBound :: Int8) `shouldBe` True it "Says that Int# 200 is invalid" $ isValid (I8# 200#) `shouldBe` False it "Says that Int# -200 is invalid" $ isValid (I8# (-200#)) `shouldBe` False describe "Validity Int16" $ do + it "Says that minBound is valid" $ isValid (minBound :: Int16) `shouldBe` True + it "Says that maxBound is valid" $ isValid (maxBound :: Int16) `shouldBe` True it "Says that Int# 4000 is invalid" $ isValid (I16# 40000#) `shouldBe` False it "Says that Int# -4000 is invalid" $ isValid (I16# (-40000#)) `shouldBe` False describe "Validity Int32" $ do + it "Says that minBound is valid" $ isValid (minBound :: Int32) `shouldBe` True + it "Says that maxBound is valid" $ isValid (maxBound :: Int32) `shouldBe` True it "Says that Int# 2200000000 is invalid" $ isValid (I32# 2200000000#) `shouldBe` False it "Says that Int# -2200000000 is invalid" $ isValid (I32# (-2200000000#)) `shouldBe` False describe "Validity Word8" $ do + it "Says that minBound is valid" $ isValid (minBound :: Word8) `shouldBe` True + it "Says that maxBound is valid" $ isValid (maxBound :: Word8) `shouldBe` True it "Says that Word# 300 is invalid" $ isValid (W8# 300##) `shouldBe` False describe "Validity Word16" $ do + it "Says that minBound is valid" $ isValid (minBound :: Word16) `shouldBe` True + it "Says that maxBound is valid" $ isValid (maxBound :: Word16) `shouldBe` True it "Says that Word# 80000 is invalid" $ isValid (W16# 80000##) `shouldBe` False describe "Validity Word32" $ do + it "Says that minBound is valid" $ isValid (minBound :: Word32) `shouldBe` True + it "Says that maxBound is valid" $ isValid (maxBound :: Word32) `shouldBe` True it "Says that Word# 4800000000 is invalid" $ isValid (W32# 4800000000##) `shouldBe` False - describe "Weird Chars" $ do - describe "isUtf16SurrogateCodePoint" $ do - it "Says that a is a valid char" $ isUtf16SurrogateCodePoint 'a' `shouldBe` False - it "Says that \\55810 is an invalid char" $ isUtf16SurrogateCodePoint '\55810' `shouldBe` True - describe "validateCharNotUtf16SurrogateCodePoint" $ do - it "Says that a is a valid char" $ - prettyValidation (validateCharNotUtf16SurrogateCodePoint 'a') `shouldSatisfy` isNothing - it "Says that \\55810 is an invalid char" $ - prettyValidation (validateCharNotUtf16SurrogateCodePoint '\55810') `shouldSatisfy` isJust + describe "Chars" $ do + describe "Small" $ do + describe "Validity Char" $ do + it "Says that minBound is valid" $ isValid (minBound :: Char) `shouldBe` True + it "Says that maxBound is valid" $ isValid (maxBound :: Char) `shouldBe` True + it "Says that 2147483647 is invalid" $ isValid (C# (chr# 2147483647#)) `shouldBe` False + it "Says that a negative char is invalid" $ isValid (C# (chr# -1#)) `shouldBe` False + it "Says that a very positive char is invalid" $ isValid (C# (chr# 9223372036854775807#)) `shouldBe` False + it "Says that a very negative char is invalid" $ isValid (C# (chr# -9223372036854775808#)) `shouldBe` False + describe "Weird" $ do + describe "isUtf16SurrogateCodePoint" $ do + it "Says that a is a valid char" $ isUtf16SurrogateCodePoint 'a' `shouldBe` False + it "Says that \\55810 is an invalid char" $ isUtf16SurrogateCodePoint '\55810' `shouldBe` True + describe "validateCharNotUtf16SurrogateCodePoint" $ do + it "Says that a is a valid char" $ + prettyValidation (validateCharNotUtf16SurrogateCodePoint 'a') `shouldSatisfy` isNothing + it "Says that \\55810 is an invalid char" $ + prettyValidation (validateCharNotUtf16SurrogateCodePoint '\55810') `shouldSatisfy` isJust describe "Ratio" $ do it "says that 0 is valid" $ NormalisedRatio (0 :% 1 :: Ratio Int) `shouldSatisfy` isValid it "says that 1 is valid" $ NormalisedRatio (1 :% 1 :: Ratio Int) `shouldSatisfy` isValid diff --git a/validity.cabal b/validity.cabal --- a/validity.cabal +++ b/validity.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 1ec9a779808bae72c15d0e6503515a33bc316727328b1986713451d1985d915d +-- hash: 6e3da519f8ddc7a538070f618f28ca85aa221ce124f13eae8d806fe81e827a0e name: validity -version: 0.10.0.0 +version: 0.11.0.0 synopsis: Validity typeclass description: For more info, see . .