validity 0.9.0.3 → 0.10.0.0
raw patch · 3 files changed
+85/−41 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
- src/Data/Validity.hs +35/−15
- test/Data/ValiditySpec.hs +48/−24
- validity.cabal +2/−2
src/Data/Validity.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeOperators #-} #if MIN_VERSION_base(4,9,0) {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}@@ -96,12 +97,16 @@ #endif import Data.Bits ((.&.)) import Data.Char (ord)-import Data.Int (Int16, Int32, Int64, Int8)+import Data.Int (Int64)+import GHC.Int (Int8(..), Int16(..), Int32(..))+import GHC.Exts (isTrue#, (<#), (>=#)) #if MIN_VERSION_base(4,8,0)-import Data.Word (Word16, Word32, Word64, Word8)+import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..)) #else-import Data.Word (Word, Word16, Word32, Word64, Word8)+import Data.Word (Word)+import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..)) #endif+import GHC.Exts (ltWord#) import GHC.Generics #if MIN_VERSION_base(4,8,0) import GHC.Natural@@ -410,17 +415,29 @@ instance Validity Int where validate = trivialValidation --- | Trivially valid+-- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. instance Validity Int8 where- validate = trivialValidation+ 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#)+ ] --- | Trivially valid+-- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. instance Validity Int16 where- validate = trivialValidation+ 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#)+ ] --- | Trivially valid+-- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. instance Validity Int32 where- validate = trivialValidation+ 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#)+ ] -- | Trivially valid instance Validity Int64 where@@ -430,17 +447,20 @@ instance Validity Word where validate = trivialValidation --- | Trivially valid+-- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. instance Validity Word8 where- validate = trivialValidation+ validate (W8# w#) =+ declare "The contained integer is smaller than 2^8 = 256" $ isTrue# (w# `ltWord#` 256##) --- | Trivially valid+-- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. instance Validity Word16 where- validate = trivialValidation+ validate (W16# w#) =+ declare "The contained integer is smaller than 2^16 = 65536" $ isTrue# (w# `ltWord#` 65536##) --- | Trivially valid+-- | NOT trivially valid on GHC because small number types are represented using a 64bit structure underneath. instance Validity Word32 where- validate = trivialValidation+ validate (W32# w#) =+ declare "The contained integer is smaller than 2^32 = 4294967296" $ isTrue# (w# `ltWord#` 4294967296##) -- | Trivially valid instance Validity Word64 where
test/Data/ValiditySpec.hs view
@@ -1,31 +1,35 @@ {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-} +-- {-# LANGUAGE CPP #-}+ module Data.ValiditySpec- ( spec- ) where+ ( spec,+ )+where -import GHC.Generics (Generic)-#if !MIN_VERSION_base(4,7,0)-import Data.Monoid-#endif+-- #if !MIN_VERSION_base(4,7,0)+-- import Data.Monoid+-- #endif import Data.Maybe import Data.Validity-import GHC.Real (Ratio(..), infinity, notANumber)-+import GHC.Generics (Generic)+import GHC.Int (Int16 (..), Int32 (..), Int8 (..))+import GHC.Real (Ratio (..), infinity, notANumber)+import GHC.Word (Word16 (..), Word32 (..), Word8 (..)) import Test.Hspec -newtype NormalisedRatio a =- NormalisedRatio (Ratio a)+newtype NormalisedRatio a+ = NormalisedRatio (Ratio a) deriving (Show, Eq, Generic) instance (Validity a, Integral a) => Validity (NormalisedRatio a) where validate nr@(NormalisedRatio r) = mconcat- [ genericValidate nr- , validateRatioNotNaN r- , validateRatioNotInfinite r- , validateRatioNormalised r+ [ genericValidate nr,+ validateRatioNotNaN r,+ validateRatioNotInfinite r,+ validateRatioNormalised r ] data Wrong@@ -39,14 +43,30 @@ Wrong -> invalid "Wrong" Fine -> valid -data GeneratedValidity =- G Rational Rational+data GeneratedValidity+ = G Rational Rational deriving (Show, Eq, Generic) instance Validity GeneratedValidity spec :: Spec spec = do+ describe "Small numbers" $ do+ describe "Validity Int8" $ do+ 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 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 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 Word# 300 is invalid" $ isValid (W8# 300##) `shouldBe` False+ describe "Validity Word16" $ do+ it "Says that Word# 80000 is invalid" $ isValid (W16# 80000##) `shouldBe` False+ describe "Validity Word32" $ do+ 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@@ -59,16 +79,20 @@ 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- it "says that minBound is valid" $ NormalisedRatio (minBound :% 1 :: Ratio Int) `shouldSatisfy` isValid- it "says that maxBound is valid" $ NormalisedRatio (maxBound :% 1 :: Ratio Int) `shouldSatisfy` isValid- it "says that maxBound / minBound is invalid" $ NormalisedRatio (maxBound :% minBound :: Ratio Int) `shouldSatisfy` (not . isValid)- it "says that minBound / maxBound is invalid" $ NormalisedRatio (minBound :% maxBound :: Ratio Int) `shouldSatisfy` (not . isValid)-- it "says that minBound / 2957808295740799111 is valid" $ NormalisedRatio (minBound :% (2957808295740799111) :: Ratio Int) `shouldSatisfy` isValid+ it "says that minBound is valid" $+ NormalisedRatio (minBound :% 1 :: Ratio Int) `shouldSatisfy` isValid+ it "says that maxBound is valid" $+ NormalisedRatio (maxBound :% 1 :: Ratio Int) `shouldSatisfy` isValid+ it "says that maxBound / minBound is invalid" $+ NormalisedRatio (maxBound :% minBound :: Ratio Int) `shouldSatisfy` (not . isValid)+ it "says that minBound / maxBound is invalid" $+ NormalisedRatio (minBound :% maxBound :: Ratio Int) `shouldSatisfy` (not . isValid)+ it "says that minBound / 2957808295740799111 is valid" $+ NormalisedRatio (minBound :% (2957808295740799111) :: Ratio Int) `shouldSatisfy` isValid describe "NormalisedRatio" $ do it "says that NaN is invalid" $ NormalisedRatio notANumber `shouldSatisfy` (not . isValid) it "says that +Inf is invalid" $ NormalisedRatio infinity `shouldSatisfy` (not . isValid)- it "says that -Inf is invalid" $ NormalisedRatio (-infinity) `shouldSatisfy` (not . isValid)+ it "says that -Inf is invalid" $ NormalisedRatio (- infinity) `shouldSatisfy` (not . isValid) it "says that these non-normalised numbers are invalid" $ do NormalisedRatio ((5 :: Integer) :% 5) `shouldSatisfy` (not . isValid) NormalisedRatio ((1 :: Integer) :% (-5)) `shouldSatisfy` (not . isValid)
validity.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: d006c09ce2c1b3a5b9614851314390ed87a2dd35f3304de883115ca80df6a853+-- hash: 1ec9a779808bae72c15d0e6503515a33bc316727328b1986713451d1985d915d name: validity-version: 0.9.0.3+version: 0.10.0.0 synopsis: Validity typeclass description: For more info, see <https://github.com/NorfairKing/validity the readme>. .